diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/BUGS gcc-2.95/gcc/f/BUGS *** egcs-1.1.2/gcc/f/BUGS Sat Mar 13 07:22:37 1999 --- gcc-2.95/gcc/f/BUGS Sat Jul 17 08:41:22 1999 *************** *** 1,59 **** ! This file lists known bugs in the GNU Fortran compiler. Copyright (C) ! 1995, 1996 Free Software Foundation, Inc. You may copy, distribute, ! and modify it freely as long as you preserve this copyright notice and ! permission notice. ! Bugs in GNU Fortran ! ******************* This section identifies bugs that `g77' *users* might run into in ! the `egcs'-1.1.2 version of `g77'. This includes bugs that are ! actually in the `gcc' back end (GBE) or in `libf2c', because those sets ! of code are at least somewhat under the control of (and necessarily ! intertwined with) `g77', so it isn't worth separating them out. For information on bugs in *other* versions of `g77', see ! `egcs/gcc/f/NEWS'. An online, "live" version of this document (derived directly from ! the up-to-date mainline version of `g77' within `egcs') is available at ! `http://egcs.cygnus.com/onlinedocs/g77_bugs.html'. For information on bugs that might afflict people who configure, port, build, and install `g77', see "Problems Installing" in `egcs/gcc/f/INSTALL'. ! * `g77' generates bad code for assignments, or other conversions, of ! `REAL' or `COMPLEX' constant expressions to type `INTEGER(KIND=2)' ! (often referred to as `INTEGER*8'). ! ! For example, `INTEGER*8 J; J = 4E10' is miscompiled on some ! systems--the wrong value is stored in J. ! ! * The `IDate' Intrinsic (VXT) fails to return the year in the ! documented, non-Y2K-compliant range of 0-99, instead returning 100 ! for the year 2000. ! ! * Year 2000 (Y2K) compliance information is missing from the ! documentation. ! ! * `g77' crashes when compiling I/O statements using keywords that ! define `INTEGER' values, such as `IOSTAT=J', where J is other than ! default `INTEGER' (such as `INTEGER*2'). ! ! * The `-ax' option is not obeyed when compiling Fortran programs. ! (It is not passed to the `f771' driver.) ! ! * `g77' fails to warn about a reference to a function when the ! corresponding *subsequent* function program unit disagrees with ! the reference concerning the type of the function. ! ! * Automatic arrays possibly aren't working on HP-UX systems, at ! least in HP-UX version 10.20. Writing into them apparently causes ! over-writing of statically declared data in the main program. ! This probably means the arrays themselves are being ! under-allocated, or pointers to them being improperly handled, ! e.g. not passed to other procedures as they should be. * `g77' fails to warn about use of a "live" iterative-DO variable as an implied-DO variable in a `WRITE' or `PRINT' statement (although --- 1,46 ---- ! *Note:* This file is automatically generated from the files ! `bugs0.texi' and `bugs.texi'. `BUGS' is *not* a source file, although ! it is normally included within source distributions. ! ! This file lists known bugs in the GCC-2.95 version of the GNU ! Fortran compiler. Copyright (C) 1995-1999 Free Software Foundation, ! Inc. You may copy, distribute, and modify it freely as long as you ! preserve this copyright notice and permission notice. ! Known Bugs In GNU Fortran ! ************************* This section identifies bugs that `g77' *users* might run into in ! the GCC-2.95 version of `g77'. This includes bugs that are actually in ! the `gcc' back end (GBE) or in `libf2c', because those sets of code are ! at least somewhat under the control of (and necessarily intertwined ! with) `g77', so it isn't worth separating them out. For information on bugs in *other* versions of `g77', see ! `egcs/gcc/f/NEWS'. There, lists of bugs fixed in various versions of ! `g77' can help determine what bugs existed in prior versions. ! ! *Warning:* The information below is still under development, and ! might not accurately reflect the `g77' code base of which it is a part. ! Efforts are made to keep it somewhat up-to-date, but they are ! particularly concentrated on any version of this information that is ! distributed as part of a *released* `g77'. ! ! In particular, while this information is intended to apply to the ! GCC-2.95 version of `g77', only an official *release* of that version ! is expected to contain documentation that is most consistent with the ! `g77' product in that version. An online, "live" version of this document (derived directly from ! the mainline, development version of `g77' within `egcs') is available ! via `http://egcs.cygnus.com/onlinedocs/g77_bugs.html'. Follow the ! "Known Bugs" link. For information on bugs that might afflict people who configure, port, build, and install `g77', see "Problems Installing" in `egcs/gcc/f/INSTALL'. ! The following information was last updated on 1999-06-29: * `g77' fails to warn about use of a "live" iterative-DO variable as an implied-DO variable in a `WRITE' or `PRINT' statement (although *************** port, build, and install `g77', see "Pro *** 147,164 **** 0.6 should solve most or all remaining problems (such as cross-compiling involving 64-bit machines). - * Maintainers of gcc report that the back end definitely has "broken" - support for `COMPLEX' types. Based on their input, it seems many - of the problems affect only the more-general facilities for gcc's - `__complex__' type, such as `__complex__ int' (where the real and - imaginary parts are integers) that GNU Fortran does not use. - - Version 0.5.20 of `g77' works around this problem by not using the - back end's support for `COMPLEX'. The new option - `-fno-emulate-complex' avoids the work-around, reverting to using - the same "broken" mechanism as that used by versions of `g77' - prior to 0.5.20. - * `g77' currently inserts needless padding for things like `COMMON A,IPAD' where `A' is `CHARACTER*1' and `IPAD' is `INTEGER(KIND=1)' on machines like x86, because the back end insists that `IPAD' be --- 134,139 ---- *************** port, build, and install `g77', see "Pro *** 169,201 **** specifications of alignment requirements and preferences for targets, and front ends like `g77' should take advantage of this when it becomes available. - - * The x86 target's `-malign-double' option no longer reliably aligns - double-precision variables and arrays when they are placed in the - stack frame. - - This can significantly reduce the performance of some applications, - even on a run-to-run basis (that is, performance measurements can - vary fairly widely depending on whether frequently used variables - are properly aligned, and that can change from one program run to - the next, even from one procedure call to the next). - - Versions 0.5.22 and earlier of `g77' included a patch to `gcc' - that enabled this, but that patch has been deemed an improper - (probably buggy) one for version 2.8 of `gcc' and for `egcs'. - - Note that version 1.1 of `egcs' aligns double-precision variables - and arrays when they are in static storage even if - `-malign-double' is not specified. - - There is ongoing investigation into how to make `-malign-double' - work properly, also into how to make it unnecessary to get all - double-precision variables and arrays aligned when such alignment - would not violate the relevant specifications for processor and - inter-procedural interfaces. - - For a suite of programs to test double-precision alignment, see - `ftp://alpha.gnu.org/gnu/g77/align/'. * The `libf2c' routines that perform some run-time arithmetic on `COMPLEX' operands were modified circa version 0.5.20 of `g77' to --- 144,149 ---- diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/ChangeLog gcc-2.95/gcc/f/ChangeLog *** egcs-1.1.2/gcc/f/ChangeLog Sat Mar 13 18:38:27 1999 --- gcc-2.95/gcc/f/ChangeLog Thu Jul 29 02:39:10 1999 *************** *** 1,4804 **** ! Sun Mar 14 02:38:07 PST 1999 Jeff Law (law@cygnus.com) ! * egcs-1.1.2 Released. ! 1999-03-13 Craig Burley ! * bugs.texi: Document newly discovered bug (19990313-*.f tests). ! 1999-03-13 Craig Burley ! * bugs.texi: Editorial fixes. ! 1999-03-11 Craig Burley ! * bugs.texi, g77.texi, news.texi: Point to URLs for live ! versions of docs. ! Clarify which versions to which these docs apply. ! Other minor fix-ups. ! 1999-03-05 Craig Burley ! * news.texi: IDATE (VXT) fixed to return year as 0..99. ! ! 1999-03-03 Craig Burley ! * bugs.texi: Update with latest bug-fixes from 1.2. ! Remove fixed bugs. ! 1999-02-26 Craig Burley ! * news.texi: List fixes to Date_and_Time and LStat, plus ! the docs, under a new heading for egcs 1.1.2. ! 1999-02-26 Craig Burley ! * intdoc.in (STAT_func, STAT_subr, ! FSTAT_func, FSTAT_subr, LSTAT_func, LSTAT_subr): ! Properly order array elements. Specify N/A return values. ! 1999-02-26 Craig Burley ! * intdoc.in (DATE_AND_TIME): Explain that VALUES(7) holds ! seconds, and VALUES(8), therefore, the milliseconds. ! 1999-02-26 Craig Burley ! * bugs.texi: Mention bugs known fixed in egcs 1.2 as of now. ! 1999-02-26 Craig Burley ! Fix what evidently remains of these, for 4.4bsd: ! Tue Aug 18 21:41:31 1998 Jeffrey A Law (law@cygnus.com) ! * Make-lang.in: Add several "else true" clauses to deal with lame ! systems. ! 1999-02-25 Andreas Jaeger ! * f/intdoc.in: Add missing `,' after cross references. ! 1999-02-20 Craig Burley ! * g77.texi: Properly attribute Priest document; clarify ! that it is in the .ps version of the Goldberg document. ! 1999-02-18 Craig Burley ! * intdoc.in (LOG10): Fix typo. ! 1999-02-17 Dave Love ! * intdoc.in: Say `common' logarithm for log10. ! 1999-02-15 Craig Burley ! * g77.texi: Change my email address in a couple of places. ! 1999-02-14 Craig Burley ! * version.c: Bump for 1998-10-02 change (forgot to do this ! before). ! 1999-02-14 Craig Burley ! * intdoc.in (LOG10): Fix description. ! 1999-02-14 Craig Burley ! * news.texi: Mention fix for SIGNAL invocation circa egcs-1.1. ! 1999-02-14 Craig Burley ! * intdoc.in (MCLOCK8, TIME8): Warn about lower range on ! 32-bit systems. ! Sat Feb 6 17:17:09 1999 Jeffrey A Law (law@cygnus.com) ! * g77.texi: Update email addresses. ! 1998-11-20 Dave Love ! ! * g77.texi: Assorted minor changes. ! 1998-11-19 Dave Love ! * intdoc.in: Terminate some @xrefs with `,'. ! Mon Nov 9 23:13:30 1998 Jeffrey A Law (law@cygnus.com) ! * g77.texi: Updates from Craig. ! 1998-10-09 Dave Love ! * g77.texi: Various updates. ! 1998-10-02 Dave Love ! * com.c (ffecom_expr_intrinsic_): Fix return type for RAND. ! Fri Oct 2 01:27:06 1998 Kamil Iskra ! * Make-lang.in (f77.install-common): Add missing "else true;". ! Sat Sep 5 23:55:15 1998 Jeffrey A Law (law@cygnus.com) ! * news.texi: Tweaks from Craig. ! ! Tue Sep 1 10:00:21 1998 Craig Burley ! ! * bugs.texi, g77.1, g77.texi, intdoc.in, news.texi: Doc updates ! from Craig. ! ! 1998-08-23 Dave Love ! ! * g77.texi: Increment `version-g77' and fix a few typos. ! ! Tue Aug 11 08:12:14 1998 H.J. Lu (hjl@gnu.org) ! ! * Make-lang.in (g77.o): Touch lang-f77 before checking it. ! ! 1998-08-09 Dave Love ! * Make-lang.in (f/g77.dvi): Replace non-working use of texi2dvi ! with explicit use of tex. ! (f77.mostlyclean): Remove TeX index files. ! * g77install.texi (Prerequisites): Kluge round TeX lossage with ! hyphen in @value in @code. ! Tue Aug 4 16:59:39 1998 Craig Burley ! * com.c (ffecom_convert_narrow_, ffecom_convert_widen_): ! Allow conversion from pointer to same-sized integer, ! to fix invoking SIGNAL as a function. ! 1998-07-26 Dave Love ! * BUGS, INSTALL, NEWS: Rebuilt. ! Sat Jul 25 17:23:55 1998 Craig Burley ! Fix 980615-0.f: ! * stc.c (ffestc_R1229_start): Set info to ANY as well. ! Tue Jul 21 04:33:37 1998 Craig Burley ! * g77spec.c (lang_specific_driver): Return unmolested ! command line when --help seen. ! Comment out code that printed g77-specific --help info. ! Sat Jul 18 19:16:48 1998 Craig Burley ! * lang-options.h: Fix up doc strings. ! Remove the unimplemented -fdcp-intrinsics-* options. ! * str-1t.fin: Change mixed-case spelling of `GoTo' from ! `Goto'. ! Thu Jul 16 13:26:36 1998 Craig Burley ! * com.c (ffecom_finish_symbol_transform_): Revert change ! of 1998-05-23, as it was too aggressive, in that it ! prevented transformation of (used) functions before ! primary code generation. ! 1998-07-15 Dave Love ! * intdoc.texi: Regenerated. ! Mon Jul 13 18:45:06 1998 Craig Burley ! * Make-lang.in (f77.rebuilt): Fix to depend on ! build-dir-based, not source-based, g77.info. ! * g77.texi: Merge docs with 0.5.24. ! * g77install.texi: Ditto. ! Mon Jul 13 18:02:29 1998 Craig Burley ! Cleanups vis-a-vis g77-0.5.24: ! * g77spec.c (lang_specific_driver): Tabify source. ! * top.c (ffe_decode_option): Use fixed macro to set ! internal-checking flag. ! * top.h (ffe_set_is_do_internal_checks): Fix macro. ! Mon Jul 13 17:33:44 1998 Craig Burley ! Cleanups vis-a-vis system.h cutover and g77-0.5.24: ! * Makefile.in (fini.o): Define USE_HCONFIG macro ! so source code doesn't have to. ! * fini.c: Don't define USE_HCONFIG here, since ! source code usually shouldn't care about this. ! * ansify.c: Include stddef.h only if we have it. ! * intdoc.c: Ditto. ! * proj.h: Ditto. ! Mon Jul 13 17:30:29 1998 Nick Clifton ! * lang-options.h: Format changed to work with --help support added ! to gcc/toplev.c ! Mon Jul 13 11:54:03 1998 Craig Burley ! * com.c (ffecom_push_tempvar): Replace kludge that ! munged back-end globals directly with proper calls ! to push_topmost_sequence and pop_topmost_sequence. ! 1998-07-12 Dave Love * version.c: Bump version. ! Sat Jul 11 19:24:32 1998 Craig Burley ! Fix 980616-0.f: ! * equiv.c (ffeequiv_offset_): Don't crash on various ! possible ANY operands. ! Sat Jul 11 18:24:37 1998 Craig Burley ! * com.c (ffecom_expr_) [FFEBLD_opCONTER]: Die if padding ! for constant is non-zero. ! * com.c (__eprintf): Delete this function, it is obsolete. ! 1998-07-09 Dave Love ! * intdoc.in (HOSTNM_func, HOSTNM_subr): Update last change. ! Thu Jul 9 00:45:59 1998 Craig Burley ! Fix debugging of CHARACTER*(*), etc., which requires ! emitting debug info on types like `ftnlen': ! * com.c (ffecom_start_progunit_): Don't bother ! resetting "invented" flag for identifier. ! (ffecom_transform_equiv_): Don't bother zeroing ! "ignored" flag for decl. ! (pushdecl): No longer set "ignored", "used", or ! "suppressed debug" flags for decls having "invented" ! identifiers. ! ! 1998-07-06 Mike Stump ! * Make-lang.in (f77.stage?): Use mv -f instead of just mv so that ! we can move g77.c. ! 1998-07-06 Dave Love ! * intdoc.in (HOSTNM_func, HOSTNM_subr): Note possible need for ! -lsocket. ! 1998-07-05 Dave Love ! * intdoc.in: Add entry for DATE_AND_TIME. ! * intrin.def: Add implementation for DATE_AND_TIME. Make second ! and third args of SYSTEM_CLOCK optional. ! * com.c (ffecom_expr_intrinsic_): New case for DATE_AND_TIME. ! * com-rt.def (FFECOM_gfrtSYSTEM_CLOCK): Call G77_system_clock_0, ! not system_clock_. ! (FFECOM_gfrtDATE_AND_TIME): New DEFGFRT. ! Wed Jul 1 11:19:13 1998 Craig Burley ! Fix 980701-1.f (which was producing "unaligned trap" ! on an Alpha running GNU/Linux, as predicted): ! * equiv.c (ffeequiv_layout_local_): Don't bother ! coping with pre-padding of entire area while building ! it; do that instead after the building is done, and ! do it by modifying only the modulo field. This covers ! the case of alignment stringency being increased without ! lowering the starting offset, unlike the previous changes, ! and even more elegantly than those. ! * target.c (ffetarget_align): Make sure alignments ! are non-zero, just in case. ! ! Mon Jun 29 09:47:33 1998 Craig Burley ! ! Fix 980628-*.f: ! * bld.h: New `pad' field and accessor macros for ! ACCTER, ARRTER, and CONTER ops. ! * bld.c (ffebld_new_accter, ffebld_new_arrter, ! ffebld_new_conter_with_orig): Initialize `pad' field ! to zero. ! * com.c (ffecom_transform_common_): Include initial ! padding (aka modulo aka offset) in size calculation. ! Copy initial padding value into FFE initialization expression ! so the GBE transformation of that expression includes it. ! Make array low bound 0 instead of 1, for consistency. ! (ffecom_transform_equiv_): Include initial ! padding (aka modulo aka offset) in size calculation. ! Copy initial padding value into FFE initialization expression ! so the GBE transformation of that expression includes it. ! Make array low bound 0 instead of 1, for consistency. ! (ffecom_expr_, case FFEBLD_opACCTER): Delete unused `size' ! variable. ! Track destination offset separately, allowing for ! initial padding. ! Don't bother setting initial PURPOSE offset if zero. ! Include initial padding in size calculation. ! (ffecom_expr_, case FFEBLD_opARRTER): Allow for ! initial padding. ! Include initial padding in size calculation. ! Make array low bound 0 instead of 1, for consistency. ! (ffecom_finish_global_): Make array low bound 0 instead ! of 1, for consistency. ! (ffecom_notify_init_storage): Copy `pad' field from old ! ACCTER to new ARRTER. ! (ffecom_notify_init_symbol): Ditto. ! * data.c (ffedata_gather_): Initialize `pad' field in new ! ARRTER to 0. ! (ffedata_value_): Ditto. ! * equiv.c (ffeequiv_layout_local_): When lowering start ! 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 ! padding only the first time its seen. ! If new padding larger than old, update old. ! (ffeglobal_save_common): Use correct type for size throughout. ! * global.h: Use correct type for size throughout. ! (ffeglobal_common_pad): New macro. ! (ffeglobal_pad): Delete this unused and broken macro. ! ! Fri Jun 26 11:54:19 1998 Craig Burley ! ! * g77spec.c (lang_specific_driver): Put `-lg2c' in ! front of any `-lm' that is seen. ! ! Mon Jun 22 23:12:05 1998 H.J. Lu (hjl@gnu.org) ! ! * Make-lang.in (G77STAGESTUFF): Add g77.c. ! ! Mon Jun 15 23:39:24 1998 Craig Burley ! ! * Make-lang.in (f/g77.info): Use -f when removing ! pre-existing Info files, if any. (This rm command ! can go away once makeinfo has been changed to delete ! .info-N files beyond the last one it creates.) ! ! * Make-lang.in ($(srcdir)/f/intdoc.texi): Compile ! using $(INCLUDES) macro to get the new hconfig.h ! and system.h headers. ! ! Mon Jun 15 22:21:57 1998 Craig Burley ! ! Cutover to system.h: ! * Make-lang.in: ! * Makefile.in: ! * ansify.c: ! * bad.c: ! * bld.c: ! * com.c: ! * com.h: ! * expr.c: ! * fini.c: ! * g77spec.c: ! * implic.c: ! * intdoc.c: ! * intrin.c: ! * lex.c: ! * lex.h: ! * parse.c: ! * proj.c: ! * proj.h: ! * src.c: ! * src.h: ! * stb.c: ! * ste.c: ! * target.c: ! * top.c: ! * system.j: New file. ! ! Use toplev.h where appropriate: ! * Make-lang.in: ! * Makefile.in: ! * bad.c: ! * bld.c: ! * com.c: ! * lex.c: ! * ste.c: ! * top.c: ! * toplev.j: New file. ! ! Conditionalize all dumping/reporting routines so they don't ! get built for gcc/egcs: ! * bld.c: ! * bld.h: ! * com.c: ! * equiv.c: ! * equiv.h: ! * sta.c: ! * stt.c: ! * stt.h: ! * symbol.c: ! * symbol.h: ! ! Use hconfig.h instead of config.h where appropriate: ! * Makefile.in (proj-h.o): Compile with -DUSE_HCONFIG. ! * fini.c: Define USE_HCONFIG before including proj.h. ! ! * Makefile.in (deps-kinda): Redirect stderr to stdout, ! to eliminate diagnostics vis-a-vis g77spec.c. ! ! * Makefile.in: Regenerate dependencies via deps-kinda. ! ! * lex.c (ffelex_file_fixed, ffelex_file_free): Eliminate ! apparently spurious warnings about uninitialized variables ! `c', `column', and so on. ! ! Sat Jun 13 03:13:18 1998 Craig Burley ! ! * g77spec.c (lang_specific_driver): Print out egcs ! version info first, to be compatible with what some ! test facilities expect. ! ! Wed Jun 10 13:17:32 1998 Dave Brolley ! ! * top.h (ffe_decode_option): New argc/argv interface. ! * top.c (ffe_decode_option): New argc/argv interface. ! * parse.c (yyparse): New argc/argv interface for ffe_decode_option. ! * com.c (lang_decode_option): New argc/argv interface. ! ! Mon Jun 1 19:37:42 1998 Craig Burley ! ! * com.c (ffecom_init_0): Fix setup of INTEGER(KIND=7) ! pointer type. ! * info.c (ffeinfo_type): Don't crash on null type. ! * expr.c (ffeexpr_fulfill_call_): Don't special-case ! %LOC(expr) or LOC(expr). ! Delete FFEGLOBAL_argsummaryPTR. ! * global.c, global.h: Delete FFEGLOBAL_argsummaryPTR. ! ! Thu May 28 21:32:18 1998 Craig Burley ! ! Restore circa-0.5.22 capabilities of `g77' driver: ! * Make-lang.in (g77spec.o): Depend on f/version.h. ! (g77version.o): New rule to compile g77 version info. ! (g77$(exeext)): Depend on and link in g77version.o. ! * g77spec.c: Rewrite to be more like 0.5.22 version ! of g77.c, making filtering of command line smarter ! so mixed Fortran and C (etc.) can be compiled, verbose ! version info can be obtained, etc. ! * lang-specs.h (f77-version): New "language" to support ! "g77 -v" command under new gcc 2.8 regime. ! * lex.c (ffelex_file_fixed): If -fnull-version, just ! substitute a "source file" that prints out version info. ! * top.c, top.h: Support -fnull-version. ! ! * lang-specs.h: Use "%O" instead of OO macro to specify ! object extension. Remove old stringizing cruft. ! ! * Make-lang.in (g77.c, g77spec.o, g77.o, g77$(exeext), ! g77-cross$(exeext), f771, ! $(srcdir)/f/g77.info, $(srcdir)/f/g77.dvi, ! $(srcdir)/f/intdoc.texi, ! f77.install-common, f77.install-info, f77.install-man, ! f77.uninstall, $(G77STAGESTUFF), f77.stage1, f77.stage2, ! f77.stage3, f77.stage4, f77.distdir): Don't do anything ! unless user specified "f77" or "F77" in $LANGUAGES either ! during configuration or explicitly. For convenience of ! various tests and to work around lack of the assignment ! "LANGUAGES=$(BOOT_LANGUAGES)" in the "make stage1" command ! of "make bootstrap" in gcc, use a touch file named "lang-f77" ! to communicate whether this is the case. ! ! * Make-lang.in (F77_FLAGS_TO_PASS): Delete this macro, ! replace with minimal expansion of its former self in ! each of the two instances where it was used. ! ! * Makefile.in (HOST_CC): Delete this definition. ! ! * com.c (index, rindex): Delete these declarations. ! ! * proj.h: (isascii): Delete this. ! ! * Make-lang.in (f77.install-common): Warn if `f77-install-ok' ! flag-file exists, since it no longer triggers any activity. ! ! Rename libf2c.a and f2c.h to libg2c.a and g2c.h, ! normalize and simplify g77/libg2c build process: ! * Make-lang.in: Remove all support for overwriting ! /usr/bin/f77 etc., or whatever the actual names are ! via $(prefix) and $(local_prefix). (g++ overwrites ! /usr/bin/c++, but then it's often the only C++ compiler ! on the system; f77 often exists on systems that are ! installing g77.) ! (f77.realclean): Remove obsolete target. ! (g77.c, g77$(exeext)): Minor changes to look more like g++'s ! stuff. ! (f771): Now built with srcdir=gcc/f, not srcdir=gcc, to be ! more like g++ and such. ! (f/Makefile): Removed, as g++ doesn't need this rule. ! (f77.install-common): No longer install f77, etc. ! (f77.install-man): No longer install f77.1. ! (f77.uninstall): No longer uninstall f77, f77.1, etc. ! (f77.stage1, f77.stage2, f77.stage3, f77.stage4): Do work ! only if "f77" appears in $(LANGUAGES). ! (Note: gcc's Makefile.in's bootstrap target should set ! LANGUAGES=$(BOOT_LANGUAGES) when making the stage1 target.) ! * Makefile.in: Update vis-a-vis gcc/cp/Makefile.in. ! (none): Remove. ! (g77-only): Relocate. ! (all.indirect, f771, *.o): Now assumes current directory ! is this dir (gcc/f), not the parent directory. ! (TAGS): Remove "echo 'parse.y,0' >> TAGS ;" line. ! * config-lang.in: Delete commented-out code. ! Fix stagestuff definition. Add more stuff to ! diff_excludes definition. Don't create any directories. ! Set outputs to f/Makefile, to get variable substition ! to happen (what does that really do, anyway?!). ! * g77spec.c: Rename libf2c to libg2c. ! ! * com.h: Remove all of the gcc back-end decls, ! since egcs should have all of them correct. ! ! * com.c: Include "proj.h" before anything else, ! as that's how things are supposed to work. ! * ste.c: Ditto. ! ! * bad.c: Include "flags.j" here, since some diagnostics ! check flag_pedantic_errors. ! ! * Makefile.in (f/*.o): Rebuild dependencies via ! deps-kinda. ! ! * output.j: New source file. ! * Make-lang.in (F77_SRCS): Update accordingly. ! * Makefile.in (OUTPUT_H): Ditto. ! (deps-kinda): Ditto. ! * com.c: Include "output.j" here. ! * lex.c: Ditto. ! ! Mon May 25 03:34:42 1998 Craig Burley ! ! * com.c (ffecom_expr_): Fix D**I and Z**I cases to ! not convert (DOUBLE PRECISION) D and (DOUBLE COMPLEX) Z ! to INTEGER. (This is dead code here anyway.) ! ! Sat May 23 06:32:52 1998 Craig Burley ! ! * com.c (ffecom_finish_symbol_transform_): Don't transform ! statement (nested) functions, to avoid gcc compiling them ! and thus producing linker errors if they refer to undefined ! external functions. But warn if they're unused and -Wunused. ! * bad.def (FFEBAD_SFUNC_UNUSED): New diagnostic. ! ! Wed May 20 12:12:55 1998 Craig Burley ! ! * Version 0.5.23 released. ! ! Tue May 19 14:52:41 1998 Craig Burley ! ! * bad.def (FFEBAD_OPEN_UNSUPPORTED, FFEBAD_INQUIRE_UNSUPPORTED, ! FFEBAD_READ_UNSUPPORTED, FFEBAD_WRITE_UNSUPPORTED, ! FFEBAD_QUAD_UNSUPPORTED, FFEBAD_BLOCKDATA_STMT, ! FFEBAD_TRUNCATING_CHARACTER, FFEBAD_TRUNCATING_HOLLERITH, ! FFEBAD_TRUNCATING_NUMERIC, FFEBAD_TRUNCATING_TYPELESS, ! FFEBAD_TYPELESS_OVERFLOW): Change these from warnings ! to errors. ! ! Tue May 19 14:51:59 1998 Craig Burley ! ! * Make-lang.in (f77.install-info, f77.uninstall): ! Use install-info as appropriate. ! Tue May 19 12:56:54 1998 Craig Burley ! * com.c (ffecom_init_0): Rename xargc to f__xargc, ! in accord with same-dated change to f/runtime. ! Fri May 15 10:52:49 1998 Craig Burley ! * com.c (ffecom_convert_narrow_, ffecom_convert_widen_): ! Be even more persnickety in checking for internal bugs. ! Also, if precision isn't changing, just return the expr. ! * expr.c (ffeexpr_token_number_): Call ! ffeexpr_make_float_const_ to make an integer. ! (ffeexpr_make_float_const_): Handle making an integer. ! ! * intrin.c (ffeintrin_init_0): Distinguish between ! crashes on bad arg base and kind types. ! ! Thu May 14 13:30:59 1998 Craig Burley ! ! * Make-lang.in (f/expr.c): Now depends on f/stamp-str. ! * expr.c: Use ffestrOther in place of ffeexprDotdot_. ! * str-ot.fin: Add more keywords for expr.c. ! ! * intdoc.c (dumpimp): Trivial fix. ! ! * com.c (ffecom_expr_): Add ltkt variable for clarity. ! ! Wed May 13 13:05:34 1998 Craig Burley ! ! * Make-lang.in (G77STAGESTUFF): Add g77.o, g77spec.o, ! and g77version.o. ! (f77.clean): Add removal of g77.c, g77.o, g77spec.o, ! and g77version.o. ! (f77.distclean): Delete removal of g77.c. ! ! Thu Apr 30 18:59:43 1998 Jim Wilson ! ! * Make-lang.in (g77.info, g77.dvi, BUGS, INSTALL, NEWS): Put -o ! option before input file. ! ! Tue Apr 28 09:23:10 1998 Craig Burley ! ! Fix 980427-0.f: ! * global.c (ffeglobal_ref_progunit_): When transitioning ! from EXT to FUNC, discard hook, since the decl, if any, is ! probably wrong. ! ! Sun Apr 26 09:05:50 1998 Craig Burley ! ! * com.c (ffecom_char_enhance_arg_): Wrap the upper bound ! (the PARM_DECL specifying the length of the CHARACTER*(*) ! dummy arg) in a variable_size invocation, to prevent ! dwarf2out.c crashing when compiling code with -g. ! ! Sat Apr 18 05:03:21 1998 Craig Burley ! ! * com.c (ffecom_check_size_overflow_): Ignore overflow ! as well if dummy argument. ! ! Fri Apr 17 17:18:04 1998 Craig Burley ! ! * version.h: Get rid of the overly large headers ! here too, as done in version.c. ! ! Tue Apr 14 14:40:40 1998 Craig Burley ! ! * com.c (ffecom_start_progunit_): Mark function decl ! as used, to avoid spurious warning (-Wunused) for ENTRY. ! ! Tue Apr 14 14:19:34 1998 Craig Burley ! ! * sta.c (ffesta_second_): Check for CASE DEFAULT ! as well as CASE, or it won't be recognized. ! ! Mon Mar 23 21:20:35 1998 Craig Burley ! ! * version.c: Reduce to a one-line file, like ! gcc's version.c, since there's really no content ! there. ! ! Mon Mar 23 11:58:43 1998 Craig Burley ! ! * bugs.texi: Various updates. ! ! * com.c (ffecom_tree_canonize_ptr_): Fix up spacing a bit. ! ! Mon Mar 16 21:20:35 1998 Craig Burley ! ! * expr.c (ffeexpr_sym_impdoitem_): Don't blindly ! reset symbol info after calling ffesymbol_error, ! to avoid crash. ! ! Mon Mar 16 15:38:50 1998 Craig Burley ! ! * Version 0.5.22 released. ! ! Mon Mar 16 14:36:02 1998 Craig Burley ! ! Make -g work better for ENTRY: ! * com.c (ffecom_start_progunit_): Master function ! for ENTRY-laden procedure is not really invented, ! so it can be debugged. ! (ffecom_do_entry_): Push/set/pop lineno for each ! entry point. ! ! Sun Mar 15 05:48:49 1998 Craig Burley ! ! * intrin.def: Fix spelling of mixed-case form ! of `CPU_Time' (was `Cpu_Time'). ! ! Thu Mar 12 13:50:21 1998 Craig Burley ! ! * lang-options.h: Sort all -f*-intrinsics-* options, ! for consistency with other g77 versions. ! ! 1998-03-09 Dave Love ! ! * Make-lang.in: Set CONFIG_SITE to a non-existent file since ! /dev/null loses with bash 2.0/autoconf 2.12. Put ! F77_FLAGS_TO_PASS before CC. ! ! Sun Mar 8 16:35:34 1998 Craig Burley ! ! * intrin.def: Use tabs instead of blanks more ! consistently (excepting DEFGEN section for now). ! ! Sat Feb 28 15:24:38 1998 Craig Burley ! ! * intrin.def: Make CPU_TIME's arg generic real to be just ! like SECOND_subr. ! ! Fri Feb 20 12:45:53 1998 Craig Burley ! ! * expr.c (ffeexpr_token_arguments_): Make sure ! outer exprstack isn't null. ! ! 1998-02-16 Dave Love ! ! * Makefile.in (f/fini): Don't use -W -Wall with HOST_CC. ! ! Fri Feb 13 00:14:56 1998 Kaveh R. Ghazi ! ! * com.c (type_for_mode): Add explicit braces to avoid ambiguous `else'. ! ! * expr.c (ffeexpr_type_combine): Likewise. ! (ffeexpr_reduce_): Likewise. ! (ffeexpr_declare_parenthesized_): Likewise. ! ! * src.c (ffesrc_strcmp_1ns2i): Likewise. ! (ffesrc_strcmp_2c): Likewise. ! (ffesrc_strncmp_2c): Likewise. ! ! * stb.c (ffestb_halt1_): Likewise. ! (ffestb_R90910_): Likewise. ! (ffestb_R9109_): Likewise. ! ! * stc.c (ffestc_R544_equiv_): Likewise. ! ! * std.c (ffestd_subr_copy_easy_): Likewise. ! (ffestd_R1001dump_): Likewise. ! (ffestd_R1001dump_1005_1_): Likewise. ! (ffestd_R1001dump_1005_2_): Likewise. ! (ffestd_R1001dump_1005_3_): Likewise. ! (ffestd_R1001dump_1005_4_): Likewise. ! (ffestd_R1001dump_1005_5_): Likewise. ! (ffestd_R1001dump_1010_2_): Likewise. ! ! * ste.c (ffeste_R840): Likewise. ! ! * sts.c (ffests_puttext): Likewise. ! ! * symbol.c (ffesymbol_check_token_): Likewise. ! ! * target.c (ffetarget_real1): Likewise. ! (ffetarget_real2): Likewise. ! ! Sun Jan 25 12:32:15 1998 Kaveh R. Ghazi ! ! * Make-lang.in (f77.stage1): Depend on stage1-start so parallel ! make works better. ! * (f77.stage2): Likewise for stage2-start. ! * (f77.stage3): Likewise for stage3-start. ! * (f77.stage4): Likewise for stage4-start. ! ! Sun Jan 11 02:14:47 1998 Craig Burley ! ! Support FORMAT(I<1+2>) (constant variable-FORMAT ! expressions): ! * bad.def (FFEBAD_FORMAT_VARIABLE): New diagnostic. ! * std.c (ffestd_R1001rtexpr_): New function. ! (ffestd_R1001dump_, ffestd_R1001dump_1005_1_, ! ffestd_R1001dump_1005_2_, ffestd_R1001dump_1005_3_, ! ffestd_R1001dump_1005_4_, ffestd_R1001dump_1005_5_, ! ffestd_R1001dump_1010_2_, ffestd_R1001dump_1010_3_, ! ffestd_R1001dump_1010_4_, ffestd_R1001dump_1010_5_): ! Use new function instead of ffestd_R1001error_. ! ! * stb.c (ffestb_R10014_, ffestb_R10016_, ffestb_R10018_, ! ffestb_R100110_): Restructure `for' loop for style. ! ! Fix 970626-2.f by not doing most back-end processing ! when current_function_decl is an ERROR_MARK, and by ! making that the case when its type would be an ERROR_MARK: ! * com.c (ffecom_start_progunit_, finish_function, ! lang_printable_name, start_function, ! ffecom_finish_symbol_transform_): Test for ERROR_MARK. ! * std.c (ffestd_stmt_pass_): Don't do any downstream ! processing if ERROR_MARK. ! ! * Make-lang.in (f77.install-common): Don't install, and ! don't uninstall existing, Info files if f/g77.info ! doesn't exit. (This is a somewhat modified version ! of an egcs patch on 1998-01-07 12:05:51 by Bruno Haible ! .) ! ! Fri Jan 9 19:09:07 1998 Craig Burley ! ! Fix -fpedantic combined with `F()' invocation, ! also -fugly-comma combined with `IARGC()' invocation: ! * bad.def (FFEBAD_NULL_ARGUMENT_W): New diagnostic. ! * expr.c (ffeexpr_finished_): Don't reject null expressions ! in the argument-expression context -- let outer context ! handle that. ! (ffeexpr_token_arguments_): Warn about null expressions ! here if -fpedantic (as appropriate). ! Obey -fugly-comma for only external-procedure invocations. ! * intrin.c (ffeintrin_check_): No longer ignore explicit ! omitted trailing args. ! ! Tue Dec 23 14:58:04 1997 Craig Burley ! ! * intrin.c (ffeintrin_fulfill_generic): Don't generate ! FFEBAD_INTRINSIC_TYPE for CHARACTER*(*) intrinsic. ! ! * com.c (ffecom_gfrt_basictype): ! (ffecom_gfrt_kindtype): ! (ffecom_make_gfrt_): ! (FFECOM_rttypeVOIDSTAR_): New return type `void *', for ! the SIGNAL intrinsic. ! * com-rt.def (FFECOM_rttypeSIGNAL): Now returns `void *'. ! * intdoc.c: Replace `p' kind specifier with `7'. ! * intrin.c (ffeintrin_check_, ffeintrin_init_0): Replace ! `p' kind specifier with `7'. ! * intrin.def (FFEINTRIN_impLOC, FFEINTRIN_impSIGNAL_func, ! FFEINTRIN_impSIGNAL_subr): Replace `p' specifier with `7'. ! Also, SIGNAL now returns a `void *' status, not `int'. ! ! Improve run-time diagnostic for "PRINT '(I1', 42": ! * com.c (ffecom_char_args_x_): Renamed from ffecom_char_args_, ! which is now a macro (to avoid lots of changes to other code) ! with new arg, ffecom_char_args_with_null_ being another new ! macro to call same function with different value for new arg. ! This function now appends a null byte to opCONTER expression ! if the new arg is TRUE. ! (ffecom_arg_ptr_to_expr): Support NULL length pointer. ! * ste.c (ffeste_io_cilist_): ! (ffeste_io_icilist_): Pass NULL length ptr for ! FORMAT expression, so null byte gets appended where ! feasible. ! * target.c (ffetarget_character1): ! (ffetarget_concatenate_character1): ! (ffetarget_substr_character1): ! (ffetarget_convert_character1_character1): ! (ffetarget_convert_character1_hollerith): ! (ffetarget_convert_character1_integer4): ! (ffetarget_convert_character1_logical4): ! (ffetarget_convert_character1_typeless): ! (ffetarget_hollerith): Append extra phantom null byte as ! part of FFETARGET-NULL-BYTE kludge. ! ! * intrin.def (FFEINTRIN_impCPU_TIME): Point to ! FFECOM_gfrtSECOND as primary run-time routine. ! ! Mon Dec 22 12:41:07 1997 Craig Burley ! ! * intrin.c (ffeintrin_init_0): Remove duplicate ! check for `!'. ! ! Sun Dec 14 02:49:58 1997 Craig Burley ! ! * intrin.c (ffeintrin_init_0): Fix up indentation a bit. ! Fix bug that prevented checking of arguments other ! than the first. ! ! * intdoc.c: Fix up indentation a bit. ! ! Tue Dec 9 16:20:57 1997 Richard Henderson ! ! * com.c (ffecom_type_vardesc_): Vardesc.dims is a `ftnlen*'. ! ! Mon Dec 1 19:12:36 1997 Craig Burley ! ! * intrin.c (ffeintrin_check_): Fix up indentation a bit more. ! ! Mon Dec 1 16:21:08 1997 Craig Burley ! ! * com.c (ffecom_arglist_expr_): Crash if non-supplied ! optional arg isn't passed as an address. ! Pass null pointer explicitly, instead of via ffecom routine. ! If incoming argstring is NULL, substitute pointer to "0". ! Recognize '0' as ending the usual arg stuff, just like '\0'. ! ! Sun Nov 30 22:22:22 1997 Craig Burley ! ! * intdoc.c: Minor fix-ups. ! ! * intrin.c (ffeintrin_check_): Fix up indentation a bit. ! ! * intrin.def: Fix up spacing a bit. ! ! 1997-11-17 Dave Love ! ! * com.c (ffecom_arglist_expr_): Pass null pointers for optional ! args which aren't supplied. ! ! Sun Nov 16 21:45:43 1997 H.J. Lu (hjl@gnu.ai.mit.edu) ! ! * Make-lang.in (f77.install-info): Depend on f77.info. ! ! 1997-11-06 Dave Love ! ! * intrin.def: Allow non-integer args for INT2 and INT8 (per ! documentation). ! ! Tue Oct 28 02:21:25 1997 Craig Burley ! ! * lang-options.h: Add -fgnu-intrinsics-* and ! -fbadu77-intrinsics-* options. ! ! Sun Oct 26 02:36:21 1997 Craig Burley ! ! * com.c (lang_print_error_function): Fix to more ! reliably notice when the diagnosed region changes. ! ! Sat Oct 25 23:43:36 1997 Craig Burley ! ! Fix 950327-0.f: ! * sta.c, sta.h (ffesta_outpooldisp): New function. ! * std.c (ffestd_stmt_pass_): Don't kill NULL pool. ! (ffestd_R842): If pool already preserved, save NULL ! for pool, because it should be killed only once. ! ! * malloc.c [MALLOC_DEBUG]: Put initializer for `name' ! component in braces, to avoid compiler warning. ! ! Fri Oct 10 13:00:48 1997 Craig Burley ! ! * ste.c (ffeste_begin_iterdo_): Fix loop setup so iteration ! variable is modified only after the #iterations is calculated; ! otherwise if the iteration variable is aliased to any of the ! operands in the start, end, or increment expressions, the ! wrong #iterations might be calculated. ! ! * com.c (ffecom_save_tree): Fix indentation. ! ! 1997-10-05 Dave Love ! ! * intrin.def: Make SECOND_subr's arg generic real for people ! porting from Cray and making everything double precision. ! ! Mon Sep 29 16:18:21 1997 Craig Burley ! ! * stu.c (ffestu_list_exec_transition_, ! ffestu_dummies_transition_): Specify `bool' type for ! `in_progress' variables. ! ! * com.h (assemble_string): Declare this routine (instead ! of #include'ing "output.h" from gcc) to eliminate warnings ! from lex.c. ! ! Fri Sep 19 01:12:27 1997 Craig Burley ! ! * expr.c (ffeexpr_reduced_eqop2_): ! (ffeexpr_reduced_relop2_): Minor fixes to diagnostic code. ! ! * fini.c (main): Change return type to `int'. ! ! Wed Sep 17 10:47:08 1997 Craig Burley ! ! * com-rt.def (FFECOM_gfrtDSIGN, FFECOM_gfrtISIGN, ! FFECOM_gfrtSIGN): Add second argument. ! ! * expr.c (ffeexpr_cb_comma_c_): Trivial fixes. ! ! Tue Sep 9 01:59:35 1997 Craig Burley ! ! * Version 0.5.21 released. ! ! Tue Sep 9 00:31:01 1997 Craig Burley ! ! * intdoc.c (dumpem): Put appropriate commentary in ! output file, so readers know it isn't source. ! ! Wed Aug 27 08:08:25 1997 Craig Burley ! ! * proj.h: Always #include "config.j" first, to pick up ! gcc's configuration. ! * com.c: Change bcopy() and bzero() calls to memcpy() ! and memset() calls, to make more of g77 ANSI C. ! ! 1997-08-26 Dave Love ! ! * Make-lang.in ($(srcdir)/f/runtime/configure, ! $(srcdir)/f/runtime/libU77/configure): Fix for when srcdir isn't ! relative. ! ! Tue Aug 26 05:59:21 1997 Craig Burley ! ! * ansify.c (main): Make sure readers of stdout know ! it's derived from stdin; omit comment text; get source ! line numbers in future stderr output to be correct. ! ! Tue Aug 26 01:36:01 1997 Craig Burley ! ! Fix 970825-0.f: ! * stb.c (ffestb_R5284_): Allow OPEN_PAREN after closing ! SLASH as well as NAME. ! ! Mon Aug 25 23:48:17 1997 Craig Burley ! ! Changes to allow g77 docs to be built entirely from scratch ! using any ANSI C compiler, not requiring GNU C: ! * Make-lang.in ($(srcdir)/f/intdoc.texi): "Pipe" new ! location of intrinsic documentation data base, f/intdoc.in, ! through new `ansify' program to append `\n\' to quoted ! newlines, into f/intdoc.h0. Do appropriate cleanups. Explain. ! (f77.mostlyclean): Add f/ansify and f/intdoc.h0 to cleanups. ! * f/ansify.c: New program. ! * f/intdoc.c: Fix so it conforms to ANSI C. ! #include f/intdoc.h0 instead of f/intdoc.h. ! Avoid some warnings. ! * f/intdoc.h, f/intdoc.in: Rename the former to the latter; no ! changes made to the content in this patch! ! * f/intrin.h (ffeintrinFamily): Fix to conform to ANSI C. ! ! Sun Aug 24 06:52:48 1997 Craig Burley ! ! Fix up g77 compiler data base for libf2c routines: ! * com-rt.def (FFECOM_gfrtSIGNAL): Change return type to ! FTNINT to match actual code. ! ! * com.c (ffecomRttype_): Replace FFECOM_rttypeINT_ with ! FFECOM_rttypeFTNINT_. ! Add and fix up comments. ! (ffecom_make_gfrt_, ffecom_gfrt_basictype, ! ffecom_gfrt_kindtype): Replace FFECOM_rttypeINT_ with ! FFECOM_rttypeFTNINT_; add FFECOM_rttypeDOUBLEREAL_. ! ! Wed Aug 20 17:18:40 1997 Craig Burley ! ! * global.c (ffeglobal_ref_progunit_): It's okay to have ! a different CHARACTER*n length for a reference if the ! existing length is for another reference, not a definition. ! ! Mon Aug 18 14:27:18 1997 Craig Burley ! ! Fix 970814-0.f: ! * global.c (ffeglobal_new_progunit_): Distinguish ! between previously defined, versus inferred, filewide ! when it comes to diagnostics. ! ! Fix 970816-1.f: ! * global.c (ffeglobal_ref_progunit_): Change BDATA into EXT ! right at the beginning, so EXTERNAL FOO followed later ! by SUBROUTINE FOO is not diagnosed. ! ! Fix 970813-0.f: ! * com-rt.def (FFECOM_gfrtALARM): Returns `integer', not ! `void'. ! ! Sun Aug 17 03:32:44 1997 Craig Burley ! ! Fix up problems when virtual memory exhausted: ! * malloc.c (malloc_new_): Use gcc's xmalloc(), so we ! print a nicer message when malloc returns no memory. ! (malloc_resize_): Ditto for xrealloc(). ! ! * Make-lang.in, Makefile.in: Comment out lines containing ! just formfeeds. ! ! Sat Aug 16 19:41:33 1997 Craig Burley ! ! * com.c (ffecom_make_gfrt_): For rttypeREAL_F2C_, return ! double_type_node; for rttypeREAL_GNU_, return ! _real_type_node. ! ! 1997-08-13 Dave Love ! ! * config-lang.in (diff_excludes): Add some hints about known ! problematic platforms. ! ! 1997-08-13 Dave Love ! ! * intdoc.h: Document `alarm'. ! ! Mon Aug 11 21:19:22 1997 Craig Burley ! ! * Make-lang.in ($(RUNTIMESTAGESTUFF)): Add ! f/runtime/stamp-lib. ! ! Mon Aug 11 01:52:03 1997 Craig Burley ! ! * com.c (ffecom_build_complex_constant_): Go with the ! new build_complex() approach used in gcc-2.8. ! ! * com.c (ffecom_sym_transform_): Don't set ! DECL_IN_SYSTEM_HEADER for a tree node that isn't ! a VAR_DECL, which happens when var is in common! ! ! * com.c (ffecom_expr_intrinsic_) (case FFEINTRIN_impALARM): ! No need to test codegen_imp -- there's only one valid here. ! ! * intrin.def (FFEINTRIN_impALARM): Specify `Status' argument ! as write-only. ! ! Fri Aug 8 05:40:23 1997 Craig Burley ! ! Substantial changes to accommodate distinctions among ! run-time routines that support intrinsics, and between ! routines that compute and return the same type vs. those ! that compute one type and return another (or `void'): ! * com-rt.def: Specify new return type REAL_F2C_ instead ! of many DOUBLE_, COMPLEX_F2C_ instead of COMPLEX_, and ! so on. ! Clear up the *BES* routines "once and for all". ! * com.c: New return types. ! (ffecom_convert_narrow_, ffecom_convert_widen_): ! New functions that are "safe" variants of convert(), ! to catch errors that ffecom_expr_intrinsic_() now ! no longer catches. ! (ffecom_arglist_expr_): Ensure arguments are not ! converted to narrower types. ! (ffecom_call_): Ensure return value is not converted ! to a wider type. ! (ffecom_char_args_): Use new ffeintrin_gfrt_direct() ! routine. ! (ffecom_expr_intrinsic_): Simplify how run-time ! routine is selected (via `gfrt' only now; lose the ! redundant `ix' variable). ! Eliminate the `library' label; any code that doesn't ! return directly just `break's out now with `gfrt' ! set appropriately. ! Set `gfrt' to default choice initially, either a ! fast direct form or, if not available, a slower ! indirect-callable form. ! (ffecom_make_gfrt_): No longer need to do special ! check for complex; it's built into the new return-type ! regime. ! (ffecom_ptr_to_expr): Use new ffeintrin_gfrt_indirect() ! routine. ! * intrin.c, intrin.h: `gfrt' field replaced with three fields, ! so it is easier to provide faster direct-callable and ! GNU-convention indirect-callable routines in the future. ! DEFIMP macro adjusted accordingly, along with all its uses. ! (ffeintrin_gfrt_direct): New function. ! (ffeintrin_gfrt_indirect): Ditto. ! (ffeintrin_is_actualarg): If `-fno-f2c' is in effect, ! require a GNU-callable version of intrinsic instead of ! an f2c-callable version, so indirect calling is still checked. ! * intrin.def: Replace one GFRT field with the three new fields, ! as appropriate for each DEFIMP intrinsic. ! ! * com.c (ffecom_stabilize_aggregate_, ! ffecom_convert_to_complex_): Make these `static'. ! ! Thu Aug 7 11:24:34 1997 Craig Burley ! ! Provide means for front end to determine actual ! "standard" return type for an intrinsic if it is ! passed as an actual argument: ! * com.h, com.c (ffecom_gfrt_basictype, ! ffecom_gfrt_kindtype): New functions. ! (ffecom_gfrt_kind_type_): Replaced with new function. ! All callers updated. ! (ffecom_make_gfrt_): No longer need do anything ! with kind type. ! ! * intrin.c (ffeintrin_basictype, ffeintrin_kindtype): ! Now returns correct type info for specific intrinsic ! (based on type of run-time-library implementation). ! ! Wed Aug 6 23:08:46 1997 Craig Burley ! ! * global.c (ffeglobal_ref_progunit_): Don't reset ! number of arguments just due to new type info, ! so useful warnings can be issued. ! ! 1997-08-06 Dave Love ! ! * intrin.def: Fix IDATE_vxt argument order. ! * intdoc.h: Likewise. ! ! Thu Jul 31 22:22:03 1997 Craig Burley ! ! * global.c (ffeglobal_proc_ref_arg): If REF/DESCR ! disagreement, DESCR is CHARACTER, and types disagree, ! pretend the argsummary agrees so the message ends up ! being about type disagreement. ! (ffeglobal_proc_def_arg): Ditto. ! ! * expr.c (ffeexpr_token_first_rhs_3_): Set info for LABTOK ! to NONE of everything, to avoid misdiagnosing filewide ! usage of alternate returns. ! ! Sun Jul 20 23:07:47 1997 Craig Burley ! ! * com.c (ffecom_sym_transform_): If type gets set ! to error_mark_node, just return that for transformed symbol. ! (ffecom_member_phase2_): If type gets set to error_mark_node, ! just return. ! (ffecom_check_size_overflow_): Add `dummy' argument to ! flag that type is for a dummy, update all callers. ! ! Sun Jul 13 17:40:53 1997 Craig Burley ! ! Fix 970712-1.f: ! * where.c (ffewhere_set_from_track): If start point ! is too large, just use initial start point. 0.6 should ! fix all this properly. ! ! Fix 970712-2.f: ! * com.c (ffecom_sym_transform_): Preserve error_mark_node for type. ! (ffecom_type_localvar_): Ditto. ! (ffecom_sym_transform_): If type is error_mark_node, ! don't error-check decl size, because back end responds by ! setting that to an integer 0 instead of error_mark_node. ! (ffecom_transform_common_): Same as earlier fix to _transform_ ! in that size is checked by dividing BITS_PER_UNIT instead of ! multiplying. ! (ffecom_transform_equiv_): Ditto. ! ! Fix 970712-3.f: ! * stb.c (ffestb_R10014_): Fix flaky fall-through in error ! test for FFELEX_typeCONCAT by just replicating the code, ! and do FFELEX_typeCOLONCOLON while at it. ! ! 1997-07-07 Dave Love ! ! * intdoc.h: Add various missing pieces; correct GMTIME, LTIME ! result ordering. ! ! * intrin.def, com-rt.def: Add alarm. ! ! * com.c (ffecom_expr_intrinsic_): Add case for alarm. ! ! Thu Jun 26 04:19:40 1997 Craig Burley ! ! Fix 970302-3.f: ! * com.c (ffecom_sym_transform_): For sanity-check compare ! of gbe size of local variable to g77 expectation, ! use varasm.c/assemble_variable technique of dividing ! BITS_PER_UNIT out of gbe info instead of multiplying ! g77 info up, to avoid crash when size in bytes is very ! large, and overflows an `int' or similar when multiplied. ! ! Fix 970626-2.f: ! * com.c (ffecom_finish_symbol_transform_): Don't bother ! transforming a dummy argument, to avoid a crash. ! * ste.c (ffeste_R1227): Don't return a value if the ! result decl, or its type, is error_mark_node. ! ! Fix 970626-4.f: ! * lex.c (ffelex_splice_tokens): `-fdollar-ok' is ! irrelevant to whether a DOLLAR token should be made ! from an initial character of `$'. ! ! Fix 970626-6.f: ! * stb.c (ffestb_do3_): DO iteration variable is an ! lhs, not rhs, expression. ! ! Fix 970626-7.f and 970626-8.f: ! * expr.c (ffeexpr_cb_comma_i_1_): Set IMPDO expression ! to have clean info, because undefined rank, for example, ! caused crash on mangled source on UltraSPARC but not ! on Alpha for a series of weird reasons. ! (ffeexpr_cb_close_paren_): If not CLOSE_PAREN, push ! opANY expression onto stack instead of attempting ! to mimic what program might have wanted. ! (ffeexpr_cb_close_paren_): Don't wrap opPAREN around ! opIMPDO, just warn that it's gratuitous. ! * bad.def (FFEBAD_IMPDO_PAREN): New warning. ! ! Fix 970626-9.f: ! * expr.c (ffeexpr_declare_parenthesized_): Must shut down ! parsing in kindANY case, otherwise the parsing engine might ! decide there's an ambiguity. ! (ffeexpr_token_name_rhs_): Eliminate parentypeSUBROUTINE_ ! case, so we crash right away if it comes through. ! * st.c, st.h, sta.c, sta.h (ffest_shutdown, ffesta_shutdown): ! New functions. ! ! Tue Jun 24 19:47:29 1997 Craig Burley ! ! * com.c (ffecom_check_size_overflow_): New function ! catches some cases of the size of a type getting ! too large. varasm.c must catch the rest. ! (ffecom_sym_transform_): Use new function. ! (ffecom_type_localvar_): Ditto. ! ! Mon Jun 23 01:09:28 1997 Craig Burley ! ! * global.c (ffeglobal_proc_def_arg): Fix comparison ! of argno to #args. ! (ffeglobal_proc_ref_arg): Ditto. ! ! * lang-options.h, top.c: Rename `-fdebug' to `-fxyzzy', ! since it's an unsupported internals option and some ! poor user might guess that it does something. ! ! * bad.def: Make a warning for each filewide diagnostic. ! Put all filewides together. ! * com.c (ffecom_sym_transform_): Don't substitute ! known global tree for global entities when `-fno-globals'. ! * global.c (ffeglobal_new_progunit_): Don't produce ! fatal diagnostics about globals when `-fno-globals'. ! Instead, produce equivalent warning when `-Wglobals'. ! (ffeglobal_proc_ref_arg): Ditto. ! (ffeglobal_proc_ref_nargs): Ditto. ! (ffeglobal_ref_progunit_): Ditto. ! * lang-options.h, top.c, top.h: New `-fno-globals' option. ! ! Sat Jun 21 12:32:54 1997 Craig Burley ! ! * expr.c (ffeexpr_fulfill_call_): Set array variable ! to avoid warning about uninitialized variable. ! ! * Make-lang.in: Get rid of any setting of HOST_* macros, ! since these will break gcc's build! ! * makefile: New file to make building derived files ! easier. ! ! Thu Jun 19 18:19:28 1997 Craig Burley ! ! * g77.c (main): Install Emilio Lopes' patch to support ! Ratfor, and to fix the printing of the version string ! to go to stderr, not stdout. ! * lang-specs.h: Install Emilio Lopes' patch to support ! Ratfor, and patch the result to support picking up ! `*f771' from the `specs' file. ! ! Thu Jun 12 14:36:25 1997 Craig Burley ! ! * storag.c (ffestorag_update_init, ffestorag_update_save): ! Also update parent, in case equivalence processing ! has already eliminated pointers to it via the ! local equivalence info. ! ! Tue Jun 10 14:08:26 1997 Craig Burley ! ! * intdoc.c: Add cross-reference to end of description ! of any generic intrinsic pointing to other intrinsics ! with the same name. ! ! Warn about explicit type declaration for intrinsic ! that disagrees with invocation: ! * expr.c (ffeexpr_paren_rhs_let_): Preserve type info ! for intrinsic functions. ! (ffeexpr_token_funsubstr_): Ditto. ! * intrin.c (ffeintrin_fulfill_generic): Warn if type ! info of fulfilled intrinsic invocation disagrees with ! explicit type info given symbol. ! (ffeintrin_fulfill_specific): Ditto. ! * stc.c (ffestc_R1208_item): Preserve type info ! for intrinsics. ! (ffestc_R501_item): Ditto. ! ! Mon Jun 9 17:45:44 1997 Craig Burley ! ! * com.c (ffecom_expr_intrinsic_): Fix several of the ! libU77/libF77-unix handlers to properly convert their ! arguments. ! ! * com-rt.def (FFECOM_gfrtFSTAT): Append missing "i" to ! arg string. ! ! Fri Jun 6 14:37:30 1997 Craig Burley ! ! * com.c (ffecom_expr_intrinsic_): Have a case statement ! for every intrinsic implementation, so missing ones ! are caught via gcc warnings. ! Don't call ffeintrin_codegen_imp anymore. ! * intrin.c (ffeintrin_fulfill_generic): Remove cg_imp ! stuff from here. ! (ffeintrin_codegen_imp): Delete this function. ! * intrin.def, intrin.h: Remove DEFIMQ stuff from here ! as well. ! ! Thu Jun 5 13:03:07 1997 Craig Burley ! ! * top.c (ffe_decode_option): New -fbadu77-intrinsics-* ! options. ! * top.h: Ditto. ! * intrin.h: New BADU77 family. ! * intrin.c (ffeintrin_state_family): Ditto. ! ! Implement new scheme to track intrinsic names vs. forms: ! * intrin.c (ffeintrin_fulfill_generic), ! (ffeintrin_fulfill_specific), (ffeintrin_is_intrinsic), ! intrin.def: The documented name is now either in the ! generic info or, if no generic, in the specific info. ! For a generic, the specific info contains merely the ! distinguishing form (usually "function" or "subroutine"), ! used for diagnostics about ambiguous references and ! in the documentation. ! ! * intrin.def: Clean up formatting of DEFNAME block. ! Convert many libU77 intrinsics into generics that ! support both subroutine and function forms. ! Put the function forms of side-effect routines into ! the new BADU77 family. ! Make MCLOCK and TIME return INTEGER*4 again, and add ! INTEGER*8 equivalents called MCLOCK8 and TIME8. ! Fix up more status return values to be written and ! insist on them being I1 as well. ! * com.c (ffecom_expr_intrinsic_): Lots of changes to ! support new libU77 intrinsic interfaces. ! ! Mon Jun 2 00:37:53 1997 Craig Burley ! ! * com.c (ffecom_init_0): Pointer type is now INTEGER(KIND=7), ! not INTEGER(KIND=0), since we want to reserve KIND=0 for ! future use. ! ! Thu May 29 14:30:33 1997 Craig Burley ! ! Fix bugs preventing CTIME(I*4) from working correctly: ! * com.c (ffecom_char_args_): For FUNCREF case, process ! args to intrinsic just as they would be in ! ffecom_expr_intrinsic_. ! * com-rt.def (FFECOM_gfrtCTIME, FFECOM_gfrtTTYNAM): Fix ! argument decls to specify `&'. ! ! Wed May 28 22:19:49 1997 Craig Burley ! ! Fix gratuitous warnings exposed by dophot aka 970528-1: ! * global.c (ffeglobal_proc_def_arg, ffeglobal_proc_ref_arg): ! Support distinct function/subroutine arguments instead of ! just procedures. ! * global.h: Ditto. ! * expr.c (ffeexpr_fulfill_call_): A SYMTER with kindNONE ! also is a procedure (either function or subroutine). ! ! Mon May 26 20:25:31 1997 Craig Burley ! ! * bad.def: Have several lexer diagnostics refer to ! documentation for people who need more info on what Fortran ! source code is supposed to look like. ! ! * expr.c (ffeexpr_reduced_bool1_), bad.def: New diagnostics ! specific to .NOT. now mention only one operand instead ! of two. ! ! * g77.c: Recognize -fsyntax-only, similar to -c etc. ! (lookup_option): Fix bug that prevented non-`--' options ! from being recognized. ! ! Sun May 25 04:29:04 1997 Craig Burley ! ! * intrin.def (FFEINTRIN_impCTIME): Accept `I*' expression ! for STime instead of requiring `I2'. ! ! Tue May 20 16:14:40 1997 Craig Burley ! ! * symbol.c (ffesymbol_reference): All references to ! standard intrinsics are considered explicit, so as ! to avoid generating basically useless warnings. ! * intrin.c, intrin.h (ffeintrin_is_standard): Returns TRUE ! if intrinsic is standard. ! ! Sun May 18 21:14:59 1997 Craig Burley ! ! * com-rt.def: Changed all external names of the ! form `"\([a-z0-9]*\)_' to `"G77_\1_0"' so as to ! allow any name valid as an intrinsic to be used ! as such and as a user-defined external procedure ! name or common block as well. ! ! Thu May 8 13:07:10 1997 Craig Burley ! ! * expr.c (ffeexpr_cb_end_notloc_): For %VAL, %REF, and ! %DESCR, copy arg info into new node. ! ! Mon May 5 14:42:17 1997 Craig Burley ! ! From Uwe F. Mayer : ! * Make-lang.in (g77-cross): Fix typo in g77.c path. ! ! From Brian McIlwrath : ! * lang-specs.h: Have g77 pick up options from a section ! labeled `*f771' of the `specs' file. ! ! Sat May 3 02:46:08 1997 Craig Burley ! ! * intrin.def (FFEINTRIN_defSIGNAL): Add optional `Status' ! argument that com.c already expects (per Dave Love). ! ! More changes to support better tracking of (filewide) ! globals, in particular, the arguments to procedures: ! * bad.def (FFEBAD_FILEWIDE_NARGS, FFEBAD_FILEWIDE_NARGS_W, ! FFEBAD_FILEWIDE_ARG, FFEBAD_FILEWIDE_ARG_W): New diagnostics. ! * expr.c (ffebad_fulfill_call_): Provide info on each ! argument to ffeglobal. ! * global.c, global.h (ffeglobal_proc_def_arg, ! ffeglobal_proc_def_nargs, ffeglobal_proc_ref_arg, ! ffeglobal_proc_ref_args): New functions. ! (ffeglobalArgSummary, ffeglobalArgInfo_): New types. ! ! Tue Apr 29 18:35:41 1997 Craig Burley ! ! More changes to support better tracking of (filewide) ! globals: ! * expr.c (ffeexpr_fulfill_call_): New function. ! (ffeexpr_token_name_lhs_): Call after building procedure ! reference expression. Also leave info field for ANY-ized ! expression alone. ! (ffeexpr_token_arguments_): Ditto. ! ! Mon Apr 28 20:04:18 1997 Craig Burley ! ! Changes to support better tracking of (filewide) ! globals, mainly to avoid crashes due to inlining: ! * bad.def: Go back to quoting intrinsic names, ! (FFEBAD_FILEWIDE_DISAGREEMENT, FFEBAD_FILEWIDE_TIFF, ! FFEBAD_FILEWIDE_TYPE_MISMATCH): New diagnostics. ! (FFEBAD_INTRINSIC_EXPIMP, FFEBAD_INTRINSIC_GLOBAL): Reword ! for clarity. ! * com.c (ffecom_do_entry_, ffecom_start_progunit_, ! ffecom_sym_transform_): Accommodate new FFEGLOBAL_typeEXT ! possibility. ! * expr.c (ffeexpr_sym_lhs_call_, ffeexpr_sym_lhs_extfunc_, ! ffeexpr_sym_rhs_actualarg_, ffeexpr_declare_parenthesized_, ! ffeexpr_paren_rhs_let_, ffeexpr_token_funsubstr_): ! Fill in real kind info instead of leaving NONE where ! appropriate. ! Register references to intrinsics and globals with ffesymbol ! using new ffesymbol_reference function instead of ! ffesymbol_globalize. ! * global.c (ffeglobal_type_string_): New array for ! new diagnostics. ! * global.h, global.c: ! Replace ->init mechanism with ->tick mechanism. ! Move other common-related members into a substructure of ! a union, so the proc substructure can be introduced ! to include members related to externals other than commons. ! Don't complain about ANY-ized globals; ANY-ize globals ! once they're complained about, in any case where code ! generation could become a problem. ! Handle global entries that have NONE type (seen as ! intrinsics), EXT type (seen as EXTERNAL), and so on. ! Keep track of kind and type of externals, both via ! definition and via reference. ! Diagnose disagreements about kind or type of externals ! (such as functions). ! (ffeglobal_ref_intrinsic, ffeglobal_ref_progunit_): New ! functions. ! * stc.c (ffestc_R1207_item, ffestc_R1208_item, ! ffestc_R1219, ffestc_R1226): ! Call ffesymbol_reference, not ffesymbol_globalize. ! * stu.c (ffestu_sym_end_transition, ! ffestu_sym_exec_transition): ! Call ffesymbol_reference, not ffesymbol_globalize. ! * symbol.c (ffesymbol_globalize): Removed... ! (ffesymbol_reference): ...to this new function, ! which more generally registers references to symbols, ! globalizes globals, and calls on the ffeglobal module ! to check globals filewide. ! ! * global.h, global.c: Rename some macros and functions ! to more clearly distinguish common from other globals. ! All callers changed. ! ! * com.c (ffecom_sym_transform_): Trees describing ! filewide globals must be allocated on permanent obstack. ! ! * expr.c (ffeexpr_token_name_lhs_): Don't generate ! gratuitous diagnostics for FFEINFO_whereANY case. ! ! Thu Apr 17 03:27:18 1997 Craig Burley ! ! * global.c: Add support for flagging intrinsic/global ! confusion via warnings. ! * bad.def (FFEBAD_INTRINSIC_EXPIMP, ! FFEBAD_INTRINSIC_GLOBAL): New diagnostics. ! * expr.c (ffeexpr_token_funsubstr_): Ditto. ! (ffeexpr_sym_lhs_call_): Ditto. ! (ffeexpr_paren_rhs_let_): Ditto. ! * stc.c (ffestc_R1208_item): Ditto. ! ! Wed Apr 16 22:40:56 1997 Craig Burley ! ! * expr.c (ffeexpr_declare_parenthesized_): INCLUDE ! context can't be an intrinsic invocation either. ! ! Fri Mar 28 10:43:28 1997 Craig Burley ! ! * expr.c (ffeexpr_token_arguments_): Make sure top of ! exprstack is operand before dereferencing operand field. ! ! * lex.c (ffelex_prepare_eos_): Fill up truncated ! hollerith token, so crash on null ->text field doesn't ! happen later. ! ! * stb.c (ffestb_R10014_): If NAMES isn't recognized (or ! the recognized part is followed in the token by a ! non-digit), don't try and collect digits, as there ! might be more than FFEWHERE_indexMAX letters to skip ! past to do so -- and the code is diagnosed anyway. ! ! Thu Mar 27 00:02:48 1997 Craig Burley ! ! * com.c (ffecom_sym_transform_): Force local ! adjustable array onto stack. ! ! * stc.c (ffestc_R547_item_object): Don't actually put ! the symbol in COMMON if the symbol has already been ! EQUIVALENCE'd to a different COMMON area. ! ! * equiv.c (ffeequiv_add): Don't actually do anything ! if there's a disagreement over which COMMON area is ! involved. ! ! Tue Mar 25 03:35:19 1997 Craig Burley ! ! * com.c (ffecom_transform_common_): If no explicit init ! of COMMON area, don't actually init it even though ! storage area suggests it. ! ! Mon Mar 24 12:10:08 1997 Craig Burley ! ! * lex.c (ffelex_image_char_): Avoid overflowing the ! column counter itself, as well as the card image. ! ! * where.c (ffewhere_line_new): Cast ffelex_line_length() ! to (size_t) so 255 doesn't overflow to 0! ! ! * stc.c (ffestc_labeldef_notloop_begin_): Don't gratuitously ! terminate loop before processing statement, so block ! doesn't disappear out from under EXIT/CYCLE processing. ! (ffestc_labeldef_notloop_): Has old code from above ! function, instead of just calling it. ! ! * expr.c (ffeexpr_cb_comma_i_4_): Don't skip over ! arbitrary token (such as EOS). ! ! * com.c (ffecom_init_zero_): Handle RECORD_TYPE and ! UNION_TYPE so -fno-zeros works with -femulated-complex. ! ! 1997-03-12 Dave Love ! ! * intrin.def: New intrinsics INT2, INT8, CPU_TIME. Fix AND, OR, ! XOR. [Integrated by burley, AND/OR/XOR already fixed, INT8 ! implementation changed/fixed.] ! ! Wed Mar 12 10:40:08 1997 Craig Burley ! ! * Make-lang.in ($(srcdir)/f/intdoc.texi): Simplify rules ! so building f/intdoc is not always necessary; remove ! f/intdoc after running it if it is built. ! ! Tue Mar 11 23:42:00 1997 Craig Burley ! ! * intrin.def (FFEINTRIN_impAND, FFEINTRIN_impOR, ! FFEINTRIN_impXOR): Use the IAND, IOR, and IEOR implementations ! of these, instead of crashing in ffecom_expr_intrinsic_ ! or adding case labels there. ! ! Mon Mar 10 22:51:23 1997 Craig Burley ! ! * intdoc.c: Fix so any C compiler can compile this. ! ! Fri Feb 28 13:16:50 1997 Craig Burley ! ! * Version 0.5.20 released. ! ! Fri Feb 28 01:45:25 1997 Craig Burley ! ! * Make-lang.in (RUNTIMESTAGESTUFF, LIBU77STAGESTUFF): ! Move some files incorrectly in the former to the latter, ! and add another file or two to the latter. ! ! New meanings for (KIND=n), and new denotations in the ! little language describing intrinsics: ! * com.c (ffecom_init_0): Assign new meanings. ! * intdoc.c: Document new meanings. ! Support the new denotations. ! * intrin.c: Employ new meanings, mapping them to internal ! values (which are the same as they ever were for now). ! Support the new denotations. ! * intrin.def: Switch DEFIMP table to the new denotations. ! ! * intrin.c (ffeintrin_check_): Fix bug that was leaving ! LOC() and %LOC() returning INTEGER*4 on systems where ! it should return INTEGER*8. ! ! * type.c: Canonicalize function definitions, for etags ! and such. ! ! Wed Feb 26 20:43:03 1997 Craig Burley ! ! * com.c (ffecom_init_0): Choose INTEGER(KIND=n) types, ! where n is 2, 3, and 4, according to the new docs ! instead of according to the old C correspondences ! (which seem less useful at this point). ! ! * equiv.c (ffeequiv_destroy_): New function. ! (ffeequiv_layout_local_): Use this new function ! whenever the laying out of a local equivalence chain ! is aborted for any reason. ! Otherwise ensure that symbols no longer reference ! the stale ffeequiv entries that result when they ! are killed off in this procedure. ! Also, the rooted symbol is one that has storage, ! it really is irrelevant whether it has an equiv entry ! at this point (though the code to remove the equiv ! entry was put in at the end, just in case). ! (ffeequiv_kill): When doing internal checks, make ! sure the victim isn't named by any symbols it points ! to. Not as complete a check as looking through the ! entire symbol table (which does matter, since some ! code in equiv.c used to remove symbols from the lists ! for an ffeequiv victim but not remove that victim as the ! symbol's equiv info), but this check did find some ! real bugs in the code (that were fixed). ! ! Mon Feb 24 16:42:13 1997 Craig Burley ! ! * com.c (ffecom_expr_intrinsic_): Fix a couple of ! warnings about uninitialized variables. ! * intrin.c (ffeintrin_check_): Ditto, but there were ! a couple of _real_ uninitialized-variable _bugs_ here! ! (ffeintrin_fulfill_specific): Ditto, no real bug here. ! ! Sun Feb 23 15:01:20 1997 Craig Burley ! ! Clean up diagnostics (especially about intrinsics): ! * bad.def (FFEBAD_UNIMPL_STMT): Remove. ! (FFEBAD_INTRINSIC_*, FFEBAD_NEED_INTRINSIC): Clean these ! up so they're friendlier. ! (FFEBAD_INTRINSIC_CMPAMBIG): New. ! * intrin.c (ffeintrin_fulfill_generic, ! ffeintrin_fulfill_specific, ffeintrin_is_intrinsic): ! Always choose ! generic or specific name text (which is for doc purposes ! anyway) over implementation name text (which is for ! internal use). ! * intrin.def: Use more descriptive name texts for generics ! and specifics in cases where the names themselves are not ! enough (e.g. IDATE, which has two forms). ! ! Fix some intrinsic mappings: ! * intrin.def (FFEINTRIN_specIDINT, FFEINTRIN_specAND, ! FFEINTRIN_specDFLOAT, FFEINTRIN_specDREAL, FFEINTRIN_specOR, ! FFEINTRIN_specXOR): Now have their own implementations, ! instead of borrowing from others. ! (FFEINTRIN_specAJMAX0, FFEINTRIN_specAJMIN0, FFEINTRIN_specBJTEST, ! FFEINTRIN_specDFLOTJ, FFEINTRIN_specFLOATJ, FFEINTRIN_specJIABS, ! FFEINTRIN_specJIAND, FFEINTRIN_specJIBCLR, FFEINTRIN_specJIBITS, ! FFEINTRIN_specJIBSET, FFEINTRIN_specJIDIM, FFEINTRIN_specJIDINT, ! FFEINTRIN_specJIDNNT, FFEINTRIN_specJIEOR, FFEINTRIN_specJIFIX, ! FFEINTRIN_specJINT, FFEINTRIN_specJIOR, FFEINTRIN_specJISHFT, ! FFEINTRIN_specJISHFTC, FFEINTRIN_specJISIN, FFEINTRIN_specJMAX0, ! FFEINTRIN_specJMAX1, FFEINTRIN_specJMIN0, FFEINTRIN_specJMIN1, ! FFEINTRIN_specJMOD, FFEINTRIN_specJNINT, FFEINTRIN_specJNOT,): ! Turn these implementations off, since it's not clear ! just what types they expect in the context of portable Fortran. ! (DFLOAT): Now in FVZ family, since f2c supports them ! ! Support intrinsic inquiry functions (BIT_SIZE, LEN): ! * intrin.c: Allow `i' in . ! * intrin.def (FFEINTRIN_impBIT_SIZE, FFEINTRIN_impLEN): ! Mark args with `i'. ! ! Sat Feb 22 13:34:09 1997 Craig Burley ! ! Only warn, don't error, for reference to unimplemented ! intrinsic: ! * bad.def (FFEBAD_INTRINSIC_UNIMPLW): Warning version ! of _UNIMPL. ! * intrin.c (ffeintrin_is_intrinsic): Use new warning ! version of _UNIMPL (FFEBAD_INTRINSIC_UNIMPLW). ! ! Complain about REAL(Z) and AIMAG(Z) (Z is DOUBLE COMPLEX): ! * bad.def (FFEBAD_INTRINSIC_CMPAMBIG): New diagnostic. ! * expr.c: Needed #include "intrin.h" anyway. ! (ffeexpr_token_intrincheck_): New function handles delayed ! diagnostic for "REAL(REAL(expr)" if next token isn't ")". ! (ffeexpr_token_arguments_): Do most of the actual checking here. ! * intrin.h, intrin.c (ffeintrin_fulfill_specific): New ! argument, check_intrin, to tell caller that intrin is REAL(Z) ! or AIMAG(Z). All callers updated, mostly to pass NULL in ! for this. ! (ffeintrin_check_): Also has new arg check_intrin for same ! purpose. All callers updated the same way. ! * intrin.def (FFEINTRIN_impAIMAG): Change return type ! from "R0" to "RC", to accommodate f2c (and perhaps other ! non-F90 F77 compilers). ! * top.h, top.c: New option -fugly-complex. ! ! New GNU intrinsics REALPART, IMAGPART, and COMPLEX: ! * com.c (ffecom_expr_intrinsic_): Implement impCOMPLEX ! and impREALPART here. (specIMAGPART => specAIMAG.) ! * intrin.def: Add the intrinsics here. ! ! Rename implementations of VXTIDATE and VXTTIME to IDATEVXT ! and TIMEVXT, so they sort more consistently: ! * com.c (ffecom_expr_intrinsic_): ! * intrin.def: ! ! Delete intrinsic group `dcp', add `gnu', etc.: ! * intrin.c (ffeintrin_state_family): FFEINTRIN_familyGNU ! replaces FFEINTRIN_familyDCP, and gets state from `gnu' ! group. ! Get rid of FFEINTRIN_familyF2Z, nobody needs it. ! Move FFEINTRIN_specDCMPLX from DCP family to FVZ family, ! as f2c has it. ! Move FFEINTRIN_specDFLOAT from F2C family to FVZ family. ! (FFEINTRIN_specZABS, FFEINTRIN_specZCOS, FFEINTRIN_specZEXP, ! FFEINTRIN_specZLOG, FFEINTRIN_specZSIN, FFEINTRIN_specZSQRT): ! Move these from F2Z family to F2C family. ! * intrin.h (FFEINTRIN_familyF2Z, FFEINTRIN_familyDCP): Remove. ! (FFEINTRIN_familyGNU): Add. ! * top.h, top.c: Replace `dcp' with `gnu'. ! ! * com.c (ffecom_expr_intrinsic_): Clean up by collecting ! simple conversions into one nice, conceptual place. ! Fix up some intrinsic subroutines (MVBITS, KILL, UMASK) to ! properly push and pop call temps, to avoid wasting temp ! registers. ! ! * g77.c (doit): Toon says variables should be defined ! before being referenced. Spoilsport. ! ! * intrin.c (ffeintrin_check_): Now Dave's worried about ! warnings about uninitialized variables. Okay, so for ! basic return values 'g' and 's', they _were_ ! uninitialized -- is determinism really _that_ useful? ! ! * intrin.def (FFEINTRIN_impFGETC): Fix STATUS argument ! so that it is INTENT(OUT) instead of INTENT(IN). ! ! 1997-02-21 Dave Love ! ! * intrin.def, com.c: Support Sun-type `short' and `long' ! intrinsics. Perhaps should also do Microcruft-style `int2'. ! ! Thu Feb 20 15:16:53 1997 Craig Burley ! ! * com.c (ffecom_expr_intrinsic_): Clean up indentation. ! Support SECONDSUBR intrinsic implementation. ! Rename SECOND to SECONDFUNC for direct support via library. ! ! * g77.c: Fix to return proper status value to shell, ! by obtaining it from processes it spawns. ! ! * intdoc.c: Fix minor typo. ! ! * intrin.def: Turn SECOND into generic that maps into ! function and subroutine forms. ! ! * intrin.def: Make FLOAT and SNGL into specific intrinsics. ! ! * intrin.def, intrin.h: Change the way DEFGEN and DEFSPEC ! macros work, to save on verbage. ! ! Mon Feb 17 02:08:04 1997 Craig Burley ! ! New subsystem to automatically generate documentation ! on intrinsics: ! * Make-lang.in ($(srcdir)/f/g77.info, ! $(srcdir)/f/g77.dvi): Move g77 doc rules around. ! Add to g77 doc rules the new subsystem. ! (f77.mostlyclean, f77.maintainer-clean): Also clean up ! after new doc subsystem. ! * intdoc.c, intdoc.h: New doc subsystem code. ! * intrin.h [FFEINTRIN_DOC]: When 1, don't pull in ! stuff not needed by doc subsystem. ! ! Improve on intrinsics mechanism to both be more ! self-documenting and to catch more user errors: ! * intrin.c (ffeintrin_check_): Recognize new arg-len ! and arg-rank information, and check it. ! Move goto and signal indicators to the basic type. ! Permit reference to arbitrary argument number, not ! just first argument (for BESJN and BESYN). ! (ffeintrin_init_0): Check and accept new notations. ! * intrin.c, intrin.def: Value in COL now identifies ! arguments starting with number 0 being the first. ! ! Some minor intrinsics cleanups (resulting from doc work): ! * com.c (ffecom_expr_intrinsic_): Implement FLUSH ! directly once again, handle its optional argument, ! so it need not be a generic (awkward to handle in docs). ! * intrin.def (BESJ0, BESJ1, BESJN, BESY0, BESY1, BESYN, ! CHDIR, CHMOD, CTIME, DBESJ0, DBESJ1, DBESJN, DBESY0, ! DBESY1, DBESYN, DDIM, ETIME, FGETC, FNUM, FPUTC, FSTAT, ! GERROR, GETCWD, GETGID, GETLOG, GETPID, GETUID, GMTIME, ! HOSTNM, IDATE, IERRNO, IIDINT, IRAND, ISATTY, ITIME, JIDINT, ! LNBLNK, LSTAT, LTIME, MCLOCK, PERROR, SRAND, SYMLNK, TTYNAM, ! UMASK): Change capitalization of initcaps (official) name ! to be consistent with Burley's somewhat arbitrary rules. ! (BESJN, BESYN): These have return arguments of same type ! as their _second_ argument. ! (FLUSH): Now a specific, not generic, intrinsic, with one ! optional argument. ! (FLUSH1): Eliminated. ! Add arg-len and arg-rank info to several intrinsics. ! (ITIME): Change argument type from REAL to INTEGER. ! ! Tue Feb 11 14:04:42 1997 Craig Burley ! ! * Make-lang.in (f771): Invocation of Makefile now done ! with $(srcdir)=gcc to go along with $(VPATH)=gcc. ! ($(srcdir)/f/runtime/configure, ! $(srcdir)/f/runtime/libU77/configure): Break these out ! so spurious triggers of this rule don't happen (as when ! configure.in is more recent than libU77/configure). ! (f77.rebuilt): Distinguish source versus build files, ! so this target can be invoked from build directory and ! still work. ! * Makefile.in: This now expects $(srcdir) to be the gcc ! source directory, not gcc/f, to agree with $(VPATH). ! Accordingly, $(INCLUDES) has been fixed, various cruft ! removed, the removal of f771 has been fixed to remove ! the _real_ f771 (not the one in gcc's parent directory), ! and so on. ! ! * lex.c: Part of ffelex_finish_statement_() now done ! by new function ffelex_prepare_eos_(), so that, in one ! popular case, the EOS can be prepared while the pointer ! is at the end of the non-continued line instead of the ! end of the line that marks no continuation. This improves ! the appearance of diagnostics substantially. ! ! Mon Feb 10 12:44:06 1997 Craig Burley ! ! * Make-lang.in: runtime Makefile's, and include/f2c.h, ! also depend on f/runtime/configure and f/runtime/libU77/configure. ! ! Fix various libU77 routines: ! * com-rt.def (FFECOM_gfrtCTIME, FFECOM_gfrtMCLOCK, ! FFECOM_gfrtTIME): These now use INTEGER*8 for time values, ! for compatibility with systems like Alpha. ! (FFECOM_gfrtSYSTEM_CLOCK, FFECOM_gfrtTTYNAM): Delete incorrect ! trailing underscore in routine names. ! * intrin.c, intrin.def: Support INTEGER*8 return values and ! arguments ('4'). Change FFEINTRIN_impCTIME, FFEINTRIN_impMCLOCK, ! and FFEINTRIN_impTIME accordingly. ! (ffeintrin_is_intrinsic): Don't give caller a clue about ! form of intrinsic -- shouldn't be needed at this point. ! ! Cope with generic intrinsics that are subroutines and functions: ! * com.c (ffecom_finish_symbol_transform_, ffecom_expr_transform_): ! Don't transform an intrinsic that is not known to be a subroutine ! or a function. (Maybe someday have to avoid transforming ! any intrinsic with an undecided or unknown implementation.) ! * expr.c (ffeexpr_declare_unadorned_, ! ffeexpr_declare_parenthesized_): Ok to invoke generic ! intrinsic that has at least one subroutine form as a ! subroutine. ! Ok to pass intrinsic as actual arg if it has a known specific ! intrinsic form that is valid as actual arg. ! (ffeexpr_declare_parenthesized_): An unknown kind of ! intrinsic has a paren_type chosen based on context. ! (ffeexpr_token_arguments_): Build funcref/subrref based ! on context, not on kind of procedure being called. ! * intrin.h, intrin.c (ffeintrin_is_intrinsic): Undo changes of ! Tue Feb 4 23:12:04 1997 by me, change all callers to leave ! intrinsics as FFEINFO_kindNONE at this point. (Some callers ! also had unused variables deleted as a result.) ! ! Enable all intrinsic groups (especially f90 and vxt): ! * target.h (FFETARGET_defaultSTATE_DCP, FFETARGET_defaultSTATE_F2C, ! FFETARGET_defaultSTATE_F90, FFETARGET_defaultSTATE_MIL, ! FFETARGET_defaultSTATE_UNIX, FFETARGET_defaultSTATE_VXT): ! Delete these macros, let top.c set them directly. ! * top.c (ffeintrinsic_state_dcp_, ffe_intrinsic_state_f2c_, ! ffe_intrinsic_state_f90_, ffe_intrinsic_state_mil_, ! ffe_intrinsic_state_unix_, ffe_intrinsic_state_vxt_): ! Enable all these directly. ! ! Sat Feb 8 03:21:50 1997 Craig Burley ! ! * g77.c: Incorporate recent changes to ../gcc.c. ! For version magic (e.g. `g77 -v'), instead of compiling ! /dev/null, write, compile, run, and then delete a small ! program that prints the version numbers of the three ! components of libf2c (libF77, libI77, and libU77), ! so we get this info with bug reports. ! Also, this change reduces the chances of accidentally ! linking to an old (complex-alias-problem) libf2c. ! Fix `-L' so the argument is expected in `-Larg'. ! ! * com.h (FFECOM_f2cLONGINT): For INTEGER*8 support in f2c.h, ! dynamically determine proper type here, instead of ! assuming `long long int' is correct. ! ! Tue Feb 4 23:12:04 1997 Craig Burley ! ! Add libU77 library from Dave Love : ! * Make-lang.in (f77-runtime): Depend on new Makefile. ! (f/runtime/libU77/Makefile): New rule. ! Also configure libU77. ! ($(srcdir)/f/runtime/configure: Use Makefile.in, ! so configuration doesn't have to have happened. ! (f77.mostlyclean, f77.clean, f77.distclean, ! f77.maintainer-clean): Some fixups here, but more work ! needed. ! (RUNTIMESTAGESTUFF): Add libU77's config.status. ! (LIBU77STAGESTUFF, f77.stage1, f77.stage2, f77.stage3, ! f77.stage4): New macro, appropriate uses added. ! * com-rt.def: Add libU77 procedures. ! * com.c (ffecom_f2c_ptr_to_integer_type_node, ! ffecom_f2c_ptr_to_real_type_node): New type nodes. ! (FFECOM_rttypeCHARACTER_): New type of run-time function. ! (ffecom_char_args_): Handle CHARACTER*n intrinsics ! where n != 1 here, instead of in ffecom_expr_intrinsic_. ! (ffecom_expr_intrinsic_): New code to handle new ! intrinsics. ! In particular, change how FFEINTRIN_impFLUSH is handled. ! (ffecom_make_gfrt_): Handle new type of run-time function. ! (ffecom_init_0): Initialize new type nodes. ! * config-lang.in: New libU77 directory. ! * intrin.h, intrin.c (ffeintrin_is_intrinsic): Handle ! potential generic for subroutine _and_ function ! specifics via two new arguments. All callers changed. ! Properly ignore deleted/disabled intrinsics in resolving ! generics. ! (ffeintrin_check_, ffeintrin_init_0): Handle CHARACTER intrinsics of (*) ! length. ! * intrin.def: Permission granted by FSF to place this in ! public domain, which will allow it to serve as source ! for both g77 program and its documentation. ! Add libU77 intrinsics. ! (FLUSH): Now a generic, not specific, intrinsic. ! (DEFIMP): Now support return modifier for CHARACTER intrinsics. ! ! * com-rt.def (FFECOM_gfrtDIM, FFECOM_gfrtERF, ! FFECOM_gfrtERFC, FFECOM_gfrtEXP, FFECOM_gfrtSIGN, ! FFECOM_gfrtSIN, FFECOM_gfrtSINH, FFECOM_gfrtTAN, ! FFECOM_gfrtTANH, FFECOM_gfrtPOW_RI): Change "&r" to "&f". ! ! Sat Feb 1 12:15:09 1997 Craig Burley ! ! * Version 0.5.19.1 released. ! ! * com.c (ffecom_expr_, ffecom_expr_intrinsic_, ! ffecom_tree_divide_): FFECOM_gfrtPOW_ZI, ! FFECOM_gfrtCONJG, FFECOM_gfrtDCONJG, ! FFECOM_gfrtCCOS, FFECOM_gfrtCDCOS, ! FFECOM_gfrtCLOG, FFECOM_gfrtCDLOG, ! FFECOM_gfrtCSIN, FFECOM_gfrtCDSIN, ! FFECOM_gfrtCSQRT, FFECOM_gfrtCDSQRT, ! FFECOM_gfrtDIV_CC, FFECOM_gfrtDIV_ZZ: These all require ! result to _not_ overlap one or more inputs. ! ! Sat Feb 1 00:25:55 1997 Craig Burley ! ! * com.c (ffecom_init_0): Do internal checks only if ! -fset-g77-defaults not specified. ! ! Fix %LOC(), LOC() to return sufficiently wide type: ! * com.h, com.c (ffecom_pointer_kind_, ffecom_label_kind_, ! ffecom_pointer_kind(), ffecom_label_kind()): New globals ! and accessor macros hold kind for integer pointers on target ! machine. ! (ffecom_init_0): Determine narrowest INTEGER type that ! can hold a pointer (usually INTEGER*4 or INTEGER*8), ! store it in ffecom_pointer_kind_, etc. ! * expr.c (ffeexpr_cb_end_loc_): Use right type for %LOC(). ! * intrin.c (ffeintrin_check_, ffeintrin_init_0): Support ! new 'p' kind for type of intrinsic. ! * intrin.def (FFEINTRIN_impLOC): Returns "Ip" instead of "I1", ! so LOC() type is correct for target machine. ! ! Support -fugly-assign: ! * lang-options.h, top.h, top.c (ffe_decode_option): ! Accept -fugly-assign and -fno-ugly-assign. ! * com.c (ffecom_expr_): Handle -fugly-assign. ! * expr.c (ffeexpr_finished_): Check right type for ASSIGN ! contexts. ! ! Fri Jan 31 14:30:00 1997 Craig Burley ! ! Remove last vestiges of -fvxt-not-f90: ! * stb.c (ffestb_R10012_, ffestb_R10014_, ffestb_V0201_): ! top.c, top.h: ! ! Fri Jan 31 02:13:54 1997 Craig Burley ! ! * top.c (ffe_decode_option): Warn if -fugly is specified, ! it'll go away soon. ! ! * symbol.h: No need to #include "bad.h". ! ! Reorganize features from -fvxt-not-f90 to -fvxt: ! * lang-options.h, top.h, top.c: ! Accept -fvxt and -fno-vxt, but not -fvxt-not-f90 or -ff90-not-vxt. ! Warn if the latter two are used. ! * expr.c (ffeexpr_nil_rhs_): Double-quote means octal constant. ! (ffeexpr_token_rhs_): Double-quote means octal constant. ! * target.h (FFETARGET_defaultIS_VXT_NOT_90): Delete macro ! definition, no longer needed. ! ! Make some -ff90 features the default: ! * data.c (ffedata_value): DATA implies SAVE. ! * src.h (ffesrc_is_name_noninit): Underscores always okay. ! ! Fix up some more #error directives by quoting their text: ! * bld.c (ffebld_constant_is_zero): ! * target.h: ! ! Sat Jan 18 18:22:09 1997 Craig Burley ! ! * g77.c (lookup_option, main): Recognize `-Xlinker', ! `-Wl,', `-l', `-L', `--library-directory', `-o', ! `--output'. ! (lookup_option): Don't depend on SWITCH_TAKES_ARG ! being correct, it might or might not have `-x' in ! it depending on host. ! Return NULL argument if it would be an empty string. ! (main): If no input files (by gcc.c's definition) ! but `-o' or `--output' specified, produce diagnostic ! to avoid overwriting output via gcc. ! Recognize C++ `+e' options. ! Treat -L as another non-magical option (like -B). ! Don't append_arg `-x' twice. ! ! Fri Jan 10 23:36:00 1997 Craig Burley ! ! * top.c [BUILT_FOR_270] (ffe_decode_option): Make ! -fargument-noalias-global the default. ! ! Fri Jan 10 07:42:27 1997 Craig Burley ! ! Enable inlining of previously-compiled program units: ! * com.c (ffecom_do_entry_, ffecom_start_progunit_): ! Register new public function in ffeglobal database. ! (ffecom_sym_transform_): Any GLOBAL or potentially GLOBAL ! symbol should be looked up in ffeglobal database and ! that tree node used, if found. That way, gcc knows ! the references are to those earlier definitions, so it ! can emit shorter branches/calls, inline, etc. ! (ffecom_transform_common_): Minor change for clarity. ! * expr.c (ffeexpr_sym-lhs_call_, ffeexpr_sym_lhs_extfunc_, ! ffeexpr_sym_rhs_actualarg_, ffeexpr_paren_rhs_let_, ! ffeexpr_token_funsubstr_): Globalize symbol as needed. ! * global.c (ffeglobal_promoted): New function to look up ! existing local symbol in ffeglobal database. ! * global.h: Declare new function. ! * name.h (ffename_token): New macro, plus alphabetize. ! * stc.c (ffestc_R1207_item): Globalize EXTERNAL symbol. ! * stu.c (ffestu_sym_end_transition, ffestu_sym_exec_transition): ! Globalize symbol as needed. ! * symbol.h, symbol.c (ffesymbol_globalize): New function. ! ! Thu Jan 9 14:20:00 1997 Craig Burley ! ! * ste.c (ffeste_R809): Produce a diagnostic for SELECT CASE ! on CHARACTER type, instead of crashing. ! ! Thu Jan 9 00:52:45 1997 Craig Burley ! ! * stc.c (ffestc_order_entry_, ffestc_order_format_, ! ffestc_R1226): Allow ENTRY and FORMAT before IMPLICIT ! NONE, by having them transition only to state 1 instead ! of state 2 (which is disallowed by IMPLICIT NONE). ! ! Mon Jan 6 22:44:53 1997 Craig Burley ! ! Fix AXP bug found by Rick Niles (961201-1.f): ! * com.c (ffecom_init_0): Undo my 1996-05-14 change, as ! it is incorrect and prevented easily finding this bug. ! * target.h [__alpha__] (ffetargetReal1, ffetargetReal2): ! Use int instead of long. ! (ffetarget_cvt_r1_to_rv_, ffetarget_cvt_rv_to_r1_, ! ffetarget_cvt_r2_to_rv_, ffetarget_cvt_rv_to_r2_): ! New functions that intercede for callers of ! REAL_VALUE_(TO|UNTO)_TARGET_(SINGLE|DOUBLE). ! All callers changed, and damaging casts to (long *) removed. ! ! Sun Jan 5 03:26:11 1997 Craig Burley ! ! * Make-lang.in (g77, g77-cross): Depend on both g77.c and ! zzz.c, in $(srcdir)/f/. ! ! Better design for -fugly-assumed: ! * stc.c (ffestc_R501_item, ffestc_R524_item, ! ffestc_R547_item_object): Pass new is_ugly_assumed flag. ! * stt.c, stt.h (ffestt_dimlist_as_expr, ! ffestt_dimlist_type): New is_ugly_assumed flag now ! controls whether "1" is treated as "*". ! Don't treat "2-1" or other collapsed constants as "*". ! ! Sat Jan 4 15:26:22 1997 Craig Burley ! ! * stb.c (ffestb_R10012_): Don't confirm on FORMAT(A,) ! or even FORMAT(A,,B), as R1229 only warns about the ! former currently, and this seems reasonable. ! ! Improvements to diagnostics: ! * sta.c (ffesta_second_): Don't add any ffestb parsers ! unless they're specifically called for. ! Set up ffesta_tokens[0] before calling ffestc_exec_transition, ! else stale info might get used. ! (ffesta_save_): Do a better job picking which parser to run ! after running all parsers with no confirmed possibles. ! (FFESTA_maxPOSSIBLES_): Decrease from 100 now that so few ! possibles are ever on the list at a given time. ! (struct _ffesta_possible): Add named attribute. ! (ffesta_add_possible_exec_, ffesta_add_possible_nonexec_): ! Make these into macros that call a single function that now ! sets the named attribute. ! (ffesta_add_possible_unnamed_exec_, ! ffeseta_add_possible_unnamed_nonexec_): New macros. ! (ffesta_second_): Designate unnamed possibles as ! appropriate. ! * stb.c (ffestb_R1229, ffestb_R12291_): Use more general ! diagnostic, so things like "POINTER (FOO, BAR)" are ! diagnosed as unrecognized statements, not invalid statement ! functions. ! * stb.h, stb.c (ffestb_unimplemented): Remove function. ! ! 1996-12-30 Dave Love ! ! * com.c: #include libU77/config.h ! (ffecom_f2c_ptr_to_integer_type_node, ! ffecom_f2c_ptr_to_integer_type_node): New variables. ! (ffecom_init_0): Use them. ! (ffecom_expr_intrinsic_): Many news cases for libU77 intrinsics. ! ! * com-rt.def: New definitions for libU77. ! * intrin.def: Likewise. Also correct ftell arg spec. ! ! * Makefile.in (f/runtime/libU77/config.h): New target for com.c ! dependency. ! * Make-lang.in (f771): Depend on f/runtime/Makefile for the above. ! ! Sat Dec 28 12:28:29 1996 Craig Burley ! ! * stt.c (ffestt_dimlist_type): Treat ([...,]1) in dimlist ! as ([...,]*) if -fugly-assumed, so assumed-size array ! detected early enough. ! ! Thu Dec 19 14:01:57 1996 Craig Burley ! ! * target.h (FFETARGET_REAL_VALUE_FROM_INT_): Conditionalize ! definition on BUILT_FOR_280, not BUILT_WITH_280, since ! the name of the macro was (properly) changed since 0.5.19. ! ! Fix warnings/errors resulting from ffetargetOffset becoming ! `long long int' instead of `unsigned long' as of 0.5.19, ! while ffebitCount remains `unsigned long': ! * bld.c (ffebld_constantarray_dump): Avoid warnings by ! using loop var of appropriate type, and using casts. ! * com.c (ffecom_expr_): Use right type for loop var. ! (ffecom_sym_transform_, ffecom_transform_equiv_): ! Cast to right type in assertions. ! * data.c (ffedata_gather_, ffedata_value_): Cast to right ! type in assertions and comparisons. ! ! Wed Dec 18 12:07:11 1996 Craig Burley ! ! Patch from Alexandre Oliva : ! * Makefile.in (all.indirect): Don't pass -bbigtoc option ! to GNU ld. ! ! Cope with new versions of gcc: ! * com.h (BUILT_FOR_280): New macro. ! * com.c (ffecom_ptr_to_expr): Conditionalize test of ! OFFSET_REF. ! (ffecom_build_complex_constant_): Conditionalize calling ! sequence for build_complex. ! ! Sat Dec 7 07:15:17 1996 Craig Burley ! ! * Version 0.5.19 released. ! ! Fri Dec 6 12:23:55 1996 Craig Burley ! ! * g77.c: Default to assuming "f77" is in $LANGUAGES, since ! the LANGUAGE_F77 macro isn't defined by anyone anymore (but ! might as well leave the no-f77 code in just in case). ! * Make-lang.in (g77, g77-cross): Don't define LANGUAGE_F77 ! anymore. ! ! 1996-12-06 Dave Love ! ! * Make-lang.in (g77, g77-cross): Revert to building `g77' or not ! conditional on `f77' in LANGUAGES. ! ! Wed Dec 4 13:08:44 1996 Craig Burley ! ! * Make-lang.in (g77, g77-cross): No libs or lib dependencies ! in case where "f77" is not in $LANGUAGES. ! ! * lex.c (ffelex_image_char_, ffelex_file_fixed, ! ffelex_file_free): Fixes to properly handle lines with ! null character, and too-long lines as well. ! ! * lex.c: Call ffebad_start_msg_lex instead of ! ffebad_start_msg throughout. ! ! Sun Dec 1 21:19:55 1996 Craig Burley ! ! Fix-up for 1996-11-25 changes: ! * com.c (ffecom_member_phase2_): Subtract out 0 offset for ! elegance and consistency with EQUIVALENCE aggregates. ! (ffecom_sym_transform_): Ditto for LOCAL/COMMON, and ! ensure we get the same parent storage area. ! * data.c (ffedata_gather_, ffedata_value_): Subtract out ! aggregate offset. ! ! Wed Nov 27 13:55:57 1996 Craig Burley ! ! * proj.h: Quote the text of the #error message, to avoid ! strange-looking diagnostics from non-gcc ANSI compilers. ! ! * top.c: Make -fno-debug-kludge the default. ! ! Mon Nov 25 20:13:45 1996 Craig Burley ! ! Provide more info on EQUIVALENCE mismatches: ! * bad.def (FFEBAD_EQUIV_MISMATCH): More detailed message. ! * equiv.c (ffeequiv_layout_local_, ffeequiv_layout_cblock): ! More details for FFEBAD_EQUIV_MISMATCH. ! ! Fix problem with EQUIVALENCE handling: ! * equiv.c (ffeequiv_layout_local_): Redesign algorithm -- ! old one was broken, resulting in rejection of good code. ! (ffeequiv_offset_): Add argument, change callers. ! Clean up the code, fix up the (probably unused) negative-value ! case for SYMTER. ! * com.c (ffecom_sym_transform_): For local EQUIVALENCE ! member, subtract out aggregate offset (which is <= 0). ! ! Thu Nov 21 12:44:56 1996 Craig Burley ! ! Change type of ffetargetOffset from `unsigned long' to `long long': ! * bld.c (ffebld_constantarray_dump): Change printf formats. ! * storag.c (ffestorag_dump): Ditto. ! * symbol.c (ffesymbol_report): Ditto. ! * target.h (ffetargetOffset_f): Ditto and change type itself. ! ! Handle situation where list of languages does not include f77: ! * Make-lang.in: Define LANGUAGE_F77 to 1 only if `f77' is in ! the $LANGUAGES macro for the build. ! * g77.c: Compile to a (nearly) no-op program if LANGUAGE_F77 ! is not defined to 1. ! ! Fixes to delay confirmation of READ, WRITE, and GOTO statements ! so the corresponding assignments to same-named CHAR*(*) arrays ! work: ! * stb.c (ffestb_R90915_, ffestb_91014_): New functions. ! (ffestb_goto3_, ffestb_goto5_): Move confirmation from 3 to 5 ! for the OPEN_PAREN case. ! (ffestb_R9091_, ffestb_R9094_, ffestb_R90913_, ffestb_R90914_, ! ffestb_R91012_, ffestb_R91013_): Use new functions, and confirm ! except for the OPEN_PAREN case. ! ! Fixes to not confirm declarations with an open paren where ! an equal sign or other assignment-like token might be, so the ! corresponding assignments to same-named CHAR*(*) arrays work: ! (ffestb_decl_entsp_5_): Move assertion so we crash on that first, ! if it turns out to be wrong, before the less-debuggable crash ! on mistaken confirmation. ! (ffestb_decl_entsp_6_, ffestb_decl_entsp_7_, ffestb_decl_entsp_8_): ! Include OPEN_PAREN in list of assignment-only tokens. ! ! Fix more diagnosed-crash bugs: ! * stu.c (ffestu_sym_end_transition): ANY-ize an adjustable array ! with bad dimension expressions even if still stateUNCERTAIN. ! (ffestu_symter_end_transition_, ffestu_symter_exec_transition_): ! Return TRUE for opANY as well. ! For code elegance, move opSYMTER case into first switch. ! ! 1996-11-17 Dave Love ! ! * lex.c: Fix last change. ! ! 1996-11-14 Dave Love ! ! * Make-lang.in, config-lang.in: Remove the (broken) libU77 stuff, ! pending 0.5.20. ! ! Thu Nov 14 15:40:59 1996 Craig Burley ! ! * bad.def (FFEBAD_UNIMPL_STMT): Explain that invalid ! intrinsic references can trigger this message, too. ! ! 1996-11-12 Dave Love ! ! * lex.c: Declare dwarfout routines. ! ! * config-lang.in: Sink grep o/p. ! ! Mon Nov 11 14:21:13 1996 Craig Burley ! ! * g77.c (main): Might as well print version number ! for --verbose as well. ! ! Thu Nov 7 18:41:41 1996 Craig Burley ! ! * expr.c, lang-options.h, target.h, top.c, top.h: Split out ! remaining -fugly stuff into -fugly-logint and -fugly-comma, ! leaving -fugly as simply a `macro' that expands into other ! options, and eliminate defaults for some of the ugly stuff ! in target.h. ! ! * Make-lang.in (gcc-cross): Compile zzz.c, not version.o (!), ! in to get version info for this target. ! ! * config-lang.in: Test for GBE patch application based ! on whether 2.6.x or 2.7.x GBE is detected. ! ! Wed Nov 6 14:19:45 1996 Craig Burley ! ! * Make-lang.in (g77): Compile zzz.c in to get version info. ! * g77.c: Add support for --help and --version. ! ! * g77.c (lookup_option): Short-circuit long-winded tests ! when second char is not hyphen, just to save a spot of time. ! ! Sat Nov 2 13:50:31 1996 Craig Burley ! ! * intrin.def: Add FTELL and FSEEK intrinsics, plus new ! `g' codes for alternate-return (GOTO) arguments. ! * intrin.c (ffeintrin_check_): Support `g' codes. ! * com-rt.def: Add ftell_() and fseek_() to database. ! * com.c (ffecom_expr_intrinsic_): Ditto. Also, let each ! subroutine intrinsic decide for itself what to do with ! tree_type, the default being NULL_TREE once again (so ! ffecom_call_ doesn't think it's supposed to cast the ! 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. ! (ffeste_R910_finish): Ditto. ! (ffeste_io_call_): Simplify logic. ! (ffeste_io_impdo_): ! (ffeste_subr_beru_): ! (ffeste_R904): ! (ffeste_R907): ! (ffeste_R909_start): ! (ffeste_R909_item): ! (ffeste_R909_finish): ! (ffeste_R910_start): ! (ffeste_R910_item): ! (ffeste_R910_finish): ! (ffeste_R911_start): ! (ffeste_R923A): Ditto all the above. ! ! Thu Oct 31 20:56:28 1996 Craig Burley ! ! * config-lang.in, Make-lang.in: Rename flag file ! build-u77 to build-libu77, for consistency with ! install-libf2c and such. ! ! * config-lang.in: Don't complain about failure to patch ! if pre-2.7.0 gcc is involved (since our patch for that ! doesn't add support for tooning). ! ! Sat Oct 26 05:56:51 1996 Craig Burley ! ! * bad.def (FFEBAD_TYPELESS_TOO_LARGE): Remove this ! unused and redundant diagnostic. ! ! Sat Oct 26 00:45:42 1996 Craig Burley ! ! * target.c (ffetarget_integerhex): Fix dumb bug. ! ! 1996-10-20 Dave Love ! ! * gbe/2.7.2.1.diff: New file. ! ! * Makefile.in (F771_LDFLAGS): Add -bbigtoc for AIX4.1 up, suggested by ! endo@material.tohoku.ac.jp [among others!]. ! ! Sat Oct 19 03:11:14 1996 Craig Burley ! ! * bad.def, bld.c, bld.h, expr.c, lang-options.h, target.c, ! target.h, top.c, top.h (ffebld_constant_new_integerbinary, ! ffebld_constant_new_integerhex, ffebld_constant_new_integeroctal, ! ffeexpr_token_name_apos_name_, ffetarget_integerbinary, ! ffetarget_integerhex, ffetarget_integeroctal): Support ! new -fno-typeless-boz option with new functions, mods to ! existing octal-handling functions, new macros, new error ! messages, and so on. ! ! * com.c, lang-options.h, top.c, top.h (ffecom_notify_primary_entry): ! Print program unit name on stderr if -fno-silent (new option). ! ! * lang-options.h, top.c, top.h, stt.c (ffestt_dimlist_as_expr): ! Treat ([...,]1) in dimlist as ([...,]*) if -fugly-assumed ! (new option). ! ! * lang-options.h: Comment out options duplicated in gcc/toplev.c, ! because, somehow, having them commented in and building on my ! DEC Alpha results in a cc1 that always segfaults, and gdb that ! also segfaults whenever it debugs it up to init_lex() calling ! xmalloc() or so. ! ! Thu Oct 17 00:39:27 1996 Craig Burley ! ! * stb.c (ffestb_R10013_): Don't change meaning of .sign until ! after previous meaning/value used to set sign of value ! (960507-1.f). ! ! Sun Oct 13 22:15:23 1996 Craig Burley ! ! * top.c (ffe_decode_option): Don't set back-end flags ! that are nonexistent prior to gcc 2.7.0. ! ! Sun Oct 13 12:48:45 1996 Craig Burley ! ! * com.c (convert): Don't convert emulated complex expr to ! real (via REALPART_EXPR) if the target type is (emulated) ! complex. ! ! Wed Oct 2 21:57:12 1996 Craig Burley ! ! * com.c (ffecom_debug_kludge_): Set DECL_IN_SYSTEM_HEADER so ! -Wunused doesn't complain about these manufactured decls. ! (ffecom_expr_): Ditto, for original (non-ASSIGN'ed) variable. ! (ffecom_transform_equiv_): Clear DECL_IGNORED_P for aggregate ! area so it shows up as a debug-accessible symbol. ! (pushdecl): Default for "invented" identifiers (a g77-specific ! concept for now) is that they are artificial, in system header, ! ignored for debugging purposes, used, and (for types) suppressed. ! This ought to be overkill. ! ! Fri Sep 27 23:13:07 1996 Craig Burley ! ! * ste.c (ffeste_begin_iterdo_, ffeste_end_iterdo_): Support ! one-trip DO loops (F66-style). ! * lang-options.h, top.c, top.h (-fonetrip): New option. ! ! Thu Sep 26 00:18:40 1996 Craig Burley ! ! * com.c (ffecom_debug_kludge_): New function. ! (ffecom_sym_transform_): Use new function for COMMON and EQUIVALENCE ! members. ! ! * lang-options.h, top.c, top.h (-fno-debug-kludge): ! New option. ! ! 1996-09-24 Dave Love ! ! * Make-lang.in (include/f2c.h): ! Remove dependencies on xmake_file and tmake_file. ! They expand inconsistently in 2.8 c.f. 2.7; $(GCC_PARTS) depends on ! them anyhow. ! ! 1996-09-22 Dave Love ! ! * config-lang.in: Add --enable-libu77 option handling. ! ! * Make-lang.in: ! Conditionally add --enable-libu77 when running runtime configure. ! Define LIBU77STAGESTUFF and use it in relevant rules. ! ! 1996-08-21 Dave Love ! ! * Make-lang.in (f77-runtime): ! `stmp-hdrs' should have been `stmp-headers'. ! ! 1996-08-20 Dave Love ! ! * Make-lang.in (f77-runtime): ! Depend on stmp-hdrs, not stmp-int-hdrs, since libF77 ! needs float.h. ! ! Sat Jun 22 18:17:11 1996 Craig Burley ! ! * com.c (ffecom_tree_divide_): Fix RECORD_TYPE case to ! look at type of first field, properly, to determine ! whether to call c_div or z_div. ! ! Tue Jun 4 04:27:18 1996 Craig Burley ! ! * com.c (ffecom_build_complex_constant_): Explicitly specify ! TREE_PURPOSE. ! (ffecom_expr_): Fix thinko. ! (ffecom_2): For COMPLEX_EXPR, explicitly specify TREE_PURPOSE. ! ! Mon May 27 16:23:43 1996 Craig Burley ! ! Changes to optionally avoid gcc's back-end complex support: ! * com.c (ffecom_stabilize_aggregate_): New function. ! (ffecom_convert_to_complex_): New function. ! (ffecom_make_complex_type_): New function. ! (ffecom_build_complex_constant_): New function. ! (ffecom_expr_): For opCONVERT of non-COMPLEX to COMPLEX, ! don't bother explicitly converting to the subtype first, ! because gcc does that anyway, and more code would have ! to be added to find the subtype for the emulated-complex ! case. ! (ffecom_f2c_make_type_): Use ffecom_make_complex_type_ ! instead of make_node etc. to make a complex type. ! (ffecom_1, ffecom_2): Translate operations on COMPLEX operands ! to appropriate operations when emulating complex. ! (ffecom_constantunion): Use ffecom_build_complex_constant_ ! instead of build_complex to build a complex constant. ! (ffecom_init_0): Change point at which types are laid out ! for improved consistency. ! Use ffecom_make_complex_type_ instead of make_node etc. ! to make a complex type. ! Always calculate storage sizes from TYPE_SIZE, never TYPE_PRECISION. ! (convert): Use e, not expr, since we've copied into that anyway. ! For RECORD_TYPE cases, do emulated-complex conversions. ! (ffecom_f2c_set_lio_code_): Always calculate storage sizes ! from TYPE_SIZE, never TYPE_PRECISION. ! (ffecom_tree_divide_): Allow RECORD_TYPE to also be handled ! by run-time library. ! (ffecom_expr_intrinsic_): Handle possible RECORD_TYPE as argument ! to AIMAG intrinsic. ! ! * top.h, top.c, lang-options.h: Support new -f(no-)emulate-complex option. ! ! * com.c (ffecom_sym_transform_): Clarify and fix typos in comments. ! ! Mon May 20 02:06:27 1996 Craig Burley ! ! * target.h: Use new REAL_VALUE_UNTO_TARGET_* macros instead ! of REAL_VALUE_FROM_TARGET_DOUBLE and _SINGLE. ! Explicitly use long instead of HOST_WIDE_INT for emulation ! of ffetargetReal1 and ffetargetReal2. ! ! 1996-05-20 Dave Love ! ! * config-lang.in: ! Test for patch being applied with flag_move_all_movables in toplev.c. ! ! * install.texi (Patching GNU Fortran): ! Mention overriding X_CFLAGS rather than ! editing proj.h on SunOS4. ! ! * Make-lang.in (F77_FLAGS_TO_PASS): ! Add X_CFLAGS (convenient for SunOS4 kluge, in ! particular). ! (f77.{,mostly,dist}clean): Reorder things, in particular not to delete ! Makefiles too early. ! ! * g77.c (DEFAULT_SWITCH_TAKES_ARG): Define a la gcc.c in the ! current GCC snapshot. ! ! Tue May 14 00:24:07 1996 Craig Burley ! ! Changes for DEC Alpha AXP support: ! * com.c (ffecom_init_0): REAL_ARITHMETIC means internal ! REAL/DOUBLE PRECISION might well have a different size ! than the compiled type, so don't crash if this is the ! case. ! * target.h: Use `int' for ffetargetInteger1, ! ffetargetLogical1, and magical tests. Set _f format ! strings accordingly. ! ! Tue Apr 16 14:08:28 1996 Craig Burley ! ! * top.c (ffe_decode_option): -Wall no longer implies ! -Wsurprising. ! ! Sat Apr 13 14:50:06 1996 Craig Burley ! ! * com.c (ffecom_char_args_): If item is error_mark_node, ! set *length that way, too. ! ! * com.c (ffecom_expr_power_integer_): If either operand ! is error_mark_node, return that. ! ! * com.c (ffecom_intrinsic_len_): If item is error_mark_node, ! return that for length. ! ! * expr.c (ffeexpr_declare_unadorned_, ! ffeexpr_declare_parenthesized_): Instead of crashing ! on unexpected contexts, produce a diagnostic. ! ! * intrin.c (ffeintrin_check_), intrin.def (impSIGNAL): ! Allow procedure as second arg to SIGNAL intrinsic. ! ! * stu.c (ffestu_symter_end_transition_): New function. ! (ffestu_symter_exec_transition_): Return bool arg. ! Always transition symbol (don't inhibit when !whereNONE). ! (ffestu_sym_end_transition): If DUMMY/LOCAL arg has any ! opANY exprs in its dimlist, diagnose it so it doesn't ! make it through to later stages that try to deal with ! dimlist stuff. ! (ffestu_sym_exec_transition): If sym has any opANY exprs ! in its dimlist, diagnose it so it becomes opANY itself. ! ! * symbol.c (ffesymbol_error): If token arg is NULL, ! just ANY-ize the symbol -- don't produce diagnostic. ! ! Mon Apr 1 10:14:02 1996 Craig Burley ! ! * Version 0.5.18 released. ! ! Mon Mar 25 20:52:24 1996 Craig Burley ! ! * com.c (ffecom_expr_power_integer_): Don't generate code ! that compares COMPLEX (or, as it happens, REAL) via "LT_EXPR", ! since the back end crashes on that. (This code would never ! be executed anyway, but the test that avoids it has now been ! translated to control whether the code gets generated at all.) ! Fixes 960323-3.f. ! ! * com.c (ffecom_type_localvar_): Handle variable-sized ! dimension bounds expressions here, so they get calculated ! and saved on procedure entry. Fixes 960323-4.f. ! ! * com.c (ffecom_notify_init_symbol): Symbol has no init ! info at all if only zeros have been used to initialize it. ! Fixes 960324-0.f. ! ! * expr.c, expr.h (ffeexpr_type_combine): Renamed from ! ffeexpr_type_combine_ and now a public procedure; last arg now ! a token, instead of an internal structure used to extract a token. ! Now allows the outputs to be aliased with the inputs. ! Now allows a NULL token to mean "don't report error". ! (ffeexpr_reduced_bool2_, ffeexpr_reduced_eqop2_, ! ffeexpr_reduced_math2_, ffeexpr_reduced_power_, ! ffeexpr_reduced_relop2_): Handle new calling sequence for ! ffeexpr_type_combine. ! * (ffeexpr_convert): Don't put an opCONVERT node ! in just because the size is unknown; all downstream code ! should be able to deal without it being there anyway, and ! getting rid of it allows new intrinsic code to more easily ! combine types and such without generating bad code. ! * info.c, info.h (ffeinfo_kindtype_max): Rewrite to do ! proper comparison of size of types, not just comparison ! of their internal kind numbers (so I2.eq.I1 doesn't promote ! I1 to I2, rather the other way around). ! * intrin.c (ffeintrin_check_): Combine types of arguments ! in COL a la expression handling, for greater flexibility ! and permissiveness (though, someday, -fpedantic should ! report use of this kind of thing). ! Make sure Hollerith/typeless where CHARACTER expected is ! rejected. This all fixes 960323-2.f. ! ! * ste.c (ffeste_begin_iterdo_): Fix some more type conversions ! so INTEGER*2-laden DO loops don't crash at compile time on ! certain machines. Believed to fix 960323-1.f. ! ! * stu.c (ffestu_sym_end_transition): Certainly reject ! whereDUMMY not in any dummy list, whether stateUNCERTAIN ! or stateUNDERSTOOD. Fixes 960323-0.f. ! ! Tue Mar 19 13:12:40 1996 Craig Burley ! ! * data.c (ffedata_value): Fix crash on opANY, and simplify ! the code at the same time. ! ! * Make-lang.in (f77-runtime): Also depends on lib[FI]77/Makefile... ! (include/f2c.h...): ...which in turn depend on */Makefile.in. ! (f77.rebuilt): Rebuild runtime stuff too. ! ! * intrin.c (ffeintrin_check_): Accommodate TYPELESS/HOLLERITH ! types, convert args as necessary, etc. ! ! * expr.c (ffeexpr_convert): Fix test for TYPELESS/HOLLERITH ! to obey the docs; crash if no source token when error. ! (ffeexpr_collapse_convert): Crash if no token when error. ! ! Mon Mar 18 15:51:30 1996 Craig Burley ! ! * com.c (ffecom_init_zero_): Renamed from ! ffecom_init_local_zero_; now handles top-level ! (COMMON) initializations too. ! ! * bld.c (ffebld_constant_is_zero): ! * com.c (ffecom_symbol_transform_, ffecom_sym_transform_assign_, ! ffecom_transform_common_, ffecom_transform_equiv_): ! * data.c: ! * equiv.c: ! * equiv.h: ! * lang-options.h: ! * stc.c: ! * storag.c: ! * storag.h: ! * symbol.c: ! * symbol.h: ! * target.c: ! * target.h: ! * top.c: ! * top.h: All of this is mostly housekeeping-type changes ! to support -f(no-)zeros, i.e. not always stuff zero ! values into the initializer fields of symbol/storage objects, ! but still track that they have been given initial values. ! ! * bad.def: Fix wording for DATA-related diagnostics. ! ! * com.c (ffecom_sym_transform_assign_): Don't check ! any EQUIVALENCE stuff for local ASSIGN, the check was ! bad (crashing), and it's not necessary, anyway. ! ! * com.c (ffecom_expr_intrinsic_): For MAX and MIN, ! ignore null arguments as far arg[123], and fix handling ! of ANY arguments. (New intrinsic support now allows ! spurious trailing null arguments.) ! ! * com.c (ffecom_init_0): Add HOLLERITH (unsigned) ! equivalents for INTEGER*2, *4, and *8, so shift intrinsics ! and other things that need unsigned versions of signed ! types work. ! ! Sat Mar 16 12:11:40 1996 Craig Burley ! ! * storag.c (ffestorag_exec_layout): Treat adjustable ! local array like dummy -- don't create storage object. ! * com.c (ffecom_sym_transform_): Allow for NULL storage ! object in LOCAL case (adjustable array). ! ! Fri Mar 15 13:09:41 1996 Craig Burley ! ! * com.c (ffecom_sym_transform_): Allow local symbols ! with nonconstant sizes (adjustable local arrays). ! (ffecom_type_localvar_): Allow dimensions with nonconstant ! component (adjustable local arrays). ! * expr.c: Various minor changes to handle adjustable ! local arrays (a new case of stateUNCERTAIN). ! * stu.c (ffestu_sym_end_transition, ! ffestu_sym_exec_transition): Ditto. ! * symbol.def: Update docs to reflect these changes. ! ! * com.c (ffecom_expr_): Reduce space/time needed for ! opACCTER case by handling it here instead of converting ! it to opARRTER earlier on. ! (ffecom_notify_init_storage): Don't convert ACCTER to ARRTER. ! (ffecom_notify_init_symbol): Ditto. ! ! * com.c (ffecom_init_0): Crash and burn if any of the types' ! sizes, according to the GBE, disagrees with the sizes of ! the FFE's internal implementation. This might catch ! Alpha/SGI bugs earlier. ! ! Fri Mar 15 01:09:41 1996 Craig Burley ! ! * com-rt.def, com.c, com.h: Changes for rewrite of intrinsic ! handling. ! * com.c (ffecom_arglist_expr_): New function. ! (ffecom_widest_expr_type_): New function. ! (ffecom_expr_intrinsic_): Reorganize, some rewriting. ! (ffecom_f2c_make_type_): Layout complex types. ! (ffecom_gfrt_args_): New function. ! (ffecom_list_expr): Trivial change for consistency. ! ! * expr.c (ffeexpr_token_name_rhs_): Go back to getting ! type from specific, not implementation, info. ! (ffeexpr_token_funsubstr_): Set intrinsic implementation too! ! * intrin.c: Major rewrite of most portions. ! * intrin.def: Major rearchitecting of tables. ! * intrin.h (ffeintrin_basictype, ffeintrin_kindtype): ! Now (once again) take ffeintrinSpec as arg, not ffeintrinImp; ! for now, these return NONE, since they're not really needed ! and adding the necessary info to the tables is not trivial. ! (ffeintrin_codegen_imp): New function. ! * stc.c (ffestc_R1208_item): Change way ffeintrin funcs called, ! back to original per above; but comment out the code anyway. ! ! * intrin.c (ffe_init_0): Do internal checks only if ! -fset-g77-defaults not specified. ! ! * lang-options.h: Add -fset-g77-defaults option. ! * lang-specs.h: Always pass -fset-g77-defaults. ! * top.c, top.h: New option. ! ! Sat Mar 9 17:49:50 1996 Craig Burley ! ! * Make-lang.in (stmp-int-hdrs): Use --no-validate when ! generating the f77.rebuilt files (BUGS, INSTALL, NEWS) ! so cross-references can work properly in g77.info ! without a lot of hassle. Users can probably deal with ! the way they end up looking in the f77.rebuilt files. ! ! * bld.c (ffebld_constant_new_integer4_val): INTEGER*8 ! support -- new function. ! (ffebld_constant_new_logical4_val): New function. ! * com.c (ffecom_f2c_longint_type_node): New type. ! (FFECOM_rttypeLONGINT_): New return type code. ! (ffecom_expr_): Add code to invoke pow_qq instead ! of pow_ii for INTEGER4 (INTEGER*8) case. ! If ffecom_expr_power_integer_ returns NULL_TREE, just do ! the usual work. ! (ffecom_make_gfrt_): Handle new type. ! (ffecom_expr_power_integer_): Let caller do the work if in ! dummy-transforming case, since ! caller now knows about INTEGER*8 and such, by returning ! NULL_TREE. ! * expr.c (ffeexpr_reduced_power_): Complain about non-INTEGER ! raised to INTEGER4 (INTEGER*8) power. ! ! * target.c (ffetarget_power_integerdefault_integerdefault): ! Fix any**negative. ! * com.c (ffecom_expr_power_integer_): Fix (-1)**(-8) and similar ! to ABS() the integral result if the exponent is negative ! and even. ! ! * ste.c (ffeste_begin_iterdo_): Clean up a type ref. ! Always convert iteration count to _default_ INTEGER. ! ! * sta.c (ffesta_second_): Add BYTE and WORD type/stmts; ! changes by Scott Snyder . ! * stb.c (ffestb_decl_recursive): Ditto. ! (ffestb_decl_recursive): Ditto. ! (ffestb_decl_entsp_2_): Ditto. ! (ffestb_decl_entsp_3_): Ditto. ! (ffestb_decl_funcname_2_): Ditto. ! (ffestb_decl_R539): Ditto. ! (ffestb_decl_R5395_): Ditto. ! * stc.c (ffestc_establish_declstmt_): Ditto. ! * std.c (ffestd_R539item): Ditto. ! (ffestd_R1219): Ditto. ! * stp.h: Ditto. ! * str-1t.fin: Ditto. ! * str-2t.fin: Ditto. ! ! * expr.c (ffeexpr_finished_): For DO loops, allow ! any INTEGER type; convert LOGICAL (assuming -fugly) ! to corresponding INTEGER type instead of always default ! INTEGER; let later phases do conversion of DO start, ! end, incr vars for implied-DO; change checks for non-integral ! DO vars to be -Wsurprising warnings. ! * ste.c (ffeste_io_impdo_): Convert start, end, and incr ! to type of DO variable. ! ! * com.c (ffecom_init_0): Add new types for [IL][234], ! much of which was done by Scott Snyder . ! * target.c: Ditto. ! * target.h: Ditto. ! ! Wed Mar 6 14:08:45 1996 Craig Burley ! ! * top.c (ffe_init_gbe_): Make -frerun-loop-opt the default. ! ! Mon Mar 4 12:27:00 1996 Craig Burley ! ! * expr.c (ffeexpr_exprstack_push_unary_): Really warn only ! about two successive _arithmetic_ operators. ! ! * stc.c (ffestc_R522item_object): Allow SAVE of (understood) ! local entity. ! ! * top.c (ffe_decode_option): New -f(no-)second-underscore options. ! * top.h: New options. ! * com.c (ffecom_get_external_identifier_, ffecom_get_identifier_): ! New options. ! ! * Make-lang.in (f77.maintainer-clean): Clean f/BUGS, f/INSTALL, ! f/NEWS. ! ($(srcdir)/f/BUGS, $(srcdir)/f/INSTALL, $(srcdir)/f/NEWS): ! New rules. ! ($(srcdir)/f/g77.info, $(srcdir)/f/g77.dvi): Depend on ! f/bugs.texi and f/news.texi. ! (f77.install-man): Install f77 man pages (if enabled). ! (f77.uninstall): Uninstall info docs, f77 man pages (if enabled). ! ! * top.c (ffe_init_gbe_): New function. ! (ffe_decode_option, ffe_file): Call ffe_init_gbe_ to ! set defaults for gcc options. ! ! Sat Jan 20 13:57:19 1996 Craig Burley ! ! * com.c (ffecom_get_identifier_): Eliminate needless ! comparison of results of strchr. ! ! Tue Dec 26 11:41:56 1995 Craig Burley ! ! * Make-lang.in: Add rules for new files g77.texi, g77.info, ! and g77.dvi. ! Reorganize the *clean rules to more closely parallel gcc's. ! ! * config-lang.in: Exclude g77.info from diffs. ! ! Sun Dec 10 02:29:13 1995 Craig Burley ! ! * expr.c (ffeexpr_declare_unadorned_, ! ffeexpr_declare_parenthesized_): Break out handling of ! contextDATAIMPDO[INDEX,CTRL] so it's independent of symbol state. ! Don't exec-transition these here (let ffeexpr_sym_impdoitem_ ! handle that when appropriate). Don't "declare" them twice. ! ! Tue Dec 5 06:48:26 1995 Craig Burley ! ! * stc.c (ffestc_promote_sfdummy_): Allow whereNONE parent ! symbol, since it is not necessarily known whether it will ! become LOCAL or DUMMY. ! ! Mon Dec 4 03:46:55 1995 Craig Burley ! ! * lex.c (ffelex_display_token, ffelex_type_string_): Resurrect ! these from their old versions and update them for possible invocation ! from debugger. ! * lex.h (ffelex_display_token): Declare this in case anyone ! else wants to call it. ! ! * lex.c (ffelex_total_tokens_): Have this reflect actual allocated ! tokens, no longer include outstanding "uses" of tokens. ! ! * malloc.c, malloc.h (MALLOC_DEBUG): New macro to control ! checking of whether callers follow rules, now defaults to 0 ! for "no checking" to improve compile times. ! ! * malloc.c (malloc_pool_kill): Fix bug that could prevent ! subpool from actually being killed (wasn't setting its use ! count to 1). ! ! * proj.h, *.c (dmpout): Replace all occurrences of `stdout' ! and some of `stderr' with `dmpout', so where to dump debugging ! output can be easily controlled during build; add default ! for `dmpout' of `stderr' to proj.h. ! ! Sun Dec 3 00:56:29 1995 Craig Burley ! ! * com.c (ffecom_return_expr): Eliminate attempt at warning ! about unset return values, since the back end does this better, ! with better wording, and is not triggered by clearly working ! (but spaghetti) code as easily as this test. ! ! Sat Dec 2 08:28:56 1995 Craig Burley ! ! * target.c (ffetarget_power_*_integerdefault): Raising 0 to ! integer constant power should not be an error condition; ! if so, other code should catch 0 to any power, etc. ! ! * bad.def (FFEBAD_BAD_POWER): 0**integer now a warning instead ! of an error. ! ! Fri Dec 1 00:12:03 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * bad.def: Clarify diagnostic regarding complex constant elements. ! * expr.c (ffeexpr_cb_comma_c_): Capitalize real/imaginary ! for clarified diagnostic. ! ! * com.c (ffecom_close_include_): Close the file! ! ! * lex.c (ffelex_file_fixed): Update line info if the line ! has any content, not just if it finishes a previous line ! or has a label. ! (ffelex_file_free): Clarify switch statement code. ! ! Sat Nov 18 19:37:22 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * Version 0.5.17 released. ! ! Fri Nov 17 14:27:24 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * Make-lang.in: Fix typo in comment. ! ! * Makefile.in (f/fini.o, f/proj-h.o): Don't use `$<' since ! not all makes support it (e.g. NeXT make), use explicit ! source name instead (with $(srcdir) and munging). ! (ASSERT_H): assert.h lives in source dir, not build dir. ! ! Thu Nov 16 12:47:50 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * com.c (ffecom_init_0): Fix dumb bug in code to produce ! warning message about non-32-bit-systems. ! ! * stc.c (ffestc_R501_item): Parenthesize test to make ! warning go away (and perhaps fix bug). ! ! Thu Nov 16 03:43:33 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * g77.c: Upgrade to 2.7.0's gcc.c. ! Fix -v to pass a temp name instead of "/dev/null" for "-o". ! ! Fri Nov 10 19:16:05 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * ste.c (ffeste_begin_iterdo_): Add Toon's change to ! make loops faster on some machines (implement termination ! condition as "--i >= 0" instead of "i-- > 0"). ! ! Thu Nov 2 03:58:17 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * Make-lang.in: Remove unnecessary $(exeext) a la cp/Make-lang.in. ! ! * com.c (ffecom_expr_): Restore old strategy for assignp variant ! of opSYMTER case...always return the ASSIGN version of var. ! That way, `-O -Wuninitialized' will catch "I=3;GOTO I;END" ! (though the diagnostic will refer to `__g77_ASSIGN_i'). ! ! * com.c (ffecom_expr_power_integer_): For constant rhs case, ! wrap every new eval of lhs in save_expr() so it is clear to ! back end that MULT_EXPR(lhs,lhs) has identical operands, ! otherwise for an rhs like 32767 it generates around 65K pseudo ! registers, with which stupid_life_analysis cannot cope ! (due to reg_renumber in regs.h being `short *' instead of ! `int *'). ! ! * com.c (ffecom_expr_): Speed up implementation of LOGICAL ! versions of opNOT, opAND, opOR, opXOR/opNEQV, and opEQV by ! assuming the values actually are kosher LOGICAL bit patterns. ! Also simplify code that implements some of the INTEGER versions ! of these. ! ! * com.c (skip_redundant_dir_prefix, read_name_map, ! ffecom_open_include_, signed_type, unsigned_type): Fold in ! changes to cccp.c made from 2.7.0 through ss-950826. ! ! * equiv.c (ffeequiv_layout_local_): Kill the equiv list ! if no syms in list. ! ! * expr.c (ffeexpr_reduced_eqop2_): Issue specific diagnostic ! regarding usage of .EQV./.NEQV. in preference to .EQ./.NE.. ! ! * intrin.c: Add ERF and ERFC as generic intrinsics. ! intrin.def: Same. ! ! * sta.c (ffesta_save_, ffesta_second_): Whoever calls ! ffestd_exec_begin must also set ffesta_seen_first_exec = TRUE, ! and anytime stc sees an exec transition, it must do both. ! stc.c (ffestc_eof): Same. ! ! * stc.c (ffestc_promote_sfdummy_): If failed implicit typing ! or CHARACTER*(*) arg, after calling ffesymbol_error, don't ! reset info to ENTITY/DUMMY, because ffecom_sym_transform_ ! doesn't expect such a thing with ANY/ANY type. ! ! * target.h (*logical*): Change some of these so they parallel ! changes in com.c, e.g. for _eqv_, use (l)==(r) instead of ! !!(l)==!!(r), to get a more faithful result. ! ! Fri Oct 27 07:06:59 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * com.c (ffecom_sym_transform_): Simplify code for local ! EQUIVALENCE case. ! ! * expr.c (ffeexpr_exprstack_push_unary_): Warn about two ! successive operators. ! (ffeexpr_exprstack_push_binary_): Warn about "surprising" ! operator precedence, as in "-2**2". ! ! * lang-options.h: Add -W(no-)surprising options. ! ! * parse.c (yyparse): Don't reset -fpedantic if not -pedantic. ! ! * top.c (ffe_decode_option): Support new -Wsurprising option. ! * top.h: Ditto. ! ! Mon Oct 23 09:14:15 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * com.c (ffecom_finish_symbol_transform_): Don't transform ! NONE/NONE (CHARACTER*(*)) vars, as these don't mean anything ! in debugging terms, and can't be turned into anything ! in the back end (so ffecom_sym_transform_ crashes on them). ! ! * com.c (ffecom_expr_): Change strategy for assignp variant ! of opSYMTER case...always return the original var unless ! it is not wide enough. ! ! * ste.c (ffeste_io_cilist_): Clarify diagnostic for ASSIGN ! involving too-narrow variable. This shouldn't happen, though. ! (ffeste_io_icilist_): Ditto. ! (ffeste_R838): Ditto. ! (ffeste_R839): Ditto. ! ! Thu Oct 19 03:21:20 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * com.c (ffecom_sym_transform_assign_): Set TREE_STATIC ! using the same decision-making process as used for their twin ! variables, so ASSIGN can last across RETURN/CALL as appropriate. ! ! Fri Sep 22 20:21:18 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * Makefile.in: fini is a host program, so it needs a host-compiled ! version of proj.o, named proj-h.o. f/fini, f/fini.o, and ! f/proj-h.o targets updated accordingly. ! ! * com.c (__eprintf): New function. ! ! Wed Sep 20 02:26:36 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * lang-options.h: Add omitted -funix-intrinsics-* options. ! ! * malloc.c (malloc_find_inpool_): Check for infinite ! loop, crash if detected (user reports encountering ! them in some large programs, this might help track ! down the bugs). ! ! Thu Sep 7 13:00:32 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * com.c (lang_print_error_function): Don't dereference null ! pointer when outside any program unit. ! (ffecom_let_char_, ffecom_arg_ptr_to_expr): If catlist ! item or length ever error_mark_node, don't continue processing, ! since back-end functions like build_pointer_type crash on ! error_mark_node's (due to pushing bad obstacks, etc.). ! ! Wed Aug 30 15:58:35 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * Version 0.5.16 released. ! ! Mon Aug 28 12:24:20 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * bad.c (ffebad_finish): Fix botched message when no places ! are printed (due to unknown line info, etc.). ! ! * std.c (ffestd_subr_labels_): Do a better job finding ! line info in the case of typeANY and diagnostics. ! ! Fri Aug 25 15:19:29 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * com.c (DECL_ARTIFICIAL): Surround all references to this ! macro with #if !BUILT_FOR_270 and #endif. ! (init_lex): Surround print_error_function decl with ! #if !BUILT_FOR_270 and #endif. ! (lang_init): Call new ffelex_hash_kludge function to solve ! problem with preprocessed files that have INCLUDE statements. ! ! * lex.c (ffelex_getc_): New function. ! (ffelex_cfelex_): Use ffelex_getc_ instead of getc in any ! paths of code that can be affected by ffelex_hash_kludge. ! Don't make an EOF token for unrecognized token; set token ! to NULL instead, to avoid problems when not initialized. ! (ffelex_hash_): Use ffelex_getc_ instead of getc in any ! paths of code that can be affected by ffelex_hash_kludge. ! Test token returned by ffelex_cfelex_ for NULL, meaning ! unrecognized token. ! Get rid of useless used_up variable. ! Don't do ffewhere stuff or kill any tokens if in ! ffelex_hash_kludge. ! (ffelex_file_fixed, ffelex_file_free): Use ffelex_getc_ ! instead of getc in any paths of code that can be affected ! by ffelex_hash_kludge. ! (ffelex_hash_kludge): New function. ! ! * lex.h (ffelex_hash_kludge): New function. ! ! Wed Aug 23 15:17:40 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * com.c: Implement -f(no-)underscoring options by always ! compiling in code to do it, and having that code inhibit ! itself when -fno-underscoring is in effect. This option ! overrides -f(no-)f2c for this purpose; -f(no-)f2c returns ! to it's <=0.5.15 behavior of affecting only how code ! is generated, not how/whether names are mangled. ! ! * target.h: Redo specification of appending underscores so ! the macros are named "_default" instead of "_is" and the ! two-underscore macro defaults to 1. ! ! * top.c, top.h (underscoring): Add appropriate stuff ! for the -f(no-)underscoring options. ! ! Tue Aug 22 10:25:01 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * bad.c (ffebad_finish): Call report_error_function (in toplev.c) ! to better identify location of problem. ! Say "(continued):" instead of "(continued:)" for consistency. ! ! * com.c (ffecom_gen_sfuncdef_): Set and reset new ! ffecom_nested_entry_ variable to hold ffesymbol being compiled. ! (lang_print_error_function): New function from toplev.c. ! Use ffecom_nested_entry_ to help determine which name ! and kind-string to print. ! (ffecom_expr_intrinsic_): Handle EXIT and FLUSH invocations ! with different calling sequences than library functions. ! Have SIGNAL and SYSTEM push and pop calltemps, and convert ! their return values to the destination type (just in case). ! (FFECOM_rttypeINT_): New return type for `int', in case ! gcc/f/runtime/libF77/system_.c(system_) is really supposed ! to return `int' instead of `ftnint'. ! ! * com.h (report_error_function): Declare this. ! ! * equiv.c (ffeequiv_layout_local_): Don't forget to consider ! root variable itself as possible "first rooted variable", ! else might never set symbol and then crash later. ! ! * intrin.c (ffeintrin_check_exit_): Change to allow no args ! and rename to ffeintrin_check_int_1_o_ for `optional'. ! #define ffeintrin_check_exit_ and _flush_ to this new ! function, so intrin.def can refer to the appropriate names. ! ! * intrin.def (FFEINTRIN_impFLUSH): Validate using ! ffeintrin_check_flush_ so passing an INTEGER arg is allowed. ! ! * lex.c (ffelex_file_push_, ffelex_file_pop_): New functions ! to manage input_file_stack in gbe. ! (ffelex_hash_): Call new functions (instead of doing code). ! (ffelex_include_): Call new functions to update stack for ! INCLUDE (_hash_ handles cpp output of #include). ! ! Mon Aug 21 08:09:04 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * Makefile.in: Put `-W' in front of every `-Wall', since ! 2.7.0 requires that to engage `-Wunused' for parameters. ! ! * com.c: Mark all parameters as artificial, so ! `-W -Wunused' doesn't complain about unused ones (since ! there's no way right not to individually specify attributes ! like `unused'). ! ! * proj.h: Don't #define UNUSED if already defined, regardless ! of host compiler. ! ! Sun Aug 20 16:03:56 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * gbe/2.7.0.diff: Regenerate. ! ! * lang-options.h, lang-specs.h: If not __STDC__ (ANSI C), ! avoid doing anything, especially the stringizing in -specs.h. ! ! Thu Aug 17 03:36:12 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * lang-specs.h: Remove useless optional settings of -traditional, ! since -traditional is always set anyway. ! ! Wed Aug 16 16:56:46 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * Make-lang.in (F2C_INSTALL_FLAG, F2CLIBOK): More ! control over whether to install f2c-related stuff. ! (install-f2c-*): New targets to install f2c-related ! stuff in system, not just gcc, directories. ! ! * com.c: Change calls to ffecom_get_invented_identifier ! to use generally more predictable names. ! Change calls to build_range_type to ensure consistency ! of types of operands. ! (ffecom_get_external_identifier_): Change to accept ! symbol info, not just text, so it can use f2c flag for ! symbol to decide whether to append underscore(s). ! (ffecom_get_identifier_): Don't change names if f2c flag ! off for compilation. ! (ffecom_type_permanent_copy_): Use same type for new max as ! used for min. ! (ffecom_notify_init_storage): Offline fixups for stand-alone. ! ! * data.c (ffedata_gather): Explicitly test for common block, ! since it's no longer always the case that a local EQUIVALENCE ! group has no symbol ptr (it now can, if a user-predictable ! "rooted" symbol has been identified). ! ! * equiv.c: Add some debugging stuff. ! (ffeequiv_layout_local_): Set symbol ptr with user-predictable ! "rooted" symbol, for giving the invented aggregate a ! predictable name. ! ! * g77.c (append_arg): Allow for 20 extra args instead of 10. ! (main): For version-only case, add `-fnull-version' and, unless ! explicitly omitted, `-lf2c -lm'. ! ! * lang-options.h: New "-fnull-version" option. ! ! * lang-specs.h: Support ".fpp" suffix for preprocessed source ! (useful for OS/2, MS-DOS, other case-insensitive systems). ! ! * stc.c (ffestc_R544_equiv_): Swap way lists are merged so this ! is consistent with the order in which lists are built, making ! user predictability of invented aggregate name much higher. ! ! * storag.c, storag.h (FFESTORAG_typeDUMMY): Delete this enum. ! ! * top.c: Accept, but otherwise ignore, `-fnull-version'. ! ! Tue Aug 15 07:01:07 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * DOC, INSTALL, PROJECTS: Extensive improvements to documentation. ! ! Sun Aug 13 01:55:18 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * INSTALL (f77-install-ok): Document the use of this file. ! ! * Make-lang.in (F77_INSTALL_FLAG): New flag to control ! whether to install an `f77' command (based on whether ! a file named `f77-install-ok' exists in the source or ! build directory) to replace the broken attempt to use ! comment lines to avoid installing `f77' (broken in the ! sense that it prevented installation of `g77'). ! ! Mon Aug 7 06:14:26 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * DOC: Add new sections for g77 & gcc compiler options, ! source code form, and types, sizes and precisions. ! Remove lots of old "delta-version" info, or at least ! summarize it. ! ! * INSTALL: Add info here that used to be in DOC. ! Other changes. ! ! * g77.c (lookup_option, main): Check for --print-* options, ! so we avoid adding version-determining stuff. ! ! Wed Jul 26 15:51:03 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * Make-lang.in, Makefile.in (input.j, INPUT_H): New file. ! Update dependencies accordingly. ! ! * bad.c (ffebad_here): Okay to use unknown line/col. ! ! * compilers.h (@f77-cpp-input): Remove -P option now that ! # directives are handled by f771. Update other options ! to be more consistent with @c in gcc/gcc.c. Don't run f771 ! if -E specified, etc., a la @c. ! (@f77): Don't run f771 if -E specified, etc., a la @c. ! ! * config-lang.in: Avoid use of word "guaranteed". ! ! * input.j: New file to wrap around gcc/input.h. ! ! * lex.j: Add support for parsing # directives output by cpp. ! (ffelex_cfebackslash_): New function. ! (ffelex_cfelex_): New function. ! (ffelex_get_directive_line_): New function. ! (ffelex_hash_): New function. ! (ffelex_include_): Change to not use ffewhere_file_(begin|end). ! Also fix bug in pointing to next line (for diagnostics, &c) ! following successful INCLUDE. ! (ffelex_next_line_): New function that does chunk of code ! seen in several places elsewhere in the lexers. ! (ffelex_file_fixed): Delay finishing statement until source ! line is registered with ffewhere, so INCLUDE processing ! picks up the info correctly. ! Okay to kill or use unknown line/col objects now. ! Handle HASH (#) lines. ! Reorder tests for insubstantial lines to put most frequent ! occurrences at top, for possible minor speedup. ! Some general consolidation of code. ! (ffelex_file_free): Handle HASH (#) lines. ! Okay to kill or use unknown line/col objects now. ! Some general consolidation of code. ! (ffelex_init_1): Detect HASH (#) lines. ! (ffelex_set_expecting_hollerith): Okay to kill or use unknown ! line/col objects now. ! ! * lex.h (FFELEX_typeHASH): New enum. ! ! * options-lang.h (-fident, -fno-ident): New options. ! ! * stw.c (ffestw_update): Okay to kill unknown line/col objects ! now. ! ! * target.h (FFETARGET_okREALQUAD, FFETARGET_okCOMPLEXDOUBLE, ! FFETARGET_okCOMPLEXQUAD): #define these appropriately. ! ! * top.c: Include flag.j wrapper, not flags.h directly. ! (ffe_is_ident_): New flag. ! (ffe_decode_option): Handle -fident and -fno-ident. ! (ffe_file): Replace obsolete ffewhere_file_(begin|end) with ! ffewhere_file_set. ! ! * top.h (ffe_is_ident_, ffe_is_ident, ffe_set_is_ident): ! New flag and access functions. ! ! * where.c, where.h: Remove all tracking of parent file. ! (ffewhere_file_begin, ffewhere_file_end): Delete these. ! (ffewhere_line_use): Make it work with unknown line object. ! ! Mon Jul 17 03:04:09 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * com.c (ffecom_sym_transform_): Set DECL_IN_SYSTEM_HEADER ! flag for any local vars used as stmtfunc dummies or DATA ! implied-DO iter vars, so no -Wunused warnings are produced ! for them (a la f2c). ! (ffecom_init_0): Do "extern int xargc;" for IARGC() intrinsic. ! Warn if target machine not 32 bits, since g77 isn't yet ! working on them at all well. ! ! * expr.c (ffeexpr_sym_lhs_call_, ffeexpr_sym_lhs_data_, ! ffeexpr_sym_lhs_extfunc_, ffeexpr_sym_rhs_actualarg_, ! ffeexpr_sym_rhs_let_, ffeexpr_paren_rhs_let_): Don't ! gratuitously set attr bits that don't apply just ! to avoid null set meaning error; instead, use explicit ! error flag, and allow null attr set, to ! fix certain bugs discovered by looking at this code. ! ! * g77.c: Major changes to improve support for gcc long options, ! to make `g77 -v' report more useful info, and so on. ! ! Mon Jul 3 14:49:16 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * DOC, com.c, intrin.h, intrin.c, intrin.def, target.h, top.c, ! top.h: Add new `unix' group of intrinsics, which includes the ! newly added ERF, ERFC, EXIT, plus even newer ABORT, DERF, DERFC, ! FLUSH, GETARG, GETENV, SIGNAL, and SYSTEM. ! ! Tue Jun 27 23:01:05 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * bld.c, bld.h (ffebld_constant_pool, ! ffebld_constant_character_pool): Use a single macro (the ! former) to access the pool for allocating constants, instead ! of latter in public and FFEBLD_CONSTANT_POOL_ internally ! in bld.c (which was the only one that was correct before ! these changes). Add verification of integrity of certain ! heap-allocated areas. ! ! * com.c (ffecom_overlap_, ffecom_args_overlap_, ! ffecom_tree_canonize_ptr_, ffecom_tree_canonize_ref_): New ! functions to optimize calling COMPLEX and, someday, CHARACTER ! functions requiring additional argument to be passed. ! (ffecom_call_, ffecom_call_binop_, ffecom_expr_, ! ffecom_expr_intrinsic_): Change calling ! sequences to include more info on possible destination. ! (ffecom_expr_intrinsic_): Add ERF(), ERFC(), and EXIT() ! intrinsic code. ! (ffecom_sym_transform_): For assumed-size arrays, set high ! bound to highest possible value instead of low bound, to ! improve validity of overlap checking. ! (duplicate_decls): If olddecl and newdecl are the same, ! don't do any munging, just return affirmative. ! ! * expr.c: Change ffecom_constant_character_pool() to ! ffecom_constant_pool(). ! ! * info.c (ffeinfo_new): Compile this version if not being ! compiled by GNU C. ! ! * info.h (ffeinfo_new): Don't define macro if not being ! compiled by GNU C. ! ! * intrin.c, intrin.def: Add ERF(), ERFC(), and EXIT() intrinsics. ! (ffeintrin_check_exit_): New for EXIT() subroutine intrinsic. ! ! * malloc.c, malloc.h (malloc_verify_*): New functions to verify ! integrity of heap-storage areas. ! ! * stc.c (ffestc_R834, ffestc_R835): Handle possibility that ! an enclosing DO won't have a construct name even when the ! CYCLE/EXIT does (i.e. without dereferencing NULL). ! ! * target.c, target.h (ffetarget_verify_character1): New function ! to verify integrity of heap storage used to hold character constant. ! ! Thu Jun 22 15:36:39 1995 Howard Gordon (flash@super.org) ! ! * stp.h (ffestpVxtcodeIx): Fix typo in typedef for this. ! ! Mon May 29 15:22:31 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * *: Make all sorts of changes to accommodate upcoming gcc-2.7.0. ! I didn't keep track of them, nor just when I made them, nor ! when I (much later, probably in early August 1995) modified ! them so they could properly handle both 2.7.0 and 2.6.x. ! ! * com.c (ffecom_expr_power_integer_): Don't expand_start_stmt_expr ! if transforming dummy args, because the back end cannot handle ! that (it's rejected by the gcc front end), just generate ! call to run-time library. ! Back out changes in 0.5.15 because more temporaries might be ! needed anyway (for COMPLEX**INTEGER). ! (ffecom_push_tempvar): Remove inhibitor. ! Around start_decl and finish_decl (in particular, arround ! expand_decl, which is called by them), push NULL_TREE into ! sequence_rtl_expr, an external published by gcc/function.c. ! This makes sure the temporary is truly in the function's ! context, not the inner context of a statement-valued expression. ! (I think the back end is inconsistent here, but am not ! interested in convincing the gbe maintainers about this now.) ! (pushdecl): Make sure that when pushing PARM_DECLs, nothing ! other than them are pushed, as happened for 0.5.15 and which, ! if done for other reasons not fixed here, might well indicate ! some other problem -- so crash if it happens. ! ! * equiv.c (ffeequiv_layout_local_): If the local equiv group ! has a non-nil COMMON field, it should mean that an error has ! occurred and been reported, so just trash the local equiv ! group and do nothing. ! ! * stc.c (ffestc_promote_sfdummy_): Set sfdummy arg state to ! UNDERSTOOD so above checking for duplicate args actually ! works, and so we don't crash later in pushdecl. ! ! * ste.c (ffeste_R1001): Set initial value only for VAR_DECLs, ! not for, e.g., LABEL_DECLs, which the FORMAT label can be ! if it was previously treated as an executable label. ! ! Sat May 20 01:53:53 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * com.c (ffecom_sym_transform_): For adjustable arrays, ! pass high bound through variable_size in case its primaries ! are changed (dumb0.f, and this might also improve ! performance so it approaches f2c|gcc). ! ! Fri May 19 11:00:36 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * Version 0.5.15 released. ! ! * com.c (ffecom_expr_power_integer_): Push temp vars ! before expanding a statement expression, since that seems ! to cause temp vars to be "forgotten" after the end of the ! expansion in the back end. Disallow more temp-var ! pushing during such an expansion, just in case. ! (ffecom_push_tempvar): Crash if a new variable needs to be ! pushed but cannot be at this point (should never happen). ! ! Wed May 17 12:26:16 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * expr.c (ffeexpr_collapse_convert): Add code to convert ! LOGICAL to CHARACTER. Reject conversion of REAL or COMPLEX ! to CHARACTER entirely, as it cannot be supported with all ! configurations. ! ! * target.h, target.c (ffetarget_convert_character1_logical1): ! New function. ! ! Sun May 14 00:00:09 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * com.c (ffecom_do_entry_, ffecom_gen_sfuncdef_, ! ffecom_start_progunit_, ffecom_sym_transform_, ! ffecom_init_0, start_function): Changes to have REAL ! external functions return same type as DOUBLE PRECISION ! external functions when -ff2c is in force; while at it, ! some code cleanups done. ! ! * stc.c (ffestc_R547_item_object): Disallow array declarator ! if one already exists for symbol. ! ! * ste.c (ffeste_R1227): Convert result variable to type ! of function result as seen by back end (e.g. for when REAL ! external function actually returns result as double). ! ! * target.h (FFETARGET_defaultFIXED_LINE_LENGTH): New ! macro for default for -ffixed-line-length-N option. ! ! * top.c (ffe_fixed_line_length_): Initialize this to new ! target.h macro instead of constant 72. ! ! Tue May 9 01:20:03 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * lex.c (ffelex_send_token_): If sending CHARACTER token with ! null text field, put a single '\0' in it and set length/size ! fields to 0 (to fix 950508-0.f). ! (ffelex_image_char_): When setting ffelex_bad_line_ to TRUE, ! always "close" card image by appending a null char and setting ! ffelex_card_length_. As part of this, append useful text ! to identify the two kinds of problems that involve this. ! (ffelex_file_fixed): Reset ffelex_bad_line_ to FALSE after ! seeing a line with invalid first character (fixes 950508-1.f). ! If final nontab column is zero, assume tab seen in line. ! (ffelex_card_image_): Always make this array 8 characters ! longer than reflected by ffelex_card_size_. ! (ffelex_init_1): Get final nontab column info from top instead ! of assuming 72. ! ! * options-lang.h: Add -ffixed-line-length- prefix. ! ! * top.h: Add ffe_fixed_line_length() and _set_ version, plus ! corresponding extern. ! ! * top.c: Handle -ffixed-line-length- option prefix. ! ! Fri Apr 28 05:40:25 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * Version 0.5.14 released. ! ! * Make-lang.in: Add assert.j. ! ! * Makefile.in: Add assert.j. ! ! * assert.j: New file. ! ! Thu Apr 27 16:24:22 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * bad.h (ffebad_severity): New function. ! ! * bad.c (ffebad_severity): New function. ! ! * bad.def (FFEBAD_OPEN_INCLUDE): Change severity from SEVERE ! to FATAL, since processing continues, and that seems fine. ! ! * com.c: Add facility to handle -I. ! (ffecom_file, ffecom_close_include, ffecom_open_include, ! ffecom_decode_include_option): New global functions for -I. ! (ffecom_file_, ffecom_initialize_char_syntax_, ! ffecom_close_include_, ffecom_decode_include_option_, ! ffecom_open_include_, append_include_chain, open_include_file, ! print_containing_files, read_filename_string, file_name_map, ! savestring): New internal functions for -I. ! ! * compilers.h: Pass -I flag(s) to f771 (via "%{I*}"). ! ! * lex.c (ffelex_include_): Call ffecom_close_include ! to close include file, for its tracking needs for -I, ! instead of using fclose. ! ! * options-lang.h: Add -I prefix. ! ! * parse.c (yyparse): Call ffecom_file for main input file, ! so -I handling works (diagnostics). ! ! * std.c (ffestd_S3P4): Have ffecom_open_include handle ! opening and diagnosing errors with INCLUDE files. ! ! * ste.c (ffeste_begin_iterdo_): Use correct algorithm for ! calculating # of iterations -- mathematically similar but ! computationally different algorithm was not handling cases ! like "DO I=6,5,2" correctly, because (5-6)/2+1 => 1, not 0. ! ! * top.c (ffe_decode_option): Allow -I, restructure a bit ! for clarity and, maybe, speed. ! ! Mon Apr 17 13:31:11 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * g77.c: Remove -lc, turns out not all systems has it, but ! leave other changes in for clarity of code. ! ! Sun Apr 16 21:50:33 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * com.c (ffecom_expr_): Implement ARRAY_EXPR as INDIRECT_REF ! of appropriate PLUS_EXPRs of ptr_to_expr of array, to see ! if this generates better code. (Conditional on ! FFECOM_FASTER_ARRAY_REFS.) ! ! Sun Apr 16 00:22:48 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * Make-lang.in (F77_SRCS): Remove g77.c, since it doesn't ! contribute to building f771. ! ! * Makefile.in (dircheck): Remove/replace with f/Makefile, because ! phony targets that are referenced in other real targets get run ! when those targets are specified, which is a waste of time (e.g. ! when rebuilding and only g77.c has changed, f771 was being linked ! anyway). ! ! * g77.c: Include -lc between -lf2c and -lm throughout. ! ! * implic.c (ffeimplic_establish_symbol): If -Wimplicit, warn if ! implicit type given to symbol. ! ! * lex.c (ffelex_include_): Don't gratuitously increment line ! number here. ! ! * top.h, top.c (ffe_is_warn_implicit_): New global variable and ! related access macros. ! (ffe_decode_option): Handle -W options, including -Wall and ! -Wimplicit. ! ! * where.c (ffewhere_line_new): Don't muck with root line (was ! crashing on null input since lexer changes over the past week ! or so). ! ! Thu Apr 13 16:48:30 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * com.c (ffecom_init_0): Register built-in functions for cos, ! sin, and sqrt. ! (ffecom_tree_fun_type_double): New variable. ! (ffecom_expr_intrinsic_): Update f2c input and output files ! to latest version of f2c (no important g77-related changes ! noted, just bug fixes to f2c and such). ! (builtin_function): New function from c-decl.c. ! ! * com-rt.def: Refer to built-in functions for cos, sin, and sqrt. ! ! Thu Apr 13 10:25:09 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * com.c (ffecom_expr_intrinsic_): Convert 0. to appropriate ! type to keep DCMPLX(I) from crashing the compiler. ! (ffecom_expr_): Don't convert result from ffecom_tree_divide_. ! (ffecom_tree_divide_): Add tree_type argument, have all callers ! pass one, and don't convert right-hand operand to it (this is ! to make this new function work as much like the old in-line ! code used in ffecom_expr_ as possible). ! ! * lex.c: Maintain lineno and input_filename the way the gcc ! lexer does. ! ! * std.c (ffestd_exec_end): Save and restore lineno and ! input_filename around the second pass, which sets them ! appropriately for each saved statement. ! ! Wed Apr 12 09:44:45 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * com.c (ffecom_expr_power_integer_): New function. ! (ffecom_expr_): Call new function for power op with integer second ! argument, for generating better code. Also replace divide ! code with call to new ffecom_tree_divide_ function. ! Canonicalize calls to ffecom_truth_value(_invert). ! (ffecom_tree_divide_): New function. ! ! Wed Apr 5 14:15:44 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * lex.c: Change to allocate text for tokens only when actually ! needed, which should speed compilation up somewhat. ! Change to allow INCLUDE at any point where a statement ! can end, i.e. in ffelex_finish_statement_ or when a SEMICOLON ! token is sent. ! Remove some old, obsolete code. ! Clean up layout of entire file to improve formatting, ! readability, etc. ! (ffelex_set_expecting_hollerith): Remove include argument. ! ! Fri Mar 31 23:19:08 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * bad.h, bad.c (ffebad_start_msg, ffebad_start_msg_lex): ! New functions to generate arbitrary messages. ! (FFEBAD_severityPEDANTIC): New severity, to correspond ! to toplev's pedwarn() function. ! ! * lex.c (ffelex_backslash_): New function to implement ! backslash processing. ! (ffelex_file_fixed, ffelex_file_free): Implement new ! backslash processing. ! ! * std.c (ffestd_R1001dump_): Don't assume CHARACTER and ! HOLLERITH tokens stop at '\0' characters, now that backslash ! processing is supported -- use their advertised lengths instead, ! and double up the '\002' character for libf2c. ! ! Mon Mar 27 17:10:33 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * com.c (ffecom_init_local_zero_): Implement -finit-local-zero. ! (ffecom_sym_transform_): Same. ! (ffecom_transform_equiv_): Same. ! ! * options-lang.h: Add -f(no-)(init-local-zero,backslash,ugly-init). ! ! * stb.c (ffestb_V020): Reject "TYPEblah(...", which might be ! an array assignment. ! ! * target.h, top.h, top.c: Implement -finit-local-zero. ! ! Fri Mar 24 19:56:22 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * Make-lang.in, Makefile.in: Remove conf-proj(.in) and ! proj.h(.in) rules, plus related config.log, config.cache, ! and config.status stuff. ! ! * com.c (ffecom_init_0): Change messages when atof(), bsearch(), ! or strtoul() do not work as expected in the start-up test. ! ! * conf-proj, conf-proj.in: Delete. ! ! * lex.c (ffelex_file_fixed): Allow f2c's '&' in column 1 ! to mean continuation line. ! ! * options-lang.h: New file, #include'd by ../toplev.c. ! ! * proj.h.in: Rename back to proj.h. ! ! * proj.h (LAME_ASSERT): Remove. ! (LAME_STDIO): Remove. ! (NO_STDDEF): Remove. ! (NO_STDLIB): Remove. ! (NO_BSEARCH): Remove auto detection, rename to !FFEPROJ_BSEARCH. ! (NO_STRTOUL): Remove auto detection, rename to !FFEPROJ_STRTOUL. ! (USE_HOST_LIMITS): Remove (maybe still needed by stand-alone?). ! (STR, STRX): Do only ANSI C definitions. ! ! Mon Mar 13 10:46:13 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * BUGS: Add item about g77 requiring gcc to compile it. ! ! * NEWS: New file listing user-visible changes in the release. ! ! * PROJECTS: Update to include a new item or two, and modify ! or delete items that are addressed in this or previous releases. ! ! * bad.c (ffebad_finish): Don't crash if missing string &c, ! just substitute obviously distressed string "[REPORT BUG!!]" ! for cases where the message/caller are fudgy. ! ! * bad.def: Clean up error messages in a major way, add new ones ! for use by changes in target.c. ! ! * com.c (ffecom_expr_): Handle opANY in opCONVERT. ! (ffecom_let_char_): Disregard destinations with ERROR_MARK. ! (ffecom_1, ffecom_1_fn, ffecom_2, ffecom_2s, ffecom_3, ! ffecom_3s, &c): Check all inputs for error_mark_node. ! (ffecom_start_progunit_): Don't transform all symbols ! in BLOCK DATA, since it never executes, and it is silly ! to, e.g., generate all the structures for NAMELIST. ! (ffecom_char_length_expr_): Rename to ffecom_intrinsic_len_. ! (ffecom_intrinsic_ichar_): New function to handle ICHAR of ! arbitrary expression with possible 0-length operands. ! (ffecom_expr_intrinsic_): Use ffecom_intrinsic_char_. ! For MVBITS, set tree_type to void_type_node. ! (ffecom_start_progunit_): Name master function for entry points ! after primary entry point so users can easily guess it while ! debugging. ! (ffecom_arg_ptr_to_expr): Change treatment of Hollerith, ! Typeless, and %DESCR. ! (ffecom_expr_): Change treatment of Hollerith. ! ! * data.c (ffedata_gather_): Handle opANY in opCONVERT. ! ! * expr.c (ffeexpr_token_apostrophe_): Issue FFEBAD_NULL_CHAR_CONST ! warning as necessary. ! (ffeexpr_token_name_rhs_): Set context for args to intrinsic ! so that assignment-like concatenation is allowed for ICHAR(), ! IACHAR(), and LEN() intrinsics. ! (ffeexpr_reduced_*_): Say "an array" instead of "an entity" in ! diagnostics, since it's more informative. ! (ffeexpr_finished_): For many contexts, check for null expression ! and array before trying to do a conversion, to avoid redundant ! diagnostics. ! ! * g77.1: Fix typo for preprocessed suffix (.F, not .f). ! ! * global.c (ffeglobal_init_common): Warn if initializing ! blank common. ! (ffeglobal_pad_common): Enable code to warn if initial ! padding needed. ! (ffeglobal_size_common): Complain if enlarging already- ! initialized common, since it won't work right anyway. ! ! * intrin.c: Add IMAG() intrinsic. ! (ffeintrin_check_loc_): Allow opSUBSTR in LOC(). ! ! * intrin.def: Add IMAG() intrinsic. ! ! * lex.c: Don't report FFEBAD_NULL_CHAR_CONST errors. ! ! * sta.c, sta.h, stb.c: Changes to clean up error messages (see ! bad.def). ! ! * stb.c (ffestb_R100113_): Issue FFEBAD_NULL_CHAR_CONST ! warning as necessary. ! ! * stc.c (ffestc_shriek_do_): Don't try to reference doref_line ! stuff in ANY case, since it won't be valid. ! (ffestc_R1227): Allow RETURN in main program unit, with ! appropriate warnings/errors. ! (ffestc_subr_format_): Array of any type is a CHAREXPR (F77 C5). ! ! * ste.c (ffeste_begin_doiter_): Couple of fixes to accurately ! determine if loop never executes. ! ! * target.c (ffetarget_convert_*_hollerith_): Append spaces, ! not zeros, to follow F77 Appendix C, and to warn when ! truncation of non-blanks done. ! (ffetarget_convert_*_typeless): Rewrite to do typeless ! conversions properly, and warn when truncation done. ! (ffetarget_print_binary, ffetarget_print_octal, ! ffetarget_print_hex): Rewrite to use new implementation of ! typeless. ! (ffetarget_typeless_*): Rewrite to use new implementation ! of typeless, and to warn about overflow. ! ! * target.h (ffetargetTypeless): New implementation of ! this type. ! ! * type.h, type.c (ffetype_size_typeless): Remove (incorrect) ! implementation of this function and its extern. ! ! Sun Mar 5 18:46:42 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * BUGS: Clarify that constant handling would also fix lack of ! adequate IEEE-754/854 support to some degree, and typeless ! and non-decimal constants. ! * com.c (ffecom_type_permanent_copy_): Comment out to avoid ! warnings. ! (duplicate_decls): New function a la gcc/c-decl.c. ! (pushdecl): Use duplicate_decls to decide whether to return ! existing decl or new one, instead of always returning existing ! decl. ! (ffecom_expr_): opPERCENT_LOC now supports CHARACTER arguments. ! (ffecom_init_0): Give f2c I/O code 0 for basictypeANY/kindtypeANY. ! (ffecom_sym_transform_): For adjustable arrays, pass low bound ! through variable_size in case its primaries are changed (950302-1.f). ! * com.h: More decls that belong in tree.h &c. ! * data.c (ffedata_eval_integer1_): Fix opPAREN case to not ! treat value of expression as an error code. ! * expr.c (ffeexpr_finished_): Allow opSUBSTR in contextLOC case. ! ! * proj.c: Add "const" as appropriate. ! Mon Feb 27 10:04:03 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * bad.def (FFEBAD_BAD_SUBSTR): Fix bad grammar in message. ! Fri Feb 24 16:21:31 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * Version 0.5.13 released. ! * INSTALL: Warn that f/zzz.o will compare differently between ! stages, since it puts the __TIME__ macro into a string. ! * com.c (ffecom_sym_transform_): Transform kindFUNCTION/whereDUMMY ! to pointer-to-function, not function. ! (ffecom_expr_): Use ffecom_arg_ptr_to_expr instead of ! ffecom_char_args_ to handle comparison between CHARACTER ! types, so either operand can be a CONCATENATE. ! (ffecom_transform_common_): Set size of initialized common area ! to global (largest-known) size, even though size of init might ! be smaller. ! * equiv.c (ffeequiv_offset_): Check symbol info for ANY. ! * expr.c (ffeexpr_find_close_paren_, ffeexpr_nil_*): New functions ! to handle following the contour of a rejected expression, so ! statements like "PRINT(I,I,I)=0" don't cause the PRINT statement ! code to get the second passed back to it as if there was a ! missing close-paren before it, the comma causing the PRINT code ! to confirm the statement, resulting in an ambiguity vis-a-vis ! the let statement code. ! Use the new ffecom_find_close_paren_ handler when an expected ! close-paren is missing. ! (ffeexpr_isdigits_): New function, use in all places that ! currently use isdigit in repetitive code. ! (ffeexpr_collapse_symter): Collapse to ANY if init-expr is ANY, ! so as to avoid having symbol get "transformed" if used to ! dimension an array. ! (ffeexpr_token_real_, ffeexpr_token_number_real_): Don't issue ! diagnostic about exponent, since it'll be passed along the ! handler path, resulting in a diagnostic anyway. ! (ffeexpr_token_apos_char_): Use consistent handler path ! regardless of whether diagnostics inhibited. ! (ffeexpr_token_name_apos_name_): Skip past closing quote/apos ! even if not a match or other diagnostic issued. ! (ffeexpr_sym_impdoitem_): Exec-transition local SEEN symbol. ! * lex.c (ffelex_image_char_): Set ffelex_saw_tab_ if TAB ! seen, not if anything other than TAB seen! ! * stc.c (ffestc_R537_item): If source is ANY but dest isn't, ! set dest symbol's init expr to ANY. ! (ffestc_R501_attrib, ffestc_R522, ffestc_R522start): Complain ! about conflict between "SAVE" by itself and other uses of ! SAVE only in pedantic mode. ! * ste.c (ffeste_R1212): Fix loop over labels to always ! increment caseno, to avoid pushcase returning 2 for duplicate ! values when one of the labels is invalid. ! Thu Feb 23 12:42:04 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * Version 0.5.12 released. ! * Make-lang.in (f77.install-common): Add "else true;" before outer ! "fi" per Makefile.in patch. ! * Makefile.in (dircheck): Add "else true;" before "fi" per ! patch from chs1pm@surrey.ac.uk. ! * com.c (ffecom_push_tempvar): If type desired is ERROR_MARK, ! return error_mark_node, to avoid crash that results from ! making a VAR_DECL with error_mark_node as its type. ! * ste.c (ffeste_begin_iterdo_): Convert itercount to INTEGER ! anytime calculation of number of iterations ends up with type ! other than INTEGER (e.g. DOUBLE PRECISION, REAL). ! Thu Feb 23 02:48:38 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * Version 0.5.11 released. ! * DOC: Explain -fugly-args. ! * bad.def (FFEBAD_ACTUALARG): Explain -fugly-args and how to ! rewrite code to not require it. ! * com.c (ffecom_vardesc_): Handle negative type code, just in ! case. ! (ffecom_arg_ptr_to_expr): Let ffecom_expr handle hollerith ! and typeless constants (move code to ffecom_constantunion). ! (ffecom_constantunion): Handle hollerith and typeless constants. ! * expr.c (ffecom_finished_): Check -fugly-args in actual-arg ! context where hollerith/typeless provided. ! * intrin.def (FFEINTRIN_genDFLOAT): Add FFEINTRIN_specDFLOAT. ! (FFEINTRIN_specDFLOAT): Add as f2c intrinsic. ! * target.h (ffetarget_convert_real[12]_integer, ! ffetarget_convert_complex[12]_integer): Pass -1 for high integer ! value if low part is negative. ! (FFETARGET_defaultIS_UGLY_ARGS): New macro. ! * top.c (ffe_is_ugly_args_): New variable. ! (ffe_decode_option): Handle -fugly-args and -fno-ugly-args. ! * top.h (ffe_is_ugly_args_, ffe_is_ugly_args(), ! ffe_set_is_ugly_args()): New variable and macros. ! Thu Feb 23 02:48:38 1995 Pedro A M Vazquez (vazquez@iqm.unicamp.br) ! * g77.c (sys_errlist): Use const for __FreeBSD__ systems ! as well. ! Wed Feb 22 13:33:43 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * Version 0.5.10 released. ! * CREDITS: Add Rick Niles. ! * INSTALL: Note how to get around lack of makeinfo. ! * Make-lang.in (f/proj.h): Remove # comment. ! * Makefile.in (f/proj.h): Remove # comment. ! * com.c (ffecom_expr_): Simplify opFUNCREF/opSUBRREF conversion. ! (ffecom_sym_transform_): For whereGLOBAL and whereDUMMY ! kindFUNCTION, use ffecom_tree_fun_type[][] only for non-constant ! (non-statement-function) f2c functions. ! (ffecom_init_0): ffecom_tree_fun_type[][] and _ptr_to_*_* are ! really f2c-interface arrays, so use base type void for COMPLEX ! (like CHARACTER). ! Tue Feb 21 19:01:18 1995 Dave Love ! * Make-lang.in (f77.install-common): Expurgate the test for and ! possible installation of f2c in line with elsewhere. Seems to have ! been missing a semicolon anyhow! ! Tue Feb 21 11:45:25 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * Version 0.5.9 released. ! * Make-lang.in (f/proj.h): touch file to register update, ! because the previous commands won't necessarily modify it. ! * Makefile.in (f/proj.h): touch file to register update, ! because the previous commands won't necessarily modify it. ! * Makefile.in (f/str-*.h, f/str-*.j): Explicitly specify ! output file names, so these targets go in build, not source, ! directory. ! * bits.c, bits.h: Switch to valid ANSI C replacement for ! ARRAY_ZERO. ! * com.c (ffecom_expr_): Add assignp arg to support ASSIGN better. ! If assignp is TRUE, use different tree for FFEBLD_opSYMTER case. ! (ffecom_sym_transform_assign_): New function. ! (ffecom_expr_assign): New function. ! (ffecom_expr_assign_w): New function. ! * com.c (ffecom_f2c_make_type_): Do make_signed_type instead ! of make_unsigned_type throughout. ! * com.c (ffecom_finish_symbol_transform_): Expand scope of ! commented-out code to probably produce faster compiler code. ! * com.c (ffecom_gen_sfuncdef_): Push/pop calltemps so ! COMPLEX works right. ! Remove obsolete comment. ! * com.c (ffecom_start_progunit_): If non-multi alt-entry ! COMPLEX function, primary (static) entry point returns result ! directory, not via extra arg -- to agree with ffecom_return_expr ! and others. ! Pretransform all symbols so statement functions are defined ! before any code emitted. ! * com.c (ffecom_finish_progunit): Don't posttransform all ! symbols here -- pretransform them instead. ! * com.c (ffecom_init_0): Don't warn about possible ASSIGN ! crash, as this shouldn't happen now. ! * com.c (ffecom_push_tempvar): Fix to handle temp vars ! pushed while context is a statement (nested) function, and ! add appropriate commentary. ! * com.c (ffecom_return_expr): Check TREE_USED to determine ! where return value is unset. ! * com.h (struct _ffecom_symbol_): Add note about length_tree ! now being used to keep tree for ASSIGN version of symbol. ! * com.h (ffecom_expr_assign, ffecom_expr_assign_rw): New decls. ! (error): Add this prototype for back-end function. ! * fini.c (main): Grab input, output, and include names ! directly off the command line instead of making the latter ! two out of the first. ! * lex.c: Improve tab handling for both fixed and free source ! forms, and ignore carriage-returns on input, while generally ! improving the code. ffelex_handle_tab_ has been renamed and ! reinvented as ffelex_image_char_, among other things. ! * malloc.c, malloc.h: Switch to valid ANSI C replacement for ! ARRAY_ZERO, and kill the full number of bytes in pools and ! areas. ! * proj.h.in (ARRAY_ZERO, ARRAY_ZERO_SIZE): Remove. ! * ste.c (ffeste_io_cilist_, ffeste_io_icilist_, ffeste_R838, ! ffeste_R839): Issue diagnostic if a too-narrow variable used in an ! ASSIGN context despite changes to this code and code in com.c. ! * where.c, where.h: Switch to valid ANSI C replacement for ! ARRAY_ZERO. ! Fri Feb 17 03:35:19 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * Version 0.5.8 released. ! * INSTALL: In quick-build case, list g77 target first so g77 ! gets installed. Also, explain that gcc gets built and installed ! as well, even though this isn't really what we want (and maybe ! we'll find a way around this someday). ! Fri Feb 17 02:35:41 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * Version 0.5.7 released. ! * Makefile.in (CONFIG_H, HCONFIG_H, TCONFIG_H, TM_H): Remove ! ../ prefix in front of .h files, since they're in the cd. ! Fri Feb 17 01:50:48 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * Version 0.5.6 released. ! Thu Feb 16 20:26:54 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * ../README.g77: Remove description of g77 as "not-yet-published". ! * CREDITS: More changes. ! * Make-lang.in (G77STAGESTUFF): Remove cktyps stuff. ! * Makefile.in (CONFIG_H, HCONFIG_H, TCONFIG_H, TM_H): Don't ! prefix gcc dir with $(srcdir) since these don't live there, ! they are created in the build dir by gcc's configure. Add ! a note explaining what these macros are about. ! Update dependencies via deps-kinda. ! * README.NEXTSTEP: Credit Toon, and per his request, add his ! email address. ! * com.h (FFECOM_DETERMINE_TYPES): #include "config.j". ! * config.j, convert.j, flags.j, hconfig.j, rtl.j, tconfig.j, ! tm.j, tree.j: Don't #include if already done. ! * convert.j: #include "tree.j" first, as convert.h clearly depends ! on trees being defined. ! * rtl.j: #include "config.j" first, since there's some stuff ! in rtl.h that assumes it has been #included. ! * tree.j: #include "config.j" first, or real.h makes inconsistent ! decision about return type of ereal_atof, leading to bugs, and ! because tree.h/real.h assume config.h already included. ! Wed Feb 15 14:40:20 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * Version 0.5.5 released. ! * Copyright notices updated to be FSF-style. ! * INSTALL: Some more clarification regarding building just f77. ! * Make-lang.in (F77_SRCS): Update wrt changing some .h to .j. ! (install-libf77): Fix typo in new parenthetical note. ! * Makefile.in (f/*.o): Update. ! (CONFIG_H, CONVERT_H, FLAGS_H, GLIMITS_H, HCONFIG_H, RTL_H, ! TCONFIG_H, TM_H, TREE_H): Update/new symbols. ! (deps-kinda): More fixes wrt changing some .h to .j. ! Document and explain this rule a bit better. ! Accommodate changes in output of gcc -MM. ! * *.h, *.c: Change #include's so proj.h not assumed to #include ! malloc.h or config.h (now config.j), and so new .j files are ! used instead of old .h ones. ! * com.c (ffecom_init_0): Use FLOAT_TYPE_SIZE for f2c's ! TYLONG/TYLOGICAL type codes, to get g77 working on Alpha. ! * com.h: Make all f2c-related integral types "int", not "long ! int". ! * config.j, convert.j, flags.j, glimits.j, hconfig.j, rtl.j, ! tconfig.j, tm.j, tree.j: New files wrapping around gbe ! .h files. ! * config.h, convert.h, flags.h, glimits.h, hconfig.h, rtl.h, ! tconfig.h, tm.h, tree.h: Deleted so new .j files ! can #include the gbe files directly, instead of using "../", ! and thus do better with various kinds of builds. ! * proj.h: Delete unused NO_STDDEF and related stuff. ! Tue Feb 14 08:28:08 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * BUGS: Remove item #12, cross-compiling & autoconf scripts ! reportedly expected to work properly (according to d.love). ! * INSTALL: Add explanation of d.love's patch to config-lang.in. ! Add explanation of how to install just g77 when gcc already installed. ! Add note about usability of "-Wall". Add note about bug- ! reporting. ! * Make-lang.in ($(srcdir)/f/conf-proj): Add comment about why ! conf-proj.out. ! (install-libf77): Echo parenthetical note to user about how to do ! just the (aborted) libf2c installation. ! (deps-kinda): Update to work with new configuration/build stuff. ! * bad.c (ffebad_finish): Put capitalized "warning:" &c message ! as prefix on any diagnostic without pointers into source. ! * bad.def (FFEBAD_TOO_BIG_INIT): Add this warning message. ! * config-lang.in: Add Dave Love's patch to catch case where ! back-end patches not applied and abort configuration. ! * data.c (ffedata_gather_, ffedata_value_): Warn when about ! to initialize a large aggregate area, due to design flaw resulting ! in too much time/space used to handle such cases. ! Use COMMON area name, and first notice of symbol, for multiple- ! initialization diagnostic, instead of member symbol and unknown ! location. ! (FFEDATA_sizeTOO_BIG_INIT_): New macro per above. ! Mon Feb 13 13:54:26 1995 Dave Love ! * Make-lang.in (F77_SRCS): Use $(srcdir)/f/proj.h.in, not ! $(srcdir)/f/proj.h for build outside srcdir. ! Sun Feb 12 13:37:11 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * ../README.g77: Clarify procedures for unpacking, add asterisks ! to mark important things the user must do. ! * Fix dates in/add dates to ../README.g77, BUGS, CREDITS, DOC, ! INSTALL, PROJECTS, README. ! Sun Feb 12 00:26:10 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * Version 0.5.4 released. ! * Make-lang.in (f/proj.h): Reproduce this rule here from ! Makefile.in. ! ($(srcdir)/f/conf-proj): Put autoconf's stdout in temp file ! conf-proj.out, then mv to conf-proj only if successful, so ! conf-proj not touched if autoconf not installed. ! * Makefile.in ($(srcdir)/conf-proj): See Make-lang.in's similar ! rule. ! Sat Feb 11 20:56:02 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * BUGS: Clarify some bugs. ! * DOC: Many improvements and fixes. ! * README: Move bulk of text, edited, to ../README.g77, and ! replace with pointer to that file. ! * com.c (ffecom_init_0): Comment out warning about sizeof(ftnlen) ! as per ste.c change. Add text about ASSIGN to help user understand ! what is being warned about. ! * conf-proj.in: Fix typos in comments. ! * proj.h.in: Add ARRAY_ZERO_SIZE to parallel malloc.h's version, ! in case it proves to be needed. ! * ste.c: Comment out assertions requiring sizeof(ftnlen) >= ! sizeof(char *), in the hopes that overflow will never happen. ! (ffeste_R838): Change assertion to fatal() with at least ! partially helpful message. ! Sat Feb 11 12:38:00 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * com.c (ffecom_vardesc_): Crash if typecode is -1. ! * ste.c (ffeste_io_dolio_): Crash if typecode is -1. ! Sat Feb 11 09:51:57 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * ste.c: In I/O code tests for item arrayness, sort of revert ! to much earlier code that tests original exp, but also check ! in newer way just in case. Newer way alone treated FOO(1:40) ! as an array, not sure why older way alone didn't work, but I ! think maybe it was when diagnosed code was involved, and ! since there are now checks for error_mark_node, maybe the old ! way alone would work. But better to be safe; both original ! ffebld exp _and_ the transformed tree must indicate an array ! for the size-determination code to be used, else just 1/2 elements ! assumed. And this text is for EMACS: (foo at bar). ! Fri Feb 10 11:05:50 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * ste.c: In many cases, surround statement-expansion code ! with ffecom_push_calltemps () and ffecom_pop_calltemps () ! so COMPLEX-returning functions can have temporaries pushed ! in "auto-pop" mode and have them auto-popped at the end of ! the statement. ! Wed Feb 8 14:35:10 1995 Dave Love ! * runtime/f2c.h.in (ftnlen, ftnint): Make same size as integer. ! * runtime/libI77/err.c (f_init): Thinko in MISSING_FILE_ELEMS ! conditional. ! * runtime/libI77/wrtfmt.c (mv_cur): Likewise. ! * runtime/libI77/wsfe.c (x_putc): Likewise. ! * runtime/libF77/signal_.c (signal_): Return 0 (this is a ! subroutine). ! * Makefile.in (f/proj.h): Depend on com.h. ! * Make-lang.in (include/f2c.h): Likewise (and proj.h). ! (install-libf77): Also install f2c.h. ! * runtime/libI77/Makefile.in (*.o): Add f2c.h dependency. ! * runtime/libF77/Makefile.in: Likewise. ! Wed Feb 8 13:56:47 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * stc.c (ffestc_R501_item): Don't reset kind/where to NONE when ! setting basictype/kindtype info for symbol, or especially ! its function/result twin, because kind/where might not be NONE. ! Tue Feb 7 14:47:26 1995 Dave Love ! * Make-lang.in (include/f2c.h:): Set shell variable src more ! robustly (independent of whether srcdir is relative or absolute). ! * Makefile.in (f/proj.h:): Likewise. ! * conf-proj.in: Check need for LAME_ASSERT. Fix indentation in ! check for LAME_STDIO (cosmetic only with ANSI C). ! * com.h: Extra ...SIZE stuff taken from com.c. ! * com.c (FFECOM_DETERMINE_TYPES): Define before including com.h. ! (BITS_PER_WORD etc.) Remove and use conditional definitions to com.h. ! * runtime/configure.in: #define FFECOM_DETERMINE_TYPES for com.h in ! f2c type determination. ! * tm.h: Remove (at least pro tem) because of relative path and use ! top-level one. ! * Make-lang.in (include/f2c.h:): Set shell variable src more ! robustly (independent of whether srcdir is relative or absolute). ! * Makefile.in (f/proj.h:): Likewise. ! Mon Feb 6 19:58:32 1995 Dave Love ! * g77.c (append_arg): Use K&R declaration for, e.g. SunOS4 build. ! Fri Feb 3 20:33:14 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * g77.c (main): Treat -l like filename in terms of -x handling. ! Rewrite arglist mechanism for ease of maintenance. ! Make sure every -lf2c is followed by -lm and vice versa. ! * Make-lang.in: Put complete list of sources in F77_SRCS def ! so changing a .h file, for example, causes rebuild. ! * Makefile.in: Change test for nextstep to m68k-next-nextstep* so ! all versions of nextstep on m68k get the necessary flag. ! Fri Feb 3 19:10:32 1995 Dave Love ! * INSTALL: Note about possible conflict with existing libf2c.a and ! f2c.h. ! * Make-lang.in (f77.distclean): Tidy and move deletion of ! f/config.cache to mostlyclean. ! (install-libf77): Test for $(libdir)/libf2c.* and barf if found ! unless F2CLIBOK defined. ! * runtime/Makefile.in (all): Change path to include directory (and ! elsewhere). ! (INCLUDES): Remove (unused/misleading). ! (distclean): Include f2c.h. ! (clean): Include config.cache. ! * runtime/libF77/Makefile.in (.SUFFIXES): Correct typo. ! (ALL_CFLAGS) Fix up include search path to find f2c.h in top level ! includes always. ! (all): Depend on f2c.h. ! * runtime/libI77/Makefile.in (.SUFFIXES): Likewise. ! Thu Feb 2 17:17:06 1995 Dave Love ! * INSTALL: Note about --srcdir and GNU make. ! * runtime/f2c.h.in (Pad_UDread, ALWAYS_FLUSH): Reomve the #defines ! per below. ! * runtime/configure.in (Pad_UDread, ALWAYS_FLUSH): Define these ! here, not in f2c.h as they'r eonly relevant for building. ! * runtime/configure: Regenerated. ! * config-lang.in: Warn about using GNU make outside source tree ! since I can't get Irix5 or SunOS4 makes to work in this case. ! * Makefile.in (VPATH): Don't set it here. ! (srcdir): Make it the normal `.' (overridden) at top level. ! (all.indirect): New dependency `dircheck'. ! (f771): Likewise ! (dircheck): New target for foolproofing. ! (f/proj.h:): Change finding source. ! (CONFIG_H): Don't use this as the relative path in the include loses ! f builddir != srcdir. ! * config.h: Remove per CONFIG_H change above. ! * Make-lang.in (F77_FLAGS_TO_PASS): Remove GCC_FOR_TARGET. ! (f771:): Pass VPATH, srcdir to sub-make. ! (f/Makefile:): New target. ! (stmp-int-hdrs): new variable for cheating build. ! (f77-runtime:): Alter GCC_FOR_TARGET treatment. ! (include/f2c.h f/runtime/Makefile:) Likewise. ! (f77-runtime-unsafe:): New (cheating) target. ! Thu Feb 2 12:09:51 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * BUGS: Update regarding losing EQUIVALENCE members in -g, and ! regarding RS/6000 problems in the back end. ! * CREDITS: Make some changes as requested. ! * com.c (ffecom_member_trunk_): Remove unused static variable. ! (ffecom_finish_symbol_transform_): Improve comments. ! (ffecom_let_char_): Fix size of temp address-type var. ! (ffecom_member_phase2_): Try fixing problem fixed by change ! to ffecom_transform_equiv_ (f_m_p2_ function currently not used). ! (ffecom_transform_equiv_): Remove def of unused static variable. ! Comment-out use of ffecom_member_phase2_, until problems with ! back end fixed. ! (ffecom_push_tempvar): Fix assertion to not crash okay code. ! * com.h: Remove old, commented-out code. ! Add prototype for warning() in back end. ! * ste.c (ffeste_io_dofio_, ffeste_io_dolio_, ffeste_io_douio_, ! ffeste_io_icilist_): Check correct type of variable for arrayness. ! Sun Jan 29 14:41:42 1995 Dave Love ! * BUGS: Remove references to my configure bugs; add another. ! * runtime/Makefile.in (AR_FLAGS): Provide default value. ! * runtime/f2c.h.in (integer, logical): Take typedefs from ! F2C_INTEGER configuration parameter again. ! (NON_UNIX_STDIO): don't define it. ! * runtime/configure.in: Bring type checks for f2c.h in line with ! com.h. ! (MISSING_FILE_ELEMS): New variable to determine whether the relevant ! elements of the FILE struct exist, independent of NON_UNIX_STDIO. ! * runtime/libI77/{err,wrtfmt,wsfe}.c (MISSING_FILE_ELEMS): Use new ! parameter. ! * config-lang.in: Comment out more of f2c rules (c.f. Make-lang.in). ! (This stuff is relevant iff you gave configure --enable-f2c.) ! Create f/runtime directory tree iff not building in source ! directory. ! * Makefile.in (srcdir): Append slash so we get the right value when ! not building in the source directory. This is a consequence of not ! building the `f' sources in `f'. ! (VPATH): Override configure's value for reasons above. ! (f/proj.h f/conf-proj): New rules to build proj.h by ! autoconfiguration. ! * proj.h: Rename to proj.h.in for autoconfiguration. ! * proj.h.in: New as above. ! * conf-proj conf-proj.in: New files for autoconfiguration. ! * Make-lang.in (include/f2c.h f/runtime/Makefile:): Change the order ! of setting the sh variables so that the right GCC_FOR_TARGET is ! used. ! (f77.*clean:) Add products of new configuration files and make sure ! all the *clean targets do something (unlike the ones in ! cp/Make-lange.in). ! * com.h (FFECOM_f2cINTEGER, FFECOM_f2cLOGICAL): Define as long or ! int appropriately to ensure sizeof(real) == sizeof(integer). ! * PROJECTS: Library section. ! * runtime/libI77/endfile.c: Don't #include sys/types.h conditional ! on NON_UNIX_STDIO since rawio.h needs size_t. ! * runtime/libI77/uio.c: #include for size_t if not ! KR_headers. ! Wed Jan 25 03:31:51 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * Version 0.5.3 released. ! * INSTALL: Revise. ! * Make-lang.in: Comment out rules for building f2c itself (f/f2c/). ! * README: Revise. ! * com.c (ffecom_init_0): Warn if ftnlen or INTEGER not big enough ! to hold a char *. ! * gbe/2.6.2.diff: Update. ! Mon Jan 23 17:10:49 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * TODO: Remove. ! BUGS: New file. ! PROJECTS: New file. ! CREDITS: New file. ! * cktyps*: Remove. ! Make-lang.in: Remove cktyps stuff. ! Makefile.in: Remove cktyps stuff. ! * DOC: Add info on changes for 0.5.3. ! * bad.c: Put "warning:" &c on diagnostic messages. ! Don't output informational messages if warnings disabled. ! Thu Jan 19 12:38:13 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * g77.c: Avoid putting out useless "-xnone -xf77" pairs so ! larger command lines can be accommodated. ! Recognize both `-xlang' and `-x lang'. ! Recognize `-xnone' and `-x none' to mean what it does, instead ! of treating "none" as any other language. ! Some minor, slight improvements in the way args are handled ! (hopefully for clearer, more maintainable code), including ! consistency checks on arg count just in case. ! Wed Jan 18 16:41:57 1995 Craig Burley (burley@gnu.ai.mit.edu) ! * DOC: Explain -fautomatic better. ! * INSTALL: Describe libf2c.a better. ! * Make-lang.in, Makefile.in: Build f771 &c with gcc/ as cd instead ! of gcc/f/ so debugging info is better (source file tracking). ! Add new source file type.c. ! * Makefile.in: For nextstep3, link f771 with -segaddr __DATA ! 6000000. Fix typo. Change deps-kinda target to handle building ! from gcc/. Update dependencies. ! * bld-op.def, bld.h, bld.c: Remove opBACKEND and all related ! stuff. ! Remove consistency tests that cause compiler warnings. ! * cktyps.c: Remove all typing checking. ! * com-rt.def: Change all rttypeFLOAT_ intrinsics to rttypeDOUBLE_, ! to precisely match how they're declared in libf2c. ! * com.h, com.c: Revise to more elegantly track related stuff ! in the version of f2c.h used to build libf2c. ! * com.c: Increase FFECOM_sizeMAXSTACKITEM, and if 0 or undefined ! when checked to determine where to put entity, treat as infinite. ! Rewrite temporary mechanism to be based on trees instead of ! ffeinfo stuff, and make it much simpler. Change interface ! accordingly. ! Fixes to better track types of things, make appropriate ! conversions, etc. E.g. when making an arg for a libf2c ! function, make sure it's of the right type (such as ftnlen). ! Delete opBACKEND transformation code. ! (ffecom_init_0): Smoother initialization of types, especially ! paying attention to using consistent rules for making INTEGER, ! REAL, DOUBLE PRECISION, etc., and for deciding their "*N" ! and kind values that will work across all g77 platforms. ! No longer require per-target configuration info in target.h ! or config/*/*; use new type module to store size, alignment. ! (ffecom_member_phase2): Declare COMMON/EQUIVALENCE group members ! so debugger sees them. ! (ffecom_finish_progunit): Transform all symbols in program unit, ! so -g will show they all exist. ! * expr.c (ffeexpr_collapse_substr): Handle strange substring ! range values. ! * info.h, info.c: Provide connection to new type module. ! Remove tests that yield compiler warnings. ! * intrin.c (ffeintrin_is_intrinsic): Properly handle deleted ! intrinsic. ! * lex.c (ffelex_file_fixed): Remove redundant/buggy code. ! * stc.c (ffestc_kindtype_kind_, ffestc_kindtype_star_): Replace ! boring switch stmt with simple call to new type module. This ! sort of thing is a reason to get up in the morning. ! * ste.c: Update to handle new interface for ! ffecom_push/pop_tempvar. ! Fixes to better track types of things. ! Fixes to not crash for certain diagnosed constructs. ! (ffeste_begin_iterdo_): Check only constants for overflow to avoid ! spurious diagnostics. ! Don't convert larger integer (say, INTEGER*8) to canonical integer ! for iteration count. ! * stw.h: Track DO iteration count temporary variable. ! * symbol.c: Remove consistency tests that cause compiler warnings. ! * target.c (ffetarget_aggregate_info): Replace big switch with ! little call to new type module. ! (ffetarget_layout): Remove consistency tests that cause ! compiler warnings. ! (ffetarget_convert_character1_typeless): Pick up length of ! typeless type from new type module. ! * target.h: Crash build if target float bit pattern cannot be ! precisely determined. ! Remove all the type cruft now determined by ffecom_init_0 ! at invocation time and maintained in new type module. ! Put casts on second arg of all REAL_VALUE_TO_TARGET_DOUBLE ! uses so compiler warnings avoided (requires target float bit ! pattern to be precisely determined, hence code to crash build). ! * top.c: Add inits/terminates for new type module. ! * type.h, type.c: New module. ! * gbe/2.6.2.diff: Remove all patches to files in gcc/config/ ! directory and its subdirectories. ! Mon Jan 9 19:23:25 1995 Dave Love ! * com.h (FFECOM_F2C_INTEGER_TYPE_NODE): Define and use instead of ! long_integer_type_node where appropriate. ! Tue Jan 3 14:56:18 1995 Dave Love ! * com.h: Make ffecom_f2c_logical_type_node long, consistent with ! integer. ! Fri Dec 2 20:07:37 1994 Dave Love ! * config-lang.in (stagestuff): Add f2c conditionally. ! * Make-lang.in: Add f2c and related targets. ! * f2c: Add the directory. ! Fri Nov 25 22:17:26 1994 Dave Love ! * Makefile.in (FLAGS_TO_PASS): pass $(CROSS) ! * Make-lang.in: more changes to runtime targets ! Thu Nov 24 18:03:21 1994 Dave Love ! * Makefile.in (FLAGS_TO_PASS): define for sub-makes ! * g77.c (main): change f77-cpp-output to f77-cpp-input (.F files) ! Wed Nov 23 15:22:53 1994 Dave Love ! * bad.c (ffebad_finish): kluge to fool emacs19 into finding errors: ! add trailing space to :: ! Tue Nov 22 11:30:50 1994 Dave Love ! * runtime/libF77/signal_.c (RETSIGTYPE): added ! Mon Nov 21 13:04:13 1994 Dave Love ! * Makefile.in (compiler): add runtime ! * config-lang.in (stagestuff): add libf2c.a to stagestuff ! * Make-lang.in: ! G77STAGESTUFF <- MORESTAGESTUFF ! f77-runtime: new target, plus supporting ones ! * runtime: add the directory, containing libI77, libF77 and autoconf ! stuff ! * g++.1: remove ! * g77.1: minor fixes ! Thu Nov 17 15:18:05 1994 Craig Burley (burley@gnu.ai.mit.edu) ! * Version 0.5.2 released. ! * bad.def: Modify wording of FFEBAD_UNIMPL_STMT to indicate ! that it covers a wide array of possible problems (that, someday, ! should be handled via separate diagnostics). ! * lex.c: Allow $ in identifiers if -fdollar-ok. ! * top.c: Support -fdollar-ok. ! * top.h: Support -fdollar-ok. ! * target.h: Support -fdollar-ok. ! * DOC: Describe -fdollar-ok. ! * std.c (ffestd_R1229_finish): Fix bug so stand-alone build works. ! * ste.c (ffeste_R819A): Fix bug so stand-alone build works. ! * Make: Improvements for stand-alone build. ! * Makefile.in: Fix copyright text at top of file. ! * LINK, SRCS, UNLINK: Removed. Not particularly useful now that ! g77 sources live in their own subdirectory. ! * g77.c (main): Cast arg to bzero to avoid warning. (This is ! identical to Kenner's fix to cp/g++.c.) ! * gbe/: New subdirectory, to contain .diff files for various ! versions of the GNU CC back end. ! * gbe/README: New file. ! * gbe/2.6.2.diff: New file. ! Tue Nov 8 10:23:10 1994 Dave Love ! * Make-lang.in: don't install as f77 as well as g77 to avoid ! confusion with system's compiler (especially while testing) ! * g77.c (main): use -lf2c and -lm; fix sense of test for .f/.F files ! Fri Oct 28 09:45:00 1994 Craig Burley (burley@gnu.ai.mit.edu) ! * Version 0.5.1 released. ! * gcc.c: Invoke f771 instead of f-771. ! Fri Oct 28 02:00:44 1994 Craig Burley (burley@gnu.ai.mit.edu) ! * Version 0.5.0 released. ! Fri Oct 14 15:03:35 1994 Craig Burley (burley@gnu.ai.mit.edu) ! * Makefile.in: Handle the Fortran-77 front-end in a subdirectory. ! * f-*: Move Fortran-77 front-end to f/*. --- 1,1257 ---- ! Wed Jul 28 21:39:31 PDT 1999 Jeff Law (law@cygnus.com) ! * gcc-2.95 Released. ! * version.c: No longer a prerelease. ! Sat Jul 17 21:57:07 1999 Jeffrey A Law (law@cygnus.com) ! * root.texi: Clear DEVEOPMENT per Craig's instructions. ! 1999-07-17 Alexandre Oliva ! ! * root.texi: Update e-mail addresses to gcc.gnu.org. ! * g77spec.c (lang_specific_driver): Updated URL with bug reporting ! instructions to gcc.gnu.org. Removed e-mail address. ! Sat Jul 17 11:28:43 1999 Craig Burley ! * root.texi, g77install.texi: Switchover to GCC terminology. ! Also, FSF-G77 had been mistakenly set at some point. ! Thu Jul 8 15:38:50 1999 Craig Burley ! * news.texi: Describe DATE intrinsic fix. ! Tue Jun 29 10:10:25 1999 Craig Burley ! * bugs.texi: Undo Friday's change, as there's now a fix ! available from netlib. ! * news.texi: Document the fix. ! Mon Jun 28 10:43:11 1999 Craig Burley ! * com.c (ffecom_prepare_expr_): A COMPLEX intrinsic needs ! a temp even if -fno-f2c. ! * version.c: Bump version. ! Fri Jun 25 11:06:32 1999 Craig Burley ! * bugs.texi: Describe K(5)=10*3 NAMELIST-read bug. ! Mon Jun 21 12:40:17 1999 Gerald Pfeifer ! * g77.texi: Update links. ! Wed Jun 16 11:43:02 1999 Craig Burley ! * news.texi: Mention BACKSPACE fix to libg2c. ! Mon Jun 7 08:42:40 1999 Craig Burley ! * Make-lang.in: Any target using libsubdir must depend ! on installdirs. ! Sat Jun 5 23:50:36 1999 Craig Burley ! * g77.texi: Describe a few more missing features people ! have emailed me about. ! Sat Jun 5 17:03:23 1999 Craig Burley ! From Dave Love to egcs-patches on 20 May 1999 17:38:38 +0100: ! * g77.texi: Clean up fossil text vis-a-vis Intel CPUs. ! Fri Jun 4 13:56:56 1999 Craig Burley ! * Make-lang.in: Use libsubdir, not prefix, to store ! temporary lang-f77 `flag' file. ! Fri Jun 4 10:26:04 1999 Craig Burley ! * news.texi (News): Mention GCC 2.95 in favor of EGCS 1.2. ! Mention that libg2c is multilibbed. ! Fri Jun 4 10:09:50 1999 Craig Burley ! * g77.texi (Missing Features): Add `Better Warnings' ! item. ! Fri May 28 16:51:41 1999 Craig Burley ! * g77.texi: Fix thinko. ! Wed May 26 14:43:27 1999 Craig Burley ! * news.texi: Document Tue May 18 03:52:04 1999 patch. ! Fix a grammo. ! Wed May 26 14:25:07 1999 Craig Burley ! * g77.texi, news.texi, root.texi, version.c: Start renaming ! EGCS 1.2 to GCC 2.95, and start using 0.5.25 to designate ! the version of g77 within GCC 2.95. ! Wed May 26 11:45:21 1999 Craig Burley ! Rename -fsubscript-check to -fbounds-check and ! -ff2c-subscript-check to -ffortran-bounds-check: ! * g77.texi: Rename options in docs, clarify usage. ! * lang-options.h: Rename options, clarify doclets. ! * news.texi: Rename options, don't bother with fortran-specific ! option. ! * top.c (ffe_decode_option): Rename recognized strings. ! Tue May 25 18:21:09 1999 Craig Burley ! * com.c (FFECOM_FASTER_ARRAY_REFS): Delete this vestige, ! now that -fflatten-arrays exists. ! Tue May 25 17:48:34 1999 Craig Burley ! Fix 19990525-0.f: ! * com.c (ffecom_arg_ptr_to_expr): Strip off parens around ! CHARACTER expression. ! (ffecom_prepare_expr_): Ditto. ! Tue May 18 03:52:04 1999 Craig Burley ! Support use of back end's improved open-coding of complex divide: ! * com.c (ffecom_tree_divide_): Use RDIV_EXPR for complex divide, ! instead of run-time call to [cz]_div, if `-Os' option specified. ! (lang_init_options): Tell back end we want support for wide range ! of inputs to complex divide. ! * Bump version. ! Tue May 18 00:21:34 1999 Zack Weinberg ! * lang-specs.h: Define __GNUC__ and __GNUC_MINOR__ only if -no-gcc ! was not given. ! Thu May 13 12:23:20 1999 Craig Burley ! Fix INTEGER*8 subscripts in array references: ! * com.c (ffecom_subscript_check_): Convert low, high, and ! element as necessary to make comparison work. ! (ffecom_arrayref_): Do more of the work. ! Properly handle subscript expr that's wider than int, ! if pointers are wider than int. ! (ffecom_expr_): Leave more work to ffecom_arrayref_. ! (ffecom_init_0): Record sizes of pointers and ints for ! convenience. ! Use set_sizetype etc. as done by gcc front end. ! (ffecom_ptr_to_expr): Leave more work to ffecom_arrayref_. ! * expr.c (ffeexpr_finished_): Don't convert INTEGER subscript ! expressions in run-time contexts. ! (ffeexpr_token_elements_, ffeexpr_token_substring_1_): Cope with ! non-default INTEGER subscript expressions. ! * news.texi: Announce. ! Finish accepting -fflatten-arrays option: ! * com.c (ffecom_arrayref_): Flatten references if requested. ! * g77.texi: Describe. ! * lang-options.h: Allow. ! * news.texi: Announce. ! * top.c, top.h: Recognize. ! * version.c: Bump version. ! Wed May 12 07:30:05 1999 Craig Burley ! * com.c (lang_init_options): Disable back end's maintenance ! of errno. ! * news.texi: Document dropping of errno. ! 1999-05-10 18:21 -0400 Zack Weinberg ! * lang-specs.h: Pass -$ to the preprocessor. ! Mon May 10 18:14:28 1999 Craig Burley ! * g77.texi: Fix various @xref's per proper style. ! Go ahead and use nested braces in @xref's, with care. ! * g77install.texi: Fix @xref per proper style. ! Mon May 10 17:38:39 1999 Craig Burley ! * news.texi: Doc upgrade to netlib libf2c as of today. ! Sun May 9 18:52:13 1999 Hans-Peter Nilsson ! * f/g77spec.c (lang_specific_driver): Correct bug-report address ! and point to the FAQ. ! Thu May 6 12:40:21 1999 Craig Burley ! * g77.texi (Arbitrary Concatenation): Put this under ! "Missing Features" instead of "Projects". ! (Internals Documentation): Point to new "Front End" chapter. ! Thu May 6 08:23:52 1999 Craig Burley ! * bugs.texi, news.texi: Automatic arrays reportedly working ! on HP-UX systems. ! Thu May 6 08:19:31 1999 Craig Burley ! * g77.texi (Advantages Over f2c): Expand on this topic. ! Mon May 3 19:41:48 1999 Craig Burley ! * com.c (ffecom_expr_intrinsic_): Fix test of CTIME_subr. ! Mon May 3 18:11:48 1999 Craig Burley ! Reverse order of two arguments to CTIME_subr, DTIME_subr, ! ETIME_subr, and TTYNAM_subr: ! * com.c (ffecom_expr_intrinsic_): Reverse the arguments. ! While at it, set TREE_SIDE_EFFECTS for CTIME_subr and ! TTYNAM_subr. ! * intdoc.in: Document the new calling sequences. ! * intrin.def: Reverse the arguments. ! * news.texi: Document the fact that they changed. ! * version.c: Bump version. ! Mon May 3 11:28:14 1999 Craig Burley ! * news.texi: Doc upgrade to netlib libf2c as of today. ! Sun May 2 17:04:28 1999 Craig Burley ! * version.c: Bump version. ! Sun May 2 16:53:01 1999 Craig Burley ! Fix compile/19990502-1.f: ! * ste.c (ffeste_R819B): Don't overwrite tree for temp ! variable when expanding the assignment into it. ! ! Sun Apr 25 20:55:10 1999 Craig Burley ! ! Fix 19990325-0.f and 19990325-1.f: ! * com.c (ffecom_possible_partial_overlap_): New function. ! (ffecom_expand_let_stmt): Use it to determine whether to assign ! to a COMPLEX operand through a temp. ! * news.texi: Document fix. ! * version.c: Bump version. ! Sat Apr 24 12:19:53 1999 Craig Burley ! * expr.c (ffeexpr_finished_): Convert DATA implied-do ! start/end/incr expressions to default INTEGER. ! Fix some broken conditionals. ! Clean up some code in the region. ! * news.c: Document the fix. * version.c: Bump version. ! Fri Apr 23 02:08:32 1999 Craig Burley ! * g77.texi (Compiler Prototypes): Replace "missing" subscript- ! checking option with something else. ! Fri Apr 23 01:48:28 1999 Craig Burley ! Support new -fsubscript-check and -ff2c-subscript-check options: ! * com-rt.def (FFECOM_gfrtRANGE): Describe s_rnge, in libf2c/libF77. ! * com.c (ffecom_subscript_check_, ffecom_arrayref_): New functions. ! (ffecom_char_args_x_): Use new ffecom_arrayref_ function for ! FFEBLD_opARRAYREF case. ! Compute character name, array type, and use new ! ffecom_subscript_check_ function for FFEBLD_opSUBSTRING case. ! (ffecom_expr_): Use new ffecom_arrayref_ function. ! (ffecom_ptr_to_expr): Use new ffecom_arrayref_ function. ! * g77.texi, news.texi: Document new options. ! * top.c, top.h: Support new options. ! * news.texi: Fix up some items to not be in "User-Visible Changes". ! * ste.c (ffeste_R819B): Fix type for loop variable, to avoid ! warnings. ! * version.c: Bump version. ! Tue Apr 20 01:38:57 1999 Craig Burley ! * bugs.texi, news.texi: Clarify -malign-double situation. ! Tue Apr 20 01:15:25 1999 Craig Burley ! * stb.c (ffestb_R5282_): Convert DATA repeat count ! to default INTEGER, to avoid problems downstream. ! * version.c: Bump version. ! Mon Apr 19 21:36:48 1999 Craig Burley ! * ste.c (ffeste_R819B): Start the loop before expanding ! the termination expression. ! * version.c: Bump version. ! Sun Apr 18 21:53:58 1999 Craig Burley ! * com.c (ffecom_sym_transform_): COMMON and EQUIVALENCE ! variables have constant addresses (EQUIVALENCE only if ! containing aggregate is static). ! ! Sat Apr 17 16:55:59 1999 Craig Burley ! ! * bugs.texi, ffe.texi, g77.texi, g77install.texi, news.texi: ! Clean up @code{} vs. @samp{}. ! Clean up dashes (`--') vs. @minus{} vs. `---'. ! ! * ffe.texi: Add copyright header. ! ! * g77.texi, lang-options.h, news.texi, top.c (ffe_decode_option): ! Remove support for -fugly option. ! Clarify that -fugly-logint is needed instead of -fugly ! to work around using .EQ./.NE. on LOGICAL operands. ! Explain more about why -fugly-logint is bad juju. ! ! * g77.texi (Missing Features): Describe READONLY as a missing ! feature. Describe AUTOMATIC better. ! ! * news.texi: Mention libf2c upgrade. ! ! Sat Apr 17 14:05:53 1999 Craig Burley ! ! Make a place for front-end internals documentation: ! * Make-lang.in (f/g77.info, f/g77.dvi): Depend on f/ffe.texi. ! * ffe.texi: New file, containing docs on front-end internals. ! * g77.texi: New chapter for, and inclusion of, ffe.texi. ! ! * g77.texi: Fix an index entry. ! ! Sat Apr 17 13:53:43 1999 Craig Burley ! ! Rewrite to use block/scope structure of GBE and to ensure ! variables (especially those going on stack/reg) are declared ! before executable code generated: ! * bld.c (ffebld_new_item, ffebld_new_one, ffebld_new_two): ! Support new hooks. ! * bld.h (ffebld_item_hook, ffebld_item_set_hook, ! ffebld_nonter_hook, ffebld_nonter_set_hook): Ditto. ! * bld.h (ffebld_basictype, ffebld_kind, ffebld_kindtype, ! ffebld_rank, ffebld_where): New convenience macros (used ! by rest of this patch). ! * com.c, com.h (ffecom_push_calltemps, ffecom_pop_calltemps, ! ffecom_push_tempvar, ffecom_pop_tempvar): Remove temp-var- ! handling mechanism. ! * com.c (ffecom_call_, ffecom_call_binop_, ffecom_tree_divide_, ! ffecom_call_gfrt): Support passing hooks for temp-var info. ! (ffecom_expr_power_integer_): Takes opPOWER expression, instead ! of its left and right operands, so it can get at the hook. ! (ffecom_prepare_let_char_, ffecom_prepare_arg_ptr_to_expr, ! ffecom_prepare_end, ffecom_prepare_expr_, ffecom_prepare_expr_rw, ! ffecom_prepare_expr_w, ffecom_prepare_return_expr, ! ffecom_prepare_ptr_to_expr): New functions supporting expression ! pre-scanning. ! (bison_rule_compstmt_): Return the tree, as in the CFE. ! (delete_block): New function, from CFE. ! (kept_level_p): New function, from CFE, modified. ! (ffecom_start_compstmt, ffecom_end_compstmt): New functions, ! replacing ffecom_start_compstmt_ and ffecom_end_compstmt_ macros, ! and they do real work. ! (struct binding_level): Add prep_state member. Initialize to 0. ! (ffecom_get_invented_identifier): Now takes either or both a ! string and an integer, using -1 to denote no integer. ! (ffecom_do_entry_): Disallow temp-var generation via expressions ! in body of function, since the exprs aren't prescanned. ! (ffecom_expr_rw): Now takes destination tree. ! (ffecom_expr_w): New function, now used in some places ! ffecom_expr_rw had been used. ! (ffecom_expr_intrinsic_): Move huge f2c-related comment to bottom ! of source file, to avoid annoying problems editing com.c using ! Emacs C-mode. ! (ffecom_expr_power_integer_): Make a temp var for division, if ! necessary. ! Handle expanded statement expression as does CFE. ! (ffecom_start_progunit_): Disallow temp-var generation in body ! of function, since expressions are not prescanned at this level. ! (ffecom_sym_transform_): Transform ASSIGN variables as well, ! so these are all transformed up front, before code-generation ! begins. ! (ffecom_arg_ptr_to_const_expr, ffecom_const_expr, ! ffecom_ptr_to_const_expr): New functions to transform expressions ! only if the results will surely be constants. ! (ffecom_arg_ptr_to_expr): Precompute size, for convenience ! obtaining temp vars. ! (ffecom_expand_let_stmt): Guess at usability of destination ! pre-expansion, to provide better prescan preparation (fewer ! spurious temp vars). ! (ffecom_init_0): Disallow temp-var generation in global scope. ! (ffecom_type_expr): New function, returns just the type tree ! for the expression. ! (start_function): Disallow temp-var generation in parm scope. ! (incomplete_type_error): Fix introductory comment. ! (poplevel): Update (somewhat) from CFE. ! (pushlevel): Update (somewhat) from CFE. ! * stc.c (ffestc_R838): Mark ASSIGNed variable as so. ! * std.c (ffestd_stmt_pass_, ffestd_R803, ffestd_R804, ffestd_R805, ! ffestd_R806): Remember and pass through the ffestw block info ! for these (IFTHEN, ELSEIF, ELSE, and ENDIF) statements. ! * ste.c (ffeste_end_iterdo_): Now takes ffestw block argument. ! (ffeste_io_inlist_): Add prototype. ! (ffeste_f2c_*): Macros rewritten, new ones added. ! (ffeste_start_block_, ffeste_end_block_, ffeste_start_stmt_, ! ffeste_end_stmt_): New macros/functions, depending on whether ! checking is enabled, to keep track of symmetry of other ste.c code. ! (ffeste_begin_iterdo_, ffeste_end_iterdo_, ffeste_io_impdo_, ! ffeste_io_dofio_, ffeste_io_dolio_, ffeste_io_douio_, ! ffeste_io_ialist_, ffeste_io_cilist_, ffeste_io_cllist_, ! ffeste_icilist_, ffeste_io_inlist_, ffeste_io_olist_, ! ffeste_subr_beru_, ffeste_do, ffeste_end_R807, ffeste_R737A, ! ffeste_R803, ffeste_R804, ffeste_R805, ffeste_R806, ffeste_R807, ! ffeste_R809, ffeste_R810, ffeste_R811, ffeste_R819A, ffeste_R819B, ! ffeste_R837, ffeste_R838, ffeste_R839, ffeste_R840, ffeste_R904, ! ffeste_R907, ffeste_R909_start, ffeste_R909_item, ffeste_R909_finish, ! ffeste_R910_start, ffeste_R910_item, ffeste_R910_finish, ! ffeste_R911_start, ffeste_R911_item, ffeste_R911_finish, ! ffeste_R923A, ffeste_R1212, ffeste_R1227): Prescan/prepare ! all pertinent expressions, update to new com.c interface, etc. ! (ffeste_io_impdo_): Relocate. ! (ffeste_R834, ffeste_R835, ffeste_R836, ffeste_R1226): Don't ! bother calling clear_momentary, nothing was generated. ! (ffeste_R842, ffeste_R843): Update to new com.c interface. ! (ffeste_R1226): Don't try to stuff error_mark_node's DECL_INITIAL. ! (ffeste_terminate_2): When checking enabled, make sure all blocks ! and statements have been ended. ! * ste.h (ffeste_R803, ffeste_R804, ffeste_R805, ffeste_R806): ! These now take ffestw block argument. ! (ffeste_terminate_2): When checking enabled, it's a function, not ! a macro. ! * stw.h (struct _ffestw_): New variable for IFTHEN. ! (ffestw_ifthen_fake_else, ffestw_set_ifthen_fake_else): New ! accessor macros. ! * symbol.c, symbol.h: Support new ASSIGN'ed-to info. ! * com.c: Clean up commentary per GNU coding standards. ! * bld.h (ffebld_size, ffebld_size_known): Canonize. ! * version.c: Bump version. ! Sun Apr 11 21:33:33 1999 Mumit Khan ! * g77spec.c (lang_specific_driver): Check whether MATH_LIBRARY is ! null to decide whether to use it. ! Wed Apr 7 09:47:09 1999 Kaveh R. Ghazi ! * ansify.c (die): Specify void argument. ! * intdoc.c (family_name, dumpgen, dumpspec, dumpimp, ! argument_info_ptr, argument_info_string, argument_name_ptr, ! argument_name_string, elaborate_if_complex, ! elaborate_if_maybe_complex, elaborate_if_real, print_type_string): ! Const-ify a char*. ! (main): Mark parameter `argv' with ATTRIBUTE_UNUSED. ! (_ffeintrin_name_, _ffeintrin_gen_, _ffeintrin_spec_, ! _ffeintrin_imp_, cc_pair, descriptions, summaries): Const-ify a char*. ! Mon Apr 5 11:57:54 1999 Donn Terry (donn@interix.com) ! * Make-lang.in (HOST_CFLAGS): compute dynamically. ! Mon Apr 5 02:11:23 1999 Craig Burley ! Fix bugs exposed by configuring with --enable-checking: ! * com.c (ffecom_do_entry_, ffecom_expr_, ffecom_arg_ptr_to_expr, ! ffecom_list_expr, ffecom_list_ptr_to_expr, finish_function, ! pop_f_function_context, store_parm_decls, poplevel): Handle ! error_mark_node properly. ! * ste.c (ffeste_begin_iterdo_, ffeste_end_iterdo_): Ditto. ! * version.c: Bump version. ! Sat Apr 3 23:57:56 1999 Craig Burley ! * g77.texi: Fix up docs for -fset-g77-defaults, and ! describe how internal consistency checking now happens. ! (Should have been done for EGCS version 1.1.) ! Sat Apr 3 23:29:33 1999 Craig Burley ! * bugs.texi, g77.texi, lang-options.h, news.texi, top.c: ! Make -fno-emulate-complex the default, as COMPLEX support ! in the back end is now believed to be working. ! * version.c: Bump version. ! Fri Apr 2 13:33:16 1999 Craig Burley ! * g77.texi: -malign-double now works. ! Give URL for alignment-testing package. ! * news.texi: -malign-double now works. ! Fri Apr 2 12:49:12 1999 Craig Burley ! * g77.texi (Funding GNU Fortran): Dude's got a web page. ! * root.texi: Ditto. ! Tue Mar 30 12:04:11 1999 Kaveh R. Ghazi ! * sta.c (ffesta_ffebad_1sp, ffesta_ffebad_1st, ffesta_ffebad_2st): ! Const-ify a char*. ! * sta.h (ffesta_ffebad_1sp, ffesta_ffebad_1st, ffesta_ffebad_2st): ! Likewise. ! * stb.c (ffestb_local_u_): Likewise. ! (ffestb_do, ffestb_dowhile, ffestb_else, ffestb_elsexyz, ! ffestb_else3_, ffestb_endxyz, ffestb_goto, ffestb_let, ! ffestb_type, ffestb_type1_, ffestb_varlist, ffestb_R423B, ! ffestb_R522, ffestb_R528, ffestb_R542, ffestb_R834, ffestb_R835, ! ffestb_R838, ffestb_R841, ffestb_R1102, ffestb_blockdata, ! ffestb_R1212, ffestb_R1228, ffestb_V009, ffestb_module, ! ffestb_R809, ffestb_R810, ffestb_R10014_, ffestb_R10015_, ! ffestb_R10018_, ffestb_R1107, ffestb_R1202, ffestb_R12026_, ! ffestb_S3P4, ffestb_V012, ffestb_V014, ffestb_V025, ffestb_V0255_, ! ffestb_V020, ffestb_dimlist, ffestb_dummy, ffestb_R524, ! ffestb_R547, ffestb_decl_chartype, ffestb_decl_dbltype, ! ffestb_decl_gentype, ffestb_decl_recursive, ffestb_decl_entsp_2_, ! ffestb_decl_func_, ffestb_V003, ffestb_V016, ffestb_V027, ! ffestb_decl_R539): Likewise. ! * stb.h (_ffestb_args_): Likewise. ! * stc.c (ffestc_subr_binsrch_, ffestc_subr_is_present_, ! ffestc_subr_speccmp_, ffestc_R904, ffestc_R907): Likewise. ! * std.c (ffestd_R1001dump_1005_1_, ffestd_R1001dump_1005_2_, ! ffestd_R1001dump_1005_3_, ffestd_R1001dump_1005_4_, ! ffestd_R1001dump_1005_5_, ffestd_R1001dump_1010_1_, ! ffestd_R1001dump_1010_2_, ffestd_R1001dump_1010_3_, ! ffestd_R1001dump_1010_4_, ffestd_R1001dump_1010_5_): Likewise. ! * ste.c (ffeste_begin_iterdo_, ffeste_subr_file_): Likewise. ! * sts.c (ffests_printf_1D, ffests_printf_1U, ffests_printf_1s, ! ffests_printf_2Us, ffests_puts, ffests_puttext): Likewise. ! * sts.h (ffests_printf_1D, ffests_printf_1U, ffests_printf_1s, ! ffests_printf_2Us, ffests_puts, ffests_puttext): Likewise. ! * stt.c (ffestt_exprlist_drive, ffestt_implist_drive, ! ffestt_tokenlist_drive): Add prototype arguments. ! * stt.h (ffestt_exprlist_drive, ffestt_implist_drive, ! ffestt_tokenlist_drive): Likewise. ! * stu.c (ffestu_dummies_transition_): Likewise. ! (ffestu_sym_end_transition): Const-ify a char*. ! * stw.c (ffestw_display_state, ffestw_new, ffestw_pop): Add ! prototype arguments. ! * stw.h (ffestw_display_state, ffestw_new, ffestw_pop): Likewise. ! * version.c (ffe_version_string): Const-ify a char*. ! * version.h (ffe_version_string): Likewise. ! Sat Mar 27 13:00:43 1999 Kaveh R. Ghazi ! * bad.c (_ffebad_message_, ffebad_string_, ffebad_message_, ! ffebad_bufputs_, ffebad_bufputs_, ffebad_start_, ffebad_string, ! ffebad_finish): Const-ify a char*. ! * bld.c (ffebld_op_string_, ffebld_op_string): Likewise. ! * bld.h (ffebld_op_string): Likewise. ! * com.c (ffecom_arglist_expr_, ffecom_build_f2c_string_, ! ffecom_debug_kludge_, ffecom_f2c_make_type_, ! ffecom_get_appended_identifier_, ffecom_get_identifier_, ! ffecom_gfrt_args_): Likewise. ! (ffecom_convert_narrow_, ffecom_convert_widen_): Add prototype. ! (builtin_function, ffecom_gfrt_name_, ffecom_gfrt_argstring_, ! ffecom_arglist_expr_, ffecom_build_f2c_string_, ! ffecom_debug_kludge_, ffecom_f2c_make_type_, ! ffecom_get_appended_identifier_, ffecom_get_external_identifier_, ! ffecom_get_identifier_, ffecom_decl_field, ! ffecom_get_invented_identifier, lang_print_error_function, ! skip_redundant_dir_prefix, read_name_map, print_containing_files): ! Const-ify a char*. ! (savestring): Remove, use `xstrdup' instead. ! * com.h (ffecom_decl_field, ffecom_get_invented_identifier): ! Const-ify a char*. ! * data.c (ffebld, ffedata_gather_): Make explicitly static. ! * expr.c (ffeexpr_isdigits_, ffeexpr_percent_, ! ffeexpr_reduced_concatenate_, ffeexpr_nil_real_, ! ffeexpr_nil_number_, ffeexpr_nil_number_period_, ! ffeexpr_nil_number_real_, ffeexpr_token_real_, ! ffeexpr_token_number_, ffeexpr_token_number_period_, ! ffeexpr_token_number_real_): Const-ify a char*. ! * fini.c (xspaces): Likewise. ! * global.c (ffeglobal_type_string_): Likewise. ! (ffeglobal_drive): Protoize. ! (ffeglobal_proc_def_arg): Const-ify a char*. ! * global.h (ffeglobal_drive): Protoize. ! (ffeglobal_proc_def_arg): Const-ify a char*. ! * implic.c (ffeimplic_none, ffeimplic_peek_symbol_type): ! Likewise. ! * implic.h (ffeimplic_peek_symbol_type): Likewise. ! * info.c (ffeinfo_basictype_string_, ffeinfo_kind_message_, ! ffeinfo_kind_string_, ffeinfo_kindtype_string_, ! ffeinfo_where_string_, ffeinfo_basictype_string, ! ffeinfo_kind_message, ffeinfo_kind_string, ! ffeinfo_kindtype_string, ffeinfo_where_string): Likewise. ! * info.h (ffeinfo_basictype_string, ffeinfo_kind_message, ! ffeinfo_kind_string, ffeinfo_kindtype_string, ! ffeinfo_where_string): Likewise. ! * intrin.c (_ffeintrin_name_, _ffeintrin_gen_, _ffeintrin_spec_, ! _ffeintrin_imp_, ffeintrin_check_, ffeintrin_cmp_name_, ! ffeintrin_fulfill_specific, ffeintrin_init_0, ! ffeintrin_is_actualarg, ffeintrin_is_intrinsic, ! ffeintrin_name_generic, ffeintrin_name_implementation, ! ffeintrin_name_specific): Likewise. ! * intrin.h (ffeintrin_is_intrinsic, ffeintrin_name_generic, ! ffeintrin_name_implementation, ffeintrin_name_specific): Likewise. ! * lex.c (ffelex_type_string_, ffelex_token_new_character, ! ffelex_token_new_name, ffelex_token_new_names, ! ffelex_token_new_number): Likewise. ! * lex.h (ffelex_token_new_character, ffelex_token_new_name, ! ffelex_token_new_names, ffelex_token_new_number): Likewise. ! * malloc.c (malloc_types_, malloc_pool_new, malloc_new_inpool_, ! malloc_new_zinpool_): Likewise. ! * malloc.h (malloc_new_inpool_, malloc_new_zinpool_, ! malloc_pool_new): Likewise. ! * name.c (ffename_space_drive_global, ffename_space_drive_symbol): ! Protoize. ! * name.h (ffename_space_drive_global, ffename_space_drive_symbol): ! Likewise. ! * symbol.c (ffesymbol_state_name_, ffesymbol_attr_name_, ! ffesymbol_attrs_string): Const-ify a char*. ! (ffesymbol_drive, ffesymbol_drive_sfnames): Protoize. ! (ffesymbol_state_string): Const-ify a char*. ! * symbol.h (ffesymbol_attrs_string): Likewise. ! (ffesymbol_drive, ffesymbol_drive_sfnames): Protoize. ! (ffesymbol_state_string): Const-ify a char*. ! * target.c (ffetarget_layout): Likewise. ! * target.h (ffetarget_layout): Likewise. ! 1999-03-25 Zack Weinberg ! * Make-lang.in: Remove all references to g77.o/g77.c. ! Link g77 from gcc.o. ! 1999-03-21 Manfred Hollstein ! * Makefile.in (g77$(exeext)): Depend on intl.o. Link in intl.o. ! Wed Mar 17 11:39:44 1999 Craig Burley ! * news.texi: Editorial fix. ! Mon Mar 15 17:12:07 1999 Craig Burley ! * bugs.texi, g77.texi, news.texi: Editorial fixes. ! Sat Mar 13 17:51:55 1999 Craig Burley ! Fix 19990313-0.f, 19990313-1.f, 19990313-2.f, 19990313-3.f: ! * bad.def (FFEBAD_NOCANDO): New error code for internal use only. ! * expr.c (ffeexpr_collapse_convert): If FFEBAD_NOCANDO returned ! by convertor, just return original expr. ! * target.h: Return FFEBAD_NOCANDO for (usually) 64-bit ! conversions that aren't yet working properly. ! * news.texi: Explain. ! * version.c: Bump version. ! Sat Mar 13 14:26:55 1999 Craig Burley ! * RELEASE-PREP: New file, lists things to do for a release. ! * Make-lang.in, bugs.texi, bugs0.texi, g77.texi, g77install.texi, ! install0.texi, news.texi, news0.texi: Accommodate new doc ! architecture. ! Consolidate news items. Don't describe old news items in ! various generated docs. ! Don't describe FSF-g77 installation stuff in various EGCS-g77 ! generated docs. ! Move description of AUTOMATIC to more suitable location. ! * root.texi: New file for new doc architecture. ! ! Thu Mar 11 17:32:55 1999 Craig Burley ! ! * g77.texi: Add AUTOMATIC to list of unsupported extensions. ! ! Sat Mar 6 02:28:35 1999 Craig Burley ! ! Warn about non-Y2K-compliant intrinsics: ! * bad.def (FFEBAD_INTRINSIC_Y2KBAD): New diagnostic. ! * intrin.def (FFEINTRIN_impDATE, FFEINTRIN_impIDATE_vxt): ! Use new DEFIMPY macro to flag these as non-Y2K-compliant. ! * intdoc.c (DEFIMPY): Support new Y2K macro. ! * intrin.h (DEFIMPY): Ditto. ! * intrin.c (DEFIMPY): Ditto. ! (ffeintrin_fulfill_generic, ffeintrin_fulfill_specific): ! Warn about invocation of non-Y2K-compliant intrinsic. ! * com-rt.def (FFECOM_gfrtDATE, FFECOM_gfrtVXTIDATE): ! Rename external procedure names, to keep previously- ! compiled (sans-new-warnings) code from linking to ! new library. ! * g77.texi: Document all this stuff. ! * news.texi: Spread the joy. ! * version.c: Bump version. ! Fri Mar 5 13:22:44 1999 Craig Burley ! * news.texi: Relocate IDATE (VXT) fix: we put it in 1.1.2 ! so describe it there, instead of under 1.2. ! Wed Mar 3 00:57:56 1999 Craig Burley ! * news.texi: IDATE (VXT) fixed to return year as 0..99. ! Wed Mar 3 00:43:49 1999 Craig Burley ! * g77.texi: Add remaining changes pending from Dave Love. ! Wed Mar 3 00:38:42 1999 Craig Burley ! * bugs.texi, news.texi: Conditionalize cross-references ! on non-html processing, providing temporary HTML "links". ! * g77.texi: Fix up a reference. ! Wed Mar 3 00:12:31 1999 Craig Burley ! * news.texi, bugs.texi: Delete fixed bugs, make one ! of them into the appropriate news item. ! Wed Mar 3 00:05:52 1999 Craig Burley ! * news.texi: Copy over 1.1.2 news. ! 1999-03-02 Craig Burley ! * g77.texi (Bug Reporting): Clarify whether to use -E. ! Clarify other instructions. ! 1999-02-27 Craig Burley ! * lang-specs.h: Fix specs to pass `-ax' as well as `-a' option. ! 1999-02-26 Craig Burley ! * intdoc.in (STAT_func, STAT_subr, ! FSTAT_func, FSTAT_subr, LSTAT_func, LSTAT_subr): ! Properly order array elements. Specify N/A return values. ! 1999-02-26 Craig Burley ! * intdoc.in (DATE_AND_TIME): Explain that VALUES(7) holds ! seconds, and VALUES(8), therefore, milliseconds. ! 1999-02-26 Craig Burley ! * news.texi: Clarify IOSTAT= fix. ! 1999-02-25 Richard Henderson ! * lang-specs.h: Define __FAST_MATH__ when appropriate. ! 1999-02-25 Craig Burley ! * g77.texi: Clarify/index lack of run-time allocation for ! concatenation. ! ! 1999-02-25 Andreas Jaeger ! * f/intdoc.in: Add missing `,' after cross references. ! 1999-02-20 Craig Burley ! * Make-lang.in (f77.install-common, f77.install-info, ! f77.install-man, f77.uninstall): Use `$(prefix)/lang-f77' ! instead of `lang-f77' for flag file, to be sure of a ! writable directory, and remove the flag file after each ! operation to keep things clean. ! 1999-02-20 Craig Burley ! * g77.texi: Properly attribute Priest document; clarify ! that it is in the .ps version of the Goldberg document. ! 1999-02-19 Craig Burley ! * bugs0.texi, bugs.texi, install0.texi, g77install.texi, ! news0.texi, news.texi: Update copyright dates. ! Clarify which files are source, which are derived, ! and remind maintainers where copyright dates are sourced. ! * BUGS, INSTALL, NEWS: Regenerated. ! ! 1999-02-19 Craig Burley ! ! * global.c (ffeglobal_ref_progunit_): Warn about a function ! definition that disagrees with the type of a previous reference. ! Improve commentary. Fix a couple of minor bugs. Clean up ! some code. ! * news.texi: Spread the joy. ! 1999-02-18 Craig Burley ! * expr.c (ffeexpr_finished_): Disallow non-default INTEGER ! as argument for FILEINT and FILEASSOC as lhs. ! * news.texi: Document fix. ! * version.c: Bump. ! 1999-02-18 Craig Burley ! * g77.texi: Clarify -fno-globals vs. -Wno-globals. ! 1999-02-18 Craig Burley ! * intdoc.in (LOG10): Fix typo. ! 1999-02-17 Ulrich Drepper ! * intdoc.in: Fix typo. ! 1999-02-17 Craig Burley ! * g77.texi, intdoc.in: Document Y2K and some other known ! limitations. ! * intrin.def (DTIME, FDATE): Fix capitalization of ! case-sensitive forms of these intrinsics' names. ! 1999-02-17 Dave Love ! * intdoc.in: Say `common' logarithm for log10. ! 1999-02-16 Ulrich Drepper ! * g77.texi: Add missing @ in email addresses. ! 1999-02-15 Craig Burley ! * *.*: Delete my (old) email address in most places, change it ! in a few. ! 1999-02-14 Craig Burley ! * version.c: Bump. ! 1999-02-14 Craig Burley ! * version.c: Bump for 1998-10-02 change (forgot to do this ! before). ! 1999-02-14 Craig Burley ! * lang-specs.h, g77.1, g77.texi, news.texi: Recognize `.FOR' ! and `.FPP' as well as `.for' and `.fpp'. ! 1999-02-14 Craig Burley ! * intdoc.in (LOG10): Fix description. ! 1999-02-14 Craig Burley ! * news.texi: Mention fix for SIGNAL invocation circa egcs-1.1. ! 1999-02-14 Craig Burley ! * g77.texi, g77install.texi, bugs.texi, g77install.texi: Clean ! up and improve indexing, and some other areas of docs. ! 1999-02-14 Craig Burley ! * intdoc.in (MCLOCK8, TIME8): Warn about lower range on ! 32-bit systems. ! Sat Feb 6 18:02:17 1999 Jeffrey A Law (law@cygnus.com) ! * g77.texi: Update email addresses. ! Wed Feb 3 22:50:17 1999 Marc Espie ! * Make-lang.in (g77$(exeext)): Get choose-temp.o, pexecute.o and ! mkstemp.o from libiberty. ! 1999-02-01 Zack Weinberg ! * top.c: Don't define ffe_is_ident_. Don't process ! -f(no-)ident here. ! * top.h: Remove declaration of ffe_is_ident_ and macros ! ffe_is_ident() and ffe_set_is_ident(). ! * lex.c: Use flag_no_ident instead of ffe_is_ident(). ! Sun Jan 31 20:34:29 1999 Zack Weinberg ! * lang-specs.h: Map -Qn to -fno-ident. ! Tue Jan 5 22:12:41 1999 Kaveh R. Ghazi ! * Make-lang.in (g77.o): Depend on prefix.h. ! Fri Nov 27 13:10:32 1998 Kaveh R. Ghazi ! * fini.c: Rename variable `spaces' to `xspaces' to avoid ! conflicting with function `spaces' from libiberty. ! * g77spec.c: Don't prototype libiberty functions. ! * malloc.c: Likewise. ! 1998-11-20 Dave Love ! * g77.texi: Assorted minor changes. ! 1998-11-19 Dave Love ! * bugs.texi: Formatting changes from Craig. ! * intdoc.in: Terminate some @xrefs with `,'. ! 1998-11-19 Manfred Hollstein ! * Make-lang.in (mandir): Replace all uses of $(mandir) by $(man1dir). ! Mon Nov 9 23:15:39 1998 Jeffrey A Law (law@cygnus.com) ! * g77.texi, news.texi: Updates from Craig. ! Sun Nov 8 17:47:56 1998 Kaveh R. Ghazi ! * Makefile.in (INCLUDES): Add "-I$(srcdir)/../../include". ! Sat Nov 7 15:58:54 1998 Kaveh R. Ghazi ! * g77spec.c: Don't include gansidecl.h. ! * output.j: Likewise. ! 1998-11-04 Dave Love ! * g77.texi: Small formatting/indexing fixes. ! Mon Oct 12 20:41:59 1998 Kaveh R. Ghazi ! * bad.c (ffebad_finish): Change type of variable `c' to unsigned ! char, change type of variable `s' to unsigned char *. ! * com.c (ffecom_symbol_null_): Add missing initializers. ! * fini.c (MAXNAMELEN): Undef it before defining. ! * implic.c (ffeimplic_lookup_): Change type of parameter `c' to ! unsigned char. ! * intrin.c (ffeintrin_init_0): Cast the argument of ctype macros ! to (unsigned char). ! * lex.c (ffelex_splice_tokens): Change type of variable `p' to ! unsigned char *. ! (ffelex_token_name_from_names): Cast the argument of ! `ffelex_is_firstnamechar' to (unsigned char). ! (ffelex_token_names_from_names): Likewise. ! (ffelex_token_new_name): Likewise. ! (ffelex_token_new_names): Likewise. ! * malloc.c (malloc_root_): Add missing initializer. ! * stb.c (ffestb_do): Change type of variable `p' to unsigned char *. ! (ffestb_else) Likewise. ! (ffestb_else3_) Likewise. ! (ffestb_endxyz) Likewise. ! (ffestb_goto) Likewise. ! (ffestb_let) Likewise. ! (ffestb_varlist) Likewise. ! (ffestb_R522) Likewise. ! (ffestb_R528) Likewise. ! (ffestb_R834) Likewise. ! (ffestb_R835) Likewise. ! (ffestb_R838) Likewise. ! (ffestb_R1102) Likewise. ! (ffestb_blockdata) Likewise. ! (ffestb_R1212) Likewise. ! (ffestb_R810) Likewise. ! (ffestb_R10014_): Cast the argument of `ffelex_is_firstnamechar' ! to (unsigned char). ! (ffestb_V014): Change type of variable `p' to unsigned char *. ! (ffestb_dummy) Likewise. ! (ffestb_R524) Likewise. ! (ffestb_R547) Likewise. ! (ffestb_decl_chartype) Likewise. ! (ffestb_decl_dbltype) Likewise. ! (ffestb_decl_gentype) Likewise. ! (ffestb_decl_entsp_2_) Likewise. ! (ffestb_V027) Likewise. ! (ffestb_decl_R539) Likewise. ! * top.c (ffe_decode_option): Mark parameter `argc' with ! ATTRIBUTE_UNUSED. ! * where.c (ffewhere_unknown_line_): Add missing initializers. ! 1998-10-02 Dave Love ! * com.c (ffecom_expr_intrinsic_): Fix return type for RAND. ! Thu Oct 1 10:43:45 1998 Nick Clifton ! * lex.c: Replace occurances of HANDLE_SYSV_PRAGMA with ! HANDLE_GENERIC_PRAGMAS. ! Mon Sep 28 04:22:00 1998 Jeffrey A Law (law@cygnus.com) ! * news.texi: Update from Craig. ! 1998-09-23 Dave Love ! * g77.texi: Additions about `/*', trailing comments and cpp. ! 1998-09-18 Dave Love ! * g77.texi: Various additions and some small fixes. ! Thu Sep 10 14:55:44 1998 Kamil Iskra ! * Make-lang.in (f77.install-common): Add missing "else true;". ! 1998-09-07 Dave Love ! * ChangeLog.egcs: Deleted. Entries merged here. ! 1998-09-05 Dave Love ! * Makefile.in (LDFLAGS): Set from BOOT_LDFLAGS. ! (F771_LDFLAGS): Variable dispensed with. ! Fri Sep 4 19:53:34 1998 Craig Burley ! * intdoc.in: Minor editorial tweaks. ! Fri Sep 4 18:35:52 1998 Craig Burley ! * lang-options.h: Convert to wrap option and doc string ! in a new macro invocation, FTNOPT, so the nearly identical ! list can be used in FSF-g77. ! Fri Sep 4 18:35:52 1998 Craig Burley ! * Makefile.in (fini.o): Don't define USE_HCONFIG here. ! * fini.c: Define USE_HCONFIG here instead, so deps-kinda ! picks up correct dependency. ! * Makefile.in (proj-h.o): Fix dependencies list. ! Wed Sep 02 09:25:29 1998 Nick Clifton ! * lex.c (ffe_lex_hash): Change how HANDLE_PRAGMA and ! HANDLE_SYSV_PRAGMA would be called if they pragma parsing was ! enabled in this code. ! Generate warning messages if unknown pragmas are encountered. ! (pragma_getc): New function: retrieves characters from the ! input stream. Defined when HANDLE_PRAGMA is defined. ! (pragma_ungetc): New function: replaces characters back into the ! input stream. Defined when HANDLE_PRAGMA is defined. ! Tue Sep 1 10:00:21 1998 Craig Burley ! * bugs.texi, g77.1, g77.texi, intdoc.in, news.texi: Doc updates ! from Craig. ! 1998-08-23 Dave Love ! * g77.texi: Increment `version-g77' and fix a few typos. ! Tue Aug 18 21:41:31 1998 Jeffrey A Law (law@cygnus.com) ! * Make-lang.in: Add several "else true" clauses to deal with lame ! systems. ! Tue Aug 11 08:12:14 1998 H.J. Lu (hjl@gnu.org) ! * Make-lang.in (g77.o): Touch lang-f77 before checking it. ! 1998-08-09 Dave Love ! * Make-lang.in (f/g77.dvi): Replace non-working use of texi2dvi ! with explicit use of tex. ! (f77.mostlyclean): Remove TeX index files. ! * g77install.texi (Prerequisites): Kluge round TeX lossage with ! hyphen in @value in @code. ! Tue Aug 4 16:59:39 1998 Craig Burley ! * com.c (ffecom_convert_narrow_, ffecom_convert_widen_): ! Allow conversion from pointer to same-sized integer, ! to fix invoking SIGNAL as a function. ! 1998-07-26 Dave Love ! * BUGS, INSTALL, NEWS: Rebuilt. ! Sat Jul 25 17:23:55 1998 Craig Burley ! Fix 980615-0.f: ! * stc.c (ffestc_R1229_start): Set info to ANY as well. ! Tue Jul 21 04:33:37 1998 Craig Burley ! * g77spec.c (lang_specific_driver): Return unmolested ! command line when --help seen. ! Comment out code that printed g77-specific --help info. ! Sat Jul 18 19:16:48 1998 Craig Burley ! * lang-options.h: Fix up doc strings. ! Remove the unimplemented -fdcp-intrinsics-* options. ! * str-1t.fin: Change mixed-case spelling of `GoTo' from ! `Goto'. ! Thu Jul 16 13:26:36 1998 Craig Burley ! * com.c (ffecom_finish_symbol_transform_): Revert change ! of 1998-05-23, as it was too aggressive, in that it ! prevented transformation of (used) functions before ! primary code generation. ! 1998-07-15 Dave Love ! * intdoc.texi: Regenerated. ! Mon Jul 13 18:45:06 1998 Craig Burley ! * Make-lang.in (f77.rebuilt): Fix to depend on ! build-dir-based, not source-based, g77.info. ! * g77.texi: Merge docs with 0.5.24. ! * g77install.texi: Ditto. ! Mon Jul 13 18:02:29 1998 Craig Burley ! Cleanups vis-a-vis g77-0.5.24: ! * g77spec.c (lang_specific_driver): Tabify source. ! * top.c (ffe_decode_option): Use fixed macro to set ! internal-checking flag. ! * top.h (ffe_set_is_do_internal_checks): Fix macro. ! Mon Jul 13 17:33:44 1998 Craig Burley ! Cleanups vis-a-vis system.h cutover and g77-0.5.24: ! * Makefile.in (fini.o): Define USE_HCONFIG macro ! so source code doesn't have to. ! * fini.c: Don't define USE_HCONFIG here, since ! source code usually shouldn't care about this. ! * ansify.c: Include stddef.h only if we have it. ! * intdoc.c: Ditto. ! * proj.h: Ditto. ! Mon Jul 13 17:30:29 1998 Nick Clifton ! * lang-options.h: Format changed to work with --help support added ! to gcc/toplev.c ! Mon Jul 13 11:54:03 1998 Craig Burley ! * com.c (ffecom_push_tempvar): Replace kludge that ! munged back-end globals directly with proper calls ! to push_topmost_sequence and pop_topmost_sequence. ! 1998-07-12 Dave Love ! * version.c: Bump version. ! Sat Jul 11 19:24:32 1998 Craig Burley ! Fix 980616-0.f: ! * equiv.c (ffeequiv_offset_): Don't crash on various ! possible ANY operands. ! Sat Jul 11 18:24:37 1998 Craig Burley ! * com.c (ffecom_expr_) [FFEBLD_opCONTER]: Die if padding ! for constant is non-zero. ! * com.c (__eprintf): Delete this function, it is obsolete. ! 1998-07-09 Dave Love ! * intdoc.in (HOSTNM_func, HOSTNM_subr): Update last change. ! Thu Jul 9 00:45:59 1998 Craig Burley ! Fix debugging of CHARACTER*(*), etc., which requires ! emitting debug info on types like `ftnlen': ! * com.c (ffecom_start_progunit_): Don't bother ! resetting "invented" flag for identifier. ! (ffecom_transform_equiv_): Don't bother zeroing ! "ignored" flag for decl. ! (pushdecl): No longer set "ignored", "used", or ! "suppressed debug" flags for decls having "invented" ! identifiers. ! 1998-07-06 Mike Stump ! * Make-lang.in (f77.stage?): Use mv -f instead of just mv so that ! we can move g77.c. ! 1998-07-06 Dave Love ! * intdoc.in (HOSTNM_func, HOSTNM_subr): Note possible need for ! -lsocket. ! 1998-07-05 Dave Love ! * intdoc.in: Add entry for DATE_AND_TIME. ! * intrin.def: Add implementation for DATE_AND_TIME. Make second ! and third args of SYSTEM_CLOCK optional. ! * com.c (ffecom_expr_intrinsic_): New case for DATE_AND_TIME. ! * com-rt.def (FFECOM_gfrtSYSTEM_CLOCK): Call G77_system_clock_0, ! not system_clock_. ! (FFECOM_gfrtDATE_AND_TIME): New DEFGFRT. ! Wed Jul 1 11:19:13 1998 Craig Burley ! Fix 980701-1.f (which was producing "unaligned trap" ! on an Alpha running GNU/Linux, as predicted): ! * equiv.c (ffeequiv_layout_local_): Don't bother ! coping with pre-padding of entire area while building ! it; do that instead after the building is done, and ! do it by modifying only the modulo field. This covers ! the case of alignment stringency being increased without ! lowering the starting offset, unlike the previous changes, ! and even more elegantly than those. ! * target.c (ffetarget_align): Make sure alignments ! are non-zero, just in case. ! See ChangeLog.0 for earlier changes. ! Local Variables: ! add-log-time-format: current-time-string ! End: diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/ChangeLog.0 gcc-2.95/gcc/f/ChangeLog.0 *** egcs-1.1.2/gcc/f/ChangeLog.0 Wed Dec 31 16:00:00 1969 --- gcc-2.95/gcc/f/ChangeLog.0 Tue Mar 2 12:35:06 1999 *************** *** 0 **** --- 1,4806 ---- + Mon Jun 29 09:47:33 1998 Craig Burley + + Fix 980628-*.f: + * bld.h: New `pad' field and accessor macros for + ACCTER, ARRTER, and CONTER ops. + * bld.c (ffebld_new_accter, ffebld_new_arrter, + ffebld_new_conter_with_orig): Initialize `pad' field + to zero. + * com.c (ffecom_transform_common_): Include initial + padding (aka modulo aka offset) in size calculation. + Copy initial padding value into FFE initialization expression + so the GBE transformation of that expression includes it. + Make array low bound 0 instead of 1, for consistency. + (ffecom_transform_equiv_): Include initial + padding (aka modulo aka offset) in size calculation. + Copy initial padding value into FFE initialization expression + so the GBE transformation of that expression includes it. + Make array low bound 0 instead of 1, for consistency. + (ffecom_expr_, case FFEBLD_opACCTER): Delete unused `size' + variable. + Track destination offset separately, allowing for + initial padding. + Don't bother setting initial PURPOSE offset if zero. + Include initial padding in size calculation. + (ffecom_expr_, case FFEBLD_opARRTER): Allow for + initial padding. + Include initial padding in size calculation. + Make array low bound 0 instead of 1, for consistency. + (ffecom_finish_global_): Make array low bound 0 instead + of 1, for consistency. + (ffecom_notify_init_storage): Copy `pad' field from old + ACCTER to new ARRTER. + (ffecom_notify_init_symbol): Ditto. + * data.c (ffedata_gather_): Initialize `pad' field in new + ARRTER to 0. + (ffedata_value_): Ditto. + * equiv.c (ffeequiv_layout_local_): When lowering start + 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 + padding only the first time its seen. + If new padding larger than old, update old. + (ffeglobal_save_common): Use correct type for size throughout. + * global.h: Use correct type for size throughout. + (ffeglobal_common_pad): New macro. + (ffeglobal_pad): Delete this unused and broken macro. + + Sat Jun 27 12:18:33 1998 Jeffrey A Law (law@cygnus.com) + + * Make-lang.in (g77): Depend on mkstemp.o. Link in mkstemp.o. + + Fri Jun 26 11:54:19 1998 Craig Burley + + * g77spec.c (lang_specific_driver): Put `-lg2c' in + front of any `-lm' that is seen. + + Wed Jun 24 01:01:23 1998 Jeffrey A Law (law@cygnus.com) + + * g77spec.c (lang_specific_driver): Revert last change. + + Mon Jun 22 23:12:05 1998 H.J. Lu (hjl@gnu.org) + + * Make-lang.in (G77STAGESTUFF): Add g77.c. + + Fri Jun 19 07:54:40 1998 H.J. Lu (hjl@gnu.org) + + * g77spec.c (lang_specific_driver): Check n_infiles before + appending args. + + Mon Jun 15 23:39:24 1998 Craig Burley + + * Make-lang.in (f/g77.info): Use -f when removing + pre-existing Info files, if any. (This rm command + can go away once makeinfo has been changed to delete + .info-N files beyond the last one it creates.) + + * Make-lang.in ($(srcdir)/f/intdoc.texi): Compile + using $(INCLUDES) macro to get the new hconfig.h + and system.h headers. + + Mon Jun 15 22:21:57 1998 Craig Burley + + Cutover to system.h: + * Make-lang.in: + * Makefile.in: + * ansify.c: + * bad.c: + * bld.c: + * com.c: + * com.h: + * expr.c: + * fini.c: + * g77spec.c: + * implic.c: + * intdoc.c: + * intrin.c: + * lex.c: + * lex.h: + * parse.c: + * proj.c: + * proj.h: + * src.c: + * src.h: + * stb.c: + * ste.c: + * target.c: + * top.c: + * system.j: New file. + + Use toplev.h where appropriate: + * Make-lang.in: + * Makefile.in: + * bad.c: + * bld.c: + * com.c: + * lex.c: + * ste.c: + * top.c: + * toplev.j: New file. + + Conditionalize all dumping/reporting routines so they don't + get built for gcc/egcs: + * bld.c: + * bld.h: + * com.c: + * equiv.c: + * equiv.h: + * sta.c: + * stt.c: + * stt.h: + * symbol.c: + * symbol.h: + + Use hconfig.h instead of config.h where appropriate: + * Makefile.in (proj-h.o): Compile with -DUSE_HCONFIG. + * fini.c: Define USE_HCONFIG before including proj.h. + + * Makefile.in (deps-kinda): Redirect stderr to stdout, + to eliminate diagnostics vis-a-vis g77spec.c. + + * Makefile.in: Regenerate dependencies via deps-kinda. + + * lex.c (ffelex_file_fixed, ffelex_file_free): Eliminate + apparently spurious warnings about uninitialized variables + `c', `column', and so on. + + Sat Jun 13 03:13:18 1998 Craig Burley + + * g77spec.c (lang_specific_driver): Print out egcs + version info first, to be compatible with what some + test facilities expect. + + Wed Jun 10 13:17:32 1998 Dave Brolley + + * top.h (ffe_decode_option): New argc/argv interface. + * top.c (ffe_decode_option): New argc/argv interface. + * parse.c (yyparse): New argc/argv interface for ffe_decode_option. + * com.c (lang_decode_option): New argc/argv interface. + + Sun Jun 7 14:04:34 1998 Richard Henderson + + * com.c (lang_init_options): New function. + * top.c (ffe_decode_option): Remove all trace of -fset-g77-defaults. + Set ffe_is_do_internal_checks_ with -version. + * lang-options.h: Likewise. + * lang-specs.h: Likewise. + + Fri Jun 5 15:53:17 1998 Per Bothner + + * g77spec.c (lang_specific_pre_link, lang_specific_extra_ofiles): + Define - update needed by gcc.c change. + + Mon Jun 1 19:37:42 1998 Craig Burley + + * com.c (ffecom_init_0): Fix setup of INTEGER(KIND=7) + pointer type. + * info.c (ffeinfo_type): Don't crash on null type. + * expr.c (ffeexpr_fulfill_call_): Don't special-case + %LOC(expr) or LOC(expr). + Delete FFEGLOBAL_argsummaryPTR. + * global.c, global.h: Delete FFEGLOBAL_argsummaryPTR. + + Thu May 28 21:32:18 1998 Craig Burley + + Restore circa-0.5.22 capabilities of `g77' driver: + * Make-lang.in (g77spec.o): Depend on f/version.h. + (g77version.o): New rule to compile g77 version info. + (g77$(exeext)): Depend on and link in g77version.o. + * g77spec.c: Rewrite to be more like 0.5.22 version + of g77.c, making filtering of command line smarter + so mixed Fortran and C (etc.) can be compiled, verbose + version info can be obtained, etc. + * lang-specs.h (f77-version): New "language" to support + "g77 -v" command under new gcc 2.8 regime. + * lex.c (ffelex_file_fixed): If -fnull-version, just + substitute a "source file" that prints out version info. + * top.c, top.h: Support -fnull-version. + + * lang-specs.h: Use "%O" instead of OO macro to specify + object extension. Remove old stringizing cruft. + + * Make-lang.in (g77.c, g77spec.o, g77.o, g77$(exeext), + g77-cross$(exeext), f771, + $(srcdir)/f/g77.info, $(srcdir)/f/g77.dvi, + $(srcdir)/f/intdoc.texi, + f77.install-common, f77.install-info, f77.install-man, + f77.uninstall, $(G77STAGESTUFF), f77.stage1, f77.stage2, + f77.stage3, f77.stage4, f77.distdir): Don't do anything + unless user specified "f77" or "F77" in $LANGUAGES either + during configuration or explicitly. For convenience of + various tests and to work around lack of the assignment + "LANGUAGES=$(BOOT_LANGUAGES)" in the "make stage1" command + of "make bootstrap" in gcc, use a touch file named "lang-f77" + to communicate whether this is the case. + + * Make-lang.in (F77_FLAGS_TO_PASS): Delete this macro, + replace with minimal expansion of its former self in + each of the two instances where it was used. + + * Makefile.in (HOST_CC): Delete this definition. + + * com.c (index, rindex): Delete these declarations. + + * proj.h: (isascii): Delete this. + + * Make-lang.in (f77.install-common): Warn if `f77-install-ok' + flag-file exists, since it no longer triggers any activity. + + Rename libf2c.a and f2c.h to libg2c.a and g2c.h, + normalize and simplify g77/libg2c build process: + * Make-lang.in: Remove all support for overwriting + /usr/bin/f77 etc., or whatever the actual names are + via $(prefix) and $(local_prefix). (g++ overwrites + /usr/bin/c++, but then it's often the only C++ compiler + on the system; f77 often exists on systems that are + installing g77.) + (f77.realclean): Remove obsolete target. + (g77.c, g77$(exeext)): Minor changes to look more like g++'s + stuff. + (f771): Now built with srcdir=gcc/f, not srcdir=gcc, to be + more like g++ and such. + (f/Makefile): Removed, as g++ doesn't need this rule. + (f77.install-common): No longer install f77, etc. + (f77.install-man): No longer install f77.1. + (f77.uninstall): No longer uninstall f77, f77.1, etc. + (f77.stage1, f77.stage2, f77.stage3, f77.stage4): Do work + only if "f77" appears in $(LANGUAGES). + (Note: gcc's Makefile.in's bootstrap target should set + LANGUAGES=$(BOOT_LANGUAGES) when making the stage1 target.) + * Makefile.in: Update vis-a-vis gcc/cp/Makefile.in. + (none): Remove. + (g77-only): Relocate. + (all.indirect, f771, *.o): Now assumes current directory + is this dir (gcc/f), not the parent directory. + (TAGS): Remove "echo 'parse.y,0' >> TAGS ;" line. + * config-lang.in: Delete commented-out code. + Fix stagestuff definition. Add more stuff to + diff_excludes definition. Don't create any directories. + Set outputs to f/Makefile, to get variable substition + to happen (what does that really do, anyway?!). + * g77spec.c: Rename libf2c to libg2c. + + * com.h: Remove all of the gcc back-end decls, + since egcs should have all of them correct. + + * com.c: Include "proj.h" before anything else, + as that's how things are supposed to work. + * ste.c: Ditto. + + * bad.c: Include "flags.j" here, since some diagnostics + check flag_pedantic_errors. + + * Makefile.in (f/*.o): Rebuild dependencies via + deps-kinda. + + * output.j: New source file. + * Make-lang.in (F77_SRCS): Update accordingly. + * Makefile.in (OUTPUT_H): Ditto. + (deps-kinda): Ditto. + * com.c: Include "output.j" here. + * lex.c: Ditto. + + Mon May 25 03:34:42 1998 Craig Burley + + * com.c (ffecom_expr_): Fix D**I and Z**I cases to + not convert (DOUBLE PRECISION) D and (DOUBLE COMPLEX) Z + to INTEGER. (This is dead code here anyway.) + + Sat May 23 06:32:52 1998 Craig Burley + + * com.c (ffecom_finish_symbol_transform_): Don't transform + statement (nested) functions, to avoid gcc compiling them + and thus producing linker errors if they refer to undefined + external functions. But warn if they're unused and -Wunused. + * bad.def (FFEBAD_SFUNC_UNUSED): New diagnostic. + + Wed May 20 12:12:55 1998 Craig Burley + + * Version 0.5.23 released. + + Tue May 19 14:52:41 1998 Craig Burley + + * bad.def (FFEBAD_OPEN_UNSUPPORTED, FFEBAD_INQUIRE_UNSUPPORTED, + FFEBAD_READ_UNSUPPORTED, FFEBAD_WRITE_UNSUPPORTED, + FFEBAD_QUAD_UNSUPPORTED, FFEBAD_BLOCKDATA_STMT, + FFEBAD_TRUNCATING_CHARACTER, FFEBAD_TRUNCATING_HOLLERITH, + FFEBAD_TRUNCATING_NUMERIC, FFEBAD_TRUNCATING_TYPELESS, + FFEBAD_TYPELESS_OVERFLOW): Change these from warnings + to errors. + + Tue May 19 14:51:59 1998 Craig Burley + + * Make-lang.in (f77.install-info, f77.uninstall): + Use install-info as appropriate. + + Tue May 19 12:56:54 1998 Craig Burley + + * com.c (ffecom_init_0): Rename xargc to f__xargc, + in accord with same-dated change to f/runtime. + + Fri May 15 10:52:49 1998 Craig Burley + + * com.c (ffecom_convert_narrow_, ffecom_convert_widen_): + Be even more persnickety in checking for internal bugs. + Also, if precision isn't changing, just return the expr. + + * expr.c (ffeexpr_token_number_): Call + ffeexpr_make_float_const_ to make an integer. + (ffeexpr_make_float_const_): Handle making an integer. + + * intrin.c (ffeintrin_init_0): Distinguish between + crashes on bad arg base and kind types. + + Fri May 15 01:44:22 1998 Mumit Khan + + * Make-lang.in (f77.mostlyclean): Add missing exeext. + + Thu May 14 13:30:59 1998 Craig Burley + + * Make-lang.in (f/expr.c): Now depends on f/stamp-str. + * expr.c: Use ffestrOther in place of ffeexprDotdot_. + * str-ot.fin: Add more keywords for expr.c. + + * intdoc.c (dumpimp): Trivial fix. + + * com.c (ffecom_expr_): Add ltkt variable for clarity. + + Wed May 13 13:05:34 1998 Craig Burley + + * Make-lang.in (G77STAGESTUFF): Add g77.o, g77spec.o, + and g77version.o. + (f77.clean): Add removal of g77.c, g77.o, g77spec.o, + and g77version.o. + (f77.distclean): Delete removal of g77.c. + + Thu Apr 30 18:59:43 1998 Jim Wilson + + * Make-lang.in (g77.info, g77.dvi, BUGS, INSTALL, NEWS): Put -o + option before input file. + + Tue Apr 28 09:23:10 1998 Craig Burley + + Fix 980427-0.f: + * global.c (ffeglobal_ref_progunit_): When transitioning + from EXT to FUNC, discard hook, since the decl, if any, is + probably wrong. + + Sun Apr 26 09:05:50 1998 Craig Burley + + * com.c (ffecom_char_enhance_arg_): Wrap the upper bound + (the PARM_DECL specifying the length of the CHARACTER*(*) + dummy arg) in a variable_size invocation, to prevent + dwarf2out.c crashing when compiling code with -g. + + Sat Apr 18 15:26:57 1998 Jim Wilson + + * g77spec.c (lang_specific_driver): New argument in_added_libraries. + New local added_libraries. Increment count when add library to + arglist. + + Sat Apr 18 05:03:21 1998 Craig Burley + + * com.c (ffecom_check_size_overflow_): Ignore overflow + as well if dummy argument. + + Fri Apr 17 17:18:04 1998 Craig Burley + + * version.h: Get rid of the overly large headers + here too, as done in version.c. + + Tue Apr 14 15:51:37 1998 Dave Brolley + + * com.c (init_parse): Now returns char* containing filename; + + Tue Apr 14 14:40:40 1998 Craig Burley + + * com.c (ffecom_start_progunit_): Mark function decl + as used, to avoid spurious warning (-Wunused) for ENTRY. + + Tue Apr 14 14:19:34 1998 Craig Burley + + * sta.c (ffesta_second_): Check for CASE DEFAULT + as well as CASE, or it won't be recognized. + + Thu Apr 9 00:18:44 1998 Dave Brolley (brolley@cygnus.com) + + * com.c (finput): New variable. + (init_parse): Handle !USE_CPPLIB. + (finish_parse): New function. + (lang_init): No longer declare finput. + + Sat Apr 4 17:45:01 1998 Richard Henderson + + * com.c (ffecom_expr_): Revert Oct 22 change. Instead take a WIDENP + argument so that we can respect the signedness of the original type. + (ffecom_init_0): Do sizetype initialization first. + + 1998-03-28 Dave Love + + * Make-lang.in (f771$(exeext)): Fix typo. + + 1998-03-24 Martin von Loewis + + * com.c (lang_print_xnode): New function. + + Mon Mar 23 21:20:35 1998 Craig Burley + + * version.c: Reduce to a one-line file, like + gcc's version.c, since there's really no content + there. + + Mon Mar 23 11:58:43 1998 Craig Burley + + * bugs.texi: Various updates. + + * com.c (ffecom_tree_canonize_ptr_): Fix up spacing a bit. + + Sun Mar 22 00:50:42 1998 Nick Clifton + Geoff Noer + + * Makefile.in: Various fixes for building cygwin32 native toolchains. + * Make-lang.in: Likewise. + + Mon Mar 16 21:20:35 1998 Craig Burley + + * expr.c (ffeexpr_sym_impdoitem_): Don't blindly + reset symbol info after calling ffesymbol_error, + to avoid crash. + + Mon Mar 16 15:38:50 1998 Craig Burley + + * Version 0.5.22 released. + + Mon Mar 16 14:36:02 1998 Craig Burley + + Make -g work better for ENTRY: + * com.c (ffecom_start_progunit_): Master function + for ENTRY-laden procedure is not really invented, + so it can be debugged. + (ffecom_do_entry_): Push/set/pop lineno for each + entry point. + + Sun Mar 15 05:48:49 1998 Craig Burley + + * intrin.def: Fix spelling of mixed-case form + of `CPU_Time' (was `Cpu_Time'). + + Thu Mar 12 13:50:21 1998 Craig Burley + + * lang-options.h: Sort all -f*-intrinsics-* options, + for consistency with other g77 versions. + + Thu Mar 12 09:39:40 1998 Manfred Hollstein + + * lang-specs.h: Properly put brackets around array elements in initializer. + + 1998-03-09 Dave Love + + * Make-lang.in: Set CONFIG_SITE to a non-existent file since + /dev/null loses with bash 2.0/autoconf 2.12. Put + F77_FLAGS_TO_PASS before CC. + + Sun Mar 8 16:35:34 1998 Craig Burley + + * intrin.def: Use tabs instead of blanks more + consistently (excepting DEFGEN section for now). + + Wed Mar 4 17:38:21 1998 Jeffrey A Law (law@cygnus.com) + + * Make-lang.in: Remove more references to libf77. + + Tue Mar 3 10:52:35 1998 Manfred Hollstein + + * g77.texi: Use @url for citing URLs. + + Sat Feb 28 15:24:38 1998 Craig Burley + + * intrin.def: Make CPU_TIME's arg generic real to be just + like SECOND_subr. + + Fri Feb 20 12:45:53 1998 Craig Burley + + * expr.c (ffeexpr_token_arguments_): Make sure + outer exprstack isn't null. + + 1998-02-16 Dave Love + + * Makefile.in (f/fini): Don't use -W -Wall with HOST_CC. + + Fri Feb 13 00:14:56 1998 Kaveh R. Ghazi + + * com.c (type_for_mode): Add explicit braces to avoid ambiguous `else'. + + * expr.c (ffeexpr_type_combine): Likewise. + (ffeexpr_reduce_): Likewise. + (ffeexpr_declare_parenthesized_): Likewise. + + * src.c (ffesrc_strcmp_1ns2i): Likewise. + (ffesrc_strcmp_2c): Likewise. + (ffesrc_strncmp_2c): Likewise. + + * stb.c (ffestb_halt1_): Likewise. + (ffestb_R90910_): Likewise. + (ffestb_R9109_): Likewise. + + * stc.c (ffestc_R544_equiv_): Likewise. + + * std.c (ffestd_subr_copy_easy_): Likewise. + (ffestd_R1001dump_): Likewise. + (ffestd_R1001dump_1005_1_): Likewise. + (ffestd_R1001dump_1005_2_): Likewise. + (ffestd_R1001dump_1005_3_): Likewise. + (ffestd_R1001dump_1005_4_): Likewise. + (ffestd_R1001dump_1005_5_): Likewise. + (ffestd_R1001dump_1010_2_): Likewise. + + * ste.c (ffeste_R840): Likewise. + + * sts.c (ffests_puttext): Likewise. + + * symbol.c (ffesymbol_check_token_): Likewise. + + * target.c (ffetarget_real1): Likewise. + (ffetarget_real2): Likewise. + + Wed Feb 11 01:44:48 1998 Richard Henderson (rth@cygnus.com) + + * com.c (ffecom_ptr_to_expr) [FFEBLD_opARRAYREF]: Do upper - lower + in the native type, so as to properly handle negative indices. + + Tue Feb 3 20:13:05 1998 Richard Henderson + + * config-lang.in: Remove references to runtime/. + + Sun Feb 1 12:43:49 1998 J"orn Rennecke + + * com.c (ffecom_tree_canonize_ptr_): Place bitsizetype typed expr + as first agument in MULT_EXPR. + Use bitsize_int (0L, 0L) as zero for bitsizes. + (ffecom_tree_canonize_ref_): + Use bitsize_int (0L, 0L) as zero for bitsizes. + (ffecom_init_0): Use set_sizetype. + + Sun Feb 1 02:26:58 1998 Richard Henderson + + * runtime directory -- moved into "libf2c" in the toplevel + directory. + * Make-lang.in: Remove all runtime related stuff. + + Sun Jan 25 12:32:15 1998 Kaveh R. Ghazi + + * Make-lang.in (f77.stage1): Depend on stage1-start so parallel + make works better. + * (f77.stage2): Likewise for stage2-start. + * (f77.stage3): Likewise for stage3-start. + * (f77.stage4): Likewise for stage4-start. + + Sat Jan 17 21:28:08 1998 Pieter Nagel + + * Makefile.in (FLAGS_TO_PASS): Pass down gcc_include_dir and + local_prefix to sub-make invocations. + + Tue Jan 13 22:07:54 1998 Jeffrey A Law (law@cygnus.com) + + * lang-options.h: Add missing options. + + Sun Jan 11 02:14:47 1998 Craig Burley + + Support FORMAT(I<1+2>) (constant variable-FORMAT + expressions): + * bad.def (FFEBAD_FORMAT_VARIABLE): New diagnostic. + * std.c (ffestd_R1001rtexpr_): New function. + (ffestd_R1001dump_, ffestd_R1001dump_1005_1_, + ffestd_R1001dump_1005_2_, ffestd_R1001dump_1005_3_, + ffestd_R1001dump_1005_4_, ffestd_R1001dump_1005_5_, + ffestd_R1001dump_1010_2_, ffestd_R1001dump_1010_3_, + ffestd_R1001dump_1010_4_, ffestd_R1001dump_1010_5_): + Use new function instead of ffestd_R1001error_. + + * stb.c (ffestb_R10014_, ffestb_R10016_, ffestb_R10018_, + ffestb_R100110_): Restructure `for' loop for style. + + Fix 970626-2.f by not doing most back-end processing + when current_function_decl is an ERROR_MARK, and by + making that the case when its type would be an ERROR_MARK: + * com.c (ffecom_start_progunit_, finish_function, + lang_printable_name, start_function, + ffecom_finish_symbol_transform_): Test for ERROR_MARK. + * std.c (ffestd_stmt_pass_): Don't do any downstream + processing if ERROR_MARK. + + * Make-lang.in (f77.install-common): Don't install, and + don't uninstall existing, Info files if f/g77.info + doesn't exit. (This is a somewhat modified version + of an egcs patch on 1998-01-07 12:05:51 by Bruno Haible + .) + + Fri Jan 9 19:09:07 1998 Craig Burley + + Fix -fpedantic combined with `F()' invocation, + also -fugly-comma combined with `IARGC()' invocation: + * bad.def (FFEBAD_NULL_ARGUMENT_W): New diagnostic. + * expr.c (ffeexpr_finished_): Don't reject null expressions + in the argument-expression context -- let outer context + handle that. + (ffeexpr_token_arguments_): Warn about null expressions + here if -fpedantic (as appropriate). + Obey -fugly-comma for only external-procedure invocations. + * intrin.c (ffeintrin_check_): No longer ignore explicit + omitted trailing args. + + Tue Dec 23 14:58:04 1997 Craig Burley + + * intrin.c (ffeintrin_fulfill_generic): Don't generate + FFEBAD_INTRINSIC_TYPE for CHARACTER*(*) intrinsic. + + * com.c (ffecom_gfrt_basictype): + (ffecom_gfrt_kindtype): + (ffecom_make_gfrt_): + (FFECOM_rttypeVOIDSTAR_): New return type `void *', for + the SIGNAL intrinsic. + * com-rt.def (FFECOM_rttypeSIGNAL): Now returns `void *'. + * intdoc.c: Replace `p' kind specifier with `7'. + * intrin.c (ffeintrin_check_, ffeintrin_init_0): Replace + `p' kind specifier with `7'. + * intrin.def (FFEINTRIN_impLOC, FFEINTRIN_impSIGNAL_func, + FFEINTRIN_impSIGNAL_subr): Replace `p' specifier with `7'. + Also, SIGNAL now returns a `void *' status, not `int'. + + Improve run-time diagnostic for "PRINT '(I1', 42": + * com.c (ffecom_char_args_x_): Renamed from ffecom_char_args_, + which is now a macro (to avoid lots of changes to other code) + with new arg, ffecom_char_args_with_null_ being another new + macro to call same function with different value for new arg. + This function now appends a null byte to opCONTER expression + if the new arg is TRUE. + (ffecom_arg_ptr_to_expr): Support NULL length pointer. + * ste.c (ffeste_io_cilist_): + (ffeste_io_icilist_): Pass NULL length ptr for + FORMAT expression, so null byte gets appended where + feasible. + * target.c (ffetarget_character1): + (ffetarget_concatenate_character1): + (ffetarget_substr_character1): + (ffetarget_convert_character1_character1): + (ffetarget_convert_character1_hollerith): + (ffetarget_convert_character1_integer4): + (ffetarget_convert_character1_logical4): + (ffetarget_convert_character1_typeless): + (ffetarget_hollerith): Append extra phantom null byte as + part of FFETARGET-NULL-BYTE kludge. + + * intrin.def (FFEINTRIN_impCPU_TIME): Point to + FFECOM_gfrtSECOND as primary run-time routine. + + Mon Dec 22 12:41:07 1997 Craig Burley + + * intrin.c (ffeintrin_init_0): Remove duplicate + check for `!'. + + Fri Dec 19 00:12:01 1997 Richard Henderson + + * com.c (ffecom_sym_transform_): Assumed arrays have no upper bound. + + Mon Dec 15 17:35:35 1997 Richard Henderson + + * com.c (ffecom_type_vardesc_): Vardesc.dims is a `ftnlen*'. + + Sun Dec 14 02:49:58 1997 Craig Burley + + * intrin.c (ffeintrin_init_0): Fix up indentation a bit. + Fix bug that prevented checking of arguments other + than the first. + + * intdoc.c: Fix up indentation a bit. + + Tue Dec 9 16:20:57 1997 Richard Henderson + + * com.c (ffecom_type_vardesc_): Vardesc.dims is a `ftnlen*'. + + Tue Dec 2 09:57:16 1997 Jeffrey A Law (law@cygnus.com) + + * Make-lang.in (f77.clean): Remove g77.c. + + Mon Dec 1 19:12:36 1997 Craig Burley + + * intrin.c (ffeintrin_check_): Fix up indentation a bit more. + + Mon Dec 1 16:21:08 1997 Craig Burley + + * com.c (ffecom_arglist_expr_): Crash if non-supplied + optional arg isn't passed as an address. + Pass null pointer explicitly, instead of via ffecom routine. + If incoming argstring is NULL, substitute pointer to "0". + Recognize '0' as ending the usual arg stuff, just like '\0'. + + Sun Nov 30 22:22:22 1997 Craig Burley + + * intdoc.c: Minor fix-ups. + + * intrin.c (ffeintrin_check_): Fix up indentation a bit. + + * intrin.def: Fix up spacing a bit. + + Tue Nov 25 15:33:28 1997 Jeffrey A Law (law@cygnus.com) + + * Make-lang.in (f77.all.build): Add $(exeext) to binary files. + (f77.all.cross, f77.start.encap): Simliarly. + + Fri Nov 21 09:35:20 1997 Fred Fish + + * Make-lang.in (stmp-f2c.h): Move inclusion of F77_FLAGS_TO_PASS + to before override of CC so that the override works. + + Thu Nov 20 00:58:14 1997 H.J. Lu (hjl@gnu.ai.mit.edu) + + * Make-lang.in (f77.install-info): Depend on f77.info. + + 1997-11-17 Dave Love + + * com.c (ffecom_arglist_expr_): Pass null pointers for optional + args which aren't supplied. + + Sun Nov 16 21:45:43 1997 H.J. Lu (hjl@gnu.ai.mit.edu) + + * Make-lang.in (f77.install-info): Depend on f77.info. + + 1997-11-14 Dave Love + + * intrin.def: Supply gfrt for CPU_TIME. Generalize arg types of + INT2, INT8, per doc. + + 1997-11-06 Dave Love + + * intrin.def: Allow non-integer args for INT2 and INT8 (per + documentation). + + Sun Nov 2 19:49:51 1997 Richard Henderson + + * com.c (ffecom_expr_): Only use TREE_TYPE argument for simple + arithmetic; convert types as necessary; recurse with target tree type. + + Tue Oct 28 02:21:25 1997 Craig Burley + + * lang-options.h: Add -fgnu-intrinsics-* and + -fbadu77-intrinsics-* options. + + Sun Oct 26 02:36:21 1997 Craig Burley + + * com.c (lang_print_error_function): Fix to more + reliably notice when the diagnosed region changes. + + Sat Oct 25 23:43:36 1997 Craig Burley + + Fix 950327-0.f: + * sta.c, sta.h (ffesta_outpooldisp): New function. + * std.c (ffestd_stmt_pass_): Don't kill NULL pool. + (ffestd_R842): If pool already preserved, save NULL + for pool, because it should be killed only once. + + * malloc.c [MALLOC_DEBUG]: Put initializer for `name' + component in braces, to avoid compiler warning. + + Wed Oct 22 11:37:41 1997 Richard Henderson + + * com.c (ffecom_expr_): Take an new arg TREE_TYPE that if non-null + specifies the type in which to do the calculation. Change all callers. + [FFEBLD_opARRAYREF]: Force the index expr to use sizetype. + + Thu Oct 16 02:04:08 1997 Paul Koning + + * Make-lang.in (stmp-f2c.h): Don't configure the runtime + directory if LANGUAGES does not include f77. + + Mon Oct 13 12:12:41 1997 Richard Henderson + + * Make-lang.in (g77*): Copied from cp/Make-lang.in g++*. + * g77spec.c: New file, mostly copied from g++spec.c + * g77.c: Removed. + + Fri Oct 10 13:00:48 1997 Craig Burley + + * ste.c (ffeste_begin_iterdo_): Fix loop setup so iteration + variable is modified only after the #iterations is calculated; + otherwise if the iteration variable is aliased to any of the + operands in the start, end, or increment expressions, the + wrong #iterations might be calculated. + + * com.c (ffecom_save_tree): Fix indentation. + + Mon Oct 6 14:15:03 1997 Jeffrey A Law (law@cygnus.com) + + * Make-lang.in (f77.mostlyclean): Clean up stuff in the + object tree too. + (f77.clean, f77.distclean, f77.maintainer-clean): Likewise. + + 1997-10-05 Dave Love + + * intrin.def: Make SECOND_subr's arg generic real for people + porting from Cray and making everything double precision. + + Wed Oct 1 01:45:36 1997 Philippe De Muyter + + * g77.c (pexecute, main): Use unlink, not remove. + + Mon Sep 29 16:18:21 1997 Craig Burley + + * stu.c (ffestu_list_exec_transition_, + ffestu_dummies_transition_): Specify `bool' type for + `in_progress' variables. + + * com.h (assemble_string): Declare this routine (instead + of #include'ing "output.h" from gcc) to eliminate warnings + from lex.c. + + Mon Sep 29 10:37:07 1997 Jeffrey A Law (law@cygnus.com) + + * intdoc.c (main): Remove unused attribute for main's arguments. + + Sun Sep 28 01:47:17 1997 Jeffrey A Law (law@cygnus.com) + + * Make-lang.in (G77_FLAGS_TO_PASS): Pass down RANLIB, RANLIB_TEST + and AR instead of the _FOR_TARGET versions. + + Tue Sep 23 00:39:57 1997 Alexandre Oliva + + * Make-lang.in: install.texi was renamed to g77install.texi + * install0.texi: Likewise. + + Fri Sep 19 01:12:27 1997 Craig Burley + + * expr.c (ffeexpr_reduced_eqop2_): + (ffeexpr_reduced_relop2_): Minor fixes to diagnostic code. + + * fini.c (main): Change return type to `int'. + + Thu Sep 18 17:31:38 1997 Jeffrey A Law (law@cygnus.com) + + * proj.h (FFEPROJ_BSEARCH): Delete all references. + (FFEPROJ_STRTOUL): Likewise. + * proj.c (bsearch): Compile this if no bsearch is provided by the + host system. + (strtoul): Similarly. + + * g77install.texi: Renamed from install.texi + * g77.texi: Corresponding changes. + + * fini.c (main): Return type is int. + + * com.c (lang_printable_name): Use verbosity argument. + + Thu Sep 18 16:08:40 1997 Jeffrey A Law (law@cygnus.com) + + * Make-lang.in: Fix merge problems. + + Wed Sep 17 10:47:08 1997 Craig Burley + + * com-rt.def (FFECOM_gfrtDSIGN, FFECOM_gfrtISIGN, + FFECOM_gfrtSIGN): Add second argument. + + * expr.c (ffeexpr_cb_comma_c_): Trivial fixes. + + Sun Sep 14 21:01:23 1997 Jeffrey A Law (law@cygnus.com) + + * Make-lang.in: Various changes to build info files + in the object tree rather than the source tree. + + * proj.h: Include ctype.h. + + Sun Sep 14 12:35:20 1997 Fred Fish (fnf@ninemoons.com) + + * proj.h (isascii): Provide a default definition if none is available. + + Thu Sep 11 19:26:10 1997 Dave Love + + * config-lang.in: Remove the messages about possible build problems. + + Wed Sep 10 16:39:47 1997 Jim Wilson + + * Make-lang.in (LN, LN_S): New macros, use where appropriate. + + Tue Sep 9 13:20:40 1997 Jim Wilson + + * g77.c (pexecute, doit): Add checks for __CYGWIN32__. + + Tue Sep 9 01:59:35 1997 Craig Burley + + * Version 0.5.21 released. + + Tue Sep 9 00:31:01 1997 Craig Burley + + * intdoc.c (dumpem): Put appropriate commentary in + output file, so readers know it isn't source. + + Wed Aug 27 20:32:03 1997 Jeffrey A Law (law@cygnus.com) + + * top.c (ffe_decode_option): Turn on flag_move_all_moveables + and flag_reduce_all_givs. + + Wed Aug 27 08:08:25 1997 Craig Burley + + * proj.h: Always #include "config.j" first, to pick up + gcc's configuration. + * com.c: Change bcopy() and bzero() calls to memcpy() + and memset() calls, to make more of g77 ANSI C. + + 1997-08-26 Dave Love + + * Make-lang.in ($(srcdir)/f/runtime/configure, + $(srcdir)/f/runtime/libU77/configure): Fix for when srcdir isn't + relative. + + Tue Aug 26 05:59:21 1997 Craig Burley + + * ansify.c (main): Make sure readers of stdout know + it's derived from stdin; omit comment text; get source + line numbers in future stderr output to be correct. + + Tue Aug 26 01:36:01 1997 Craig Burley + + Fix 970825-0.f: + * stb.c (ffestb_R5284_): Allow OPEN_PAREN after closing + SLASH as well as NAME. + + Mon Aug 25 23:48:17 1997 Craig Burley + + Changes to allow g77 docs to be built entirely from scratch + using any ANSI C compiler, not requiring GNU C: + * Make-lang.in ($(srcdir)/f/intdoc.texi): "Pipe" new + location of intrinsic documentation data base, f/intdoc.in, + through new `ansify' program to append `\n\' to quoted + newlines, into f/intdoc.h0. Do appropriate cleanups. Explain. + (f77.mostlyclean): Add f/ansify and f/intdoc.h0 to cleanups. + * f/ansify.c: New program. + * f/intdoc.c: Fix so it conforms to ANSI C. + #include f/intdoc.h0 instead of f/intdoc.h. + Avoid some warnings. + * f/intdoc.h, f/intdoc.in: Rename the former to the latter; no + changes made to the content in this patch! + * f/intrin.h (ffeintrinFamily): Fix to conform to ANSI C. + + Mon Aug 25 23:24:32 1997 H.J. Lu (hjl@gnu.ai.mit.edu) + + * Make-lang.in ($(srcdir)/f/runtime/configure, + $(srcdir)/f/runtime/libU77/configure, f77.mostlyclean, + f77.clean, f77.distclean, f77.maintainer-clean, f77.realclean): + Handle absolute pathname of $(srcdir). + (stmp-f2c.h): New. + (include/f2c.h, f/runtime/Makefile, f/runtime/libF77/Makefile, + f/runtime/libI77/Makefile, f/runtime/libU77/Makefile): Only + depend on stmp-f2c.h. + (f77.maintainer-clean): Don't make itself. + + Sun Aug 24 17:00:27 1997 Jim Wilson + + * Make-lang.in (f77.install-info): Don't cd into srcdir. Add srcdir + to filenames. Use sed to extract base filename for install. + + Sun Aug 24 06:52:48 1997 Craig Burley + + Fix up g77 compiler data base for libf2c routines: + * com-rt.def (FFECOM_gfrtSIGNAL): Change return type to + FTNINT to match actual code. + + * com.c (ffecomRttype_): Replace FFECOM_rttypeINT_ with + FFECOM_rttypeFTNINT_. + Add and fix up comments. + (ffecom_make_gfrt_, ffecom_gfrt_basictype, + ffecom_gfrt_kindtype): Replace FFECOM_rttypeINT_ with + FFECOM_rttypeFTNINT_; add FFECOM_rttypeDOUBLEREAL_. + + Thu Aug 21 13:15:29 1997 Jim Wilson + + * Make-lang.in (f77): Delete f77-runtime. + (f77.all.build, f77.all.cross, f77.rest.encap): Add f77-runtime. + + Wed Aug 20 17:18:40 1997 Craig Burley + + * global.c (ffeglobal_ref_progunit_): It's okay to have + a different CHARACTER*n length for a reference if the + existing length is for another reference, not a definition. + + Wed Aug 20 16:36:59 1997 Jim Wilson + + * intdoc.texi: Readd generated file. + + Mon Aug 18 14:27:18 1997 Craig Burley + + Fix 970814-0.f: + * global.c (ffeglobal_new_progunit_): Distinguish + between previously defined, versus inferred, filewide + when it comes to diagnostics. + + Fix 970816-1.f: + * global.c (ffeglobal_ref_progunit_): Change BDATA into EXT + right at the beginning, so EXTERNAL FOO followed later + by SUBROUTINE FOO is not diagnosed. + + Fix 970813-0.f: + * com-rt.def (FFECOM_gfrtALARM): Returns `integer', not + `void'. + + Mon Aug 18 09:01:54 1997 Jeffrey A Law (law@cygnus.com) + + * Makefile.in (F77_OBJS): Re-alphabetize. + * Make-lang.in (F77_SRCS): Likewise. + + Sun Aug 17 08:35:11 1997 Jeffrey A Law (law@cygnus.com) + + * INSTALL: Rebuilt. + * install.texi: Remove "Object File Differences" section. Remove + all references to zzz.o failing comparison tests. + * version.c, version.h: Renamed from zzz.c and zzz.h. Remove + date and time stamps so a 3 stage build reports no differences. + * Make-lang.in: Corresponding changes. + * Makefile.in: Likewise. + * g77.c, parse.c: Likewise. + + * intdoc.texi: Remove generated file from distribution. + + Sun Aug 17 03:32:44 1997 Craig Burley + + Fix up problems when virtual memory exhausted: + * malloc.c (malloc_new_): Use gcc's xmalloc(), so we + print a nicer message when malloc returns no memory. + (malloc_resize_): Ditto for xrealloc(). + + * Make-lang.in, Makefile.in: Comment out lines containing + just formfeeds. + + Sat Aug 16 19:41:33 1997 Craig Burley + + * com.c (ffecom_make_gfrt_): For rttypeREAL_F2C_, return + double_type_node; for rttypeREAL_GNU_, return + _real_type_node. + + 1997-08-13 Dave Love + + * config-lang.in (diff_excludes): Add some hints about known + problematic platforms. + + 1997-08-13 Dave Love + + * intdoc.h: Document `alarm'. + + Tue Aug 12 10:23:02 1997 Jeffrey A Law (law@cygnus.com) + + * config-lang.in: Don't demand the backend patch. + * com.c (lang_printable_name): Second argument is now an int. Don't + store into the value of the second argument. + * top.c (ffe_decode_option): Temporarily disable setting + of "Toon" loop options until we figure out how to address + them. + + Mon Aug 11 23:18:35 1997 Jeffrey A Law (law@cygnus.com) + + * g77-0.5.21-19970811 Imported. + This file describes changes to the front end necessary to make + it work with egcs. + + Mon Aug 11 21:19:22 1997 Craig Burley + + * Make-lang.in ($(RUNTIMESTAGESTUFF)): Add + f/runtime/stamp-lib. + + Mon Aug 11 01:52:03 1997 Craig Burley + + * com.c (ffecom_build_complex_constant_): Go with the + new build_complex() approach used in gcc-2.8. + + * com.c (ffecom_sym_transform_): Don't set + DECL_IN_SYSTEM_HEADER for a tree node that isn't + a VAR_DECL, which happens when var is in common! + + * com.c (ffecom_expr_intrinsic_) (case FFEINTRIN_impALARM): + No need to test codegen_imp -- there's only one valid here. + + * intrin.def (FFEINTRIN_impALARM): Specify `Status' argument + as write-only. + + Fri Aug 8 05:40:23 1997 Craig Burley + + Substantial changes to accommodate distinctions among + run-time routines that support intrinsics, and between + routines that compute and return the same type vs. those + that compute one type and return another (or `void'): + * com-rt.def: Specify new return type REAL_F2C_ instead + of many DOUBLE_, COMPLEX_F2C_ instead of COMPLEX_, and + so on. + Clear up the *BES* routines "once and for all". + * com.c: New return types. + (ffecom_convert_narrow_, ffecom_convert_widen_): + New functions that are "safe" variants of convert(), + to catch errors that ffecom_expr_intrinsic_() now + no longer catches. + (ffecom_arglist_expr_): Ensure arguments are not + converted to narrower types. + (ffecom_call_): Ensure return value is not converted + to a wider type. + (ffecom_char_args_): Use new ffeintrin_gfrt_direct() + routine. + (ffecom_expr_intrinsic_): Simplify how run-time + routine is selected (via `gfrt' only now; lose the + redundant `ix' variable). + Eliminate the `library' label; any code that doesn't + return directly just `break's out now with `gfrt' + set appropriately. + Set `gfrt' to default choice initially, either a + fast direct form or, if not available, a slower + indirect-callable form. + (ffecom_make_gfrt_): No longer need to do special + check for complex; it's built into the new return-type + regime. + (ffecom_ptr_to_expr): Use new ffeintrin_gfrt_indirect() + routine. + * intrin.c, intrin.h: `gfrt' field replaced with three fields, + so it is easier to provide faster direct-callable and + GNU-convention indirect-callable routines in the future. + DEFIMP macro adjusted accordingly, along with all its uses. + (ffeintrin_gfrt_direct): New function. + (ffeintrin_gfrt_indirect): Ditto. + (ffeintrin_is_actualarg): If `-fno-f2c' is in effect, + require a GNU-callable version of intrinsic instead of + an f2c-callable version, so indirect calling is still checked. + * intrin.def: Replace one GFRT field with the three new fields, + as appropriate for each DEFIMP intrinsic. + + * com.c (ffecom_stabilize_aggregate_, + ffecom_convert_to_complex_): Make these `static'. + + Thu Aug 7 11:24:34 1997 Craig Burley + + Provide means for front end to determine actual + "standard" return type for an intrinsic if it is + passed as an actual argument: + * com.h, com.c (ffecom_gfrt_basictype, + ffecom_gfrt_kindtype): New functions. + (ffecom_gfrt_kind_type_): Replaced with new function. + All callers updated. + (ffecom_make_gfrt_): No longer need do anything + with kind type. + + * intrin.c (ffeintrin_basictype, ffeintrin_kindtype): + Now returns correct type info for specific intrinsic + (based on type of run-time-library implementation). + + Wed Aug 6 23:08:46 1997 Craig Burley + + * global.c (ffeglobal_ref_progunit_): Don't reset + number of arguments just due to new type info, + so useful warnings can be issued. + + 1997-08-06 Dave Love + + * intrin.def: Fix IDATE_vxt argument order. + * intdoc.h: Likewise. + + Thu Jul 31 22:22:03 1997 Craig Burley + + * global.c (ffeglobal_proc_ref_arg): If REF/DESCR + disagreement, DESCR is CHARACTER, and types disagree, + pretend the argsummary agrees so the message ends up + being about type disagreement. + (ffeglobal_proc_def_arg): Ditto. + + * expr.c (ffeexpr_token_first_rhs_3_): Set info for LABTOK + to NONE of everything, to avoid misdiagnosing filewide + usage of alternate returns. + + Sun Jul 20 23:07:47 1997 Craig Burley + + * com.c (ffecom_sym_transform_): If type gets set + to error_mark_node, just return that for transformed symbol. + (ffecom_member_phase2_): If type gets set to error_mark_node, + just return. + (ffecom_check_size_overflow_): Add `dummy' argument to + flag that type is for a dummy, update all callers. + + Sun Jul 13 17:40:53 1997 Craig Burley + + Fix 970712-1.f: + * where.c (ffewhere_set_from_track): If start point + is too large, just use initial start point. 0.6 should + fix all this properly. + + Fix 970712-2.f: + * com.c (ffecom_sym_transform_): Preserve error_mark_node for type. + (ffecom_type_localvar_): Ditto. + (ffecom_sym_transform_): If type is error_mark_node, + don't error-check decl size, because back end responds by + setting that to an integer 0 instead of error_mark_node. + (ffecom_transform_common_): Same as earlier fix to _transform_ + in that size is checked by dividing BITS_PER_UNIT instead of + multiplying. + (ffecom_transform_equiv_): Ditto. + + Fix 970712-3.f: + * stb.c (ffestb_R10014_): Fix flaky fall-through in error + test for FFELEX_typeCONCAT by just replicating the code, + and do FFELEX_typeCOLONCOLON while at it. + + 1997-07-07 Dave Love + + * intdoc.h: Add various missing pieces; correct GMTIME, LTIME + result ordering. + + * intrin.def, com-rt.def: Add alarm. + + * com.c (ffecom_expr_intrinsic_): Add case for alarm. + + Thu Jun 26 04:19:40 1997 Craig Burley + + Fix 970302-3.f: + * com.c (ffecom_sym_transform_): For sanity-check compare + of gbe size of local variable to g77 expectation, + use varasm.c/assemble_variable technique of dividing + BITS_PER_UNIT out of gbe info instead of multiplying + g77 info up, to avoid crash when size in bytes is very + large, and overflows an `int' or similar when multiplied. + + Fix 970626-2.f: + * com.c (ffecom_finish_symbol_transform_): Don't bother + transforming a dummy argument, to avoid a crash. + * ste.c (ffeste_R1227): Don't return a value if the + result decl, or its type, is error_mark_node. + + Fix 970626-4.f: + * lex.c (ffelex_splice_tokens): `-fdollar-ok' is + irrelevant to whether a DOLLAR token should be made + from an initial character of `$'. + + Fix 970626-6.f: + * stb.c (ffestb_do3_): DO iteration variable is an + lhs, not rhs, expression. + + Fix 970626-7.f and 970626-8.f: + * expr.c (ffeexpr_cb_comma_i_1_): Set IMPDO expression + to have clean info, because undefined rank, for example, + caused crash on mangled source on UltraSPARC but not + on Alpha for a series of weird reasons. + (ffeexpr_cb_close_paren_): If not CLOSE_PAREN, push + opANY expression onto stack instead of attempting + to mimic what program might have wanted. + (ffeexpr_cb_close_paren_): Don't wrap opPAREN around + opIMPDO, just warn that it's gratuitous. + * bad.def (FFEBAD_IMPDO_PAREN): New warning. + + Fix 970626-9.f: + * expr.c (ffeexpr_declare_parenthesized_): Must shut down + parsing in kindANY case, otherwise the parsing engine might + decide there's an ambiguity. + (ffeexpr_token_name_rhs_): Eliminate parentypeSUBROUTINE_ + case, so we crash right away if it comes through. + * st.c, st.h, sta.c, sta.h (ffest_shutdown, ffesta_shutdown): + New functions. + + Tue Jun 24 19:47:29 1997 Craig Burley + + * com.c (ffecom_check_size_overflow_): New function + catches some cases of the size of a type getting + too large. varasm.c must catch the rest. + (ffecom_sym_transform_): Use new function. + (ffecom_type_localvar_): Ditto. + + Mon Jun 23 01:09:28 1997 Craig Burley + + * global.c (ffeglobal_proc_def_arg): Fix comparison + of argno to #args. + (ffeglobal_proc_ref_arg): Ditto. + + * lang-options.h, top.c: Rename `-fdebug' to `-fxyzzy', + since it's an unsupported internals option and some + poor user might guess that it does something. + + * bad.def: Make a warning for each filewide diagnostic. + Put all filewides together. + * com.c (ffecom_sym_transform_): Don't substitute + known global tree for global entities when `-fno-globals'. + * global.c (ffeglobal_new_progunit_): Don't produce + fatal diagnostics about globals when `-fno-globals'. + Instead, produce equivalent warning when `-Wglobals'. + (ffeglobal_proc_ref_arg): Ditto. + (ffeglobal_proc_ref_nargs): Ditto. + (ffeglobal_ref_progunit_): Ditto. + * lang-options.h, top.c, top.h: New `-fno-globals' option. + + Sat Jun 21 12:32:54 1997 Craig Burley + + * expr.c (ffeexpr_fulfill_call_): Set array variable + to avoid warning about uninitialized variable. + + * Make-lang.in: Get rid of any setting of HOST_* macros, + since these will break gcc's build! + * makefile: New file to make building derived files + easier. + + Thu Jun 19 18:19:28 1997 Craig Burley + + * g77.c (main): Install Emilio Lopes' patch to support + Ratfor, and to fix the printing of the version string + to go to stderr, not stdout. + * lang-specs.h: Install Emilio Lopes' patch to support + Ratfor, and patch the result to support picking up + `*f771' from the `specs' file. + + Thu Jun 12 14:36:25 1997 Craig Burley + + * storag.c (ffestorag_update_init, ffestorag_update_save): + Also update parent, in case equivalence processing + has already eliminated pointers to it via the + local equivalence info. + + Tue Jun 10 14:08:26 1997 Craig Burley + + * intdoc.c: Add cross-reference to end of description + of any generic intrinsic pointing to other intrinsics + with the same name. + + Warn about explicit type declaration for intrinsic + that disagrees with invocation: + * expr.c (ffeexpr_paren_rhs_let_): Preserve type info + for intrinsic functions. + (ffeexpr_token_funsubstr_): Ditto. + * intrin.c (ffeintrin_fulfill_generic): Warn if type + info of fulfilled intrinsic invocation disagrees with + explicit type info given symbol. + (ffeintrin_fulfill_specific): Ditto. + * stc.c (ffestc_R1208_item): Preserve type info + for intrinsics. + (ffestc_R501_item): Ditto. + + Mon Jun 9 17:45:44 1997 Craig Burley + + * com.c (ffecom_expr_intrinsic_): Fix several of the + libU77/libF77-unix handlers to properly convert their + arguments. + + * com-rt.def (FFECOM_gfrtFSTAT): Append missing "i" to + arg string. + + Fri Jun 6 14:37:30 1997 Craig Burley + + * com.c (ffecom_expr_intrinsic_): Have a case statement + for every intrinsic implementation, so missing ones + are caught via gcc warnings. + Don't call ffeintrin_codegen_imp anymore. + * intrin.c (ffeintrin_fulfill_generic): Remove cg_imp + stuff from here. + (ffeintrin_codegen_imp): Delete this function. + * intrin.def, intrin.h: Remove DEFIMQ stuff from here + as well. + + Thu Jun 5 13:03:07 1997 Craig Burley + + * top.c (ffe_decode_option): New -fbadu77-intrinsics-* + options. + * top.h: Ditto. + * intrin.h: New BADU77 family. + * intrin.c (ffeintrin_state_family): Ditto. + + Implement new scheme to track intrinsic names vs. forms: + * intrin.c (ffeintrin_fulfill_generic), + (ffeintrin_fulfill_specific), (ffeintrin_is_intrinsic), + intrin.def: The documented name is now either in the + generic info or, if no generic, in the specific info. + For a generic, the specific info contains merely the + distinguishing form (usually "function" or "subroutine"), + used for diagnostics about ambiguous references and + in the documentation. + + * intrin.def: Clean up formatting of DEFNAME block. + Convert many libU77 intrinsics into generics that + support both subroutine and function forms. + Put the function forms of side-effect routines into + the new BADU77 family. + Make MCLOCK and TIME return INTEGER*4 again, and add + INTEGER*8 equivalents called MCLOCK8 and TIME8. + Fix up more status return values to be written and + insist on them being I1 as well. + * com.c (ffecom_expr_intrinsic_): Lots of changes to + support new libU77 intrinsic interfaces. + + Mon Jun 2 00:37:53 1997 Craig Burley + + * com.c (ffecom_init_0): Pointer type is now INTEGER(KIND=7), + not INTEGER(KIND=0), since we want to reserve KIND=0 for + future use. + + Thu May 29 14:30:33 1997 Craig Burley + + Fix bugs preventing CTIME(I*4) from working correctly: + * com.c (ffecom_char_args_): For FUNCREF case, process + args to intrinsic just as they would be in + ffecom_expr_intrinsic_. + * com-rt.def (FFECOM_gfrtCTIME, FFECOM_gfrtTTYNAM): Fix + argument decls to specify `&'. + + Wed May 28 22:19:49 1997 Craig Burley + + Fix gratuitous warnings exposed by dophot aka 970528-1: + * global.c (ffeglobal_proc_def_arg, ffeglobal_proc_ref_arg): + Support distinct function/subroutine arguments instead of + just procedures. + * global.h: Ditto. + * expr.c (ffeexpr_fulfill_call_): A SYMTER with kindNONE + also is a procedure (either function or subroutine). + + Mon May 26 20:25:31 1997 Craig Burley + + * bad.def: Have several lexer diagnostics refer to + documentation for people who need more info on what Fortran + source code is supposed to look like. + + * expr.c (ffeexpr_reduced_bool1_), bad.def: New diagnostics + specific to .NOT. now mention only one operand instead + of two. + + * g77.c: Recognize -fsyntax-only, similar to -c etc. + (lookup_option): Fix bug that prevented non-`--' options + from being recognized. + + Sun May 25 04:29:04 1997 Craig Burley + + * intrin.def (FFEINTRIN_impCTIME): Accept `I*' expression + for STime instead of requiring `I2'. + + Tue May 20 16:14:40 1997 Craig Burley + + * symbol.c (ffesymbol_reference): All references to + standard intrinsics are considered explicit, so as + to avoid generating basically useless warnings. + * intrin.c, intrin.h (ffeintrin_is_standard): Returns TRUE + if intrinsic is standard. + + Sun May 18 21:14:59 1997 Craig Burley + + * com-rt.def: Changed all external names of the + form `"\([a-z0-9]*\)_' to `"G77_\1_0"' so as to + allow any name valid as an intrinsic to be used + as such and as a user-defined external procedure + name or common block as well. + + Thu May 8 13:07:10 1997 Craig Burley + + * expr.c (ffeexpr_cb_end_notloc_): For %VAL, %REF, and + %DESCR, copy arg info into new node. + + Mon May 5 14:42:17 1997 Craig Burley + + From Uwe F. Mayer : + * Make-lang.in (g77-cross): Fix typo in g77.c path. + + From Brian McIlwrath : + * lang-specs.h: Have g77 pick up options from a section + labeled `*f771' of the `specs' file. + + Sat May 3 02:46:08 1997 Craig Burley + + * intrin.def (FFEINTRIN_defSIGNAL): Add optional `Status' + argument that com.c already expects (per Dave Love). + + More changes to support better tracking of (filewide) + globals, in particular, the arguments to procedures: + * bad.def (FFEBAD_FILEWIDE_NARGS, FFEBAD_FILEWIDE_NARGS_W, + FFEBAD_FILEWIDE_ARG, FFEBAD_FILEWIDE_ARG_W): New diagnostics. + * expr.c (ffebad_fulfill_call_): Provide info on each + argument to ffeglobal. + * global.c, global.h (ffeglobal_proc_def_arg, + ffeglobal_proc_def_nargs, ffeglobal_proc_ref_arg, + ffeglobal_proc_ref_args): New functions. + (ffeglobalArgSummary, ffeglobalArgInfo_): New types. + + Tue Apr 29 18:35:41 1997 Craig Burley + + More changes to support better tracking of (filewide) + globals: + * expr.c (ffeexpr_fulfill_call_): New function. + (ffeexpr_token_name_lhs_): Call after building procedure + reference expression. Also leave info field for ANY-ized + expression alone. + (ffeexpr_token_arguments_): Ditto. + + Mon Apr 28 20:04:18 1997 Craig Burley + + Changes to support better tracking of (filewide) + globals, mainly to avoid crashes due to inlining: + * bad.def: Go back to quoting intrinsic names, + (FFEBAD_FILEWIDE_DISAGREEMENT, FFEBAD_FILEWIDE_TIFF, + FFEBAD_FILEWIDE_TYPE_MISMATCH): New diagnostics. + (FFEBAD_INTRINSIC_EXPIMP, FFEBAD_INTRINSIC_GLOBAL): Reword + for clarity. + * com.c (ffecom_do_entry_, ffecom_start_progunit_, + ffecom_sym_transform_): Accommodate new FFEGLOBAL_typeEXT + possibility. + * expr.c (ffeexpr_sym_lhs_call_, ffeexpr_sym_lhs_extfunc_, + ffeexpr_sym_rhs_actualarg_, ffeexpr_declare_parenthesized_, + ffeexpr_paren_rhs_let_, ffeexpr_token_funsubstr_): + Fill in real kind info instead of leaving NONE where + appropriate. + Register references to intrinsics and globals with ffesymbol + using new ffesymbol_reference function instead of + ffesymbol_globalize. + * global.c (ffeglobal_type_string_): New array for + new diagnostics. + * global.h, global.c: + Replace ->init mechanism with ->tick mechanism. + Move other common-related members into a substructure of + a union, so the proc substructure can be introduced + to include members related to externals other than commons. + Don't complain about ANY-ized globals; ANY-ize globals + once they're complained about, in any case where code + generation could become a problem. + Handle global entries that have NONE type (seen as + intrinsics), EXT type (seen as EXTERNAL), and so on. + Keep track of kind and type of externals, both via + definition and via reference. + Diagnose disagreements about kind or type of externals + (such as functions). + (ffeglobal_ref_intrinsic, ffeglobal_ref_progunit_): New + functions. + * stc.c (ffestc_R1207_item, ffestc_R1208_item, + ffestc_R1219, ffestc_R1226): + Call ffesymbol_reference, not ffesymbol_globalize. + * stu.c (ffestu_sym_end_transition, + ffestu_sym_exec_transition): + Call ffesymbol_reference, not ffesymbol_globalize. + * symbol.c (ffesymbol_globalize): Removed... + (ffesymbol_reference): ...to this new function, + which more generally registers references to symbols, + globalizes globals, and calls on the ffeglobal module + to check globals filewide. + + * global.h, global.c: Rename some macros and functions + to more clearly distinguish common from other globals. + All callers changed. + + * com.c (ffecom_sym_transform_): Trees describing + filewide globals must be allocated on permanent obstack. + + * expr.c (ffeexpr_token_name_lhs_): Don't generate + gratuitous diagnostics for FFEINFO_whereANY case. + + Thu Apr 17 03:27:18 1997 Craig Burley + + * global.c: Add support for flagging intrinsic/global + confusion via warnings. + * bad.def (FFEBAD_INTRINSIC_EXPIMP, + FFEBAD_INTRINSIC_GLOBAL): New diagnostics. + * expr.c (ffeexpr_token_funsubstr_): Ditto. + (ffeexpr_sym_lhs_call_): Ditto. + (ffeexpr_paren_rhs_let_): Ditto. + * stc.c (ffestc_R1208_item): Ditto. + + Wed Apr 16 22:40:56 1997 Craig Burley + + * expr.c (ffeexpr_declare_parenthesized_): INCLUDE + context can't be an intrinsic invocation either. + + Fri Mar 28 10:43:28 1997 Craig Burley + + * expr.c (ffeexpr_token_arguments_): Make sure top of + exprstack is operand before dereferencing operand field. + + * lex.c (ffelex_prepare_eos_): Fill up truncated + hollerith token, so crash on null ->text field doesn't + happen later. + + * stb.c (ffestb_R10014_): If NAMES isn't recognized (or + the recognized part is followed in the token by a + non-digit), don't try and collect digits, as there + might be more than FFEWHERE_indexMAX letters to skip + past to do so -- and the code is diagnosed anyway. + + Thu Mar 27 00:02:48 1997 Craig Burley + + * com.c (ffecom_sym_transform_): Force local + adjustable array onto stack. + + * stc.c (ffestc_R547_item_object): Don't actually put + the symbol in COMMON if the symbol has already been + EQUIVALENCE'd to a different COMMON area. + + * equiv.c (ffeequiv_add): Don't actually do anything + if there's a disagreement over which COMMON area is + involved. + + Tue Mar 25 03:35:19 1997 Craig Burley + + * com.c (ffecom_transform_common_): If no explicit init + of COMMON area, don't actually init it even though + storage area suggests it. + + Mon Mar 24 12:10:08 1997 Craig Burley + + * lex.c (ffelex_image_char_): Avoid overflowing the + column counter itself, as well as the card image. + + * where.c (ffewhere_line_new): Cast ffelex_line_length() + to (size_t) so 255 doesn't overflow to 0! + + * stc.c (ffestc_labeldef_notloop_begin_): Don't gratuitously + terminate loop before processing statement, so block + doesn't disappear out from under EXIT/CYCLE processing. + (ffestc_labeldef_notloop_): Has old code from above + function, instead of just calling it. + + * expr.c (ffeexpr_cb_comma_i_4_): Don't skip over + arbitrary token (such as EOS). + + * com.c (ffecom_init_zero_): Handle RECORD_TYPE and + UNION_TYPE so -fno-zeros works with -femulated-complex. + + 1997-03-12 Dave Love + + * intrin.def: New intrinsics INT2, INT8, CPU_TIME. Fix AND, OR, + XOR. [Integrated by burley, AND/OR/XOR already fixed, INT8 + implementation changed/fixed.] + + Wed Mar 12 10:40:08 1997 Craig Burley + + * Make-lang.in ($(srcdir)/f/intdoc.texi): Simplify rules + so building f/intdoc is not always necessary; remove + f/intdoc after running it if it is built. + + Tue Mar 11 23:42:00 1997 Craig Burley + + * intrin.def (FFEINTRIN_impAND, FFEINTRIN_impOR, + FFEINTRIN_impXOR): Use the IAND, IOR, and IEOR implementations + of these, instead of crashing in ffecom_expr_intrinsic_ + or adding case labels there. + + Mon Mar 10 22:51:23 1997 Craig Burley + + * intdoc.c: Fix so any C compiler can compile this. + + Fri Feb 28 13:16:50 1997 Craig Burley + + * Version 0.5.20 released. + + Fri Feb 28 01:45:25 1997 Craig Burley + + * Make-lang.in (RUNTIMESTAGESTUFF, LIBU77STAGESTUFF): + Move some files incorrectly in the former to the latter, + and add another file or two to the latter. + + New meanings for (KIND=n), and new denotations in the + little language describing intrinsics: + * com.c (ffecom_init_0): Assign new meanings. + * intdoc.c: Document new meanings. + Support the new denotations. + * intrin.c: Employ new meanings, mapping them to internal + values (which are the same as they ever were for now). + Support the new denotations. + * intrin.def: Switch DEFIMP table to the new denotations. + + * intrin.c (ffeintrin_check_): Fix bug that was leaving + LOC() and %LOC() returning INTEGER*4 on systems where + it should return INTEGER*8. + + * type.c: Canonicalize function definitions, for etags + and such. + + Wed Feb 26 20:43:03 1997 Craig Burley + + * com.c (ffecom_init_0): Choose INTEGER(KIND=n) types, + where n is 2, 3, and 4, according to the new docs + instead of according to the old C correspondences + (which seem less useful at this point). + + * equiv.c (ffeequiv_destroy_): New function. + (ffeequiv_layout_local_): Use this new function + whenever the laying out of a local equivalence chain + is aborted for any reason. + Otherwise ensure that symbols no longer reference + the stale ffeequiv entries that result when they + are killed off in this procedure. + Also, the rooted symbol is one that has storage, + it really is irrelevant whether it has an equiv entry + at this point (though the code to remove the equiv + entry was put in at the end, just in case). + (ffeequiv_kill): When doing internal checks, make + sure the victim isn't named by any symbols it points + to. Not as complete a check as looking through the + entire symbol table (which does matter, since some + code in equiv.c used to remove symbols from the lists + for an ffeequiv victim but not remove that victim as the + symbol's equiv info), but this check did find some + real bugs in the code (that were fixed). + + Mon Feb 24 16:42:13 1997 Craig Burley + + * com.c (ffecom_expr_intrinsic_): Fix a couple of + warnings about uninitialized variables. + * intrin.c (ffeintrin_check_): Ditto, but there were + a couple of _real_ uninitialized-variable _bugs_ here! + (ffeintrin_fulfill_specific): Ditto, no real bug here. + + Sun Feb 23 15:01:20 1997 Craig Burley + + Clean up diagnostics (especially about intrinsics): + * bad.def (FFEBAD_UNIMPL_STMT): Remove. + (FFEBAD_INTRINSIC_*, FFEBAD_NEED_INTRINSIC): Clean these + up so they're friendlier. + (FFEBAD_INTRINSIC_CMPAMBIG): New. + * intrin.c (ffeintrin_fulfill_generic, + ffeintrin_fulfill_specific, ffeintrin_is_intrinsic): + Always choose + generic or specific name text (which is for doc purposes + anyway) over implementation name text (which is for + internal use). + * intrin.def: Use more descriptive name texts for generics + and specifics in cases where the names themselves are not + enough (e.g. IDATE, which has two forms). + + Fix some intrinsic mappings: + * intrin.def (FFEINTRIN_specIDINT, FFEINTRIN_specAND, + FFEINTRIN_specDFLOAT, FFEINTRIN_specDREAL, FFEINTRIN_specOR, + FFEINTRIN_specXOR): Now have their own implementations, + instead of borrowing from others. + (FFEINTRIN_specAJMAX0, FFEINTRIN_specAJMIN0, FFEINTRIN_specBJTEST, + FFEINTRIN_specDFLOTJ, FFEINTRIN_specFLOATJ, FFEINTRIN_specJIABS, + FFEINTRIN_specJIAND, FFEINTRIN_specJIBCLR, FFEINTRIN_specJIBITS, + FFEINTRIN_specJIBSET, FFEINTRIN_specJIDIM, FFEINTRIN_specJIDINT, + FFEINTRIN_specJIDNNT, FFEINTRIN_specJIEOR, FFEINTRIN_specJIFIX, + FFEINTRIN_specJINT, FFEINTRIN_specJIOR, FFEINTRIN_specJISHFT, + FFEINTRIN_specJISHFTC, FFEINTRIN_specJISIN, FFEINTRIN_specJMAX0, + FFEINTRIN_specJMAX1, FFEINTRIN_specJMIN0, FFEINTRIN_specJMIN1, + FFEINTRIN_specJMOD, FFEINTRIN_specJNINT, FFEINTRIN_specJNOT,): + Turn these implementations off, since it's not clear + just what types they expect in the context of portable Fortran. + (DFLOAT): Now in FVZ family, since f2c supports them + + Support intrinsic inquiry functions (BIT_SIZE, LEN): + * intrin.c: Allow `i' in . + * intrin.def (FFEINTRIN_impBIT_SIZE, FFEINTRIN_impLEN): + Mark args with `i'. + + Sat Feb 22 13:34:09 1997 Craig Burley + + Only warn, don't error, for reference to unimplemented + intrinsic: + * bad.def (FFEBAD_INTRINSIC_UNIMPLW): Warning version + of _UNIMPL. + * intrin.c (ffeintrin_is_intrinsic): Use new warning + version of _UNIMPL (FFEBAD_INTRINSIC_UNIMPLW). + + Complain about REAL(Z) and AIMAG(Z) (Z is DOUBLE COMPLEX): + * bad.def (FFEBAD_INTRINSIC_CMPAMBIG): New diagnostic. + * expr.c: Needed #include "intrin.h" anyway. + (ffeexpr_token_intrincheck_): New function handles delayed + diagnostic for "REAL(REAL(expr)" if next token isn't ")". + (ffeexpr_token_arguments_): Do most of the actual checking here. + * intrin.h, intrin.c (ffeintrin_fulfill_specific): New + argument, check_intrin, to tell caller that intrin is REAL(Z) + or AIMAG(Z). All callers updated, mostly to pass NULL in + for this. + (ffeintrin_check_): Also has new arg check_intrin for same + purpose. All callers updated the same way. + * intrin.def (FFEINTRIN_impAIMAG): Change return type + from "R0" to "RC", to accommodate f2c (and perhaps other + non-F90 F77 compilers). + * top.h, top.c: New option -fugly-complex. + + New GNU intrinsics REALPART, IMAGPART, and COMPLEX: + * com.c (ffecom_expr_intrinsic_): Implement impCOMPLEX + and impREALPART here. (specIMAGPART => specAIMAG.) + * intrin.def: Add the intrinsics here. + + Rename implementations of VXTIDATE and VXTTIME to IDATEVXT + and TIMEVXT, so they sort more consistently: + * com.c (ffecom_expr_intrinsic_): + * intrin.def: + + Delete intrinsic group `dcp', add `gnu', etc.: + * intrin.c (ffeintrin_state_family): FFEINTRIN_familyGNU + replaces FFEINTRIN_familyDCP, and gets state from `gnu' + group. + Get rid of FFEINTRIN_familyF2Z, nobody needs it. + Move FFEINTRIN_specDCMPLX from DCP family to FVZ family, + as f2c has it. + Move FFEINTRIN_specDFLOAT from F2C family to FVZ family. + (FFEINTRIN_specZABS, FFEINTRIN_specZCOS, FFEINTRIN_specZEXP, + FFEINTRIN_specZLOG, FFEINTRIN_specZSIN, FFEINTRIN_specZSQRT): + Move these from F2Z family to F2C family. + * intrin.h (FFEINTRIN_familyF2Z, FFEINTRIN_familyDCP): Remove. + (FFEINTRIN_familyGNU): Add. + * top.h, top.c: Replace `dcp' with `gnu'. + + * com.c (ffecom_expr_intrinsic_): Clean up by collecting + simple conversions into one nice, conceptual place. + Fix up some intrinsic subroutines (MVBITS, KILL, UMASK) to + properly push and pop call temps, to avoid wasting temp + registers. + + * g77.c (doit): Toon says variables should be defined + before being referenced. Spoilsport. + + * intrin.c (ffeintrin_check_): Now Dave's worried about + warnings about uninitialized variables. Okay, so for + basic return values 'g' and 's', they _were_ + uninitialized -- is determinism really _that_ useful? + + * intrin.def (FFEINTRIN_impFGETC): Fix STATUS argument + so that it is INTENT(OUT) instead of INTENT(IN). + + 1997-02-21 Dave Love + + * intrin.def, com.c: Support Sun-type `short' and `long' + intrinsics. Perhaps should also do Microcruft-style `int2'. + + Thu Feb 20 15:16:53 1997 Craig Burley + + * com.c (ffecom_expr_intrinsic_): Clean up indentation. + Support SECONDSUBR intrinsic implementation. + Rename SECOND to SECONDFUNC for direct support via library. + + * g77.c: Fix to return proper status value to shell, + by obtaining it from processes it spawns. + + * intdoc.c: Fix minor typo. + + * intrin.def: Turn SECOND into generic that maps into + function and subroutine forms. + + * intrin.def: Make FLOAT and SNGL into specific intrinsics. + + * intrin.def, intrin.h: Change the way DEFGEN and DEFSPEC + macros work, to save on verbage. + + Mon Feb 17 02:08:04 1997 Craig Burley + + New subsystem to automatically generate documentation + on intrinsics: + * Make-lang.in ($(srcdir)/f/g77.info, + $(srcdir)/f/g77.dvi): Move g77 doc rules around. + Add to g77 doc rules the new subsystem. + (f77.mostlyclean, f77.maintainer-clean): Also clean up + after new doc subsystem. + * intdoc.c, intdoc.h: New doc subsystem code. + * intrin.h [FFEINTRIN_DOC]: When 1, don't pull in + stuff not needed by doc subsystem. + + Improve on intrinsics mechanism to both be more + self-documenting and to catch more user errors: + * intrin.c (ffeintrin_check_): Recognize new arg-len + and arg-rank information, and check it. + Move goto and signal indicators to the basic type. + Permit reference to arbitrary argument number, not + just first argument (for BESJN and BESYN). + (ffeintrin_init_0): Check and accept new notations. + * intrin.c, intrin.def: Value in COL now identifies + arguments starting with number 0 being the first. + + Some minor intrinsics cleanups (resulting from doc work): + * com.c (ffecom_expr_intrinsic_): Implement FLUSH + directly once again, handle its optional argument, + so it need not be a generic (awkward to handle in docs). + * intrin.def (BESJ0, BESJ1, BESJN, BESY0, BESY1, BESYN, + CHDIR, CHMOD, CTIME, DBESJ0, DBESJ1, DBESJN, DBESY0, + DBESY1, DBESYN, DDIM, ETIME, FGETC, FNUM, FPUTC, FSTAT, + GERROR, GETCWD, GETGID, GETLOG, GETPID, GETUID, GMTIME, + HOSTNM, IDATE, IERRNO, IIDINT, IRAND, ISATTY, ITIME, JIDINT, + LNBLNK, LSTAT, LTIME, MCLOCK, PERROR, SRAND, SYMLNK, TTYNAM, + UMASK): Change capitalization of initcaps (official) name + to be consistent with Burley's somewhat arbitrary rules. + (BESJN, BESYN): These have return arguments of same type + as their _second_ argument. + (FLUSH): Now a specific, not generic, intrinsic, with one + optional argument. + (FLUSH1): Eliminated. + Add arg-len and arg-rank info to several intrinsics. + (ITIME): Change argument type from REAL to INTEGER. + + Tue Feb 11 14:04:42 1997 Craig Burley + + * Make-lang.in (f771): Invocation of Makefile now done + with $(srcdir)=gcc to go along with $(VPATH)=gcc. + ($(srcdir)/f/runtime/configure, + $(srcdir)/f/runtime/libU77/configure): Break these out + so spurious triggers of this rule don't happen (as when + configure.in is more recent than libU77/configure). + (f77.rebuilt): Distinguish source versus build files, + so this target can be invoked from build directory and + still work. + * Makefile.in: This now expects $(srcdir) to be the gcc + source directory, not gcc/f, to agree with $(VPATH). + Accordingly, $(INCLUDES) has been fixed, various cruft + removed, the removal of f771 has been fixed to remove + the _real_ f771 (not the one in gcc's parent directory), + and so on. + + * lex.c: Part of ffelex_finish_statement_() now done + by new function ffelex_prepare_eos_(), so that, in one + popular case, the EOS can be prepared while the pointer + is at the end of the non-continued line instead of the + end of the line that marks no continuation. This improves + the appearance of diagnostics substantially. + + Mon Feb 10 12:44:06 1997 Craig Burley + + * Make-lang.in: runtime Makefile's, and include/f2c.h, + also depend on f/runtime/configure and f/runtime/libU77/configure. + + Fix various libU77 routines: + * com-rt.def (FFECOM_gfrtCTIME, FFECOM_gfrtMCLOCK, + FFECOM_gfrtTIME): These now use INTEGER*8 for time values, + for compatibility with systems like Alpha. + (FFECOM_gfrtSYSTEM_CLOCK, FFECOM_gfrtTTYNAM): Delete incorrect + trailing underscore in routine names. + * intrin.c, intrin.def: Support INTEGER*8 return values and + arguments ('4'). Change FFEINTRIN_impCTIME, FFEINTRIN_impMCLOCK, + and FFEINTRIN_impTIME accordingly. + (ffeintrin_is_intrinsic): Don't give caller a clue about + form of intrinsic -- shouldn't be needed at this point. + + Cope with generic intrinsics that are subroutines and functions: + * com.c (ffecom_finish_symbol_transform_, ffecom_expr_transform_): + Don't transform an intrinsic that is not known to be a subroutine + or a function. (Maybe someday have to avoid transforming + any intrinsic with an undecided or unknown implementation.) + * expr.c (ffeexpr_declare_unadorned_, + ffeexpr_declare_parenthesized_): Ok to invoke generic + intrinsic that has at least one subroutine form as a + subroutine. + Ok to pass intrinsic as actual arg if it has a known specific + intrinsic form that is valid as actual arg. + (ffeexpr_declare_parenthesized_): An unknown kind of + intrinsic has a paren_type chosen based on context. + (ffeexpr_token_arguments_): Build funcref/subrref based + on context, not on kind of procedure being called. + * intrin.h, intrin.c (ffeintrin_is_intrinsic): Undo changes of + Tue Feb 4 23:12:04 1997 by me, change all callers to leave + intrinsics as FFEINFO_kindNONE at this point. (Some callers + also had unused variables deleted as a result.) + + Enable all intrinsic groups (especially f90 and vxt): + * target.h (FFETARGET_defaultSTATE_DCP, FFETARGET_defaultSTATE_F2C, + FFETARGET_defaultSTATE_F90, FFETARGET_defaultSTATE_MIL, + FFETARGET_defaultSTATE_UNIX, FFETARGET_defaultSTATE_VXT): + Delete these macros, let top.c set them directly. + * top.c (ffeintrinsic_state_dcp_, ffe_intrinsic_state_f2c_, + ffe_intrinsic_state_f90_, ffe_intrinsic_state_mil_, + ffe_intrinsic_state_unix_, ffe_intrinsic_state_vxt_): + Enable all these directly. + + Sat Feb 8 03:21:50 1997 Craig Burley + + * g77.c: Incorporate recent changes to ../gcc.c. + For version magic (e.g. `g77 -v'), instead of compiling + /dev/null, write, compile, run, and then delete a small + program that prints the version numbers of the three + components of libf2c (libF77, libI77, and libU77), + so we get this info with bug reports. + Also, this change reduces the chances of accidentally + linking to an old (complex-alias-problem) libf2c. + Fix `-L' so the argument is expected in `-Larg'. + + * com.h (FFECOM_f2cLONGINT): For INTEGER*8 support in f2c.h, + dynamically determine proper type here, instead of + assuming `long long int' is correct. + + Tue Feb 4 23:12:04 1997 Craig Burley + + Add libU77 library from Dave Love : + * Make-lang.in (f77-runtime): Depend on new Makefile. + (f/runtime/libU77/Makefile): New rule. + Also configure libU77. + ($(srcdir)/f/runtime/configure: Use Makefile.in, + so configuration doesn't have to have happened. + (f77.mostlyclean, f77.clean, f77.distclean, + f77.maintainer-clean): Some fixups here, but more work + needed. + (RUNTIMESTAGESTUFF): Add libU77's config.status. + (LIBU77STAGESTUFF, f77.stage1, f77.stage2, f77.stage3, + f77.stage4): New macro, appropriate uses added. + * com-rt.def: Add libU77 procedures. + * com.c (ffecom_f2c_ptr_to_integer_type_node, + ffecom_f2c_ptr_to_real_type_node): New type nodes. + (FFECOM_rttypeCHARACTER_): New type of run-time function. + (ffecom_char_args_): Handle CHARACTER*n intrinsics + where n != 1 here, instead of in ffecom_expr_intrinsic_. + (ffecom_expr_intrinsic_): New code to handle new + intrinsics. + In particular, change how FFEINTRIN_impFLUSH is handled. + (ffecom_make_gfrt_): Handle new type of run-time function. + (ffecom_init_0): Initialize new type nodes. + * config-lang.in: New libU77 directory. + * intrin.h, intrin.c (ffeintrin_is_intrinsic): Handle + potential generic for subroutine _and_ function + specifics via two new arguments. All callers changed. + Properly ignore deleted/disabled intrinsics in resolving + generics. + (ffeintrin_check_, ffeintrin_init_0): Handle CHARACTER intrinsics of (*) + length. + * intrin.def: Permission granted by FSF to place this in + public domain, which will allow it to serve as source + for both g77 program and its documentation. + Add libU77 intrinsics. + (FLUSH): Now a generic, not specific, intrinsic. + (DEFIMP): Now support return modifier for CHARACTER intrinsics. + + * com-rt.def (FFECOM_gfrtDIM, FFECOM_gfrtERF, + FFECOM_gfrtERFC, FFECOM_gfrtEXP, FFECOM_gfrtSIGN, + FFECOM_gfrtSIN, FFECOM_gfrtSINH, FFECOM_gfrtTAN, + FFECOM_gfrtTANH, FFECOM_gfrtPOW_RI): Change "&r" to "&f". + + Sat Feb 1 12:15:09 1997 Craig Burley + + * Version 0.5.19.1 released. + + * com.c (ffecom_expr_, ffecom_expr_intrinsic_, + ffecom_tree_divide_): FFECOM_gfrtPOW_ZI, + FFECOM_gfrtCONJG, FFECOM_gfrtDCONJG, + FFECOM_gfrtCCOS, FFECOM_gfrtCDCOS, + FFECOM_gfrtCLOG, FFECOM_gfrtCDLOG, + FFECOM_gfrtCSIN, FFECOM_gfrtCDSIN, + FFECOM_gfrtCSQRT, FFECOM_gfrtCDSQRT, + FFECOM_gfrtDIV_CC, FFECOM_gfrtDIV_ZZ: These all require + result to _not_ overlap one or more inputs. + + Sat Feb 1 00:25:55 1997 Craig Burley + + * com.c (ffecom_init_0): Do internal checks only if + -fset-g77-defaults not specified. + + Fix %LOC(), LOC() to return sufficiently wide type: + * com.h, com.c (ffecom_pointer_kind_, ffecom_label_kind_, + ffecom_pointer_kind(), ffecom_label_kind()): New globals + and accessor macros hold kind for integer pointers on target + machine. + (ffecom_init_0): Determine narrowest INTEGER type that + can hold a pointer (usually INTEGER*4 or INTEGER*8), + store it in ffecom_pointer_kind_, etc. + * expr.c (ffeexpr_cb_end_loc_): Use right type for %LOC(). + * intrin.c (ffeintrin_check_, ffeintrin_init_0): Support + new 'p' kind for type of intrinsic. + * intrin.def (FFEINTRIN_impLOC): Returns "Ip" instead of "I1", + so LOC() type is correct for target machine. + + Support -fugly-assign: + * lang-options.h, top.h, top.c (ffe_decode_option): + Accept -fugly-assign and -fno-ugly-assign. + * com.c (ffecom_expr_): Handle -fugly-assign. + * expr.c (ffeexpr_finished_): Check right type for ASSIGN + contexts. + + Fri Jan 31 14:30:00 1997 Craig Burley + + Remove last vestiges of -fvxt-not-f90: + * stb.c (ffestb_R10012_, ffestb_R10014_, ffestb_V0201_): + top.c, top.h: + + Fri Jan 31 02:13:54 1997 Craig Burley + + * top.c (ffe_decode_option): Warn if -fugly is specified, + it'll go away soon. + + * symbol.h: No need to #include "bad.h". + + Reorganize features from -fvxt-not-f90 to -fvxt: + * lang-options.h, top.h, top.c: + Accept -fvxt and -fno-vxt, but not -fvxt-not-f90 or -ff90-not-vxt. + Warn if the latter two are used. + * expr.c (ffeexpr_nil_rhs_): Double-quote means octal constant. + (ffeexpr_token_rhs_): Double-quote means octal constant. + * target.h (FFETARGET_defaultIS_VXT_NOT_90): Delete macro + definition, no longer needed. + + Make some -ff90 features the default: + * data.c (ffedata_value): DATA implies SAVE. + * src.h (ffesrc_is_name_noninit): Underscores always okay. + + Fix up some more #error directives by quoting their text: + * bld.c (ffebld_constant_is_zero): + * target.h: + + Sat Jan 18 18:22:09 1997 Craig Burley + + * g77.c (lookup_option, main): Recognize `-Xlinker', + `-Wl,', `-l', `-L', `--library-directory', `-o', + `--output'. + (lookup_option): Don't depend on SWITCH_TAKES_ARG + being correct, it might or might not have `-x' in + it depending on host. + Return NULL argument if it would be an empty string. + (main): If no input files (by gcc.c's definition) + but `-o' or `--output' specified, produce diagnostic + to avoid overwriting output via gcc. + Recognize C++ `+e' options. + Treat -L as another non-magical option (like -B). + Don't append_arg `-x' twice. + + Fri Jan 10 23:36:00 1997 Craig Burley + + * top.c [BUILT_FOR_270] (ffe_decode_option): Make + -fargument-noalias-global the default. + + Fri Jan 10 07:42:27 1997 Craig Burley + + Enable inlining of previously-compiled program units: + * com.c (ffecom_do_entry_, ffecom_start_progunit_): + Register new public function in ffeglobal database. + (ffecom_sym_transform_): Any GLOBAL or potentially GLOBAL + symbol should be looked up in ffeglobal database and + that tree node used, if found. That way, gcc knows + the references are to those earlier definitions, so it + can emit shorter branches/calls, inline, etc. + (ffecom_transform_common_): Minor change for clarity. + * expr.c (ffeexpr_sym-lhs_call_, ffeexpr_sym_lhs_extfunc_, + ffeexpr_sym_rhs_actualarg_, ffeexpr_paren_rhs_let_, + ffeexpr_token_funsubstr_): Globalize symbol as needed. + * global.c (ffeglobal_promoted): New function to look up + existing local symbol in ffeglobal database. + * global.h: Declare new function. + * name.h (ffename_token): New macro, plus alphabetize. + * stc.c (ffestc_R1207_item): Globalize EXTERNAL symbol. + * stu.c (ffestu_sym_end_transition, ffestu_sym_exec_transition): + Globalize symbol as needed. + * symbol.h, symbol.c (ffesymbol_globalize): New function. + + Thu Jan 9 14:20:00 1997 Craig Burley + + * ste.c (ffeste_R809): Produce a diagnostic for SELECT CASE + on CHARACTER type, instead of crashing. + + Thu Jan 9 00:52:45 1997 Craig Burley + + * stc.c (ffestc_order_entry_, ffestc_order_format_, + ffestc_R1226): Allow ENTRY and FORMAT before IMPLICIT + NONE, by having them transition only to state 1 instead + of state 2 (which is disallowed by IMPLICIT NONE). + + Mon Jan 6 22:44:53 1997 Craig Burley + + Fix AXP bug found by Rick Niles (961201-1.f): + * com.c (ffecom_init_0): Undo my 1996-05-14 change, as + it is incorrect and prevented easily finding this bug. + * target.h [__alpha__] (ffetargetReal1, ffetargetReal2): + Use int instead of long. + (ffetarget_cvt_r1_to_rv_, ffetarget_cvt_rv_to_r1_, + ffetarget_cvt_r2_to_rv_, ffetarget_cvt_rv_to_r2_): + New functions that intercede for callers of + REAL_VALUE_(TO|UNTO)_TARGET_(SINGLE|DOUBLE). + All callers changed, and damaging casts to (long *) removed. + + Sun Jan 5 03:26:11 1997 Craig Burley + + * Make-lang.in (g77, g77-cross): Depend on both g77.c and + zzz.c, in $(srcdir)/f/. + + Better design for -fugly-assumed: + * stc.c (ffestc_R501_item, ffestc_R524_item, + ffestc_R547_item_object): Pass new is_ugly_assumed flag. + * stt.c, stt.h (ffestt_dimlist_as_expr, + ffestt_dimlist_type): New is_ugly_assumed flag now + controls whether "1" is treated as "*". + Don't treat "2-1" or other collapsed constants as "*". + + Sat Jan 4 15:26:22 1997 Craig Burley + + * stb.c (ffestb_R10012_): Don't confirm on FORMAT(A,) + or even FORMAT(A,,B), as R1229 only warns about the + former currently, and this seems reasonable. + + Improvements to diagnostics: + * sta.c (ffesta_second_): Don't add any ffestb parsers + unless they're specifically called for. + Set up ffesta_tokens[0] before calling ffestc_exec_transition, + else stale info might get used. + (ffesta_save_): Do a better job picking which parser to run + after running all parsers with no confirmed possibles. + (FFESTA_maxPOSSIBLES_): Decrease from 100 now that so few + possibles are ever on the list at a given time. + (struct _ffesta_possible): Add named attribute. + (ffesta_add_possible_exec_, ffesta_add_possible_nonexec_): + Make these into macros that call a single function that now + sets the named attribute. + (ffesta_add_possible_unnamed_exec_, + ffeseta_add_possible_unnamed_nonexec_): New macros. + (ffesta_second_): Designate unnamed possibles as + appropriate. + * stb.c (ffestb_R1229, ffestb_R12291_): Use more general + diagnostic, so things like "POINTER (FOO, BAR)" are + diagnosed as unrecognized statements, not invalid statement + functions. + * stb.h, stb.c (ffestb_unimplemented): Remove function. + + 1996-12-30 Dave Love + + * com.c: #include libU77/config.h + (ffecom_f2c_ptr_to_integer_type_node, + ffecom_f2c_ptr_to_integer_type_node): New variables. + (ffecom_init_0): Use them. + (ffecom_expr_intrinsic_): Many news cases for libU77 intrinsics. + + * com-rt.def: New definitions for libU77. + * intrin.def: Likewise. Also correct ftell arg spec. + + * Makefile.in (f/runtime/libU77/config.h): New target for com.c + dependency. + * Make-lang.in (f771): Depend on f/runtime/Makefile for the above. + + Sat Dec 28 12:28:29 1996 Craig Burley + + * stt.c (ffestt_dimlist_type): Treat ([...,]1) in dimlist + as ([...,]*) if -fugly-assumed, so assumed-size array + detected early enough. + + Thu Dec 19 14:01:57 1996 Craig Burley + + * target.h (FFETARGET_REAL_VALUE_FROM_INT_): Conditionalize + definition on BUILT_FOR_280, not BUILT_WITH_280, since + the name of the macro was (properly) changed since 0.5.19. + + Fix warnings/errors resulting from ffetargetOffset becoming + `long long int' instead of `unsigned long' as of 0.5.19, + while ffebitCount remains `unsigned long': + * bld.c (ffebld_constantarray_dump): Avoid warnings by + using loop var of appropriate type, and using casts. + * com.c (ffecom_expr_): Use right type for loop var. + (ffecom_sym_transform_, ffecom_transform_equiv_): + Cast to right type in assertions. + * data.c (ffedata_gather_, ffedata_value_): Cast to right + type in assertions and comparisons. + + Wed Dec 18 12:07:11 1996 Craig Burley + + Patch from Alexandre Oliva : + * Makefile.in (all.indirect): Don't pass -bbigtoc option + to GNU ld. + + Cope with new versions of gcc: + * com.h (BUILT_FOR_280): New macro. + * com.c (ffecom_ptr_to_expr): Conditionalize test of + OFFSET_REF. + (ffecom_build_complex_constant_): Conditionalize calling + sequence for build_complex. + + Sat Dec 7 07:15:17 1996 Craig Burley + + * Version 0.5.19 released. + + Fri Dec 6 12:23:55 1996 Craig Burley + + * g77.c: Default to assuming "f77" is in $LANGUAGES, since + the LANGUAGE_F77 macro isn't defined by anyone anymore (but + might as well leave the no-f77 code in just in case). + * Make-lang.in (g77, g77-cross): Don't define LANGUAGE_F77 + anymore. + + 1996-12-06 Dave Love + + * Make-lang.in (g77, g77-cross): Revert to building `g77' or not + conditional on `f77' in LANGUAGES. + + Wed Dec 4 13:08:44 1996 Craig Burley + + * Make-lang.in (g77, g77-cross): No libs or lib dependencies + in case where "f77" is not in $LANGUAGES. + + * lex.c (ffelex_image_char_, ffelex_file_fixed, + ffelex_file_free): Fixes to properly handle lines with + null character, and too-long lines as well. + + * lex.c: Call ffebad_start_msg_lex instead of + ffebad_start_msg throughout. + + Sun Dec 1 21:19:55 1996 Craig Burley + + Fix-up for 1996-11-25 changes: + * com.c (ffecom_member_phase2_): Subtract out 0 offset for + elegance and consistency with EQUIVALENCE aggregates. + (ffecom_sym_transform_): Ditto for LOCAL/COMMON, and + ensure we get the same parent storage area. + * data.c (ffedata_gather_, ffedata_value_): Subtract out + aggregate offset. + + Wed Nov 27 13:55:57 1996 Craig Burley + + * proj.h: Quote the text of the #error message, to avoid + strange-looking diagnostics from non-gcc ANSI compilers. + + * top.c: Make -fno-debug-kludge the default. + + Mon Nov 25 20:13:45 1996 Craig Burley + + Provide more info on EQUIVALENCE mismatches: + * bad.def (FFEBAD_EQUIV_MISMATCH): More detailed message. + * equiv.c (ffeequiv_layout_local_, ffeequiv_layout_cblock): + More details for FFEBAD_EQUIV_MISMATCH. + + Fix problem with EQUIVALENCE handling: + * equiv.c (ffeequiv_layout_local_): Redesign algorithm -- + old one was broken, resulting in rejection of good code. + (ffeequiv_offset_): Add argument, change callers. + Clean up the code, fix up the (probably unused) negative-value + case for SYMTER. + * com.c (ffecom_sym_transform_): For local EQUIVALENCE + member, subtract out aggregate offset (which is <= 0). + + Thu Nov 21 12:44:56 1996 Craig Burley + + Change type of ffetargetOffset from `unsigned long' to `long long': + * bld.c (ffebld_constantarray_dump): Change printf formats. + * storag.c (ffestorag_dump): Ditto. + * symbol.c (ffesymbol_report): Ditto. + * target.h (ffetargetOffset_f): Ditto and change type itself. + + Handle situation where list of languages does not include f77: + * Make-lang.in: Define LANGUAGE_F77 to 1 only if `f77' is in + the $LANGUAGES macro for the build. + * g77.c: Compile to a (nearly) no-op program if LANGUAGE_F77 + is not defined to 1. + + Fixes to delay confirmation of READ, WRITE, and GOTO statements + so the corresponding assignments to same-named CHAR*(*) arrays + work: + * stb.c (ffestb_R90915_, ffestb_91014_): New functions. + (ffestb_goto3_, ffestb_goto5_): Move confirmation from 3 to 5 + for the OPEN_PAREN case. + (ffestb_R9091_, ffestb_R9094_, ffestb_R90913_, ffestb_R90914_, + ffestb_R91012_, ffestb_R91013_): Use new functions, and confirm + except for the OPEN_PAREN case. + + Fixes to not confirm declarations with an open paren where + an equal sign or other assignment-like token might be, so the + corresponding assignments to same-named CHAR*(*) arrays work: + (ffestb_decl_entsp_5_): Move assertion so we crash on that first, + if it turns out to be wrong, before the less-debuggable crash + on mistaken confirmation. + (ffestb_decl_entsp_6_, ffestb_decl_entsp_7_, ffestb_decl_entsp_8_): + Include OPEN_PAREN in list of assignment-only tokens. + + Fix more diagnosed-crash bugs: + * stu.c (ffestu_sym_end_transition): ANY-ize an adjustable array + with bad dimension expressions even if still stateUNCERTAIN. + (ffestu_symter_end_transition_, ffestu_symter_exec_transition_): + Return TRUE for opANY as well. + For code elegance, move opSYMTER case into first switch. + + 1996-11-17 Dave Love + + * lex.c: Fix last change. + + 1996-11-14 Dave Love + + * Make-lang.in, config-lang.in: Remove the (broken) libU77 stuff, + pending 0.5.20. + + Thu Nov 14 15:40:59 1996 Craig Burley + + * bad.def (FFEBAD_UNIMPL_STMT): Explain that invalid + intrinsic references can trigger this message, too. + + 1996-11-12 Dave Love + + * lex.c: Declare dwarfout routines. + + * config-lang.in: Sink grep o/p. + + Mon Nov 11 14:21:13 1996 Craig Burley + + * g77.c (main): Might as well print version number + for --verbose as well. + + Thu Nov 7 18:41:41 1996 Craig Burley + + * expr.c, lang-options.h, target.h, top.c, top.h: Split out + remaining -fugly stuff into -fugly-logint and -fugly-comma, + leaving -fugly as simply a `macro' that expands into other + options, and eliminate defaults for some of the ugly stuff + in target.h. + + * Make-lang.in (gcc-cross): Compile zzz.c, not version.o (!), + in to get version info for this target. + + * config-lang.in: Test for GBE patch application based + on whether 2.6.x or 2.7.x GBE is detected. + + Wed Nov 6 14:19:45 1996 Craig Burley + + * Make-lang.in (g77): Compile zzz.c in to get version info. + * g77.c: Add support for --help and --version. + + * g77.c (lookup_option): Short-circuit long-winded tests + when second char is not hyphen, just to save a spot of time. + + Sat Nov 2 13:50:31 1996 Craig Burley + + * intrin.def: Add FTELL and FSEEK intrinsics, plus new + `g' codes for alternate-return (GOTO) arguments. + * intrin.c (ffeintrin_check_): Support `g' codes. + * com-rt.def: Add ftell_() and fseek_() to database. + * com.c (ffecom_expr_intrinsic_): Ditto. Also, let each + subroutine intrinsic decide for itself what to do with + tree_type, the default being NULL_TREE once again (so + ffecom_call_ doesn't think it's supposed to cast the + 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. + (ffeste_R910_finish): Ditto. + (ffeste_io_call_): Simplify logic. + (ffeste_io_impdo_): + (ffeste_subr_beru_): + (ffeste_R904): + (ffeste_R907): + (ffeste_R909_start): + (ffeste_R909_item): + (ffeste_R909_finish): + (ffeste_R910_start): + (ffeste_R910_item): + (ffeste_R910_finish): + (ffeste_R911_start): + (ffeste_R923A): Ditto all the above. + + Thu Oct 31 20:56:28 1996 Craig Burley + + * config-lang.in, Make-lang.in: Rename flag file + build-u77 to build-libu77, for consistency with + install-libf2c and such. + + * config-lang.in: Don't complain about failure to patch + if pre-2.7.0 gcc is involved (since our patch for that + doesn't add support for tooning). + + Sat Oct 26 05:56:51 1996 Craig Burley + + * bad.def (FFEBAD_TYPELESS_TOO_LARGE): Remove this + unused and redundant diagnostic. + + Sat Oct 26 00:45:42 1996 Craig Burley + + * target.c (ffetarget_integerhex): Fix dumb bug. + + 1996-10-20 Dave Love + + * gbe/2.7.2.1.diff: New file. + + * Makefile.in (F771_LDFLAGS): Add -bbigtoc for AIX4.1 up, suggested by + endo@material.tohoku.ac.jp [among others!]. + + Sat Oct 19 03:11:14 1996 Craig Burley + + * bad.def, bld.c, bld.h, expr.c, lang-options.h, target.c, + target.h, top.c, top.h (ffebld_constant_new_integerbinary, + ffebld_constant_new_integerhex, ffebld_constant_new_integeroctal, + ffeexpr_token_name_apos_name_, ffetarget_integerbinary, + ffetarget_integerhex, ffetarget_integeroctal): Support + new -fno-typeless-boz option with new functions, mods to + existing octal-handling functions, new macros, new error + messages, and so on. + + * com.c, lang-options.h, top.c, top.h (ffecom_notify_primary_entry): + Print program unit name on stderr if -fno-silent (new option). + + * lang-options.h, top.c, top.h, stt.c (ffestt_dimlist_as_expr): + Treat ([...,]1) in dimlist as ([...,]*) if -fugly-assumed + (new option). + + * lang-options.h: Comment out options duplicated in gcc/toplev.c, + because, somehow, having them commented in and building on my + DEC Alpha results in a cc1 that always segfaults, and gdb that + also segfaults whenever it debugs it up to init_lex() calling + xmalloc() or so. + + Thu Oct 17 00:39:27 1996 Craig Burley + + * stb.c (ffestb_R10013_): Don't change meaning of .sign until + after previous meaning/value used to set sign of value + (960507-1.f). + + Sun Oct 13 22:15:23 1996 Craig Burley + + * top.c (ffe_decode_option): Don't set back-end flags + that are nonexistent prior to gcc 2.7.0. + + Sun Oct 13 12:48:45 1996 Craig Burley + + * com.c (convert): Don't convert emulated complex expr to + real (via REALPART_EXPR) if the target type is (emulated) + complex. + + Wed Oct 2 21:57:12 1996 Craig Burley + + * com.c (ffecom_debug_kludge_): Set DECL_IN_SYSTEM_HEADER so + -Wunused doesn't complain about these manufactured decls. + (ffecom_expr_): Ditto, for original (non-ASSIGN'ed) variable. + (ffecom_transform_equiv_): Clear DECL_IGNORED_P for aggregate + area so it shows up as a debug-accessible symbol. + (pushdecl): Default for "invented" identifiers (a g77-specific + concept for now) is that they are artificial, in system header, + ignored for debugging purposes, used, and (for types) suppressed. + This ought to be overkill. + + Fri Sep 27 23:13:07 1996 Craig Burley + + * ste.c (ffeste_begin_iterdo_, ffeste_end_iterdo_): Support + one-trip DO loops (F66-style). + * lang-options.h, top.c, top.h (-fonetrip): New option. + + Thu Sep 26 00:18:40 1996 Craig Burley + + * com.c (ffecom_debug_kludge_): New function. + (ffecom_sym_transform_): Use new function for COMMON and EQUIVALENCE + members. + + * lang-options.h, top.c, top.h (-fno-debug-kludge): + New option. + + 1996-09-24 Dave Love + + * Make-lang.in (include/f2c.h): + Remove dependencies on xmake_file and tmake_file. + They expand inconsistently in 2.8 c.f. 2.7; $(GCC_PARTS) depends on + them anyhow. + + 1996-09-22 Dave Love + + * config-lang.in: Add --enable-libu77 option handling. + + * Make-lang.in: + Conditionally add --enable-libu77 when running runtime configure. + Define LIBU77STAGESTUFF and use it in relevant rules. + + 1996-08-21 Dave Love + + * Make-lang.in (f77-runtime): + `stmp-hdrs' should have been `stmp-headers'. + + 1996-08-20 Dave Love + + * Make-lang.in (f77-runtime): + Depend on stmp-hdrs, not stmp-int-hdrs, since libF77 + needs float.h. + + Sat Jun 22 18:17:11 1996 Craig Burley + + * com.c (ffecom_tree_divide_): Fix RECORD_TYPE case to + look at type of first field, properly, to determine + whether to call c_div or z_div. + + Tue Jun 4 04:27:18 1996 Craig Burley + + * com.c (ffecom_build_complex_constant_): Explicitly specify + TREE_PURPOSE. + (ffecom_expr_): Fix thinko. + (ffecom_2): For COMPLEX_EXPR, explicitly specify TREE_PURPOSE. + + Mon May 27 16:23:43 1996 Craig Burley + + Changes to optionally avoid gcc's back-end complex support: + * com.c (ffecom_stabilize_aggregate_): New function. + (ffecom_convert_to_complex_): New function. + (ffecom_make_complex_type_): New function. + (ffecom_build_complex_constant_): New function. + (ffecom_expr_): For opCONVERT of non-COMPLEX to COMPLEX, + don't bother explicitly converting to the subtype first, + because gcc does that anyway, and more code would have + to be added to find the subtype for the emulated-complex + case. + (ffecom_f2c_make_type_): Use ffecom_make_complex_type_ + instead of make_node etc. to make a complex type. + (ffecom_1, ffecom_2): Translate operations on COMPLEX operands + to appropriate operations when emulating complex. + (ffecom_constantunion): Use ffecom_build_complex_constant_ + instead of build_complex to build a complex constant. + (ffecom_init_0): Change point at which types are laid out + for improved consistency. + Use ffecom_make_complex_type_ instead of make_node etc. + to make a complex type. + Always calculate storage sizes from TYPE_SIZE, never TYPE_PRECISION. + (convert): Use e, not expr, since we've copied into that anyway. + For RECORD_TYPE cases, do emulated-complex conversions. + (ffecom_f2c_set_lio_code_): Always calculate storage sizes + from TYPE_SIZE, never TYPE_PRECISION. + (ffecom_tree_divide_): Allow RECORD_TYPE to also be handled + by run-time library. + (ffecom_expr_intrinsic_): Handle possible RECORD_TYPE as argument + to AIMAG intrinsic. + + * top.h, top.c, lang-options.h: Support new -f(no-)emulate-complex option. + + * com.c (ffecom_sym_transform_): Clarify and fix typos in comments. + + Mon May 20 02:06:27 1996 Craig Burley + + * target.h: Use new REAL_VALUE_UNTO_TARGET_* macros instead + of REAL_VALUE_FROM_TARGET_DOUBLE and _SINGLE. + Explicitly use long instead of HOST_WIDE_INT for emulation + of ffetargetReal1 and ffetargetReal2. + + 1996-05-20 Dave Love + + * config-lang.in: + Test for patch being applied with flag_move_all_movables in toplev.c. + + * install.texi (Patching GNU Fortran): + Mention overriding X_CFLAGS rather than + editing proj.h on SunOS4. + + * Make-lang.in (F77_FLAGS_TO_PASS): + Add X_CFLAGS (convenient for SunOS4 kluge, in + particular). + (f77.{,mostly,dist}clean): Reorder things, in particular not to delete + Makefiles too early. + + * g77.c (DEFAULT_SWITCH_TAKES_ARG): Define a la gcc.c in the + current GCC snapshot. + + Tue May 14 00:24:07 1996 Craig Burley + + Changes for DEC Alpha AXP support: + * com.c (ffecom_init_0): REAL_ARITHMETIC means internal + REAL/DOUBLE PRECISION might well have a different size + than the compiled type, so don't crash if this is the + case. + * target.h: Use `int' for ffetargetInteger1, + ffetargetLogical1, and magical tests. Set _f format + strings accordingly. + + Tue Apr 16 14:08:28 1996 Craig Burley + + * top.c (ffe_decode_option): -Wall no longer implies + -Wsurprising. + + Sat Apr 13 14:50:06 1996 Craig Burley + + * com.c (ffecom_char_args_): If item is error_mark_node, + set *length that way, too. + + * com.c (ffecom_expr_power_integer_): If either operand + is error_mark_node, return that. + + * com.c (ffecom_intrinsic_len_): If item is error_mark_node, + return that for length. + + * expr.c (ffeexpr_declare_unadorned_, + ffeexpr_declare_parenthesized_): Instead of crashing + on unexpected contexts, produce a diagnostic. + + * intrin.c (ffeintrin_check_), intrin.def (impSIGNAL): + Allow procedure as second arg to SIGNAL intrinsic. + + * stu.c (ffestu_symter_end_transition_): New function. + (ffestu_symter_exec_transition_): Return bool arg. + Always transition symbol (don't inhibit when !whereNONE). + (ffestu_sym_end_transition): If DUMMY/LOCAL arg has any + opANY exprs in its dimlist, diagnose it so it doesn't + make it through to later stages that try to deal with + dimlist stuff. + (ffestu_sym_exec_transition): If sym has any opANY exprs + in its dimlist, diagnose it so it becomes opANY itself. + + * symbol.c (ffesymbol_error): If token arg is NULL, + just ANY-ize the symbol -- don't produce diagnostic. + + Mon Apr 1 10:14:02 1996 Craig Burley + + * Version 0.5.18 released. + + Mon Mar 25 20:52:24 1996 Craig Burley + + * com.c (ffecom_expr_power_integer_): Don't generate code + that compares COMPLEX (or, as it happens, REAL) via "LT_EXPR", + since the back end crashes on that. (This code would never + be executed anyway, but the test that avoids it has now been + translated to control whether the code gets generated at all.) + Fixes 960323-3.f. + + * com.c (ffecom_type_localvar_): Handle variable-sized + dimension bounds expressions here, so they get calculated + and saved on procedure entry. Fixes 960323-4.f. + + * com.c (ffecom_notify_init_symbol): Symbol has no init + info at all if only zeros have been used to initialize it. + Fixes 960324-0.f. + + * expr.c, expr.h (ffeexpr_type_combine): Renamed from + ffeexpr_type_combine_ and now a public procedure; last arg now + a token, instead of an internal structure used to extract a token. + Now allows the outputs to be aliased with the inputs. + Now allows a NULL token to mean "don't report error". + (ffeexpr_reduced_bool2_, ffeexpr_reduced_eqop2_, + ffeexpr_reduced_math2_, ffeexpr_reduced_power_, + ffeexpr_reduced_relop2_): Handle new calling sequence for + ffeexpr_type_combine. + * (ffeexpr_convert): Don't put an opCONVERT node + in just because the size is unknown; all downstream code + should be able to deal without it being there anyway, and + getting rid of it allows new intrinsic code to more easily + combine types and such without generating bad code. + * info.c, info.h (ffeinfo_kindtype_max): Rewrite to do + proper comparison of size of types, not just comparison + of their internal kind numbers (so I2.eq.I1 doesn't promote + I1 to I2, rather the other way around). + * intrin.c (ffeintrin_check_): Combine types of arguments + in COL a la expression handling, for greater flexibility + and permissiveness (though, someday, -fpedantic should + report use of this kind of thing). + Make sure Hollerith/typeless where CHARACTER expected is + rejected. This all fixes 960323-2.f. + + * ste.c (ffeste_begin_iterdo_): Fix some more type conversions + so INTEGER*2-laden DO loops don't crash at compile time on + certain machines. Believed to fix 960323-1.f. + + * stu.c (ffestu_sym_end_transition): Certainly reject + whereDUMMY not in any dummy list, whether stateUNCERTAIN + or stateUNDERSTOOD. Fixes 960323-0.f. + + Tue Mar 19 13:12:40 1996 Craig Burley + + * data.c (ffedata_value): Fix crash on opANY, and simplify + the code at the same time. + + * Make-lang.in (f77-runtime): Also depends on lib[FI]77/Makefile... + (include/f2c.h...): ...which in turn depend on */Makefile.in. + (f77.rebuilt): Rebuild runtime stuff too. + + * intrin.c (ffeintrin_check_): Accommodate TYPELESS/HOLLERITH + types, convert args as necessary, etc. + + * expr.c (ffeexpr_convert): Fix test for TYPELESS/HOLLERITH + to obey the docs; crash if no source token when error. + (ffeexpr_collapse_convert): Crash if no token when error. + + Mon Mar 18 15:51:30 1996 Craig Burley + + * com.c (ffecom_init_zero_): Renamed from + ffecom_init_local_zero_; now handles top-level + (COMMON) initializations too. + + * bld.c (ffebld_constant_is_zero): + * com.c (ffecom_symbol_transform_, ffecom_sym_transform_assign_, + ffecom_transform_common_, ffecom_transform_equiv_): + * data.c: + * equiv.c: + * equiv.h: + * lang-options.h: + * stc.c: + * storag.c: + * storag.h: + * symbol.c: + * symbol.h: + * target.c: + * target.h: + * top.c: + * top.h: All of this is mostly housekeeping-type changes + to support -f(no-)zeros, i.e. not always stuff zero + values into the initializer fields of symbol/storage objects, + but still track that they have been given initial values. + + * bad.def: Fix wording for DATA-related diagnostics. + + * com.c (ffecom_sym_transform_assign_): Don't check + any EQUIVALENCE stuff for local ASSIGN, the check was + bad (crashing), and it's not necessary, anyway. + + * com.c (ffecom_expr_intrinsic_): For MAX and MIN, + ignore null arguments as far arg[123], and fix handling + of ANY arguments. (New intrinsic support now allows + spurious trailing null arguments.) + + * com.c (ffecom_init_0): Add HOLLERITH (unsigned) + equivalents for INTEGER*2, *4, and *8, so shift intrinsics + and other things that need unsigned versions of signed + types work. + + Sat Mar 16 12:11:40 1996 Craig Burley + + * storag.c (ffestorag_exec_layout): Treat adjustable + local array like dummy -- don't create storage object. + * com.c (ffecom_sym_transform_): Allow for NULL storage + object in LOCAL case (adjustable array). + + Fri Mar 15 13:09:41 1996 Craig Burley + + * com.c (ffecom_sym_transform_): Allow local symbols + with nonconstant sizes (adjustable local arrays). + (ffecom_type_localvar_): Allow dimensions with nonconstant + component (adjustable local arrays). + * expr.c: Various minor changes to handle adjustable + local arrays (a new case of stateUNCERTAIN). + * stu.c (ffestu_sym_end_transition, + ffestu_sym_exec_transition): Ditto. + * symbol.def: Update docs to reflect these changes. + + * com.c (ffecom_expr_): Reduce space/time needed for + opACCTER case by handling it here instead of converting + it to opARRTER earlier on. + (ffecom_notify_init_storage): Don't convert ACCTER to ARRTER. + (ffecom_notify_init_symbol): Ditto. + + * com.c (ffecom_init_0): Crash and burn if any of the types' + sizes, according to the GBE, disagrees with the sizes of + the FFE's internal implementation. This might catch + Alpha/SGI bugs earlier. + + Fri Mar 15 01:09:41 1996 Craig Burley + + * com-rt.def, com.c, com.h: Changes for rewrite of intrinsic + handling. + * com.c (ffecom_arglist_expr_): New function. + (ffecom_widest_expr_type_): New function. + (ffecom_expr_intrinsic_): Reorganize, some rewriting. + (ffecom_f2c_make_type_): Layout complex types. + (ffecom_gfrt_args_): New function. + (ffecom_list_expr): Trivial change for consistency. + + * expr.c (ffeexpr_token_name_rhs_): Go back to getting + type from specific, not implementation, info. + (ffeexpr_token_funsubstr_): Set intrinsic implementation too! + * intrin.c: Major rewrite of most portions. + * intrin.def: Major rearchitecting of tables. + * intrin.h (ffeintrin_basictype, ffeintrin_kindtype): + Now (once again) take ffeintrinSpec as arg, not ffeintrinImp; + for now, these return NONE, since they're not really needed + and adding the necessary info to the tables is not trivial. + (ffeintrin_codegen_imp): New function. + * stc.c (ffestc_R1208_item): Change way ffeintrin funcs called, + back to original per above; but comment out the code anyway. + + * intrin.c (ffe_init_0): Do internal checks only if + -fset-g77-defaults not specified. + + * lang-options.h: Add -fset-g77-defaults option. + * lang-specs.h: Always pass -fset-g77-defaults. + * top.c, top.h: New option. + + Sat Mar 9 17:49:50 1996 Craig Burley + + * Make-lang.in (stmp-int-hdrs): Use --no-validate when + generating the f77.rebuilt files (BUGS, INSTALL, NEWS) + so cross-references can work properly in g77.info + without a lot of hassle. Users can probably deal with + the way they end up looking in the f77.rebuilt files. + + * bld.c (ffebld_constant_new_integer4_val): INTEGER*8 + support -- new function. + (ffebld_constant_new_logical4_val): New function. + * com.c (ffecom_f2c_longint_type_node): New type. + (FFECOM_rttypeLONGINT_): New return type code. + (ffecom_expr_): Add code to invoke pow_qq instead + of pow_ii for INTEGER4 (INTEGER*8) case. + If ffecom_expr_power_integer_ returns NULL_TREE, just do + the usual work. + (ffecom_make_gfrt_): Handle new type. + (ffecom_expr_power_integer_): Let caller do the work if in + dummy-transforming case, since + caller now knows about INTEGER*8 and such, by returning + NULL_TREE. + * expr.c (ffeexpr_reduced_power_): Complain about non-INTEGER + raised to INTEGER4 (INTEGER*8) power. + + * target.c (ffetarget_power_integerdefault_integerdefault): + Fix any**negative. + * com.c (ffecom_expr_power_integer_): Fix (-1)**(-8) and similar + to ABS() the integral result if the exponent is negative + and even. + + * ste.c (ffeste_begin_iterdo_): Clean up a type ref. + Always convert iteration count to _default_ INTEGER. + + * sta.c (ffesta_second_): Add BYTE and WORD type/stmts; + changes by Scott Snyder . + * stb.c (ffestb_decl_recursive): Ditto. + (ffestb_decl_recursive): Ditto. + (ffestb_decl_entsp_2_): Ditto. + (ffestb_decl_entsp_3_): Ditto. + (ffestb_decl_funcname_2_): Ditto. + (ffestb_decl_R539): Ditto. + (ffestb_decl_R5395_): Ditto. + * stc.c (ffestc_establish_declstmt_): Ditto. + * std.c (ffestd_R539item): Ditto. + (ffestd_R1219): Ditto. + * stp.h: Ditto. + * str-1t.fin: Ditto. + * str-2t.fin: Ditto. + + * expr.c (ffeexpr_finished_): For DO loops, allow + any INTEGER type; convert LOGICAL (assuming -fugly) + to corresponding INTEGER type instead of always default + INTEGER; let later phases do conversion of DO start, + end, incr vars for implied-DO; change checks for non-integral + DO vars to be -Wsurprising warnings. + * ste.c (ffeste_io_impdo_): Convert start, end, and incr + to type of DO variable. + + * com.c (ffecom_init_0): Add new types for [IL][234], + much of which was done by Scott Snyder . + * target.c: Ditto. + * target.h: Ditto. + + Wed Mar 6 14:08:45 1996 Craig Burley + + * top.c (ffe_init_gbe_): Make -frerun-loop-opt the default. + + Mon Mar 4 12:27:00 1996 Craig Burley + + * expr.c (ffeexpr_exprstack_push_unary_): Really warn only + about two successive _arithmetic_ operators. + + * stc.c (ffestc_R522item_object): Allow SAVE of (understood) + local entity. + + * top.c (ffe_decode_option): New -f(no-)second-underscore options. + * top.h: New options. + * com.c (ffecom_get_external_identifier_, ffecom_get_identifier_): + New options. + + * Make-lang.in (f77.maintainer-clean): Clean f/BUGS, f/INSTALL, + f/NEWS. + ($(srcdir)/f/BUGS, $(srcdir)/f/INSTALL, $(srcdir)/f/NEWS): + New rules. + ($(srcdir)/f/g77.info, $(srcdir)/f/g77.dvi): Depend on + f/bugs.texi and f/news.texi. + (f77.install-man): Install f77 man pages (if enabled). + (f77.uninstall): Uninstall info docs, f77 man pages (if enabled). + + * top.c (ffe_init_gbe_): New function. + (ffe_decode_option, ffe_file): Call ffe_init_gbe_ to + set defaults for gcc options. + + Sat Jan 20 13:57:19 1996 Craig Burley + + * com.c (ffecom_get_identifier_): Eliminate needless + comparison of results of strchr. + + Tue Dec 26 11:41:56 1995 Craig Burley + + * Make-lang.in: Add rules for new files g77.texi, g77.info, + and g77.dvi. + Reorganize the *clean rules to more closely parallel gcc's. + + * config-lang.in: Exclude g77.info from diffs. + + Sun Dec 10 02:29:13 1995 Craig Burley + + * expr.c (ffeexpr_declare_unadorned_, + ffeexpr_declare_parenthesized_): Break out handling of + contextDATAIMPDO[INDEX,CTRL] so it's independent of symbol state. + Don't exec-transition these here (let ffeexpr_sym_impdoitem_ + handle that when appropriate). Don't "declare" them twice. + + Tue Dec 5 06:48:26 1995 Craig Burley + + * stc.c (ffestc_promote_sfdummy_): Allow whereNONE parent + symbol, since it is not necessarily known whether it will + become LOCAL or DUMMY. + + Mon Dec 4 03:46:55 1995 Craig Burley + + * lex.c (ffelex_display_token, ffelex_type_string_): Resurrect + these from their old versions and update them for possible invocation + from debugger. + * lex.h (ffelex_display_token): Declare this in case anyone + else wants to call it. + + * lex.c (ffelex_total_tokens_): Have this reflect actual allocated + tokens, no longer include outstanding "uses" of tokens. + + * malloc.c, malloc.h (MALLOC_DEBUG): New macro to control + checking of whether callers follow rules, now defaults to 0 + for "no checking" to improve compile times. + + * malloc.c (malloc_pool_kill): Fix bug that could prevent + subpool from actually being killed (wasn't setting its use + count to 1). + + * proj.h, *.c (dmpout): Replace all occurrences of `stdout' + and some of `stderr' with `dmpout', so where to dump debugging + output can be easily controlled during build; add default + for `dmpout' of `stderr' to proj.h. + + Sun Dec 3 00:56:29 1995 Craig Burley + + * com.c (ffecom_return_expr): Eliminate attempt at warning + about unset return values, since the back end does this better, + with better wording, and is not triggered by clearly working + (but spaghetti) code as easily as this test. + + Sat Dec 2 08:28:56 1995 Craig Burley + + * target.c (ffetarget_power_*_integerdefault): Raising 0 to + integer constant power should not be an error condition; + if so, other code should catch 0 to any power, etc. + + * bad.def (FFEBAD_BAD_POWER): 0**integer now a warning instead + of an error. + + Fri Dec 1 00:12:03 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * bad.def: Clarify diagnostic regarding complex constant elements. + * expr.c (ffeexpr_cb_comma_c_): Capitalize real/imaginary + for clarified diagnostic. + + * com.c (ffecom_close_include_): Close the file! + + * lex.c (ffelex_file_fixed): Update line info if the line + has any content, not just if it finishes a previous line + or has a label. + (ffelex_file_free): Clarify switch statement code. + + Sat Nov 18 19:37:22 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.17 released. + + Fri Nov 17 14:27:24 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Make-lang.in: Fix typo in comment. + + * Makefile.in (f/fini.o, f/proj-h.o): Don't use `$<' since + not all makes support it (e.g. NeXT make), use explicit + source name instead (with $(srcdir) and munging). + (ASSERT_H): assert.h lives in source dir, not build dir. + + Thu Nov 16 12:47:50 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * com.c (ffecom_init_0): Fix dumb bug in code to produce + warning message about non-32-bit-systems. + + * stc.c (ffestc_R501_item): Parenthesize test to make + warning go away (and perhaps fix bug). + + Thu Nov 16 03:43:33 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * g77.c: Upgrade to 2.7.0's gcc.c. + Fix -v to pass a temp name instead of "/dev/null" for "-o". + + Fri Nov 10 19:16:05 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * ste.c (ffeste_begin_iterdo_): Add Toon's change to + make loops faster on some machines (implement termination + condition as "--i >= 0" instead of "i-- > 0"). + + Thu Nov 2 03:58:17 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Make-lang.in: Remove unnecessary $(exeext) a la cp/Make-lang.in. + + * com.c (ffecom_expr_): Restore old strategy for assignp variant + of opSYMTER case...always return the ASSIGN version of var. + That way, `-O -Wuninitialized' will catch "I=3;GOTO I;END" + (though the diagnostic will refer to `__g77_ASSIGN_i'). + + * com.c (ffecom_expr_power_integer_): For constant rhs case, + wrap every new eval of lhs in save_expr() so it is clear to + back end that MULT_EXPR(lhs,lhs) has identical operands, + otherwise for an rhs like 32767 it generates around 65K pseudo + registers, with which stupid_life_analysis cannot cope + (due to reg_renumber in regs.h being `short *' instead of + `int *'). + + * com.c (ffecom_expr_): Speed up implementation of LOGICAL + versions of opNOT, opAND, opOR, opXOR/opNEQV, and opEQV by + assuming the values actually are kosher LOGICAL bit patterns. + Also simplify code that implements some of the INTEGER versions + of these. + + * com.c (skip_redundant_dir_prefix, read_name_map, + ffecom_open_include_, signed_type, unsigned_type): Fold in + changes to cccp.c made from 2.7.0 through ss-950826. + + * equiv.c (ffeequiv_layout_local_): Kill the equiv list + if no syms in list. + + * expr.c (ffeexpr_reduced_eqop2_): Issue specific diagnostic + regarding usage of .EQV./.NEQV. in preference to .EQ./.NE.. + + * intrin.c: Add ERF and ERFC as generic intrinsics. + intrin.def: Same. + + * sta.c (ffesta_save_, ffesta_second_): Whoever calls + ffestd_exec_begin must also set ffesta_seen_first_exec = TRUE, + and anytime stc sees an exec transition, it must do both. + stc.c (ffestc_eof): Same. + + * stc.c (ffestc_promote_sfdummy_): If failed implicit typing + or CHARACTER*(*) arg, after calling ffesymbol_error, don't + reset info to ENTITY/DUMMY, because ffecom_sym_transform_ + doesn't expect such a thing with ANY/ANY type. + + * target.h (*logical*): Change some of these so they parallel + changes in com.c, e.g. for _eqv_, use (l)==(r) instead of + !!(l)==!!(r), to get a more faithful result. + + Fri Oct 27 07:06:59 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * com.c (ffecom_sym_transform_): Simplify code for local + EQUIVALENCE case. + + * expr.c (ffeexpr_exprstack_push_unary_): Warn about two + successive operators. + (ffeexpr_exprstack_push_binary_): Warn about "surprising" + operator precedence, as in "-2**2". + + * lang-options.h: Add -W(no-)surprising options. + + * parse.c (yyparse): Don't reset -fpedantic if not -pedantic. + + * top.c (ffe_decode_option): Support new -Wsurprising option. + * top.h: Ditto. + + Mon Oct 23 09:14:15 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * com.c (ffecom_finish_symbol_transform_): Don't transform + NONE/NONE (CHARACTER*(*)) vars, as these don't mean anything + in debugging terms, and can't be turned into anything + in the back end (so ffecom_sym_transform_ crashes on them). + + * com.c (ffecom_expr_): Change strategy for assignp variant + of opSYMTER case...always return the original var unless + it is not wide enough. + + * ste.c (ffeste_io_cilist_): Clarify diagnostic for ASSIGN + involving too-narrow variable. This shouldn't happen, though. + (ffeste_io_icilist_): Ditto. + (ffeste_R838): Ditto. + (ffeste_R839): Ditto. + + Thu Oct 19 03:21:20 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * com.c (ffecom_sym_transform_assign_): Set TREE_STATIC + using the same decision-making process as used for their twin + variables, so ASSIGN can last across RETURN/CALL as appropriate. + + Fri Sep 22 20:21:18 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Makefile.in: fini is a host program, so it needs a host-compiled + version of proj.o, named proj-h.o. f/fini, f/fini.o, and + f/proj-h.o targets updated accordingly. + + * com.c (__eprintf): New function. + + Wed Sep 20 02:26:36 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * lang-options.h: Add omitted -funix-intrinsics-* options. + + * malloc.c (malloc_find_inpool_): Check for infinite + loop, crash if detected (user reports encountering + them in some large programs, this might help track + down the bugs). + + Thu Sep 7 13:00:32 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * com.c (lang_print_error_function): Don't dereference null + pointer when outside any program unit. + (ffecom_let_char_, ffecom_arg_ptr_to_expr): If catlist + item or length ever error_mark_node, don't continue processing, + since back-end functions like build_pointer_type crash on + error_mark_node's (due to pushing bad obstacks, etc.). + + Wed Aug 30 15:58:35 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.16 released. + + Mon Aug 28 12:24:20 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * bad.c (ffebad_finish): Fix botched message when no places + are printed (due to unknown line info, etc.). + + * std.c (ffestd_subr_labels_): Do a better job finding + line info in the case of typeANY and diagnostics. + + Fri Aug 25 15:19:29 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * com.c (DECL_ARTIFICIAL): Surround all references to this + macro with #if !BUILT_FOR_270 and #endif. + (init_lex): Surround print_error_function decl with + #if !BUILT_FOR_270 and #endif. + (lang_init): Call new ffelex_hash_kludge function to solve + problem with preprocessed files that have INCLUDE statements. + + * lex.c (ffelex_getc_): New function. + (ffelex_cfelex_): Use ffelex_getc_ instead of getc in any + paths of code that can be affected by ffelex_hash_kludge. + Don't make an EOF token for unrecognized token; set token + to NULL instead, to avoid problems when not initialized. + (ffelex_hash_): Use ffelex_getc_ instead of getc in any + paths of code that can be affected by ffelex_hash_kludge. + Test token returned by ffelex_cfelex_ for NULL, meaning + unrecognized token. + Get rid of useless used_up variable. + Don't do ffewhere stuff or kill any tokens if in + ffelex_hash_kludge. + (ffelex_file_fixed, ffelex_file_free): Use ffelex_getc_ + instead of getc in any paths of code that can be affected + by ffelex_hash_kludge. + (ffelex_hash_kludge): New function. + + * lex.h (ffelex_hash_kludge): New function. + + Wed Aug 23 15:17:40 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * com.c: Implement -f(no-)underscoring options by always + compiling in code to do it, and having that code inhibit + itself when -fno-underscoring is in effect. This option + overrides -f(no-)f2c for this purpose; -f(no-)f2c returns + to it's <=0.5.15 behavior of affecting only how code + is generated, not how/whether names are mangled. + + * target.h: Redo specification of appending underscores so + the macros are named "_default" instead of "_is" and the + two-underscore macro defaults to 1. + + * top.c, top.h (underscoring): Add appropriate stuff + for the -f(no-)underscoring options. + + Tue Aug 22 10:25:01 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * bad.c (ffebad_finish): Call report_error_function (in toplev.c) + to better identify location of problem. + Say "(continued):" instead of "(continued:)" for consistency. + + * com.c (ffecom_gen_sfuncdef_): Set and reset new + ffecom_nested_entry_ variable to hold ffesymbol being compiled. + (lang_print_error_function): New function from toplev.c. + Use ffecom_nested_entry_ to help determine which name + and kind-string to print. + (ffecom_expr_intrinsic_): Handle EXIT and FLUSH invocations + with different calling sequences than library functions. + Have SIGNAL and SYSTEM push and pop calltemps, and convert + their return values to the destination type (just in case). + (FFECOM_rttypeINT_): New return type for `int', in case + gcc/f/runtime/libF77/system_.c(system_) is really supposed + to return `int' instead of `ftnint'. + + * com.h (report_error_function): Declare this. + + * equiv.c (ffeequiv_layout_local_): Don't forget to consider + root variable itself as possible "first rooted variable", + else might never set symbol and then crash later. + + * intrin.c (ffeintrin_check_exit_): Change to allow no args + and rename to ffeintrin_check_int_1_o_ for `optional'. + #define ffeintrin_check_exit_ and _flush_ to this new + function, so intrin.def can refer to the appropriate names. + + * intrin.def (FFEINTRIN_impFLUSH): Validate using + ffeintrin_check_flush_ so passing an INTEGER arg is allowed. + + * lex.c (ffelex_file_push_, ffelex_file_pop_): New functions + to manage input_file_stack in gbe. + (ffelex_hash_): Call new functions (instead of doing code). + (ffelex_include_): Call new functions to update stack for + INCLUDE (_hash_ handles cpp output of #include). + + Mon Aug 21 08:09:04 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Makefile.in: Put `-W' in front of every `-Wall', since + 2.7.0 requires that to engage `-Wunused' for parameters. + + * com.c: Mark all parameters as artificial, so + `-W -Wunused' doesn't complain about unused ones (since + there's no way right not to individually specify attributes + like `unused'). + + * proj.h: Don't #define UNUSED if already defined, regardless + of host compiler. + + Sun Aug 20 16:03:56 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * gbe/2.7.0.diff: Regenerate. + + * lang-options.h, lang-specs.h: If not __STDC__ (ANSI C), + avoid doing anything, especially the stringizing in -specs.h. + + Thu Aug 17 03:36:12 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * lang-specs.h: Remove useless optional settings of -traditional, + since -traditional is always set anyway. + + Wed Aug 16 16:56:46 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Make-lang.in (F2C_INSTALL_FLAG, F2CLIBOK): More + control over whether to install f2c-related stuff. + (install-f2c-*): New targets to install f2c-related + stuff in system, not just gcc, directories. + + * com.c: Change calls to ffecom_get_invented_identifier + to use generally more predictable names. + Change calls to build_range_type to ensure consistency + of types of operands. + (ffecom_get_external_identifier_): Change to accept + symbol info, not just text, so it can use f2c flag for + symbol to decide whether to append underscore(s). + (ffecom_get_identifier_): Don't change names if f2c flag + off for compilation. + (ffecom_type_permanent_copy_): Use same type for new max as + used for min. + (ffecom_notify_init_storage): Offline fixups for stand-alone. + + * data.c (ffedata_gather): Explicitly test for common block, + since it's no longer always the case that a local EQUIVALENCE + group has no symbol ptr (it now can, if a user-predictable + "rooted" symbol has been identified). + + * equiv.c: Add some debugging stuff. + (ffeequiv_layout_local_): Set symbol ptr with user-predictable + "rooted" symbol, for giving the invented aggregate a + predictable name. + + * g77.c (append_arg): Allow for 20 extra args instead of 10. + (main): For version-only case, add `-fnull-version' and, unless + explicitly omitted, `-lf2c -lm'. + + * lang-options.h: New "-fnull-version" option. + + * lang-specs.h: Support ".fpp" suffix for preprocessed source + (useful for OS/2, MS-DOS, other case-insensitive systems). + + * stc.c (ffestc_R544_equiv_): Swap way lists are merged so this + is consistent with the order in which lists are built, making + user predictability of invented aggregate name much higher. + + * storag.c, storag.h (FFESTORAG_typeDUMMY): Delete this enum. + + * top.c: Accept, but otherwise ignore, `-fnull-version'. + + Tue Aug 15 07:01:07 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * DOC, INSTALL, PROJECTS: Extensive improvements to documentation. + + Sun Aug 13 01:55:18 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * INSTALL (f77-install-ok): Document the use of this file. + + * Make-lang.in (F77_INSTALL_FLAG): New flag to control + whether to install an `f77' command (based on whether + a file named `f77-install-ok' exists in the source or + build directory) to replace the broken attempt to use + comment lines to avoid installing `f77' (broken in the + sense that it prevented installation of `g77'). + + Mon Aug 7 06:14:26 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * DOC: Add new sections for g77 & gcc compiler options, + source code form, and types, sizes and precisions. + Remove lots of old "delta-version" info, or at least + summarize it. + + * INSTALL: Add info here that used to be in DOC. + Other changes. + + * g77.c (lookup_option, main): Check for --print-* options, + so we avoid adding version-determining stuff. + + Wed Jul 26 15:51:03 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Make-lang.in, Makefile.in (input.j, INPUT_H): New file. + Update dependencies accordingly. + + * bad.c (ffebad_here): Okay to use unknown line/col. + + * compilers.h (@f77-cpp-input): Remove -P option now that + # directives are handled by f771. Update other options + to be more consistent with @c in gcc/gcc.c. Don't run f771 + if -E specified, etc., a la @c. + (@f77): Don't run f771 if -E specified, etc., a la @c. + + * config-lang.in: Avoid use of word "guaranteed". + + * input.j: New file to wrap around gcc/input.h. + + * lex.j: Add support for parsing # directives output by cpp. + (ffelex_cfebackslash_): New function. + (ffelex_cfelex_): New function. + (ffelex_get_directive_line_): New function. + (ffelex_hash_): New function. + (ffelex_include_): Change to not use ffewhere_file_(begin|end). + Also fix bug in pointing to next line (for diagnostics, &c) + following successful INCLUDE. + (ffelex_next_line_): New function that does chunk of code + seen in several places elsewhere in the lexers. + (ffelex_file_fixed): Delay finishing statement until source + line is registered with ffewhere, so INCLUDE processing + picks up the info correctly. + Okay to kill or use unknown line/col objects now. + Handle HASH (#) lines. + Reorder tests for insubstantial lines to put most frequent + occurrences at top, for possible minor speedup. + Some general consolidation of code. + (ffelex_file_free): Handle HASH (#) lines. + Okay to kill or use unknown line/col objects now. + Some general consolidation of code. + (ffelex_init_1): Detect HASH (#) lines. + (ffelex_set_expecting_hollerith): Okay to kill or use unknown + line/col objects now. + + * lex.h (FFELEX_typeHASH): New enum. + + * options-lang.h (-fident, -fno-ident): New options. + + * stw.c (ffestw_update): Okay to kill unknown line/col objects + now. + + * target.h (FFETARGET_okREALQUAD, FFETARGET_okCOMPLEXDOUBLE, + FFETARGET_okCOMPLEXQUAD): #define these appropriately. + + * top.c: Include flag.j wrapper, not flags.h directly. + (ffe_is_ident_): New flag. + (ffe_decode_option): Handle -fident and -fno-ident. + (ffe_file): Replace obsolete ffewhere_file_(begin|end) with + ffewhere_file_set. + + * top.h (ffe_is_ident_, ffe_is_ident, ffe_set_is_ident): + New flag and access functions. + + * where.c, where.h: Remove all tracking of parent file. + (ffewhere_file_begin, ffewhere_file_end): Delete these. + (ffewhere_line_use): Make it work with unknown line object. + + Mon Jul 17 03:04:09 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * com.c (ffecom_sym_transform_): Set DECL_IN_SYSTEM_HEADER + flag for any local vars used as stmtfunc dummies or DATA + implied-DO iter vars, so no -Wunused warnings are produced + for them (a la f2c). + (ffecom_init_0): Do "extern int xargc;" for IARGC() intrinsic. + Warn if target machine not 32 bits, since g77 isn't yet + working on them at all well. + + * expr.c (ffeexpr_sym_lhs_call_, ffeexpr_sym_lhs_data_, + ffeexpr_sym_lhs_extfunc_, ffeexpr_sym_rhs_actualarg_, + ffeexpr_sym_rhs_let_, ffeexpr_paren_rhs_let_): Don't + gratuitously set attr bits that don't apply just + to avoid null set meaning error; instead, use explicit + error flag, and allow null attr set, to + fix certain bugs discovered by looking at this code. + + * g77.c: Major changes to improve support for gcc long options, + to make `g77 -v' report more useful info, and so on. + + Mon Jul 3 14:49:16 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * DOC, com.c, intrin.h, intrin.c, intrin.def, target.h, top.c, + top.h: Add new `unix' group of intrinsics, which includes the + newly added ERF, ERFC, EXIT, plus even newer ABORT, DERF, DERFC, + FLUSH, GETARG, GETENV, SIGNAL, and SYSTEM. + + Tue Jun 27 23:01:05 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * bld.c, bld.h (ffebld_constant_pool, + ffebld_constant_character_pool): Use a single macro (the + former) to access the pool for allocating constants, instead + of latter in public and FFEBLD_CONSTANT_POOL_ internally + in bld.c (which was the only one that was correct before + these changes). Add verification of integrity of certain + heap-allocated areas. + + * com.c (ffecom_overlap_, ffecom_args_overlap_, + ffecom_tree_canonize_ptr_, ffecom_tree_canonize_ref_): New + functions to optimize calling COMPLEX and, someday, CHARACTER + functions requiring additional argument to be passed. + (ffecom_call_, ffecom_call_binop_, ffecom_expr_, + ffecom_expr_intrinsic_): Change calling + sequences to include more info on possible destination. + (ffecom_expr_intrinsic_): Add ERF(), ERFC(), and EXIT() + intrinsic code. + (ffecom_sym_transform_): For assumed-size arrays, set high + bound to highest possible value instead of low bound, to + improve validity of overlap checking. + (duplicate_decls): If olddecl and newdecl are the same, + don't do any munging, just return affirmative. + + * expr.c: Change ffecom_constant_character_pool() to + ffecom_constant_pool(). + + * info.c (ffeinfo_new): Compile this version if not being + compiled by GNU C. + + * info.h (ffeinfo_new): Don't define macro if not being + compiled by GNU C. + + * intrin.c, intrin.def: Add ERF(), ERFC(), and EXIT() intrinsics. + (ffeintrin_check_exit_): New for EXIT() subroutine intrinsic. + + * malloc.c, malloc.h (malloc_verify_*): New functions to verify + integrity of heap-storage areas. + + * stc.c (ffestc_R834, ffestc_R835): Handle possibility that + an enclosing DO won't have a construct name even when the + CYCLE/EXIT does (i.e. without dereferencing NULL). + + * target.c, target.h (ffetarget_verify_character1): New function + to verify integrity of heap storage used to hold character constant. + + Thu Jun 22 15:36:39 1995 Howard Gordon (flash@super.org) + + * stp.h (ffestpVxtcodeIx): Fix typo in typedef for this. + + Mon May 29 15:22:31 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * *: Make all sorts of changes to accommodate upcoming gcc-2.7.0. + I didn't keep track of them, nor just when I made them, nor + when I (much later, probably in early August 1995) modified + them so they could properly handle both 2.7.0 and 2.6.x. + + * com.c (ffecom_expr_power_integer_): Don't expand_start_stmt_expr + if transforming dummy args, because the back end cannot handle + that (it's rejected by the gcc front end), just generate + call to run-time library. + Back out changes in 0.5.15 because more temporaries might be + needed anyway (for COMPLEX**INTEGER). + (ffecom_push_tempvar): Remove inhibitor. + Around start_decl and finish_decl (in particular, arround + expand_decl, which is called by them), push NULL_TREE into + sequence_rtl_expr, an external published by gcc/function.c. + This makes sure the temporary is truly in the function's + context, not the inner context of a statement-valued expression. + (I think the back end is inconsistent here, but am not + interested in convincing the gbe maintainers about this now.) + (pushdecl): Make sure that when pushing PARM_DECLs, nothing + other than them are pushed, as happened for 0.5.15 and which, + if done for other reasons not fixed here, might well indicate + some other problem -- so crash if it happens. + + * equiv.c (ffeequiv_layout_local_): If the local equiv group + has a non-nil COMMON field, it should mean that an error has + occurred and been reported, so just trash the local equiv + group and do nothing. + + * stc.c (ffestc_promote_sfdummy_): Set sfdummy arg state to + UNDERSTOOD so above checking for duplicate args actually + works, and so we don't crash later in pushdecl. + + * ste.c (ffeste_R1001): Set initial value only for VAR_DECLs, + not for, e.g., LABEL_DECLs, which the FORMAT label can be + if it was previously treated as an executable label. + + Sat May 20 01:53:53 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * com.c (ffecom_sym_transform_): For adjustable arrays, + pass high bound through variable_size in case its primaries + are changed (dumb0.f, and this might also improve + performance so it approaches f2c|gcc). + + Fri May 19 11:00:36 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.15 released. + + * com.c (ffecom_expr_power_integer_): Push temp vars + before expanding a statement expression, since that seems + to cause temp vars to be "forgotten" after the end of the + expansion in the back end. Disallow more temp-var + pushing during such an expansion, just in case. + (ffecom_push_tempvar): Crash if a new variable needs to be + pushed but cannot be at this point (should never happen). + + Wed May 17 12:26:16 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * expr.c (ffeexpr_collapse_convert): Add code to convert + LOGICAL to CHARACTER. Reject conversion of REAL or COMPLEX + to CHARACTER entirely, as it cannot be supported with all + configurations. + + * target.h, target.c (ffetarget_convert_character1_logical1): + New function. + + Sun May 14 00:00:09 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * com.c (ffecom_do_entry_, ffecom_gen_sfuncdef_, + ffecom_start_progunit_, ffecom_sym_transform_, + ffecom_init_0, start_function): Changes to have REAL + external functions return same type as DOUBLE PRECISION + external functions when -ff2c is in force; while at it, + some code cleanups done. + + * stc.c (ffestc_R547_item_object): Disallow array declarator + if one already exists for symbol. + + * ste.c (ffeste_R1227): Convert result variable to type + of function result as seen by back end (e.g. for when REAL + external function actually returns result as double). + + * target.h (FFETARGET_defaultFIXED_LINE_LENGTH): New + macro for default for -ffixed-line-length-N option. + + * top.c (ffe_fixed_line_length_): Initialize this to new + target.h macro instead of constant 72. + + Tue May 9 01:20:03 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * lex.c (ffelex_send_token_): If sending CHARACTER token with + null text field, put a single '\0' in it and set length/size + fields to 0 (to fix 950508-0.f). + (ffelex_image_char_): When setting ffelex_bad_line_ to TRUE, + always "close" card image by appending a null char and setting + ffelex_card_length_. As part of this, append useful text + to identify the two kinds of problems that involve this. + (ffelex_file_fixed): Reset ffelex_bad_line_ to FALSE after + seeing a line with invalid first character (fixes 950508-1.f). + If final nontab column is zero, assume tab seen in line. + (ffelex_card_image_): Always make this array 8 characters + longer than reflected by ffelex_card_size_. + (ffelex_init_1): Get final nontab column info from top instead + of assuming 72. + + * options-lang.h: Add -ffixed-line-length- prefix. + + * top.h: Add ffe_fixed_line_length() and _set_ version, plus + corresponding extern. + + * top.c: Handle -ffixed-line-length- option prefix. + + Fri Apr 28 05:40:25 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.14 released. + + * Make-lang.in: Add assert.j. + + * Makefile.in: Add assert.j. + + * assert.j: New file. + + Thu Apr 27 16:24:22 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * bad.h (ffebad_severity): New function. + + * bad.c (ffebad_severity): New function. + + * bad.def (FFEBAD_OPEN_INCLUDE): Change severity from SEVERE + to FATAL, since processing continues, and that seems fine. + + * com.c: Add facility to handle -I. + (ffecom_file, ffecom_close_include, ffecom_open_include, + ffecom_decode_include_option): New global functions for -I. + (ffecom_file_, ffecom_initialize_char_syntax_, + ffecom_close_include_, ffecom_decode_include_option_, + ffecom_open_include_, append_include_chain, open_include_file, + print_containing_files, read_filename_string, file_name_map, + savestring): New internal functions for -I. + + * compilers.h: Pass -I flag(s) to f771 (via "%{I*}"). + + * lex.c (ffelex_include_): Call ffecom_close_include + to close include file, for its tracking needs for -I, + instead of using fclose. + + * options-lang.h: Add -I prefix. + + * parse.c (yyparse): Call ffecom_file for main input file, + so -I handling works (diagnostics). + + * std.c (ffestd_S3P4): Have ffecom_open_include handle + opening and diagnosing errors with INCLUDE files. + + * ste.c (ffeste_begin_iterdo_): Use correct algorithm for + calculating # of iterations -- mathematically similar but + computationally different algorithm was not handling cases + like "DO I=6,5,2" correctly, because (5-6)/2+1 => 1, not 0. + + * top.c (ffe_decode_option): Allow -I, restructure a bit + for clarity and, maybe, speed. + + Mon Apr 17 13:31:11 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * g77.c: Remove -lc, turns out not all systems has it, but + leave other changes in for clarity of code. + + Sun Apr 16 21:50:33 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * com.c (ffecom_expr_): Implement ARRAY_EXPR as INDIRECT_REF + of appropriate PLUS_EXPRs of ptr_to_expr of array, to see + if this generates better code. (Conditional on + FFECOM_FASTER_ARRAY_REFS.) + + Sun Apr 16 00:22:48 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Make-lang.in (F77_SRCS): Remove g77.c, since it doesn't + contribute to building f771. + + * Makefile.in (dircheck): Remove/replace with f/Makefile, because + phony targets that are referenced in other real targets get run + when those targets are specified, which is a waste of time (e.g. + when rebuilding and only g77.c has changed, f771 was being linked + anyway). + + * g77.c: Include -lc between -lf2c and -lm throughout. + + * implic.c (ffeimplic_establish_symbol): If -Wimplicit, warn if + implicit type given to symbol. + + * lex.c (ffelex_include_): Don't gratuitously increment line + number here. + + * top.h, top.c (ffe_is_warn_implicit_): New global variable and + related access macros. + (ffe_decode_option): Handle -W options, including -Wall and + -Wimplicit. + + * where.c (ffewhere_line_new): Don't muck with root line (was + crashing on null input since lexer changes over the past week + or so). + + Thu Apr 13 16:48:30 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * com.c (ffecom_init_0): Register built-in functions for cos, + sin, and sqrt. + (ffecom_tree_fun_type_double): New variable. + (ffecom_expr_intrinsic_): Update f2c input and output files + to latest version of f2c (no important g77-related changes + noted, just bug fixes to f2c and such). + (builtin_function): New function from c-decl.c. + + * com-rt.def: Refer to built-in functions for cos, sin, and sqrt. + + Thu Apr 13 10:25:09 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * com.c (ffecom_expr_intrinsic_): Convert 0. to appropriate + type to keep DCMPLX(I) from crashing the compiler. + (ffecom_expr_): Don't convert result from ffecom_tree_divide_. + (ffecom_tree_divide_): Add tree_type argument, have all callers + pass one, and don't convert right-hand operand to it (this is + to make this new function work as much like the old in-line + code used in ffecom_expr_ as possible). + + * lex.c: Maintain lineno and input_filename the way the gcc + lexer does. + + * std.c (ffestd_exec_end): Save and restore lineno and + input_filename around the second pass, which sets them + appropriately for each saved statement. + + Wed Apr 12 09:44:45 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * com.c (ffecom_expr_power_integer_): New function. + (ffecom_expr_): Call new function for power op with integer second + argument, for generating better code. Also replace divide + code with call to new ffecom_tree_divide_ function. + Canonicalize calls to ffecom_truth_value(_invert). + (ffecom_tree_divide_): New function. + + Wed Apr 5 14:15:44 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * lex.c: Change to allocate text for tokens only when actually + needed, which should speed compilation up somewhat. + Change to allow INCLUDE at any point where a statement + can end, i.e. in ffelex_finish_statement_ or when a SEMICOLON + token is sent. + Remove some old, obsolete code. + Clean up layout of entire file to improve formatting, + readability, etc. + (ffelex_set_expecting_hollerith): Remove include argument. + + Fri Mar 31 23:19:08 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * bad.h, bad.c (ffebad_start_msg, ffebad_start_msg_lex): + New functions to generate arbitrary messages. + (FFEBAD_severityPEDANTIC): New severity, to correspond + to toplev's pedwarn() function. + + * lex.c (ffelex_backslash_): New function to implement + backslash processing. + (ffelex_file_fixed, ffelex_file_free): Implement new + backslash processing. + + * std.c (ffestd_R1001dump_): Don't assume CHARACTER and + HOLLERITH tokens stop at '\0' characters, now that backslash + processing is supported -- use their advertised lengths instead, + and double up the '\002' character for libf2c. + + Mon Mar 27 17:10:33 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * com.c (ffecom_init_local_zero_): Implement -finit-local-zero. + (ffecom_sym_transform_): Same. + (ffecom_transform_equiv_): Same. + + * options-lang.h: Add -f(no-)(init-local-zero,backslash,ugly-init). + + * stb.c (ffestb_V020): Reject "TYPEblah(...", which might be + an array assignment. + + * target.h, top.h, top.c: Implement -finit-local-zero. + + Fri Mar 24 19:56:22 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Make-lang.in, Makefile.in: Remove conf-proj(.in) and + proj.h(.in) rules, plus related config.log, config.cache, + and config.status stuff. + + * com.c (ffecom_init_0): Change messages when atof(), bsearch(), + or strtoul() do not work as expected in the start-up test. + + * conf-proj, conf-proj.in: Delete. + + * lex.c (ffelex_file_fixed): Allow f2c's '&' in column 1 + to mean continuation line. + + * options-lang.h: New file, #include'd by ../toplev.c. + + * proj.h.in: Rename back to proj.h. + + * proj.h (LAME_ASSERT): Remove. + (LAME_STDIO): Remove. + (NO_STDDEF): Remove. + (NO_STDLIB): Remove. + (NO_BSEARCH): Remove auto detection, rename to !FFEPROJ_BSEARCH. + (NO_STRTOUL): Remove auto detection, rename to !FFEPROJ_STRTOUL. + (USE_HOST_LIMITS): Remove (maybe still needed by stand-alone?). + (STR, STRX): Do only ANSI C definitions. + + Mon Mar 13 10:46:13 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * BUGS: Add item about g77 requiring gcc to compile it. + + * NEWS: New file listing user-visible changes in the release. + + * PROJECTS: Update to include a new item or two, and modify + or delete items that are addressed in this or previous releases. + + * bad.c (ffebad_finish): Don't crash if missing string &c, + just substitute obviously distressed string "[REPORT BUG!!]" + for cases where the message/caller are fudgy. + + * bad.def: Clean up error messages in a major way, add new ones + for use by changes in target.c. + + * com.c (ffecom_expr_): Handle opANY in opCONVERT. + (ffecom_let_char_): Disregard destinations with ERROR_MARK. + (ffecom_1, ffecom_1_fn, ffecom_2, ffecom_2s, ffecom_3, + ffecom_3s, &c): Check all inputs for error_mark_node. + (ffecom_start_progunit_): Don't transform all symbols + in BLOCK DATA, since it never executes, and it is silly + to, e.g., generate all the structures for NAMELIST. + (ffecom_char_length_expr_): Rename to ffecom_intrinsic_len_. + (ffecom_intrinsic_ichar_): New function to handle ICHAR of + arbitrary expression with possible 0-length operands. + (ffecom_expr_intrinsic_): Use ffecom_intrinsic_char_. + For MVBITS, set tree_type to void_type_node. + (ffecom_start_progunit_): Name master function for entry points + after primary entry point so users can easily guess it while + debugging. + (ffecom_arg_ptr_to_expr): Change treatment of Hollerith, + Typeless, and %DESCR. + (ffecom_expr_): Change treatment of Hollerith. + + * data.c (ffedata_gather_): Handle opANY in opCONVERT. + + * expr.c (ffeexpr_token_apostrophe_): Issue FFEBAD_NULL_CHAR_CONST + warning as necessary. + (ffeexpr_token_name_rhs_): Set context for args to intrinsic + so that assignment-like concatenation is allowed for ICHAR(), + IACHAR(), and LEN() intrinsics. + (ffeexpr_reduced_*_): Say "an array" instead of "an entity" in + diagnostics, since it's more informative. + (ffeexpr_finished_): For many contexts, check for null expression + and array before trying to do a conversion, to avoid redundant + diagnostics. + + * g77.1: Fix typo for preprocessed suffix (.F, not .f). + + * global.c (ffeglobal_init_common): Warn if initializing + blank common. + (ffeglobal_pad_common): Enable code to warn if initial + padding needed. + (ffeglobal_size_common): Complain if enlarging already- + initialized common, since it won't work right anyway. + + * intrin.c: Add IMAG() intrinsic. + (ffeintrin_check_loc_): Allow opSUBSTR in LOC(). + + * intrin.def: Add IMAG() intrinsic. + + * lex.c: Don't report FFEBAD_NULL_CHAR_CONST errors. + + * sta.c, sta.h, stb.c: Changes to clean up error messages (see + bad.def). + + * stb.c (ffestb_R100113_): Issue FFEBAD_NULL_CHAR_CONST + warning as necessary. + + * stc.c (ffestc_shriek_do_): Don't try to reference doref_line + stuff in ANY case, since it won't be valid. + (ffestc_R1227): Allow RETURN in main program unit, with + appropriate warnings/errors. + (ffestc_subr_format_): Array of any type is a CHAREXPR (F77 C5). + + * ste.c (ffeste_begin_doiter_): Couple of fixes to accurately + determine if loop never executes. + + * target.c (ffetarget_convert_*_hollerith_): Append spaces, + not zeros, to follow F77 Appendix C, and to warn when + truncation of non-blanks done. + (ffetarget_convert_*_typeless): Rewrite to do typeless + conversions properly, and warn when truncation done. + (ffetarget_print_binary, ffetarget_print_octal, + ffetarget_print_hex): Rewrite to use new implementation of + typeless. + (ffetarget_typeless_*): Rewrite to use new implementation + of typeless, and to warn about overflow. + + * target.h (ffetargetTypeless): New implementation of + this type. + + * type.h, type.c (ffetype_size_typeless): Remove (incorrect) + implementation of this function and its extern. + + Sun Mar 5 18:46:42 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * BUGS: Clarify that constant handling would also fix lack of + adequate IEEE-754/854 support to some degree, and typeless + and non-decimal constants. + + * com.c (ffecom_type_permanent_copy_): Comment out to avoid + warnings. + (duplicate_decls): New function a la gcc/c-decl.c. + (pushdecl): Use duplicate_decls to decide whether to return + existing decl or new one, instead of always returning existing + decl. + (ffecom_expr_): opPERCENT_LOC now supports CHARACTER arguments. + (ffecom_init_0): Give f2c I/O code 0 for basictypeANY/kindtypeANY. + (ffecom_sym_transform_): For adjustable arrays, pass low bound + through variable_size in case its primaries are changed (950302-1.f). + + * com.h: More decls that belong in tree.h &c. + + * data.c (ffedata_eval_integer1_): Fix opPAREN case to not + treat value of expression as an error code. + + * expr.c (ffeexpr_finished_): Allow opSUBSTR in contextLOC case. + + * proj.c: Add "const" as appropriate. + + Mon Feb 27 10:04:03 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * bad.def (FFEBAD_BAD_SUBSTR): Fix bad grammar in message. + + Fri Feb 24 16:21:31 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.13 released. + + * INSTALL: Warn that f/zzz.o will compare differently between + stages, since it puts the __TIME__ macro into a string. + + * com.c (ffecom_sym_transform_): Transform kindFUNCTION/whereDUMMY + to pointer-to-function, not function. + (ffecom_expr_): Use ffecom_arg_ptr_to_expr instead of + ffecom_char_args_ to handle comparison between CHARACTER + types, so either operand can be a CONCATENATE. + (ffecom_transform_common_): Set size of initialized common area + to global (largest-known) size, even though size of init might + be smaller. + + * equiv.c (ffeequiv_offset_): Check symbol info for ANY. + + * expr.c (ffeexpr_find_close_paren_, ffeexpr_nil_*): New functions + to handle following the contour of a rejected expression, so + statements like "PRINT(I,I,I)=0" don't cause the PRINT statement + code to get the second passed back to it as if there was a + missing close-paren before it, the comma causing the PRINT code + to confirm the statement, resulting in an ambiguity vis-a-vis + the let statement code. + Use the new ffecom_find_close_paren_ handler when an expected + close-paren is missing. + (ffeexpr_isdigits_): New function, use in all places that + currently use isdigit in repetitive code. + (ffeexpr_collapse_symter): Collapse to ANY if init-expr is ANY, + so as to avoid having symbol get "transformed" if used to + dimension an array. + (ffeexpr_token_real_, ffeexpr_token_number_real_): Don't issue + diagnostic about exponent, since it'll be passed along the + handler path, resulting in a diagnostic anyway. + (ffeexpr_token_apos_char_): Use consistent handler path + regardless of whether diagnostics inhibited. + (ffeexpr_token_name_apos_name_): Skip past closing quote/apos + even if not a match or other diagnostic issued. + (ffeexpr_sym_impdoitem_): Exec-transition local SEEN symbol. + + * lex.c (ffelex_image_char_): Set ffelex_saw_tab_ if TAB + seen, not if anything other than TAB seen! + + * stc.c (ffestc_R537_item): If source is ANY but dest isn't, + set dest symbol's init expr to ANY. + (ffestc_R501_attrib, ffestc_R522, ffestc_R522start): Complain + about conflict between "SAVE" by itself and other uses of + SAVE only in pedantic mode. + + * ste.c (ffeste_R1212): Fix loop over labels to always + increment caseno, to avoid pushcase returning 2 for duplicate + values when one of the labels is invalid. + + Thu Feb 23 12:42:04 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.12 released. + + * Make-lang.in (f77.install-common): Add "else true;" before outer + "fi" per Makefile.in patch. + + * Makefile.in (dircheck): Add "else true;" before "fi" per + patch from chs1pm@surrey.ac.uk. + + * com.c (ffecom_push_tempvar): If type desired is ERROR_MARK, + return error_mark_node, to avoid crash that results from + making a VAR_DECL with error_mark_node as its type. + + * ste.c (ffeste_begin_iterdo_): Convert itercount to INTEGER + anytime calculation of number of iterations ends up with type + other than INTEGER (e.g. DOUBLE PRECISION, REAL). + + Thu Feb 23 02:48:38 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.11 released. + + * DOC: Explain -fugly-args. + + * bad.def (FFEBAD_ACTUALARG): Explain -fugly-args and how to + rewrite code to not require it. + + * com.c (ffecom_vardesc_): Handle negative type code, just in + case. + (ffecom_arg_ptr_to_expr): Let ffecom_expr handle hollerith + and typeless constants (move code to ffecom_constantunion). + (ffecom_constantunion): Handle hollerith and typeless constants. + + * expr.c (ffecom_finished_): Check -fugly-args in actual-arg + context where hollerith/typeless provided. + + * intrin.def (FFEINTRIN_genDFLOAT): Add FFEINTRIN_specDFLOAT. + (FFEINTRIN_specDFLOAT): Add as f2c intrinsic. + + * target.h (ffetarget_convert_real[12]_integer, + ffetarget_convert_complex[12]_integer): Pass -1 for high integer + value if low part is negative. + (FFETARGET_defaultIS_UGLY_ARGS): New macro. + + * top.c (ffe_is_ugly_args_): New variable. + (ffe_decode_option): Handle -fugly-args and -fno-ugly-args. + + * top.h (ffe_is_ugly_args_, ffe_is_ugly_args(), + ffe_set_is_ugly_args()): New variable and macros. + + Thu Feb 23 02:48:38 1995 Pedro A M Vazquez (vazquez@iqm.unicamp.br) + + * g77.c (sys_errlist): Use const for __FreeBSD__ systems + as well. + + Wed Feb 22 13:33:43 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.10 released. + + * CREDITS: Add Rick Niles. + + * INSTALL: Note how to get around lack of makeinfo. + + * Make-lang.in (f/proj.h): Remove # comment. + + * Makefile.in (f/proj.h): Remove # comment. + + * com.c (ffecom_expr_): Simplify opFUNCREF/opSUBRREF conversion. + (ffecom_sym_transform_): For whereGLOBAL and whereDUMMY + kindFUNCTION, use ffecom_tree_fun_type[][] only for non-constant + (non-statement-function) f2c functions. + (ffecom_init_0): ffecom_tree_fun_type[][] and _ptr_to_*_* are + really f2c-interface arrays, so use base type void for COMPLEX + (like CHARACTER). + + Tue Feb 21 19:01:18 1995 Dave Love + + * Make-lang.in (f77.install-common): Expurgate the test for and + possible installation of f2c in line with elsewhere. Seems to have + been missing a semicolon anyhow! + + Tue Feb 21 11:45:25 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.9 released. + + * Make-lang.in (f/proj.h): touch file to register update, + because the previous commands won't necessarily modify it. + + * Makefile.in (f/proj.h): touch file to register update, + because the previous commands won't necessarily modify it. + + * Makefile.in (f/str-*.h, f/str-*.j): Explicitly specify + output file names, so these targets go in build, not source, + directory. + + * bits.c, bits.h: Switch to valid ANSI C replacement for + ARRAY_ZERO. + + * com.c (ffecom_expr_): Add assignp arg to support ASSIGN better. + If assignp is TRUE, use different tree for FFEBLD_opSYMTER case. + (ffecom_sym_transform_assign_): New function. + (ffecom_expr_assign): New function. + (ffecom_expr_assign_w): New function. + + * com.c (ffecom_f2c_make_type_): Do make_signed_type instead + of make_unsigned_type throughout. + + * com.c (ffecom_finish_symbol_transform_): Expand scope of + commented-out code to probably produce faster compiler code. + + * com.c (ffecom_gen_sfuncdef_): Push/pop calltemps so + COMPLEX works right. + Remove obsolete comment. + + * com.c (ffecom_start_progunit_): If non-multi alt-entry + COMPLEX function, primary (static) entry point returns result + directory, not via extra arg -- to agree with ffecom_return_expr + and others. + Pretransform all symbols so statement functions are defined + before any code emitted. + + * com.c (ffecom_finish_progunit): Don't posttransform all + symbols here -- pretransform them instead. + + * com.c (ffecom_init_0): Don't warn about possible ASSIGN + crash, as this shouldn't happen now. + + * com.c (ffecom_push_tempvar): Fix to handle temp vars + pushed while context is a statement (nested) function, and + add appropriate commentary. + + * com.c (ffecom_return_expr): Check TREE_USED to determine + where return value is unset. + + * com.h (struct _ffecom_symbol_): Add note about length_tree + now being used to keep tree for ASSIGN version of symbol. + + * com.h (ffecom_expr_assign, ffecom_expr_assign_rw): New decls. + (error): Add this prototype for back-end function. + + * fini.c (main): Grab input, output, and include names + directly off the command line instead of making the latter + two out of the first. + + * lex.c: Improve tab handling for both fixed and free source + forms, and ignore carriage-returns on input, while generally + improving the code. ffelex_handle_tab_ has been renamed and + reinvented as ffelex_image_char_, among other things. + + * malloc.c, malloc.h: Switch to valid ANSI C replacement for + ARRAY_ZERO, and kill the full number of bytes in pools and + areas. + + * proj.h.in (ARRAY_ZERO, ARRAY_ZERO_SIZE): Remove. + + * ste.c (ffeste_io_cilist_, ffeste_io_icilist_, ffeste_R838, + ffeste_R839): Issue diagnostic if a too-narrow variable used in an + ASSIGN context despite changes to this code and code in com.c. + + * where.c, where.h: Switch to valid ANSI C replacement for + ARRAY_ZERO. + + Fri Feb 17 03:35:19 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.8 released. + + * INSTALL: In quick-build case, list g77 target first so g77 + gets installed. Also, explain that gcc gets built and installed + as well, even though this isn't really what we want (and maybe + we'll find a way around this someday). + + Fri Feb 17 02:35:41 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.7 released. + + * Makefile.in (CONFIG_H, HCONFIG_H, TCONFIG_H, TM_H): Remove + ../ prefix in front of .h files, since they're in the cd. + + Fri Feb 17 01:50:48 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.6 released. + + Thu Feb 16 20:26:54 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * ../README.g77: Remove description of g77 as "not-yet-published". + + * CREDITS: More changes. + + * Make-lang.in (G77STAGESTUFF): Remove cktyps stuff. + + * Makefile.in (CONFIG_H, HCONFIG_H, TCONFIG_H, TM_H): Don't + prefix gcc dir with $(srcdir) since these don't live there, + they are created in the build dir by gcc's configure. Add + a note explaining what these macros are about. + Update dependencies via deps-kinda. + + * README.NEXTSTEP: Credit Toon, and per his request, add his + email address. + + * com.h (FFECOM_DETERMINE_TYPES): #include "config.j". + + * config.j, convert.j, flags.j, hconfig.j, rtl.j, tconfig.j, + tm.j, tree.j: Don't #include if already done. + + * convert.j: #include "tree.j" first, as convert.h clearly depends + on trees being defined. + + * rtl.j: #include "config.j" first, since there's some stuff + in rtl.h that assumes it has been #included. + + * tree.j: #include "config.j" first, or real.h makes inconsistent + decision about return type of ereal_atof, leading to bugs, and + because tree.h/real.h assume config.h already included. + + Wed Feb 15 14:40:20 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.5 released. + + * Copyright notices updated to be FSF-style. + + * INSTALL: Some more clarification regarding building just f77. + + * Make-lang.in (F77_SRCS): Update wrt changing some .h to .j. + (install-libf77): Fix typo in new parenthetical note. + + * Makefile.in (f/*.o): Update. + (CONFIG_H, CONVERT_H, FLAGS_H, GLIMITS_H, HCONFIG_H, RTL_H, + TCONFIG_H, TM_H, TREE_H): Update/new symbols. + (deps-kinda): More fixes wrt changing some .h to .j. + Document and explain this rule a bit better. + Accommodate changes in output of gcc -MM. + + * *.h, *.c: Change #include's so proj.h not assumed to #include + malloc.h or config.h (now config.j), and so new .j files are + used instead of old .h ones. + + * com.c (ffecom_init_0): Use FLOAT_TYPE_SIZE for f2c's + TYLONG/TYLOGICAL type codes, to get g77 working on Alpha. + + * com.h: Make all f2c-related integral types "int", not "long + int". + + * config.j, convert.j, flags.j, glimits.j, hconfig.j, rtl.j, + tconfig.j, tm.j, tree.j: New files wrapping around gbe + .h files. + + * config.h, convert.h, flags.h, glimits.h, hconfig.h, rtl.h, + tconfig.h, tm.h, tree.h: Deleted so new .j files + can #include the gbe files directly, instead of using "../", + and thus do better with various kinds of builds. + + * proj.h: Delete unused NO_STDDEF and related stuff. + + Tue Feb 14 08:28:08 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * BUGS: Remove item #12, cross-compiling & autoconf scripts + reportedly expected to work properly (according to d.love). + + * INSTALL: Add explanation of d.love's patch to config-lang.in. + Add explanation of how to install just g77 when gcc already installed. + Add note about usability of "-Wall". Add note about bug- + reporting. + + * Make-lang.in ($(srcdir)/f/conf-proj): Add comment about why + conf-proj.out. + (install-libf77): Echo parenthetical note to user about how to do + just the (aborted) libf2c installation. + (deps-kinda): Update to work with new configuration/build stuff. + + * bad.c (ffebad_finish): Put capitalized "warning:" &c message + as prefix on any diagnostic without pointers into source. + + * bad.def (FFEBAD_TOO_BIG_INIT): Add this warning message. + + * config-lang.in: Add Dave Love's patch to catch case where + back-end patches not applied and abort configuration. + + * data.c (ffedata_gather_, ffedata_value_): Warn when about + to initialize a large aggregate area, due to design flaw resulting + in too much time/space used to handle such cases. + Use COMMON area name, and first notice of symbol, for multiple- + initialization diagnostic, instead of member symbol and unknown + location. + (FFEDATA_sizeTOO_BIG_INIT_): New macro per above. + + Mon Feb 13 13:54:26 1995 Dave Love + + * Make-lang.in (F77_SRCS): Use $(srcdir)/f/proj.h.in, not + $(srcdir)/f/proj.h for build outside srcdir. + + Sun Feb 12 13:37:11 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * ../README.g77: Clarify procedures for unpacking, add asterisks + to mark important things the user must do. + + * Fix dates in/add dates to ../README.g77, BUGS, CREDITS, DOC, + INSTALL, PROJECTS, README. + + Sun Feb 12 00:26:10 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.4 released. + + * Make-lang.in (f/proj.h): Reproduce this rule here from + Makefile.in. + ($(srcdir)/f/conf-proj): Put autoconf's stdout in temp file + conf-proj.out, then mv to conf-proj only if successful, so + conf-proj not touched if autoconf not installed. + + * Makefile.in ($(srcdir)/conf-proj): See Make-lang.in's similar + rule. + + Sat Feb 11 20:56:02 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * BUGS: Clarify some bugs. + + * DOC: Many improvements and fixes. + + * README: Move bulk of text, edited, to ../README.g77, and + replace with pointer to that file. + + * com.c (ffecom_init_0): Comment out warning about sizeof(ftnlen) + as per ste.c change. Add text about ASSIGN to help user understand + what is being warned about. + + * conf-proj.in: Fix typos in comments. + + * proj.h.in: Add ARRAY_ZERO_SIZE to parallel malloc.h's version, + in case it proves to be needed. + + * ste.c: Comment out assertions requiring sizeof(ftnlen) >= + sizeof(char *), in the hopes that overflow will never happen. + (ffeste_R838): Change assertion to fatal() with at least + partially helpful message. + + Sat Feb 11 12:38:00 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * com.c (ffecom_vardesc_): Crash if typecode is -1. + + * ste.c (ffeste_io_dolio_): Crash if typecode is -1. + + Sat Feb 11 09:51:57 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * ste.c: In I/O code tests for item arrayness, sort of revert + to much earlier code that tests original exp, but also check + in newer way just in case. Newer way alone treated FOO(1:40) + as an array, not sure why older way alone didn't work, but I + think maybe it was when diagnosed code was involved, and + since there are now checks for error_mark_node, maybe the old + way alone would work. But better to be safe; both original + ffebld exp _and_ the transformed tree must indicate an array + for the size-determination code to be used, else just 1/2 elements + assumed. And this text is for EMACS: (foo at bar). + + Fri Feb 10 11:05:50 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * ste.c: In many cases, surround statement-expansion code + with ffecom_push_calltemps () and ffecom_pop_calltemps () + so COMPLEX-returning functions can have temporaries pushed + in "auto-pop" mode and have them auto-popped at the end of + the statement. + + Wed Feb 8 14:35:10 1995 Dave Love + + * runtime/f2c.h.in (ftnlen, ftnint): Make same size as integer. + + * runtime/libI77/err.c (f_init): Thinko in MISSING_FILE_ELEMS + conditional. + * runtime/libI77/wrtfmt.c (mv_cur): Likewise. + * runtime/libI77/wsfe.c (x_putc): Likewise. + + * runtime/libF77/signal_.c (signal_): Return 0 (this is a + subroutine). + + * Makefile.in (f/proj.h): Depend on com.h. + * Make-lang.in (include/f2c.h): Likewise (and proj.h). + (install-libf77): Also install f2c.h. + + * runtime/libI77/Makefile.in (*.o): Add f2c.h dependency. + * runtime/libF77/Makefile.in: Likewise. + + Wed Feb 8 13:56:47 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * stc.c (ffestc_R501_item): Don't reset kind/where to NONE when + setting basictype/kindtype info for symbol, or especially + its function/result twin, because kind/where might not be NONE. + + Tue Feb 7 14:47:26 1995 Dave Love + + * Make-lang.in (include/f2c.h:): Set shell variable src more + robustly (independent of whether srcdir is relative or absolute). + * Makefile.in (f/proj.h:): Likewise. + + * conf-proj.in: Check need for LAME_ASSERT. Fix indentation in + check for LAME_STDIO (cosmetic only with ANSI C). + + * com.h: Extra ...SIZE stuff taken from com.c. + + * com.c (FFECOM_DETERMINE_TYPES): Define before including com.h. + (BITS_PER_WORD etc.) Remove and use conditional definitions to com.h. + + * runtime/configure.in: #define FFECOM_DETERMINE_TYPES for com.h in + f2c type determination. + + * tm.h: Remove (at least pro tem) because of relative path and use + top-level one. + + * Make-lang.in (include/f2c.h:): Set shell variable src more + robustly (independent of whether srcdir is relative or absolute). + * Makefile.in (f/proj.h:): Likewise. + + Mon Feb 6 19:58:32 1995 Dave Love + + * g77.c (append_arg): Use K&R declaration for, e.g. SunOS4 build. + + Fri Feb 3 20:33:14 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * g77.c (main): Treat -l like filename in terms of -x handling. + Rewrite arglist mechanism for ease of maintenance. + Make sure every -lf2c is followed by -lm and vice versa. + + * Make-lang.in: Put complete list of sources in F77_SRCS def + so changing a .h file, for example, causes rebuild. + + * Makefile.in: Change test for nextstep to m68k-next-nextstep* so + all versions of nextstep on m68k get the necessary flag. + + Fri Feb 3 19:10:32 1995 Dave Love + + * INSTALL: Note about possible conflict with existing libf2c.a and + f2c.h. + + * Make-lang.in (f77.distclean): Tidy and move deletion of + f/config.cache to mostlyclean. + (install-libf77): Test for $(libdir)/libf2c.* and barf if found + unless F2CLIBOK defined. + + * runtime/Makefile.in (all): Change path to include directory (and + elsewhere). + (INCLUDES): Remove (unused/misleading). + (distclean): Include f2c.h. + (clean): Include config.cache. + + * runtime/libF77/Makefile.in (.SUFFIXES): Correct typo. + (ALL_CFLAGS) Fix up include search path to find f2c.h in top level + includes always. + (all): Depend on f2c.h. + * runtime/libI77/Makefile.in (.SUFFIXES): Likewise. + + Thu Feb 2 17:17:06 1995 Dave Love + + * INSTALL: Note about --srcdir and GNU make. + + * runtime/f2c.h.in (Pad_UDread, ALWAYS_FLUSH): Reomve the #defines + per below. + + * runtime/configure.in (Pad_UDread, ALWAYS_FLUSH): Define these + here, not in f2c.h as they'r eonly relevant for building. + * runtime/configure: Regenerated. + + * config-lang.in: Warn about using GNU make outside source tree + since I can't get Irix5 or SunOS4 makes to work in this case. + + * Makefile.in (VPATH): Don't set it here. + (srcdir): Make it the normal `.' (overridden) at top level. + (all.indirect): New dependency `dircheck'. + (f771): Likewise + (dircheck): New target for foolproofing. + (f/proj.h:): Change finding source. + (CONFIG_H): Don't use this as the relative path in the include loses + f builddir != srcdir. + + * config.h: Remove per CONFIG_H change above. + + * Make-lang.in (F77_FLAGS_TO_PASS): Remove GCC_FOR_TARGET. + (f771:): Pass VPATH, srcdir to sub-make. + (f/Makefile:): New target. + (stmp-int-hdrs): new variable for cheating build. + (f77-runtime:): Alter GCC_FOR_TARGET treatment. + (include/f2c.h f/runtime/Makefile:) Likewise. + (f77-runtime-unsafe:): New (cheating) target. + + Thu Feb 2 12:09:51 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * BUGS: Update regarding losing EQUIVALENCE members in -g, and + regarding RS/6000 problems in the back end. + + * CREDITS: Make some changes as requested. + + * com.c (ffecom_member_trunk_): Remove unused static variable. + (ffecom_finish_symbol_transform_): Improve comments. + (ffecom_let_char_): Fix size of temp address-type var. + (ffecom_member_phase2_): Try fixing problem fixed by change + to ffecom_transform_equiv_ (f_m_p2_ function currently not used). + (ffecom_transform_equiv_): Remove def of unused static variable. + Comment-out use of ffecom_member_phase2_, until problems with + back end fixed. + (ffecom_push_tempvar): Fix assertion to not crash okay code. + + * com.h: Remove old, commented-out code. + Add prototype for warning() in back end. + + * ste.c (ffeste_io_dofio_, ffeste_io_dolio_, ffeste_io_douio_, + ffeste_io_icilist_): Check correct type of variable for arrayness. + + Sun Jan 29 14:41:42 1995 Dave Love + + * BUGS: Remove references to my configure bugs; add another. + + * runtime/Makefile.in (AR_FLAGS): Provide default value. + + * runtime/f2c.h.in (integer, logical): Take typedefs from + F2C_INTEGER configuration parameter again. + (NON_UNIX_STDIO): don't define it. + + * runtime/configure.in: Bring type checks for f2c.h in line with + com.h. + (MISSING_FILE_ELEMS): New variable to determine whether the relevant + elements of the FILE struct exist, independent of NON_UNIX_STDIO. + * runtime/libI77/{err,wrtfmt,wsfe}.c (MISSING_FILE_ELEMS): Use new + parameter. + + * config-lang.in: Comment out more of f2c rules (c.f. Make-lang.in). + (This stuff is relevant iff you gave configure --enable-f2c.) + Create f/runtime directory tree iff not building in source + directory. + + * Makefile.in (srcdir): Append slash so we get the right value when + not building in the source directory. This is a consequence of not + building the `f' sources in `f'. + (VPATH): Override configure's value for reasons above. + (f/proj.h f/conf-proj): New rules to build proj.h by + autoconfiguration. + + * proj.h: Rename to proj.h.in for autoconfiguration. + * proj.h.in: New as above. + * conf-proj conf-proj.in: New files for autoconfiguration. + + * Make-lang.in (include/f2c.h f/runtime/Makefile:): Change the order + of setting the sh variables so that the right GCC_FOR_TARGET is + used. + (f77.*clean:) Add products of new configuration files and make sure + all the *clean targets do something (unlike the ones in + cp/Make-lange.in). + + * com.h (FFECOM_f2cINTEGER, FFECOM_f2cLOGICAL): Define as long or + int appropriately to ensure sizeof(real) == sizeof(integer). + + * PROJECTS: Library section. + + * runtime/libI77/endfile.c: Don't #include sys/types.h conditional + on NON_UNIX_STDIO since rawio.h needs size_t. + * runtime/libI77/uio.c: #include for size_t if not + KR_headers. + + Wed Jan 25 03:31:51 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.3 released. + + * INSTALL: Revise. + + * Make-lang.in: Comment out rules for building f2c itself (f/f2c/). + + * README: Revise. + + * com.c (ffecom_init_0): Warn if ftnlen or INTEGER not big enough + to hold a char *. + + * gbe/2.6.2.diff: Update. + + Mon Jan 23 17:10:49 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * TODO: Remove. + BUGS: New file. + PROJECTS: New file. + CREDITS: New file. + + * cktyps*: Remove. + Make-lang.in: Remove cktyps stuff. + Makefile.in: Remove cktyps stuff. + + * DOC: Add info on changes for 0.5.3. + + * bad.c: Put "warning:" &c on diagnostic messages. + Don't output informational messages if warnings disabled. + + Thu Jan 19 12:38:13 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * g77.c: Avoid putting out useless "-xnone -xf77" pairs so + larger command lines can be accommodated. + Recognize both `-xlang' and `-x lang'. + Recognize `-xnone' and `-x none' to mean what it does, instead + of treating "none" as any other language. + Some minor, slight improvements in the way args are handled + (hopefully for clearer, more maintainable code), including + consistency checks on arg count just in case. + + Wed Jan 18 16:41:57 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * DOC: Explain -fautomatic better. + + * INSTALL: Describe libf2c.a better. + + * Make-lang.in, Makefile.in: Build f771 &c with gcc/ as cd instead + of gcc/f/ so debugging info is better (source file tracking). + Add new source file type.c. + + * Makefile.in: For nextstep3, link f771 with -segaddr __DATA + 6000000. Fix typo. Change deps-kinda target to handle building + from gcc/. Update dependencies. + + * bld-op.def, bld.h, bld.c: Remove opBACKEND and all related + stuff. + Remove consistency tests that cause compiler warnings. + + * cktyps.c: Remove all typing checking. + + * com-rt.def: Change all rttypeFLOAT_ intrinsics to rttypeDOUBLE_, + to precisely match how they're declared in libf2c. + + * com.h, com.c: Revise to more elegantly track related stuff + in the version of f2c.h used to build libf2c. + + * com.c: Increase FFECOM_sizeMAXSTACKITEM, and if 0 or undefined + when checked to determine where to put entity, treat as infinite. + Rewrite temporary mechanism to be based on trees instead of + ffeinfo stuff, and make it much simpler. Change interface + accordingly. + Fixes to better track types of things, make appropriate + conversions, etc. E.g. when making an arg for a libf2c + function, make sure it's of the right type (such as ftnlen). + Delete opBACKEND transformation code. + (ffecom_init_0): Smoother initialization of types, especially + paying attention to using consistent rules for making INTEGER, + REAL, DOUBLE PRECISION, etc., and for deciding their "*N" + and kind values that will work across all g77 platforms. + No longer require per-target configuration info in target.h + or config/*/*; use new type module to store size, alignment. + (ffecom_member_phase2): Declare COMMON/EQUIVALENCE group members + so debugger sees them. + (ffecom_finish_progunit): Transform all symbols in program unit, + so -g will show they all exist. + + * expr.c (ffeexpr_collapse_substr): Handle strange substring + range values. + + * info.h, info.c: Provide connection to new type module. + Remove tests that yield compiler warnings. + + * intrin.c (ffeintrin_is_intrinsic): Properly handle deleted + intrinsic. + + * lex.c (ffelex_file_fixed): Remove redundant/buggy code. + + * stc.c (ffestc_kindtype_kind_, ffestc_kindtype_star_): Replace + boring switch stmt with simple call to new type module. This + sort of thing is a reason to get up in the morning. + + * ste.c: Update to handle new interface for + ffecom_push/pop_tempvar. + Fixes to better track types of things. + Fixes to not crash for certain diagnosed constructs. + (ffeste_begin_iterdo_): Check only constants for overflow to avoid + spurious diagnostics. + Don't convert larger integer (say, INTEGER*8) to canonical integer + for iteration count. + + * stw.h: Track DO iteration count temporary variable. + + * symbol.c: Remove consistency tests that cause compiler warnings. + + * target.c (ffetarget_aggregate_info): Replace big switch with + little call to new type module. + (ffetarget_layout): Remove consistency tests that cause + compiler warnings. + (ffetarget_convert_character1_typeless): Pick up length of + typeless type from new type module. + + * target.h: Crash build if target float bit pattern cannot be + precisely determined. + Remove all the type cruft now determined by ffecom_init_0 + at invocation time and maintained in new type module. + Put casts on second arg of all REAL_VALUE_TO_TARGET_DOUBLE + uses so compiler warnings avoided (requires target float bit + pattern to be precisely determined, hence code to crash build). + + * top.c: Add inits/terminates for new type module. + + * type.h, type.c: New module. + + * gbe/2.6.2.diff: Remove all patches to files in gcc/config/ + directory and its subdirectories. + + Mon Jan 9 19:23:25 1995 Dave Love + + * com.h (FFECOM_F2C_INTEGER_TYPE_NODE): Define and use instead of + long_integer_type_node where appropriate. + + Tue Jan 3 14:56:18 1995 Dave Love + + * com.h: Make ffecom_f2c_logical_type_node long, consistent with + integer. + + Fri Dec 2 20:07:37 1994 Dave Love + + * config-lang.in (stagestuff): Add f2c conditionally. + * Make-lang.in: Add f2c and related targets. + * f2c: Add the directory. + + Fri Nov 25 22:17:26 1994 Dave Love + + * Makefile.in (FLAGS_TO_PASS): pass $(CROSS) + * Make-lang.in: more changes to runtime targets + + Thu Nov 24 18:03:21 1994 Dave Love + + * Makefile.in (FLAGS_TO_PASS): define for sub-makes + + * g77.c (main): change f77-cpp-output to f77-cpp-input (.F files) + + Wed Nov 23 15:22:53 1994 Dave Love + + * bad.c (ffebad_finish): kluge to fool emacs19 into finding errors: + add trailing space to :: + + Tue Nov 22 11:30:50 1994 Dave Love + + * runtime/libF77/signal_.c (RETSIGTYPE): added + + Mon Nov 21 13:04:13 1994 Dave Love + + * Makefile.in (compiler): add runtime + + * config-lang.in (stagestuff): add libf2c.a to stagestuff + + * Make-lang.in: + G77STAGESTUFF <- MORESTAGESTUFF + f77-runtime: new target, plus supporting ones + + * runtime: add the directory, containing libI77, libF77 and autoconf + stuff + + * g++.1: remove + + * g77.1: minor fixes + + Thu Nov 17 15:18:05 1994 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.2 released. + + * bad.def: Modify wording of FFEBAD_UNIMPL_STMT to indicate + that it covers a wide array of possible problems (that, someday, + should be handled via separate diagnostics). + + * lex.c: Allow $ in identifiers if -fdollar-ok. + * top.c: Support -fdollar-ok. + * top.h: Support -fdollar-ok. + * target.h: Support -fdollar-ok. + * DOC: Describe -fdollar-ok. + + * std.c (ffestd_R1229_finish): Fix bug so stand-alone build works. + * ste.c (ffeste_R819A): Fix bug so stand-alone build works. + + * Make: Improvements for stand-alone build. + + * Makefile.in: Fix copyright text at top of file. + + * LINK, SRCS, UNLINK: Removed. Not particularly useful now that + g77 sources live in their own subdirectory. + + * g77.c (main): Cast arg to bzero to avoid warning. (This is + identical to Kenner's fix to cp/g++.c.) + + * gbe/: New subdirectory, to contain .diff files for various + versions of the GNU CC back end. + + * gbe/README: New file. + * gbe/2.6.2.diff: New file. + + Tue Nov 8 10:23:10 1994 Dave Love + + * Make-lang.in: don't install as f77 as well as g77 to avoid + confusion with system's compiler (especially while testing) + + * g77.c (main): use -lf2c and -lm; fix sense of test for .f/.F files + + Fri Oct 28 09:45:00 1994 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.1 released. + + * gcc.c: Invoke f771 instead of f-771. + + Fri Oct 28 02:00:44 1994 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.0 released. + + Fri Oct 14 15:03:35 1994 Craig Burley (burley@gnu.ai.mit.edu) + + * Makefile.in: Handle the Fortran-77 front-end in a subdirectory. + * f-*: Move Fortran-77 front-end to f/*. + + Local Variables: + add-log-time-format: current-time-string + End: diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/ChangeLog.egcs gcc-2.95/gcc/f/ChangeLog.egcs *** egcs-1.1.2/gcc/f/ChangeLog.egcs Wed Jul 15 03:01:19 1998 --- gcc-2.95/gcc/f/ChangeLog.egcs Wed Dec 31 16:00:00 1969 *************** *** 1,295 **** - Sat Jun 27 12:18:33 1998 Jeffrey A Law (law@cygnus.com) - - * Make-lang.in (g77): Depend on mkstemp.o. Link in mkstemp.o. - - Wed Jun 24 01:01:23 1998 Jeffrey A Law (law@cygnus.com) - - * g77spec.c (lang_specific_driver): Revert last change. - - Fri Jun 19 07:54:40 1998 H.J. Lu (hjl@gnu.org) - - * g77spec.c (lang_specific_driver): Check n_infiles before - appending args. - - Sun Jun 7 14:04:34 1998 Richard Henderson - - * com.c (lang_init_options): New function. - * top.c (ffe_decode_option): Remove all trace of -fset-g77-defaults. - Set ffe_is_do_internal_checks_ with -version. - * lang-options.h: Likewise. - * lang-specs.h: Likewise. - - Fri Jun 5 15:53:17 1998 Per Bothner - - * g77spec.c (lang_specific_pre_link, lang_specific_extra_ofiles): - Define - update needed by gcc.c change. - - Fri May 15 01:44:22 1998 Mumit Khan - - * Make-lang.in (f77.mostlyclean): Add missing exeext. - - Sat Apr 18 15:26:57 1998 Jim Wilson - - * g77spec.c (lang_specific_driver): New argument in_added_libraries. - New local added_libraries. Increment count when add library to - arglist. - - Tue Apr 14 15:51:37 1998 Dave Brolley - - * com.c (init_parse): Now returns char* containing filename; - - Thu Apr 9 00:18:44 1998 Dave Brolley (brolley@cygnus.com) - - * com.c (finput): New variable. - (init_parse): Handle !USE_CPPLIB. - (finish_parse): New function. - (lang_init): No longer declare finput. - - Sat Apr 4 17:45:01 1998 Richard Henderson - - * com.c (ffecom_expr_): Revert Oct 22 change. Instead take a WIDENP - argument so that we can respect the signedness of the original type. - (ffecom_init_0): Do sizetype initialization first. - - 1998-03-28 Dave Love - - * Make-lang.in (f771$(exeext)): Fix typo. - - 1998-03-24 Martin von Loewis - - * com.c (lang_print_xnode): New function. - - Sun Mar 22 00:50:42 1998 Nick Clifton - Geoff Noer - - * Makefile.in: Various fixes for building cygwin32 native toolchains. - * Make-lang.in: Likewise. - - Thu Mar 12 09:39:40 1998 Manfred Hollstein - - * lang-specs.h: Properly put brackets around array elements in initializer. - - Wed Mar 4 17:38:21 1998 Jeffrey A Law (law@cygnus.com) - - * Make-lang.in: Remove more references to libf77. - - Tue Mar 3 10:52:35 1998 Manfred Hollstein - - * g77.texi: Use @url for citing URLs. - - Wed Feb 11 01:44:48 1998 Richard Henderson (rth@cygnus.com) - - * com.c (ffecom_ptr_to_expr) [FFEBLD_opARRAYREF]: Do upper - lower - in the native type, so as to properly handle negative indices. - - Tue Feb 3 20:13:05 1998 Richard Henderson - - * config-lang.in: Remove references to runtime/. - - Sun Feb 1 12:43:49 1998 J"orn Rennecke - - * com.c (ffecom_tree_canonize_ptr_): Place bitsizetype typed expr - as first agument in MULT_EXPR. - Use bitsize_int (0L, 0L) as zero for bitsizes. - (ffecom_tree_canonize_ref_): - Use bitsize_int (0L, 0L) as zero for bitsizes. - (ffecom_init_0): Use set_sizetype. - - Sun Feb 1 02:26:58 1998 Richard Henderson - - * runtime directory -- moved into "libf2c" in the toplevel - directory. - * Make-lang.in: Remove all runtime related stuff. - - Sat Jan 17 21:28:08 1998 Pieter Nagel - - * Makefile.in (FLAGS_TO_PASS): Pass down gcc_include_dir and - local_prefix to sub-make invocations. - - Tue Jan 13 22:07:54 1998 Jeffrey A Law (law@cygnus.com) - - * lang-options.h: Add missing options. - - Fri Dec 19 00:12:01 1997 Richard Henderson - - * com.c (ffecom_sym_transform_): Assumed arrays have no upper bound. - - Mon Dec 15 17:35:35 1997 Richard Henderson - - * com.c (ffecom_type_vardesc_): Vardesc.dims is a `ftnlen*'. - - Tue Dec 2 09:57:16 1997 Jeffrey A Law (law@cygnus.com) - - * Make-lang.in (f77.clean): Remove g77.c. - - Tue Nov 25 15:33:28 1997 Jeffrey A Law (law@cygnus.com) - - * Make-lang.in (f77.all.build): Add $(exeext) to binary files. - (f77.all.cross, f77.start.encap): Simliarly. - - Fri Nov 21 09:35:20 1997 Fred Fish - - * Make-lang.in (stmp-f2c.h): Move inclusion of F77_FLAGS_TO_PASS - to before override of CC so that the override works. - - Thu Nov 20 00:58:14 1997 H.J. Lu (hjl@gnu.ai.mit.edu) - - * Make-lang.in (f77.install-info): Depend on f77.info. - - 1997-11-14 Dave Love - - * intrin.def: Supply gfrt for CPU_TIME. Generalize arg types of - INT2, INT8, per doc. - - Sun Nov 2 19:49:51 1997 Richard Henderson - - * com.c (ffecom_expr_): Only use TREE_TYPE argument for simple - arithmetic; convert types as necessary; recurse with target tree type. - - Wed Oct 22 11:37:41 1997 Richard Henderson - - * com.c (ffecom_expr_): Take an new arg TREE_TYPE that if non-null - specifies the type in which to do the calculation. Change all callers. - [FFEBLD_opARRAYREF]: Force the index expr to use sizetype. - - Thu Oct 16 02:04:08 1997 Paul Koning - - * Make-lang.in (stmp-f2c.h): Don't configure the runtime - directory if LANGUAGES does not include f77. - - Mon Oct 13 12:12:41 1997 Richard Henderson - - * Make-lang.in (g77*): Copied from cp/Make-lang.in g++*. - * g77spec.c: New file, mostly copied from g++spec.c - * g77.c: Removed. - - Mon Oct 6 14:15:03 1997 Jeffrey A Law (law@cygnus.com) - - * Make-lang.in (f77.mostlyclean): Clean up stuff in the - object tree too. - (f77.clean, f77.distclean, f77.maintainer-clean): Likewise. - - Wed Oct 1 01:45:36 1997 Philippe De Muyter - - * g77.c (pexecute, main): Use unlink, not remove. - - Mon Sep 29 10:37:07 1997 Jeffrey A Law (law@cygnus.com) - - * intdoc.c (main): Remove unused attribute for main's arguments. - - Sun Sep 28 01:47:17 1997 Jeffrey A Law (law@cygnus.com) - - * Make-lang.in (G77_FLAGS_TO_PASS): Pass down RANLIB, RANLIB_TEST - and AR instead of the _FOR_TARGET versions. - - Tue Sep 23 00:39:57 1997 Alexandre Oliva - - * Make-lang.in: install.texi was renamed to g77install.texi - * install0.texi: Likewise. - - Thu Sep 18 17:31:38 1997 Jeffrey A Law (law@cygnus.com) - - * proj.h (FFEPROJ_BSEARCH): Delete all references. - (FFEPROJ_STRTOUL): Likewise. - * proj.c (bsearch): Compile this if no bsearch is provided by the - host system. - (strtoul): Similarly. - - * g77install.texi: Renamed from install.texi - * g77.texi: Corresponding changes. - - * fini.c (main): Return type is int. - - * com.c (lang_printable_name): Use verbosity argument. - - Thu Sep 18 16:08:40 1997 Jeffrey A Law (law@cygnus.com) - - * Make-lang.in: Fix merge problems. - - Sun Sep 14 21:01:23 1997 Jeffrey A Law (law@cygnus.com) - - * Make-lang.in: Various changes to build info files - in the object tree rather than the source tree. - - * proj.h: Include ctype.h. - - Sun Sep 14 12:35:20 1997 Fred Fish (fnf@ninemoons.com) - - * proj.h (isascii): Provide a default definition if none is available. - - Thu Sep 11 19:26:10 1997 Dave Love - - * config-lang.in: Remove the messages about possible build problems. - - Wed Sep 10 16:39:47 1997 Jim Wilson - - * Make-lang.in (LN, LN_S): New macros, use where appropriate. - - Tue Sep 9 13:20:40 1997 Jim Wilson - - * g77.c (pexecute, doit): Add checks for __CYGWIN32__. - - Wed Aug 27 20:32:03 1997 Jeffrey A Law (law@cygnus.com) - - * top.c (ffe_decode_option): Turn on flag_move_all_moveables - and flag_reduce_all_givs. - - Mon Aug 25 23:24:32 1997 H.J. Lu (hjl@gnu.ai.mit.edu) - - * Make-lang.in ($(srcdir)/f/runtime/configure, - $(srcdir)/f/runtime/libU77/configure, f77.mostlyclean, - f77.clean, f77.distclean, f77.maintainer-clean, f77.realclean): - Handle absolute pathname of $(srcdir). - (stmp-f2c.h): New. - (include/f2c.h, f/runtime/Makefile, f/runtime/libF77/Makefile, - f/runtime/libI77/Makefile, f/runtime/libU77/Makefile): Only - depend on stmp-f2c.h. - (f77.maintainer-clean): Don't make itself. - - Sun Aug 24 17:00:27 1997 Jim Wilson - - * Make-lang.in (f77.install-info): Don't cd into srcdir. Add srcdir - to filenames. Use sed to extract base filename for install. - - Thu Aug 21 13:15:29 1997 Jim Wilson - - * Make-lang.in (f77): Delete f77-runtime. - (f77.all.build, f77.all.cross, f77.rest.encap): Add f77-runtime. - - Wed Aug 20 16:36:59 1997 Jim Wilson - - * intdoc.texi: Readd generated file. - - Mon Aug 18 09:01:54 1997 Jeffrey A Law (law@cygnus.com) - - * Makefile.in (F77_OBJS): Re-alphabetize. - * Make-lang.in (F77_SRCS): Likewise. - - Sun Aug 17 08:35:11 1997 Jeffrey A Law (law@cygnus.com) - - * INSTALL: Rebuilt. - * install.texi: Remove "Object File Differences" section. Remove - all references to zzz.o failing comparison tests. - * version.c, version.h: Renamed from zzz.c and zzz.h. Remove - date and time stamps so a 3 stage build reports no differences. - * Make-lang.in: Corresponding changes. - * Makefile.in: Likewise. - * g77.c, parse.c: Likewise. - - * intdoc.texi: Remove generated file from distribution. - - Tue Aug 12 10:23:02 1997 Jeffrey A Law (law@cygnus.com) - - * config-lang.in: Don't demand the backend patch. - * com.c (lang_printable_name): Second argument is now an int. Don't - store into the value of the second argument. - * top.c (ffe_decode_option): Temporarily disable setting - of "Toon" loop options until we figure out how to address - them. - - Mon Aug 11 23:18:35 1997 Jeffrey A Law (law@cygnus.com) - - * g77-0.5.21-19970811 Imported. - This file describes changes to the front end necessary to make - it work with egcs. - --- 0 ---- diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/INSTALL gcc-2.95/gcc/f/INSTALL *** egcs-1.1.2/gcc/f/INSTALL Mon Nov 23 02:03:36 1998 --- gcc-2.95/gcc/f/INSTALL Sat Jul 17 08:41:22 1999 *************** *** 1,248 **** ! This file contains installation information for the GNU Fortran ! compiler. Copyright (C) 1995, 1996 Free Software Foundation, Inc. You ! may copy, distribute, and modify it freely as long as you preserve this ! copyright notice and permission notice. Installing GNU Fortran ********************** The following information describes how to install `g77'. ! Note that, for `egcs' users, much of this information is obsolete, ! and is superceded by the `egcs' installation procedures. Such ! information is explicitly flagged as such. ! ! The information in this file generally pertains to dealing with ! *source* distributions of `g77' and `gcc'. It is possible that some of ! this information will be applicable to some *binary* distributions of ! these products--however, since these distributions are not made by the ! maintainers of `g77', responsibility for binary distributions rests with ! whoever built and first distributed them. ! Nevertheless, efforts to make `g77' easier to both build and install ! from source and package up as a binary distribution are ongoing. Prerequisites ============= ! *Version info:* For `egcs' users, the following information is ! superceded by the `egcs' installation instructions. ! ! The procedures described to unpack, configure, build, and install ! `g77' assume your system has certain programs already installed. ! ! The following prerequisites should be met by your system before you ! follow the `g77' installation instructions: ! ! `gzip' and `tar' ! To unpack the `gcc' and `g77' distributions, you'll need the ! `gunzip' utility in the `gzip' distribution. Most UNIX systems ! already have `gzip' installed. If yours doesn't, you can get it ! from the FSF. ! ! Note that you'll need `tar' and other utilities as well, but all ! UNIX systems have these. There are GNU versions of all these ! available--in fact, a complete GNU UNIX system can be put together ! on most systems, if desired. ! ! The version of GNU `gzip' used to package this release is ! 1.2.4. (The version of GNU `tar' used to package this release is ! 1.12.) ! ! `gcc-2.8.1.tar.gz' ! You need to have this, or some other applicable, version of `gcc' ! on your system. The version should be an exact copy of a ! distribution from the FSF. Its size is approximately 8.4MB. ! ! If you've already unpacked `gcc-2.8.1.tar.gz' into a directory ! (named `gcc-2.8.1') called the "source tree" for `gcc', you can ! delete the distribution itself, but you'll need to remember to ! skip any instructions to unpack this distribution. ! ! Without an applicable `gcc' source tree, you cannot build `g77'. ! You can obtain an FSF distribution of `gcc' from the FSF. ! ! `g77-0.5.24.tar.gz' ! You probably have already unpacked this package, or you are ! reading an advance copy of these installation instructions, which ! are contained in this distribution. The size of this package is ! approximately 1.4MB. ! ! You can obtain an FSF distribution of `g77' from the FSF, the same ! way you obtained `gcc'. ! ! Enough disk space ! The amount of disk space needed to unpack, build, install, and use ! `g77' depends on the type of system you're using, how you build ! `g77', and how much of it you install (primarily, which languages ! you install). ! ! The sizes shown below assume all languages distributed in ! `gcc-2.8.1', plus `g77', will be built and installed. These sizes ! are indicative of GNU/Linux systems on Intel x86 running COFF and ! on Digital Alpha (AXP) systems running ELF. These should be ! fairly representative of 32-bit and 64-bit systems, respectively. ! ! Note that all sizes are approximate and subject to change without ! notice! They are based on preliminary releases of g77 made shortly ! before the public beta release. ! ! -- `gcc' and `g77' distributions occupy 10MB packed, 40MB ! unpacked. These consist of the source code and documentation, ! plus some derived files (mostly documentation), for `gcc' and ! `g77'. Any deviations from these numbers for different kinds ! of systems are likely to be very minor. ! ! -- A "bootstrap" build requires an additional 91MB for a total ! of 132MB on an ix86, and an additional 136MB for a total of ! 177MB on an Alpha. ! ! -- Removing `gcc/stage1' after the build recovers 13MB for a ! total of 119MB on an ix86, and recovers 21MB for a total of ! 155MB on an Alpha. ! ! After doing this, the integrity of the build can still be ! verified via `make compare', and the `gcc' compiler modified ! and used to build itself for testing fairly quickly, using ! the copy of the compiler kept in `gcc/stage2'. ! ! -- Removing `gcc/stage2' after the build further recovers 39MB ! for a total of 80MB, and recovers 57MB for a total of 98MB on ! an Alpha. ! ! After doing this, the compiler can still be installed, ! especially if GNU `make' is used to avoid gratuitous rebuilds ! (or, the installation can be done by hand). ! ! -- Installing `gcc' and `g77' copies 23MB onto the `--prefix' ! disk for a total of 103MB on an ix86, and copies 31MB onto ! the `--prefix' disk for a total of 130MB on an Alpha. ! ! After installation, if no further modifications and builds of ! `gcc' or `g77' are planned, the source and build directory may be ! removed, leaving the total impact on a system's disk storage as ! that of the amount copied during installation. ! ! Systems with the appropriate version of `gcc' installed don't ! require the complete bootstrap build. Doing a "straight build" ! requires about as much space as does a bootstrap build followed by ! removing both the `gcc/stage1' and `gcc/stage2' directories. ! ! Installing `gcc' and `g77' over existing versions might require ! less *new* disk space, but note that, unlike many products, `gcc' ! installs itself in a way that avoids overwriting other installed ! versions of itself, so that other versions may easily be invoked ! (via `gcc -V VERSION'). ! ! So, the amount of space saved as a result of having an existing ! version of `gcc' and `g77' already installed is not ! much--typically only the command drivers (`gcc', `g77', `g++', and ! so on, which are small) and the documentation is overwritten by ! the new installation. The rest of the new installation is done ! without replacing existing installed versions (assuming they have ! different version numbers). ! ! `make' ! Your system must have `make', and you will probably save yourself ! a lot of trouble if it is GNU `make' (sometimes referred to as ! `gmake'). In particular, you probably need GNU `make' to build ! outside the source directory (with `configure''s `--srcdir' ! option.) ! ! The version of GNU `make' used to develop this release is ! 3.76.1. ! ! `cc' ! Your system must have a working C compiler. If it doesn't, you ! might be able to obtain a prebuilt binary of some version of `gcc' ! from the network or on CD-ROM, perhaps from the FSF. The best ! source of information about binaries is probably a system-specific ! Usenet news group, initially via its FAQ. ! ! *Note Installing GNU CC: (gcc)Installation, for more information ! on prerequisites for installing `gcc'. ! ! `sed' ! All UNIX systems have `sed', but some have a broken version that ! cannot handle configuring, building, or installing `gcc' or `g77'. ! ! The version of GNU `sed' used to develop this release is ! 2.05. (Note that GNU `sed' version 3.0 was withdrawn by the ! FSF--if you happen to have this version installed, replace it with ! version 2.05 immediately. See a GNU distribution site for further ! explanation.) ! ! `root' access or equivalent ! To perform the complete installation procedures on a system, you ! need to have `root' access to that system, or equivalent access to ! the `--prefix' directory tree specified on the `configure' command ! line. ! ! Portions of the procedure (such as configuring and building `g77') ! can be performed by any user with enough disk space and virtual ! memory. ! ! However, these instructions are oriented towards less-experienced ! users who want to install `g77' on their own personal systems. ! ! System administrators with more experience will want to determine ! for themselves how they want to modify the procedures described ! below to suit the needs of their installation. ! ! `autoconf' ! The version of GNU `autoconf' used to develop this release is ! 2.12. ! ! `autoconf' is not needed in the typical case of installing `gcc' ! and `g77'. *Note Missing tools?::, for information on when it ! might be needed and how to work around not having it. ! ! `bison' ! The version of GNU `bison' used to develop this release is ! 1.25. ! ! `bison' is not needed in the typical case of installing `gcc' and ! `g77'. *Note Missing tools?::, for information on when it might ! be needed and how to work around not having it. ! ! `gperf' ! The version of GNU `gperf' used to develop this release is ! 2.5. ! ! `gperf' is not needed in the typical case of installing `gcc' and ! `g77'. *Note Missing tools?::, for information on when it might ! be needed and how to work around not having it. ! ! `makeinfo' ! The version of GNU `makeinfo' used to develop this release is ! 1.68. ! ! `makeinfo' is part of the GNU `texinfo' package; `makeinfo' ! version 1.68 is distributed as part of GNU `texinfo' version ! 3.12. ! ! `makeinfo' is not needed in the typical case of installing `gcc' ! and `g77'. *Note Missing tools?::, for information on when it ! might be needed and how to work around not having it. ! ! An up-to-date version of GNU `makeinfo' is still convenient when ! obtaining a new version of a GNU distribution such as `gcc' or ! `g77', as it allows you to obtain the `.diff.gz' file instead of ! the entire `.tar.gz' distribution (assuming you have installed ! `patch'). ! ! `patch' ! The version of GNU `patch' used to develop this release is ! 2.5. ! ! Beginning with `g77' version 0.5.23, it is no longer necessary to ! patch the `gcc' back end to build `g77'. ! ! An up-to-date version of GNU `patch' is still convenient when ! obtaining a new version of a GNU distribution such as `gcc' or ! `g77', as it allows you to obtain the `.diff.gz' file instead of ! the entire `.tar.gz' distribution (assuming you have installed the ! tools needed to rebuild derived files, such as `makeinfo'). Problems Installing =================== --- 1,41 ---- ! *Note:* This file is automatically generated from the files ! `install0.texi' and `g77install.texi'. `INSTALL' is *not* a source ! file, although it is normally included within source distributions. ! ! This file contains installation information for the GNU Fortran ! compiler. Copyright (C) {No Value For "copyrights-install"} Free ! Software Foundation, Inc. You may copy, distribute, and modify it ! freely as long as you preserve this copyright notice and permission ! notice. Installing GNU Fortran ********************** The following information describes how to install `g77'. ! Note that, for users of the GCC-2.95 version of `g77', much of the ! information is obsolete, and is superceded by the GCC installation ! procedures. Such information is accordingly omitted and flagged as ! such. ! ! *Warning:* The information below is still under development, and ! might not accurately reflect the `g77' code base of which it is a part. ! Efforts are made to keep it somewhat up-to-date, but they are ! particularly concentrated on any version of this information that is ! distributed as part of a *released* `g77'. ! ! In particular, while this information is intended to apply to the ! GCC-2.95 version of `g77', only an official *release* of that version ! is expected to contain documentation that is most consistent with the ! `g77' product in that version. ! The following information was last updated on 1999-07-17: Prerequisites ============= ! For users of the GCC-2.95 version of `g77', this information is ! superceded by the GCC installation instructions. Problems Installing =================== *************** are no plans for an interim fix. *** 270,276 **** This requirement does not mean you must already have `gcc' installed to build `g77'. As long as you have a working C compiler, you can use a ! bootstrap build to automate the process of first building `gcc' using the working C compiler you have, then building `g77' and rebuilding `gcc' using that just-built `gcc', and so on. --- 63,69 ---- This requirement does not mean you must already have `gcc' installed to build `g77'. As long as you have a working C compiler, you can use a ! "bootstrap" build to automate the process of first building `gcc' using the working C compiler you have, then building `g77' and rebuilding `gcc' using that just-built `gcc', and so on. *************** not yet established. *** 291,337 **** Missing strtoul or bsearch .......................... ! *Version info:* The following information does not apply to the ! `egcs' version of `g77'. ! ! On SunOS4 systems, linking the `f771' program used to produce an ! error message concerning an undefined symbol named `_strtoul', because ! the `strtoul' library function is not provided on that system. ! ! Other systems have, in the past, been reported to not provide their ! own `strtoul' or `bsearch' function. ! ! Some versions `g77' tried to default to providing bare-bones ! versions of `bsearch' and `strtoul' automatically, but every attempt at ! this has failed for at least one kind of system. ! ! To limit the failures to those few systems actually missing the ! required routines, the bare-bones versions are still provided, in ! `gcc/f/proj.c', if the appropriate macros are defined. These are ! `NEED_BSEARCH' for `bsearch' and `NEED_STRTOUL' for `NEED_STRTOUL'. ! ! Therefore, if you are sure your system is missing `bsearch' or ! `strtoul' in its library, define the relevant macro(s) before building ! `g77'. This can be done by editing `gcc/f/proj.c' and inserting either ! or both of the following `#define' statements before the comment shown: ! ! /* Insert #define statements here. */ ! ! #define NEED_BSEARCH ! #define NEED_STRTOUL ! ! Then, continue configuring and building `g77' as usual. ! ! Or, you can define these on the `make' command line. To build with ! the bundled `cc' on SunOS4, for example, try: ! make bootstrap BOOT_CFLAGS='-O2 -g -DNEED_STRTOUL' ! ! If you then encounter problems compiling `gcc/f/proj.c', it might be ! due to a discrepancy between how `bsearch' or `strtoul' are defined by ! that file and how they're declared by your system's header files. ! ! In that case, you'll have to use some basic knowledge of C to work ! around the problem, perhaps by editing `gcc/f/proj.c' somewhat. Cleanup Kills Stage Directories ............................... --- 84,90 ---- Missing strtoul or bsearch .......................... ! This information does not apply to the GCC-2.95 version of `g77', Cleanup Kills Stage Directories ............................... *************** System-specific Problems *** 371,377 **** A linker bug on some versions of AIX 4.1 might prevent building when `g77' is built within `gcc'. It might also occur when building within ! `egcs'. *Note LINKFAIL::. Cross-compiler Problems ----------------------- --- 124,130 ---- A linker bug on some versions of AIX 4.1 might prevent building when `g77' is built within `gcc'. It might also occur when building within ! `egcs'. Cross-compiler Problems ----------------------- *************** Changing Settings Before Building *** 422,428 **** ================================= Here are some internal `g77' settings that can be changed by editing ! source files in `gcc/f/' before building. This information, and perhaps even these settings, represent stop-gap solutions to problems people doing various ports of `g77' have --- 175,181 ---- ================================= Here are some internal `g77' settings that can be changed by editing ! source files in `egcs/gcc/f/' before building. This information, and perhaps even these settings, represent stop-gap solutions to problems people doing various ports of `g77' have *************** use of unit numbers higher than 99, you *** 442,448 **** `MXUNIT' macro, which represents the maximum unit number, to an appropriately higher value. ! To do this, edit the file `f/runtime/libI77/fio.h' in your `g77' source tree, changing the following line: #define MXUNIT 100 --- 195,201 ---- `MXUNIT' macro, which represents the maximum unit number, to an appropriately higher value. ! To do this, edit the file `egcs/libf2c/libI77/fio.h' in your `g77' source tree, changing the following line: #define MXUNIT 100 *************** are building, you might wish to modify t *** 491,498 **** the version of `libg2c' is built with the `ALWAYS_FLUSH' macro defined, enabling this behavior. ! To do this, find this line in `f/runtime/f2c.h' in your `g77' source ! tree: /* #define ALWAYS_FLUSH */ --- 244,251 ---- the version of `libg2c' is built with the `ALWAYS_FLUSH' macro defined, enabling this behavior. ! To do this, find this line in `egcs/libf2c/f2c.h' in your `g77' ! source tree: /* #define ALWAYS_FLUSH */ *************** Maximum Stackable Size *** 506,512 **** `g77', on most machines, puts many variables and arrays on the stack where possible, and can be configured (by changing ! `FFECOM_sizeMAXSTACKITEM' in `gcc/f/com.c') to force smaller-sized entities into static storage (saving on stack space) or permit larger-sized entities to be put on the stack (which can improve run-time performance, as it presents more opportunities for the GBE to --- 259,265 ---- `g77', on most machines, puts many variables and arrays on the stack where possible, and can be configured (by changing ! `FFECOM_sizeMAXSTACKITEM' in `egcs/gcc/f/com.c') to force smaller-sized entities into static storage (saving on stack space) or permit larger-sized entities to be put on the stack (which can improve run-time performance, as it presents more opportunities for the GBE to *************** factor of 10. *** 541,549 **** This size currently is quite small, since `g77' currently has a known bug requiring too much memory and time to handle such cases. In ! `gcc/f/data.c', the macro `FFEDATA_sizeTOO_BIG_INIT_' is defined to the ! minimum size for the warning to appear. The size is specified in ! storage units, which can be bytes, words, or whatever, on a case-by-case basis. After changing this macro definition, you must (of course) rebuild --- 294,302 ---- This size currently is quite small, since `g77' currently has a known bug requiring too much memory and time to handle such cases. In ! `egcs/gcc/f/data.c', the macro `FFEDATA_sizeTOO_BIG_INIT_' is defined ! to the minimum size for the warning to appear. The size is specified ! in storage units, which can be bytes, words, or whatever, on a case-by-case basis. After changing this macro definition, you must (of course) rebuild *************** support 64-bit systems. *** 582,1558 **** Quick Start =========== ! *Version info:* For `egcs' users, the following information is ! superceded by the `egcs' installation instructions. ! ! This procedure configures, builds, and installs `g77' "out of the ! box" and works on most UNIX systems. Each command is identified by a ! unique number, used in the explanatory text that follows. For the most ! part, the output of each command is not shown, though indications of ! the types of responses are given in a few cases. ! ! To perform this procedure, the installer must be logged in as user ! `root'. Much of it can be done while not logged in as `root', and ! users experienced with UNIX administration should be able to modify the ! procedure properly to do so. ! ! Following traditional UNIX conventions, it is assumed that the ! source trees for `g77' and `gcc' will be placed in `/usr/src'. It also ! is assumed that the source distributions themselves already reside in ! `/usr/FSF', a naming convention used by the author of `g77' on his own ! system: ! ! /usr/FSF/gcc-2.8.1.tar.gz ! /usr/FSF/g77-0.5.24.tar.gz ! ! If you vary *any* of the steps below, you might run into trouble, ! including possibly breaking existing programs for other users of your ! system. Before doing so, it is wise to review the explanations of some ! of the steps. These explanations follow this list of steps. ! ! sh[ 1]# cd /usr/src ! ! sh[ 2]# gunzip -c < /usr/FSF/gcc-2.8.1.tar.gz | tar xf - ! [Might say "Broken pipe"...that is normal on some systems.] ! ! sh[ 3]# gunzip -c < /usr/FSF/g77-0.5.24.tar.gz | tar xf - ! ["Broken pipe" again possible.] ! ! sh[ 4]# ln -s gcc-2.8.1 gcc ! ! sh[ 5]# ln -s g77-0.5.24 g77 ! ! sh[ 6]# mv -i g77/* gcc ! [No questions should be asked by mv here; or, you made a mistake.] ! ! sh[ 7]# cd gcc ! sh[ 8]# ./configure --prefix=/usr ! [Do not do the above if gcc is not installed in /usr/bin. ! You might need a different --prefix=..., as ! described below.] ! ! sh[ 9]# make bootstrap ! [This takes a long time, and is where most problems occur.] ! ! sh[10]# make compare ! [This verifies that the compiler is `sane'. ! If any files are printed, you have likely found a g77 bug.] ! ! sh[11]# rm -fr stage1 ! ! sh[12]# make -k install ! [The actual installation.] ! ! sh[13]# g77 -v ! [Verify that g77 is installed, obtain version info.] ! ! sh[14]# ! ! *Note Updating Your Info Directory: Updating Documentation, for ! information on how to update your system's top-level `info' directory ! to contain a reference to this manual, so that users of `g77' can ! easily find documentation instead of having to ask you for it. ! ! Elaborations of many of the above steps follows: ! ! Step 1: `cd /usr/src' ! You can build `g77' pretty much anyplace. By convention, this ! manual assumes `/usr/src'. It might be helpful if other users on ! your system knew where to look for the source code for the ! installed version of `g77' and `gcc' in any case. ! ! Step 3: `gunzip -d < /usr/FSF/g77-0.5.24.tar.gz | tar xf -' ! It is not always necessary to obtain the latest version of `g77' ! as a complete `.tar.gz' file if you have a complete, earlier ! distribution of `g77'. If appropriate, you can unpack that earlier ! version of `g77', and then apply the appropriate patches to ! achieve the same result--a source tree containing version ! 0.5.24 of `g77'. ! ! Step 4: `ln -s gcc-2.8.1 gcc' ! ! Step 5: `ln -s g77-0.5.24 g77' ! These commands mainly help reduce typing, and help reduce visual ! clutter in examples in this manual showing what to type to install ! `g77'. ! ! *Note Unpacking::, for information on using distributions of `g77' ! made by organizations other than the FSF. ! ! Step 6: `mv -i g77/* gcc' ! After doing this, you can, if you like, type `rm g77' and `rmdir ! g77-0.5.24' to remove the empty directory and the symbol link to ! it. But, it might be helpful to leave them around as quick ! reminders of which version(s) of `g77' are installed on your ! system. ! ! *Note Unpacking::, for information on the contents of the `g77' ! directory (as merged into the `gcc' directory). ! ! Step 8: `./configure --prefix=/usr' ! This is where you specify that the `g77' and `gcc' executables are ! to be installed in `/usr/bin/', the `g77' and `gcc' documentation ! is to be installed in `/usr/info/' and `/usr/man/', and so on. ! ! You should ensure that any existing installation of the `gcc' ! executable is in `/usr/bin/'. ! ! However, if that existing version of `gcc' is not 2.8.1, or if you ! simply wish to avoid risking overwriting it with a newly built ! copy of the same version, you can specify `--prefix=/usr/local' ! (which is the default) or some other path, and invoke the newly ! installed version directly from that path's `bin' directory. ! ! *Note Where in the World Does Fortran (and GNU CC) Go?: Where to ! Install, for more information on determining where to install ! `g77'. *Note Configuring gcc::, for more information on the ! configuration process triggered by invoking the `./configure' ! script. ! ! Step 9: `make bootstrap' ! *Note Installing GNU CC: (gcc)Installation, for information on the ! kinds of diagnostics you should expect during this procedure. ! ! *Note Building gcc::, for complete `g77'-specific information on ! this step. ! ! Step 10: `make compare' ! *Note Where to Port Bugs: Bug Lists, for information on where to ! report that you observed files having different contents during ! this phase. ! ! *Note How to Report Bugs: Bug Reporting, for information on *how* ! to report bugs like this. ! ! Step 11: `rm -fr stage1' ! You don't need to do this, but it frees up disk space. ! ! Step 12: `make -k install' ! If this doesn't seem to work, try: ! ! make -k install install-libf77 ! ! Or, make sure you're using GNU `make'. ! ! *Note Installation of Binaries::, for more information. ! ! *Note Updating Your Info Directory: Updating Documentation, for ! information on entering this manual into your system's list of ! texinfo manuals. ! ! Step 13: `g77 -v' ! If this command prints approximately 25 lines of output, including ! the GNU Fortran Front End version number (which should be the same ! as the version number for the version of `g77' you just built and ! installed) and the version numbers for the three parts of the ! `libf2c' library (`libF77', `libI77', `libU77'), and those version ! numbers are all in agreement, then there is a high likelihood that ! the installation has been successfully completed. ! ! You might consider doing further testing. For example, log in as ! a non-privileged user, then create a small Fortran program, such ! as: ! ! PROGRAM SMTEST ! DO 10 I=1, 10 ! PRINT *, 'Hello World #', I ! 10 CONTINUE ! END ! ! Compile, link, and run the above program, and, assuming you named ! the source file `smtest.f', the session should look like this: ! ! sh# g77 -o smtest smtest.f ! sh# ./smtest ! Hello World # 1 ! Hello World # 2 ! Hello World # 3 ! Hello World # 4 ! Hello World # 5 ! Hello World # 6 ! Hello World # 7 ! Hello World # 8 ! Hello World # 9 ! Hello World # 10 ! sh# ! ! If invoking `g77' doesn't seem to work, the problem might be that ! you've installed it in a location that is not in your shell's ! search path. For example, if you specified `--prefix=/gnu', and ! `/gnu/bin' is not in your `PATH' environment variable, you must ! explicitly specify the location of the compiler via `/gnu/bin/g77 ! -o smtest smtest.f'. ! ! After proper installation, you don't need to keep your gcc and g77 ! source and build directories around anymore. Removing them can ! free up a lot of disk space. Complete Installation ===================== ! *Version info:* For `egcs' users, the following information is ! mostly superceded by the `egcs' installation instructions. ! ! Here is the complete `g77'-specific information on how to configure, ! build, and install `g77'. ! ! Unpacking ! --------- ! ! The `gcc' source distribution is a stand-alone distribution. It is ! designed to be unpacked (producing the `gcc' source tree) and built as ! is, assuming certain prerequisites are met (including the availability ! of compatible UNIX programs such as `make', `cc', and so on). ! ! However, before building `gcc', you will want to unpack and merge ! the `g77' distribution in with it, so that you build a Fortran-capable ! version of `gcc', which includes the `g77' command, the necessary ! run-time libraries, and this manual. ! ! Unlike `gcc', the `g77' source distribution is *not* a stand-alone ! distribution. It is designed to be unpacked and, afterwards, ! immediately merged into an applicable `gcc' source tree. That is, the ! `g77' distribution *augments* a `gcc' distribution--without `gcc', ! generally only the documentation is immediately usable. ! ! A sequence of commands typically used to unpack `gcc' and `g77' is: ! ! sh# cd /usr/src ! sh# gunzip -c /usr/FSF/gcc-2.8.1.tar.gz | tar xf - ! sh# gunzip -c /usr/FSF/g77-0.5.24.tar.gz | tar xf - ! sh# ln -s gcc-2.8.1 gcc ! sh# ln -s g77-0.5.24 g77 ! sh# mv -i g77/* gcc ! ! *Notes:* The commands beginning with `gunzip...' might print `Broken ! pipe...' as they complete. That is nothing to worry about, unless you ! actually *hear* a pipe breaking. The `ln' commands are helpful in ! reducing typing and clutter in installation examples in this manual. ! Hereafter, the top level of `gcc' source tree is referred to as `gcc', ! and the top level of just the `g77' source tree (prior to issuing the ! `mv' command, above) is referred to as `g77'. ! ! There are three top-level names in a `g77' distribution: ! ! g77/COPYING.g77 ! g77/README.g77 ! g77/f ! ! All three entries should be moved (or copied) into a `gcc' source ! tree (typically named after its version number and as it appears in the ! FSF distributions--e.g. `gcc-2.8.1'). ! ! `g77/f' is the subdirectory containing all of the code, ! documentation, and other information that is specific to `g77'. The ! other two files exist to provide information on `g77' to someone ! encountering a `gcc' source tree with `g77' already present, who has ! not yet read these installation instructions and thus needs help ! understanding that the source tree they are looking at does not come ! from a single FSF distribution. They also help people encountering an ! unmerged `g77' source tree for the first time. ! ! *Note:* Please use *only* `gcc' and `g77' source trees as ! distributed by the FSF. Use of modified versions is likely to result ! in problems that appear to be in the `g77' code but, in fact, are not. ! Do not use such modified versions unless you understand all the ! differences between them and the versions the FSF distributes--in which ! case you should be able to modify the `g77' (or `gcc') source trees ! appropriately so `g77' and `gcc' can coexist as they do in the stock ! FSF distributions. ! ! Merging Distributions ! --------------------- ! ! After merging the `g77' source tree into the `gcc' source tree, you ! have put together a complete `g77' source tree. ! ! As of version 0.5.23, `g77' no longer modifies the version number of ! `gcc', nor does it patch `gcc' itself. ! ! `g77' still depends on being merged with an appropriate version of ! `gcc'. For version 0.5.24 of `g77', the specific version of `gcc' ! supported is 2.8.1. ! ! However, other versions of `gcc' might be suitable "hosts" for this ! version of `g77'. ! ! GNU version numbers make it easy to figure out whether a particular ! version of a distribution is newer or older than some other version of ! that distribution. The format is, generally, MAJOR.MINOR.PATCH, with ! each field being a decimal number. (You can safely ignore leading ! zeros; for example, 1.5.3 is the same as 1.5.03.) The MAJOR field only ! increases with time. The other two fields are reset to 0 when the ! field to their left is incremented; otherwise, they, too, only increase ! with time. So, version 2.6.2 is newer than version 2.5.8, and version ! 3.0 is newer than both. (Trailing `.0' fields often are omitted in ! announcements and in names for distributions and the directories they ! create.) ! ! If your version of `gcc' is older than the oldest version supported ! by `g77' (as casually determined by listing the contents of ! `gcc/f/INSTALL/', which contains these installation instructions in ! plain-text format), you should obtain a newer, supported version of ! `gcc'. (You could instead obtain an older version of `g77', or try and ! get your `g77' to work with the old `gcc', but neither approach is ! recommended, and you shouldn't bother reporting any bugs you find if you ! take either approach, because they're probably already fixed in the ! newer versions you're not using.) ! ! If your version of `gcc' is newer than the newest version supported ! by `g77', it is possible that your `g77' will work with it anyway. If ! the version number for `gcc' differs only in the PATCH field, you might ! as well try that version of `gcc'. Since it has the same MAJOR and ! MINOR fields, the resulting combination is likely to work. ! ! So, for example, if a particular version of `g77' has support for ! `gcc' versions 2.8.0 and 2.8.1, it is likely that `gcc-2.8.2' would ! work well with `g77'. ! ! However, `gcc-2.9.0' would almost certainly not work with that ! version of `g77' without appropriate modifications, so a new version of ! `g77' would be needed (and you should wait for it rather than bothering ! the maintainers--*note User-Visible Changes: Changes.). ! ! This complexity is the result of `gcc' and `g77' being separate ! distributions. By keeping them separate, each product is able to be ! independently improved and distributed to its user base more frequently. ! ! However, the GBE interface defined by `gcc' typically undergoes some ! incompatible changes at least every time the MINOR field of the version ! number is incremented, and such changes require corresponding changes to ! the `g77' front end (FFE). ! ! Where in the World Does Fortran (and GNU CC) Go? ! ------------------------------------------------ ! ! Before configuring, you should make sure you know where you want the ! `g77' and `gcc' binaries to be installed after they're built, because ! this information is given to the configuration tool and used during the ! build itself. ! ! A `g77' installation normally includes installation of a ! Fortran-aware version of `gcc', so that the `gcc' command recognizes ! Fortran source files and knows how to compile them. ! ! For this to work, the version of `gcc' that you will be building as ! part of `g77' *must* be installed as the "active" version of `gcc' on ! the system. ! ! Sometimes people make the mistake of installing `gcc' as ! `/usr/local/bin/gcc', leaving an older, non-Fortran-aware version in ! `/usr/bin/gcc'. (Or, the opposite happens.) This can result in `gcc' ! being unable to compile Fortran source files, because when the older ! version of `gcc' is invoked, it complains that it does not recognize ! the language, or the file name suffix. ! ! So, determine whether `gcc' already is installed on your system, ! and, if so, *where* it is installed, and prepare to configure the new ! version of `gcc' you'll be building so that it installs over the ! existing version of `gcc'. ! ! You might want to back up your existing copy of `/usr/bin/gcc', and ! the entire `/usr/lib' directory, before you perform the actual ! installation (as described in this manual). ! ! Existing `gcc' installations typically are found in `/usr' or ! `/usr/local'. (This means the commands are installed in `/usr/bin' or ! `/usr/local/bin', the libraries in `/usr/lib' or `/usr/local/lib', and ! so on.) ! ! If you aren't certain where the currently installed version of `gcc' ! and its related programs reside, look at the output of this command: ! ! gcc -v -o /tmp/delete-me -xc /dev/null -xnone ! ! All sorts of interesting information on the locations of various ! `gcc'-related programs and data files should be visible in the output ! of the above command. (The output also is likely to include a ! diagnostic from the linker, since there's no `main_()' function.) ! However, you do have to sift through it yourself; `gcc' currently ! provides no easy way to ask it where it is installed and where it looks ! for the various programs and data files it calls on to do its work. ! ! Just *building* `g77' should not overwrite any installed ! programs--but, usually, after you build `g77', you will want to install ! it, so backing up anything it might overwrite is a good idea. (This is ! true for any package, not just `g77', though in this case it is ! intentional that `g77' overwrites `gcc' if it is already installed--it ! is unusual that the installation process for one distribution ! intentionally overwrites a program or file installed by another ! distribution, although, in this case, `g77' is an augmentation of the ! `gcc' distribution.) ! ! Another reason to back up the existing version first, or make sure ! you can restore it easily, is that it might be an older version on ! which other users have come to depend for certain behaviors. However, ! even the new version of `gcc' you install will offer users the ability ! to specify an older version of the actual compilation programs if ! desired, and these older versions need not include any `g77' components. ! *Note Specifying Target Machine and Compiler Version: (gcc)Target ! Options, for information on the `-V' option of `gcc'. ! ! Configuring GNU CC ! ------------------ ! ! `g77' is configured automatically when you configure `gcc'. There ! are two parts of `g77' that are configured in two different ! ways--`g77', which "camps on" to the `gcc' configuration mechanism, and ! `libg2c', which uses a variation of the GNU `autoconf' configuration ! system. ! ! Generally, you shouldn't have to be concerned with either `g77' or ! `libg2c' configuration, unless you're configuring `g77' as a ! cross-compiler. In this case, the `libg2c' configuration, and possibly ! the `g77' and `gcc' configurations as well, might need special ! attention. (This also might be the case if you're porting `gcc' to a ! whole new system--even if it is just a new operating system on an ! existing, supported CPU.) ! ! To configure the system, see *Note Installing GNU CC: ! (gcc)Installation, following the instructions for running `./configure'. ! Pay special attention to the `--prefix=' option, which you almost ! certainly will need to specify. ! ! (Note that `gcc' installation information is provided as a ! plain-text file in `gcc/INSTALL'.) ! ! The information printed by the invocation of `./configure' should ! show that the `f' directory (the Fortran language) has been configured. ! If it does not, there is a problem. ! ! *Note:* Configuring with the `--srcdir' argument, or by starting in ! an empty directory and typing a command such as `../gcc/configure' to ! build with separate build and source directories, is known to work with ! GNU `make', but it is known to not work with other variants of `make'. ! Irix5.2 and SunOS4.1 versions of `make' definitely won't work outside ! the source directory at present. ! ! `g77''s portion of the `configure' script used to issue a warning ! message about this when configuring for building binaries outside the ! source directory, but no longer does this as of version 0.5.23. ! ! Instead, `g77' simply rejects most common attempts to build it using ! a non-GNU `make' when the build directory is not the same as the source ! directory, issuing an explanatory diagnostic. ! ! Building GNU CC ! --------------- ! ! Building `g77' requires building enough of `gcc' that these ! instructions assume you're going to build all of `gcc', including ! `g++', `protoize', and so on. You can save a little time and disk ! space by changes the `LANGUAGES' macro definition in `gcc/Makefile.in' ! or `gcc/Makefile', but if you do that, you're on your own. One change ! is almost *certainly* going to cause failures: removing `c' or `f77' ! from the definition of the `LANGUAGES' macro. ! ! After configuring `gcc', which configures `g77' and `libg2c' ! automatically, you're ready to start the actual build by invoking ! `make'. ! ! *Note:* You *must* have run the `configure' script in `gcc' before ! you run `make', even if you're using an already existing `gcc' ! development directory, because `./configure' does the work to recognize ! that you've added `g77' to the configuration. ! ! There are two general approaches to building GNU CC from scratch: ! ! "bootstrap" ! This method uses minimal native system facilities to build a ! barebones, unoptimized `gcc', that is then used to compile ! ("bootstrap") the entire system. ! ! "straight" ! This method assumes a more complete native system exists, and uses ! that just once to build the entire system. ! ! On all systems without a recent version of `gcc' already installed, ! the bootstrap method must be used. In particular, `g77' uses ! extensions to the C language offered, apparently, only by `gcc'. ! ! On most systems with a recent version of `gcc' already installed, ! the straight method can be used. This is an advantage, because it ! takes less CPU time and disk space for the build. However, it does ! require that the system have fairly recent versions of many GNU ! programs and other programs, which are not enumerated here. ! ! Bootstrap Build ! ............... ! ! A complete bootstrap build is done by issuing a command beginning ! with `make bootstrap ...', as described in *Note Installing GNU CC: ! (gcc)Installation. This is the most reliable form of build, but it ! does require the most disk space and CPU time, since the complete system ! is built twice (in Stages 2 and 3), after an initial build (during ! Stage 1) of a minimal `gcc' compiler using the native compiler and ! libraries. ! ! You might have to, or want to, control the way a bootstrap build is ! done by entering the `make' commands to build each stage one at a time, ! as described in the `gcc' manual. For example, to save time or disk ! space, you might want to not bother doing the Stage 3 build, in which ! case you are assuming that the `gcc' compiler you have built is ! basically sound (because you are giving up the opportunity to compare a ! large number of object files to ensure they're identical). ! ! To save some disk space during installation, after Stage 2 is built, ! you can type `rm -fr stage1' to remove the binaries built during Stage ! 1. ! ! Also, *Note Installing GNU CC: (gcc)Installation, for important ! information on building `gcc' that is not described in this `g77' ! manual. For example, explanations of diagnostic messages and whether ! they're expected, or indicate trouble, are found there. ! ! Straight Build ! .............. ! ! If you have a recent version of `gcc' already installed on your ! system, and if you're reasonably certain it produces code that is ! object-compatible with the version of `gcc' you want to build as part ! of building `g77', you can save time and disk space by doing a straight ! build. ! ! To build just the compilers along with the necessary run-time ! libraries, issue the following command: ! ! make -k CC=gcc ! ! If you run into problems using this method, you have two options: ! ! * Abandon this approach and do a bootstrap build. ! ! * Try to make this approach work by diagnosing the problems you're ! running into and retrying. ! ! Especially if you do the latter, you might consider submitting any ! solutions as bug/fix reports. *Note Known Causes of Trouble with GNU ! Fortran: Trouble. ! ! However, understand that many problems preventing a straight build ! from working are not `g77' problems, and, in such cases, are not likely ! to be addressed in future versions of `g77'. Consider treating them as ! `gcc' bugs instead. ! ! Pre-installation Checks ! ----------------------- ! ! Before installing the system, which includes installing `gcc', you ! might want to do some minimum checking to ensure that some basic things ! work. ! ! Here are some commands you can try, and output typically printed by ! them when they work: ! ! sh# cd /usr/src/gcc ! sh# ./g77 -B./ -v ! g77 version 0.5.24 ! Driving: ./g77 -B./ -v -c -xf77-version /dev/null -xnone ! Reading specs from ./specs ! gcc version 2.8.1 ! cpp -lang-c -v -isystem ./include -undef -D__GNUC__=2 ... ! GNU CPP version 2.8.1 (Alpha GNU/Linux with ELF) ! #include "..." search starts here: ! #include <...> search starts here: ! include ! /usr/alpha-linux/include ! /usr/lib/gcc-lib/alpha-linux/2.8.1/include ! /usr/include ! End of search list. ! ./f771 -fnull-version -quiet -dumpbase g77-version.f -version ... ! GNU F77 version 2.8.1 (alpha-linux) compiled ... ! GNU Fortran Front End version 0.5.24 ! as -nocpp -o /tmp/cca14485.o /tmp/cca14485.s ! ld -m elf64alpha -G 8 -O1 -dynamic-linker /lib/ld-linux.so.2 ... ! /tmp/cca14485 ! __G77_LIBF77_VERSION__: 0.5.24 ! @(#)LIBF77 VERSION 19970919 ! __G77_LIBI77_VERSION__: 0.5.24 ! @(#) LIBI77 VERSION pjw,dmg-mods 19980405 ! __G77_LIBU77_VERSION__: 0.5.24 ! @(#) LIBU77 VERSION 19970919 ! sh# ./xgcc -B./ -v -o /tmp/delete-me -xc /dev/null -xnone ! Reading specs from ./specs ! gcc version 2.8.1 ! ./cpp -lang-c -v -isystem ./include -undef ... ! GNU CPP version 2.8.1 (Alpha GNU/Linux with ELF) ! #include "..." search starts here: ! #include <...> search starts here: ! include ! /usr/alpha-linux/include ! /usr/lib/gcc-lib/alpha-linux/2.8.1/include ! /usr/include ! End of search list. ! ./cc1 /tmp/cca18063.i -quiet -dumpbase null.c -version ... ! GNU C version 2.8.1 (alpha-linux) compiled ... ! as -nocpp -o /tmp/cca180631.o /tmp/cca18063.s ! ld -m elf64alpha -G 8 -O1 -dynamic-linker /lib/ld-linux.so.2 ... ! /usr/lib/crt1.o: In function `_start': ! ../sysdeps/alpha/elf/start.S:77: undefined reference to `main' ! ../sysdeps/alpha/elf/start.S:77: undefined reference to `main' ! sh# ! ! (Note that long lines have been truncated, and `...' used to ! indicate such truncations.) ! ! The above two commands test whether `g77' and `gcc', respectively, ! are able to compile empty (null) source files, whether invocation of ! the C preprocessor works, whether libraries can be linked, and so on. ! ! If the output you get from either of the above two commands is ! noticeably different, especially if it is shorter or longer in ways ! that do not look consistent with the above sample output, you probably ! should not install `gcc' and `g77' until you have investigated further. ! ! For example, you could try compiling actual applications and seeing ! how that works. (You might want to do that anyway, even if the above ! tests work.) ! ! To compile using the not-yet-installed versions of `gcc' and `g77', ! use the following commands to invoke them. ! ! To invoke `g77', type: ! ! /usr/src/gcc/g77 -B/usr/src/gcc/ ... ! ! To invoke `gcc', type: ! ! /usr/src/gcc/xgcc -B/usr/src/gcc/ ... ! ! Installation of Binaries ! ------------------------ ! ! After configuring, building, and testing `g77' and `gcc', when you ! are ready to install them on your system, type: ! ! make -k CC=gcc install ! ! As described in *Note Installing GNU CC: (gcc)Installation, the ! values for the `CC' and `LANGUAGES' macros should be the same as those ! you supplied for the build itself. ! ! So, the details of the above command might vary if you used a ! bootstrap build (where you might be able to omit both definitions, or ! might have to supply the same definitions you used when building the ! final stage) or if you deviated from the instructions for a straight ! build. ! ! If the above command does not install `libg2c.a' as expected, try ! this: ! ! make -k ... install install-libf77 ! ! We don't know why some non-GNU versions of `make' sometimes require ! this alternate command, but they do. (Remember to supply the ! appropriate definition for `CC' where you see `...' in the above ! command.) ! ! Note that using the `-k' option tells `make' to continue after some ! installation problems, like not having `makeinfo' installed on your ! system. It might not be necessary for your system. ! ! *Note:* `g77' no longer installs files not directly part of `g77', ! such as `/usr/bin/f77', `/usr/lib/libf2c.a', and `/usr/include/f2c.h', ! or their `/usr/local' equivalents. ! ! *Note Distributing Binaries::, for information on how to accommodate ! systems with no existing non-`g77' `f77' compiler and systems with ! `f2c' installed. ! ! Updating Your Info Directory ! ---------------------------- ! ! As part of installing `g77', you should make sure users of `info' ! can easily access this manual on-line. ! ! `g77' does this automatically by invoking the `install-info' command ! when you use `make install' to install `g77'. ! ! If that fails, or if the `info' directory it updates is not the one ! normally accessed by users, consider invoking it yourself. For example: ! ! install-info --info-dir=/usr/info /usr/info/g77.info ! ! The above example assumes the `g77' documentation already is ! installed in `/usr/info' and that `/usr/info/dir' is the file you wish ! to update. Adjust the command accordingly, if those assumptions are ! wrong. ! ! Missing tools? ! -------------- ! ! A build of `gcc' might fail due to one or more tools being called ! upon by `make' (during the build or install process), when those tools ! are not installed on your system. ! ! This situation can result from any of the following actions ! (performed by you or someone else): ! ! * Changing the source code or documentation yourself (as a developer ! or technical writer). ! ! * Applying a patch that changes the source code or documentation ! (including, sometimes, the official patches distributed by the ! FSF). ! ! * Deleting the files that are created by the (missing) tools. ! ! The `make maintainer-clean' command is supposed to delete these ! files, so invoking this command without having all the appropriate ! tools installed is not recommended. ! ! * Creating the source directory using a method that does not ! preserve the date-time-modified information in the original ! distribution. ! ! For example, the UNIX `cp -r' command copies a directory tree ! without preserving the date-time-modified information. Use `cp ! -pr' instead. ! ! The reason these activities cause `make' to try and invoke tools ! that it probably wouldn't when building from a perfectly "clean" source ! directory containing `gcc' and `g77' is that some files in the source ! directory (and the corresponding distribution) aren't really source ! files, but *derived* files that are produced by running tools with the ! corresponding source files as input. These derived files "depend", in ! `make' terminology, on the corresponding source files. ! ! `make' determines that a file that depends on another needs to be ! updated if the date-time-modified information for the source file shows ! that it is newer than the corresponding information for the derived ! file. ! ! If it makes that determination, `make' runs the appropriate commands ! (specified in the "Makefile") to update the derived file, and this ! process typically calls upon one or more installed tools to do the work. ! ! The "safest" approach to dealing with this situation is to recreate ! the `gcc' and `g77' source directories from complete `gcc' and `g77' ! distributions known to be provided by the FSF. ! ! Another fairly "safe" approach is to simply install the tools you ! need to complete the build process. This is especially appropriate if ! you've changed the source code or applied a patch to do so. ! ! However, if you're certain that the problem is limited entirely to ! incorrect date-time-modified information, that there are no ! discrepancies between the contents of source files and files derived ! from them in the source directory, you can often update the ! date-time-modified information for the derived files to work around the ! problem of not having the appropriate tools installed. ! ! On UNIX systems, the simplest way to update the date-time-modified ! information of a file is to use the use the `touch' command. ! ! How to use `touch' to update the derived files updated by each of ! the tools is described below. *Note:* New versions of `g77' might ! change the set of files it generates by invoking each of these tools. ! If you cannot figure out for yourself how to handle such a situation, ! try an older version of `g77' until you find someone who can (or until ! you obtain and install the relevant tools). ! ! Missing `autoconf'? ! ................... ! ! If you cannot install `autoconf', make sure you have started with a ! *fresh* distribution of `gcc' and `g77', do *not* do `make ! maintainer-clean', and, to ensure that `autoconf' is not invoked by ! `make' during the build, type these commands: ! ! sh# cd gcc/f/runtime ! sh# touch configure libU77/configure ! sh# cd ../../.. ! sh# ! ! Missing `bison'? ! ................ ! ! If you cannot install `bison', make sure you have started with a ! *fresh* distribution of `gcc', do *not* do `make maintainer-clean', ! and, to ensure that `bison' is not invoked by `make' during the build, ! type these commands: ! ! sh# cd gcc ! sh# touch bi-parser.c bi-parser.h c-parse.c c-parse.h cexp.c ! sh# touch cp/parse.c cp/parse.h objc-parse.c ! sh# cd .. ! sh# ! ! Missing `gperf'? ! ................ ! ! If you cannot install `gperf', make sure you have started with a ! *fresh* distribution of `gcc', do *not* do `make maintainer-clean', ! and, to ensure that `gperf' is not invoked by `make' during the build, ! type these commands: ! ! sh# cd gcc ! sh# touch c-gperf.h ! sh# cd .. ! sh# ! ! Missing `makeinfo'? ! ................... ! ! If `makeinfo' is needed but unavailable when installing (via `make ! install'), some files, like `libg2c.a', might not be installed, because ! once `make' determines that it cannot invoke `makeinfo', it cancels any ! further processing. ! ! If you cannot install `makeinfo', an easy work-around is to specify ! `MAKEINFO=true' on the `make' command line, or to specify the `-k' ! option (`make -k install'). ! ! Another approach is to force the relevant files to be up-to-date by ! typing these commands and then re-trying the installation step: ! ! sh# cd gcc ! sh# touch f/g77.info f/BUGS f/INSTALL f/NEWS ! sh# cd .. ! sh# Distributing Binaries ===================== ! If you are building `g77' for distribution to others in binary form, ! first make sure you are aware of your legal responsibilities (read the ! file `gcc/COPYING' thoroughly). ! ! Then, consider your target audience and decide where `g77' should be ! installed. ! ! For systems like GNU/Linux that have no native Fortran compiler (or ! where `g77' could be considered the native compiler for Fortran and ! `gcc' for C, etc.), you should definitely configure `g77' for ! installation in `/usr/bin' instead of `/usr/local/bin'. Specify the ! `--prefix=/usr' option when running `./configure'. ! ! You might also want to set up the distribution so the `f77' command ! is a link to `g77', although a script that accepts "classic" UNIX `f77' ! options and translates the command-line to the appropriate `g77' ! command line would be more appropriate. If you do this, *please* also ! provide a "man page" in `man/man1/f77.1' describing the command. (A ! link to `man/man1/g77.1' is appropriate if `bin/f77' is a link to ! `bin/g77'.) ! ! For a system that might already have `f2c' installed, consider ! whether inter-operation with `g77' will be important to users of `f2c' ! on that system. If you want to improve the likelihood that users will ! be able to use both `f2c' and `g77' to compile code for a single program ! without encountering link-time or run-time incompatibilities, make sure ! that, whenever they intend to combine `f2c'-produced code with ! `g77'-produced code in an executable, they: ! ! * Use the `lib/gcc-lib/.../include/g2c.h' file generated by the ! `g77' build in place of the `f2c.h' file that normally comes with ! `f2c' (or versions of `g77' prior to 0.5.23) when compiling *all* ! of the `f2c'-produced C code ! ! * Link to the `lib/gcc-lib/.../libg2c.a' library built by the `g77' ! build instead of the `libf2c.a' library that normally comes with ! `f2c' (or versions of `g77' prior to 0.5.23) ! ! How you choose to effect the above depends on whether the existing ! installation of `f2c' must be maintained. ! ! In any case, it is important to try and ensure that the installation ! keeps working properly even after subsequent re-installation of `f2c', ! which probably involves overwriting `/usr/local/lib/libf2c.a' and ! `/usr/local/include/f2c.h', or similar. ! ! At least, copying `libg2c.a' and `g2c.h' into the appropriate ! "public" directories allows users to more easily select the version of ! `libf2c' they wish to use for a particular build. The names are ! changed by `g77' to make this coexistence easier to maintain; even if ! `f2c' is installed later, the `g77' files normally installed by its ! installation process aren't disturbed. Use of symbolic links from one ! set of files to another might result in problems after a subsequent ! reinstallation of either `f2c' or `g77', so be sure to alert users of ! your distribution accordingly. ! ! (Make sure you clearly document, in the description of your ! distribution, how installation of your distribution will affect ! existing installations of `gcc', `f2c', `f77', `libf2c.a', and so on. ! Similarly, you should clearly document any requirements you assume will ! be met by users of your distribution.) ! ! For other systems with native `f77' (and `cc') compilers, configure ! `g77' as you (or most of your audience) would configure `gcc' for their ! installations. Typically this is for installation in `/usr/local', and ! would not include a new version of `/usr/bin/f77' or ! `/usr/local/bin/f77', so users could still use the native `f77'. ! ! In any case, for `g77' to work properly, you *must* ensure that the ! binaries you distribute include: ! ! `bin/g77' ! This is the command most users use to compile Fortran. ! ! `bin/gcc' ! This is the command some users use to compile Fortran, typically ! when compiling programs written in other languages at the same ! time. The `bin/gcc' executable file must have been built from a ! `gcc' source tree into which a `g77' source tree was merged and ! configured, or it will not know how to compile Fortran programs. ! ! `info/g77.info*' ! This is the documentation for `g77'. If it is not included, users ! will have trouble understanding diagnostics messages and other ! such things, and will send you a lot of email asking questions. ! ! Please edit this documentation (by editing `gcc/f/*.texi' and ! doing `make doc' from the `/usr/src/gcc' directory) to reflect any ! changes you've made to `g77', or at least to encourage users of ! your binary distribution to report bugs to you first. ! ! Also, whether you distribute binaries or install `g77' on your own ! system, it might be helpful for everyone to add a line listing ! this manual by name and topic to the top-level `info' node in ! `/usr/info/dir'. That way, users can find `g77' documentation more ! easily. *Note Updating Your Info Directory: Updating ! Documentation. ! ! `man/man1/g77.1' ! This is the short man page for `g77'. It is not always kept ! up-to-date, but you might as well include it for people who really ! like "man" pages. ! ! `lib/gcc-lib' ! This is the directory containing the "private" files installed by ! and for `gcc', `g77', `g++', and other GNU compilers. ! ! `lib/gcc-lib/.../f771' ! This is the actual Fortran compiler. ! ! `lib/gcc-lib/.../libg2c.a' ! This is the run-time library for `g77'-compiled programs. ! ! Whether you want to include the slightly updated (and possibly ! improved) versions of `cc1', `cc1plus', and whatever other binaries get ! rebuilt with the changes the GNU Fortran distribution makes to the GNU ! back end, is up to you. These changes are highly unlikely to break any ! compilers, because they involve doing things like adding to the list of ! acceptable compiler options (so, for example, `cc1plus' accepts, and ! ignores, options that only `f771' actually processes). ! ! Please assure users that unless they have a specific need for their ! existing, older versions of `gcc' command, they are unlikely to ! experience any problems by overwriting it with your version--though ! they could certainly protect themselves by making backup copies first! ! ! Otherwise, users might try and install your binaries in a "safe" ! place, find they cannot compile Fortran programs with your distribution ! (because, perhaps, they're invoking their old version of the `gcc' ! command, which does not recognize Fortran programs), and assume that ! your binaries (or, more generally, GNU Fortran distributions in ! general) are broken, at least for their system. ! ! Finally, *please* ask for bug reports to go to you first, at least ! until you're sure your distribution is widely used and has been well ! tested. This especially goes for those of you making any changes to ! the `g77' sources to port `g77', e.g. to OS/2. has ! received a fair number of bug reports that turned out to be problems ! with other peoples' ports and distributions, about which nothing could ! be done for the user. Once you are quite certain a bug report does not ! involve your efforts, you can forward it to us. --- 335,352 ---- Quick Start =========== ! For users of the GCC-2.95 version of `g77', this information is ! superceded by the GCC installation instructions. Complete Installation ===================== ! For users of the GCC-2.95 version of `g77', this information is ! superceded by the GCC installation instructions. Distributing Binaries ===================== ! For users of the GCC-2.95 version of `g77', this information is ! superceded by the GCC installation instructions. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/Make-lang.in gcc-2.95/gcc/f/Make-lang.in *** egcs-1.1.2/gcc/f/Make-lang.in Fri Feb 26 04:55:40 1999 --- gcc-2.95/gcc/f/Make-lang.in Sun Jun 6 23:44:57 1999 *************** F77 f77: f771$(exeext) *** 59,74 **** f77.extraclean f77.maintainer-clean f77.distdir f77.rebuilt \ f77.stage1 f77.stage2 f77.stage3 f77.stage4 - g77.c: $(srcdir)/gcc.c - case "$(LANGUAGES)" in \ - *[fF]77*) touch lang-f77;; \ - *) rm -f lang-f77;; \ - esac - if [ -f lang-f77 ]; then \ - rm -f g77.c; \ - $(LN_S) $(srcdir)/gcc.c g77.c; \ - else true; fi - g77spec.o: $(srcdir)/f/g77spec.c $(srcdir)/f/version.h case "$(LANGUAGES)" in \ *[fF]77*) touch lang-f77;; \ --- 59,64 ---- *************** g77version.o: $(srcdir)/f/version.c *** 88,113 **** $(srcdir)/f/version.c; \ else true; fi - # N.B.: This is a copy of the gcc.o rule, with -DLANG_SPECIFIC_DRIVER added. - # It'd be nice if we could find an easier way to do this---rather than have - # to track changes to the toplevel gcc Makefile as well. - # We depend on g77.c last, to make it obvious where it came from. - g77.o: $(CONFIG_H) multilib.h config.status $(lang_specs_files) g77.c - case "$(LANGUAGES)" in \ - *[fF]77*) touch lang-f77;; \ - *) rm -f lang-f77;; \ - esac - if [ -f lang-f77 ]; then \ - $(CC) $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) $(DRIVER_DEFINES) \ - -DLANG_SPECIFIC_DRIVER -c g77.c; \ - else true; fi - # Create the compiler driver for g77. ! g77$(exeext): g77.o g77spec.o g77version.o version.o choose-temp.o pexecute.o prefix.o mkstemp.o \ $(LIBDEPS) $(EXTRA_GCC_OBJS) if [ -f lang-f77 ]; then \ ! $(CC) $(ALL_CFLAGS) $(LDFLAGS) -o $@ g77.o g77spec.o g77version.o \ ! version.o choose-temp.o pexecute.o prefix.o mkstemp.o $(EXTRA_GCC_OBJS) $(LIBS); \ else true; fi # Create a version of the g77 driver which calls the cross-compiler. --- 78,89 ---- $(srcdir)/f/version.c; \ else true; fi # Create the compiler driver for g77. ! g77$(exeext): gcc.o g77spec.o g77version.o version.o prefix.o intl.o \ $(LIBDEPS) $(EXTRA_GCC_OBJS) if [ -f lang-f77 ]; then \ ! $(CC) $(ALL_CFLAGS) $(LDFLAGS) -o $@ gcc.o g77spec.o g77version.o \ ! version.o prefix.o intl.o $(EXTRA_GCC_OBJS) $(LIBS); \ else true; fi # Create a version of the g77 driver which calls the cross-compiler. *************** F77_SRCS = \ *** 227,233 **** f771$(exeext): $(P) $(F77_SRCS) $(LIBDEPS) stamp-objlist touch lang-f77 cd f; $(MAKE) $(FLAGS_TO_PASS) \ ! HOST_CC="$(HOST_CC)" HOST_CFLAGS="$(HOST_CFLAGS)" HOST_CPPFLAGS="$(HOST_CPPFLAGS)" \ ../f771$(exeext) # --- 203,210 ---- f771$(exeext): $(P) $(F77_SRCS) $(LIBDEPS) stamp-objlist touch lang-f77 cd f; $(MAKE) $(FLAGS_TO_PASS) \ ! HOST_CC="`case '$(HOST_CC)' in stage*) echo '$(HOST_CC)' | sed -e 's|stage|../stage|g';; *) echo '$(HOST_CC)';; esac`" \ ! HOST_CFLAGS="$(HOST_CFLAGS)" HOST_CPPFLAGS="$(HOST_CPPFLAGS)" \ ../f771$(exeext) # *************** f77.dvi: f/g77.dvi *** 243,250 **** # g77 documentation. f/g77.info: $(srcdir)/f/g77.texi $(srcdir)/f/bugs.texi \ $(srcdir)/f/g77install.texi $(srcdir)/f/news.texi \ ! $(srcdir)/f/intdoc.texi case "$(LANGUAGES)" in \ *[fF]77*) touch lang-f77;; \ *) rm -f lang-f77;; \ --- 220,228 ---- # g77 documentation. f/g77.info: $(srcdir)/f/g77.texi $(srcdir)/f/bugs.texi \ + $(srcdir)/f/ffe.texi \ $(srcdir)/f/g77install.texi $(srcdir)/f/news.texi \ ! $(srcdir)/f/intdoc.texi $(srcdir)/f/root.texi case "$(LANGUAGES)" in \ *[fF]77*) touch lang-f77;; \ *) rm -f lang-f77;; \ *************** f/g77.info: $(srcdir)/f/g77.texi $(srcdi *** 255,262 **** else true; fi f/g77.dvi: $(srcdir)/f/g77.texi $(srcdir)/f/bugs.texi \ $(srcdir)/f/g77install.texi $(srcdir)/f/news.texi \ ! $(srcdir)/f/intdoc.texi case "$(LANGUAGES)" in \ *[fF]77*) touch lang-f77;; \ *) rm -f lang-f77;; \ --- 233,241 ---- else true; fi f/g77.dvi: $(srcdir)/f/g77.texi $(srcdir)/f/bugs.texi \ + $(srcdir)/f/ffe.texi \ $(srcdir)/f/g77install.texi $(srcdir)/f/news.texi \ ! $(srcdir)/f/intdoc.texi $(srcdir)/f/root.texi case "$(LANGUAGES)" in \ *[fF]77*) touch lang-f77;; \ *) rm -f lang-f77;; \ *************** $(srcdir)/f/intdoc.texi: f/intdoc.c f/in *** 306,320 **** rm f/intdoc f/ansify f/intdoc.h0; \ else true; fi ! $(srcdir)/f/BUGS: f/bugs0.texi f/bugs.texi cd $(srcdir)/f; $(MAKEINFO) -D BUGSONLY --no-header --no-split \ --no-validate -o BUGS bugs0.texi ! $(srcdir)/f/INSTALL: f/install0.texi f/g77install.texi cd $(srcdir)/f; $(MAKEINFO) -D INSTALLONLY --no-header --no-split \ --no-validate -o INSTALL install0.texi ! $(srcdir)/f/NEWS: f/news0.texi f/news.texi cd $(srcdir)/f; $(MAKEINFO) -D NEWSONLY --no-header --no-split \ --no-validate -o NEWS news0.texi --- 285,299 ---- rm f/intdoc f/ansify f/intdoc.h0; \ else true; fi ! $(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 ! $(srcdir)/f/INSTALL: f/install0.texi f/g77install.texi f/root.texi cd $(srcdir)/f; $(MAKEINFO) -D INSTALLONLY --no-header --no-split \ --no-validate -o INSTALL install0.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 *************** f77.install-normal: *** 329,340 **** # Install the driver program as $(target)-g77 # and also as either g77 (if native) or $(tooldir)/bin/g77. ! f77.install-common: case "$(LANGUAGES)" in \ ! *[fF]77*) touch lang-f77;; \ ! *) rm -f lang-f77;; \ esac ! -if [ -f lang-f77 -a -f f771$(exeext) ] ; then \ if [ -f g77-cross$(exeext) ] ; then \ rm -f $(bindir)/$(G77_CROSS_NAME)$(exeext); \ $(INSTALL_PROGRAM) g77-cross$(exeext) $(bindir)/$(G77_CROSS_NAME)$(exeext); \ --- 308,321 ---- # Install the driver program as $(target)-g77 # and also as either g77 (if native) or $(tooldir)/bin/g77. ! # Make sure `installdirs' target (from gcc Makefile) has been ! # run, since we use libsubdir to store our `flag' file, lang-f77. ! f77.install-common: installdirs case "$(LANGUAGES)" in \ ! *[fF]77*) touch $(libsubdir)/lang-f77;; \ ! *) rm -f $(libsubdir)/lang-f77;; \ esac ! -if [ -f $(libsubdir)/lang-f77 -a -f f771$(exeext) ] ; then \ if [ -f g77-cross$(exeext) ] ; then \ rm -f $(bindir)/$(G77_CROSS_NAME)$(exeext); \ $(INSTALL_PROGRAM) g77-cross$(exeext) $(bindir)/$(G77_CROSS_NAME)$(exeext); \ *************** f77.install-common: *** 354,417 **** echo ' f77-install-ok in the source or build directory.)'; \ echo ''; \ else true; fi # $(INSTALL_DATA) might be a relative pathname, so we can't cd into srcdir # to do the install. The sed rule was copied from stmp-int-hdrs. ! f77.install-info: f77.info case "$(LANGUAGES)" in \ ! *[fF]77*) touch lang-f77;; \ ! *) rm -f lang-f77;; \ esac ! if [ -f lang-f77 -a -f f/g77.info ] ; then \ rm -f $(infodir)/g77.info*; \ for f in f/g77.info*; do \ realfile=`echo $$f | sed -e 's|.*/\([^/]*\)$$|\1|'`; \ $(INSTALL_DATA) $$f $(infodir)/$$realfile; \ done; \ chmod a-x $(infodir)/g77.info*; \ ! fi ! @if [ -f lang-f77 -a -f $(srcdir)/f/g77.info ] ; then \ if $(SHELL) -c 'install-info --version | sed 1q | fgrep -s -v -i debian' >/dev/null 2>&1; then \ echo " install-info --info-dir=$(infodir) $(infodir)/g77.info"; \ install-info --info-dir=$(infodir) $(infodir)/g77.info || : ; \ else : ; fi; \ else : ; fi ! f77.install-man: $(srcdir)/f/g77.1 case "$(LANGUAGES)" in \ ! *[fF]77*) touch lang-f77;; \ ! *) rm -f lang-f77;; \ esac ! -if [ -f lang-f77 -a -f f771$(exeext) ] ; then \ if [ -f g77-cross$(exeext) ] ; then \ ! rm -f $(mandir)/$(G77_CROSS_NAME)$(manext); \ ! $(INSTALL_DATA) $(srcdir)/f/g77.1 $(mandir)/$(G77_CROSS_NAME)$(manext); \ ! chmod a-x $(mandir)/$(G77_CROSS_NAME)$(manext); \ else \ ! rm -f $(mandir)/$(G77_INSTALL_NAME)$(manext); \ ! $(INSTALL_DATA) $(srcdir)/f/g77.1 $(mandir)/$(G77_INSTALL_NAME)$(manext); \ ! chmod a-x $(mandir)/$(G77_INSTALL_NAME)$(manext); \ fi; \ else true; fi ! f77.uninstall: case "$(LANGUAGES)" in \ ! *[fF]77*) touch lang-f77;; \ ! *) rm -f lang-f77;; \ esac ! @if [ -f lang-f77 ] ; then \ if $(SHELL) -c 'install-info --version | sed 1q | fgrep -s -v -i debian' >/dev/null 2>&1; then \ echo " install-info --delete --info-dir=$(infodir) $(infodir)/g77.info"; \ install-info --delete --info-dir=$(infodir) $(infodir)/g77.info || : ; \ else : ; fi; \ else : ; fi ! -if [ -f lang-f77 ]; then \ rm -rf $(bindir)/$(G77_INSTALL_NAME)$(exeext); \ rm -rf $(bindir)/$(G77_CROSS_NAME)$(exeext); \ ! rm -rf $(mandir)/$(G77_INSTALL_NAME)$(manext); \ ! rm -rf $(mandir)/$(G77_CROSS_NAME)$(manext); \ rm -rf $(infodir)/g77.info*; \ fi # # Clean hooks: # A lot of the ancillary files are deleted by the main makefile. --- 335,408 ---- echo ' f77-install-ok in the source or build directory.)'; \ echo ''; \ else true; fi + rm -f $(libsubdir)/lang-f77 # $(INSTALL_DATA) might be a relative pathname, so we can't cd into srcdir # to do the install. The sed rule was copied from stmp-int-hdrs. ! # Make sure `installdirs' target (from gcc Makefile) has been ! # run, since we use libsubdir to store our `flag' file, lang-f77. ! f77.install-info: f77.info installdirs case "$(LANGUAGES)" in \ ! *[fF]77*) touch $(libsubdir)/lang-f77;; \ ! *) rm -f $(libsubdir)/lang-f77;; \ esac ! if [ -f $(libsubdir)/lang-f77 -a -f f/g77.info ] ; then \ rm -f $(infodir)/g77.info*; \ for f in f/g77.info*; do \ realfile=`echo $$f | sed -e 's|.*/\([^/]*\)$$|\1|'`; \ $(INSTALL_DATA) $$f $(infodir)/$$realfile; \ done; \ chmod a-x $(infodir)/g77.info*; \ ! else true; fi ! @if [ -f $(libsubdir)/lang-f77 -a -f $(srcdir)/f/g77.info ] ; then \ if $(SHELL) -c 'install-info --version | sed 1q | fgrep -s -v -i debian' >/dev/null 2>&1; then \ echo " install-info --info-dir=$(infodir) $(infodir)/g77.info"; \ install-info --info-dir=$(infodir) $(infodir)/g77.info || : ; \ else : ; fi; \ else : ; fi + rm -f $(libsubdir)/lang-f77 ! # Make sure `installdirs' target (from gcc Makefile) has been ! # run, since we use libsubdir to store our `flag' file, lang-f77. ! f77.install-man: $(srcdir)/f/g77.1 installdirs case "$(LANGUAGES)" in \ ! *[fF]77*) touch $(libsubdir)/lang-f77;; \ ! *) rm -f $(libsubdir)/lang-f77;; \ esac ! -if [ -f $(libsubdir)/lang-f77 -a -f f771$(exeext) ] ; then \ if [ -f g77-cross$(exeext) ] ; then \ ! rm -f $(man1dir)/$(G77_CROSS_NAME)$(manext); \ ! $(INSTALL_DATA) $(srcdir)/f/g77.1 $(man1dir)/$(G77_CROSS_NAME)$(manext); \ ! chmod a-x $(man1dir)/$(G77_CROSS_NAME)$(manext); \ else \ ! rm -f $(man1dir)/$(G77_INSTALL_NAME)$(manext); \ ! $(INSTALL_DATA) $(srcdir)/f/g77.1 $(man1dir)/$(G77_INSTALL_NAME)$(manext); \ ! chmod a-x $(man1dir)/$(G77_INSTALL_NAME)$(manext); \ fi; \ else true; fi + rm -f $(libsubdir)/lang-f77 ! # Make sure `installdirs' target (from gcc Makefile) has been ! # run, since we use libsubdir to store our `flag' file, lang-f77. ! f77.uninstall: installdirs case "$(LANGUAGES)" in \ ! *[fF]77*) touch $(libsubdir)/lang-f77;; \ ! *) rm -f $(libsubdir)/lang-f77;; \ esac ! @if [ -f $(libsubdir)/lang-f77 ] ; then \ if $(SHELL) -c 'install-info --version | sed 1q | fgrep -s -v -i debian' >/dev/null 2>&1; then \ echo " install-info --delete --info-dir=$(infodir) $(infodir)/g77.info"; \ install-info --delete --info-dir=$(infodir) $(infodir)/g77.info || : ; \ else : ; fi; \ else : ; fi ! -if [ -f $(libsubdir)/lang-f77 ]; then \ rm -rf $(bindir)/$(G77_INSTALL_NAME)$(exeext); \ rm -rf $(bindir)/$(G77_CROSS_NAME)$(exeext); \ ! rm -rf $(man1dir)/$(G77_INSTALL_NAME)$(manext); \ ! rm -rf $(man1dir)/$(G77_CROSS_NAME)$(manext); \ rm -rf $(infodir)/g77.info*; \ fi + rm -f $(libsubdir)/lang-f77 # # Clean hooks: # A lot of the ancillary files are deleted by the main makefile. *************** f77.mostlyclean: *** 424,430 **** -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 g77.c g77.o g77spec.o g77version.o f77.distclean: -rm -f lang-f77 f/Makefile f77.extraclean: --- 415,421 ---- -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 f77.distclean: -rm -f lang-f77 f/Makefile f77.extraclean: *************** f77.maintainer-clean: *** 435,441 **** # The main makefile has already created stage?/f. G77STAGESTUFF = f/*$(objext) f/fini f/stamp-str f/str-*.h f/str-*.j \ ! lang-f77 g77.c g77.o g77spec.o g77version.o f77.stage1: stage1-start -if [ -f lang-f77 ]; then \ --- 426,432 ---- # The main makefile has already created stage?/f. G77STAGESTUFF = f/*$(objext) f/fini f/stamp-str f/str-*.h f/str-*.j \ ! lang-f77 g77spec.o g77version.o f77.stage1: stage1-start -if [ -f lang-f77 ]; then \ diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/Makefile.in gcc-2.95/gcc/f/Makefile.in *** egcs-1.1.2/gcc/f/Makefile.in Wed Jul 15 02:35:54 1998 --- gcc-2.95/gcc/f/Makefile.in Wed Dec 16 13:16:32 1998 *************** ALL_CFLAGS = $(INTERNAL_CFLAGS) $(X_CFLA *** 134,145 **** # Likewise. ALL_CPPFLAGS = $(CPPFLAGS) $(X_CPPFLAGS) $(T_CPPFLAGS) ! # f771 is so big, need to tell linker on m68k-next-nextstep* to make enough ! # room for it. On AIX, linking f771 overflows the linker TOC; ! # `-bbigtoc' is appropriate for the linker on AIX 4.1 and above. ! F771_LDFLAGS = `case "${target}" in\ ! m68k-next-nextstep*) echo -segaddr __DATA 6000000;;\ ! *-*-aix[4-9]*) \`$(CC) --print-prog-name=ld\` -v 2>&1 | grep BFD >/dev/null || echo -Wl,-bbigtoc;; esac` # Even if ALLOCA is set, don't use it if compiling with GCC. --- 134,144 ---- # Likewise. ALL_CPPFLAGS = $(CPPFLAGS) $(X_CPPFLAGS) $(T_CPPFLAGS) ! # We should be compiling with the built compiler, for which ! # BOOT_LDFLAGS is appropriate. (Formerly we had a separate ! # F771_LDFLAGS, but the ld flags can be taken care of by the target ! # configuration files in egcs.) ! LDFLAGS=$(BOOT_LDFLAGS) # Even if ALLOCA is set, don't use it if compiling with GCC. *************** LIBS = $(SUBDIR_OBSTACK) $(SUBDIR_USE_AL *** 155,161 **** # Both . and srcdir are used, in that order, # so that tm.h and config.h will be found in the compilation # subdirectory rather than in the source directory. ! INCLUDES = -I. -I.. -I$(srcdir) -I$(srcdir)/.. -I$(srcdir)/../config # Always use -I$(srcdir)/config when compiling. .c.o: --- 154,160 ---- # Both . and srcdir are used, in that order, # so that tm.h and config.h will be found in the compilation # subdirectory rather than in the source directory. ! INCLUDES = -I. -I.. -I$(srcdir) -I$(srcdir)/.. -I$(srcdir)/../config -I$(srcdir)/../../include # Always use -I$(srcdir)/config when compiling. .c.o: *************** OBJDEPS = ../stamp-objlist *** 213,220 **** compiler: ../f771$(exeext) ../f771$(exeext): $(P) $(F77_OBJS) $(OBJDEPS) $(LIBDEPS) rm -f f771$(exeext) ! $(CC) $(ALL_CFLAGS) $(LDFLAGS) $(F771_LDFLAGS) -o $@ \ ! $(F77_OBJS) $(OBJS) $(LIBS) Makefile: $(srcdir)/Makefile.in $(srcdir)/../configure cd ..; $(SHELL) config.status --- 212,218 ---- compiler: ../f771$(exeext) ../f771$(exeext): $(P) $(F77_OBJS) $(OBJDEPS) $(LIBDEPS) rm -f f771$(exeext) ! $(CC) $(ALL_CFLAGS) $(LDFLAGS) -o $@ $(F77_OBJS) $(OBJS) $(LIBS) Makefile: $(srcdir)/Makefile.in $(srcdir)/../configure cd ..; $(SHELL) config.status *************** fini: fini.o proj-h.o *** 461,470 **** $(HOST_CC) $(HOST_CFLAGS) $(HOST_LDFLAGS) -o fini fini.o proj-h.o fini.o: ! $(HOST_CC) -c -DUSE_HCONFIG $(HOST_CFLAGS) $(HOST_CPPFLAGS) $(INCLUDES) \ `echo $(srcdir)/fini.c | sed 's,^\./,,'` -o $@ ! proj-h.o: proj.o $(HOST_CC) -c -DUSE_HCONFIG $(HOST_CFLAGS) $(HOST_CPPFLAGS) $(INCLUDES) \ `echo $(srcdir)/proj.c | sed 's,^\./,,'` -o $@ --- 459,469 ---- $(HOST_CC) $(HOST_CFLAGS) $(HOST_LDFLAGS) -o fini fini.o proj-h.o fini.o: ! $(HOST_CC) -c $(HOST_CFLAGS) $(HOST_CPPFLAGS) $(INCLUDES) \ `echo $(srcdir)/fini.c | sed 's,^\./,,'` -o $@ ! # Like proj.o, but depends on hconfig.h instead of config.h. ! proj-h.o: proj.c proj.h $(HCONFIG_H) $(SYSTEM_H) $(ASSERT_H) $(GLIMITS_H) $(HOST_CC) -c -DUSE_HCONFIG $(HOST_CFLAGS) $(HOST_CPPFLAGS) $(INCLUDES) \ `echo $(srcdir)/proj.c | sed 's,^\./,,'` -o $@ diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/NEWS gcc-2.95/gcc/f/NEWS *** egcs-1.1.2/gcc/f/NEWS Thu Mar 11 07:30:23 1999 --- gcc-2.95/gcc/f/NEWS Sat Jul 17 08:41:22 1999 *************** *** 1,7 **** ! This file lists recent changes to the GNU Fortran compiler. Copyright ! (C) 1995, 1996 Free Software Foundation, Inc. You may copy, ! distribute, and modify it freely as long as you preserve this copyright ! notice and permission notice. News About GNU Fortran ********************** --- 1,12 ---- ! *Note:* This file is automatically generated from the files ! `news0.texi' and `news.texi'. `NEWS' is *not* a source file, although ! it is normally included within source distributions. ! ! This file lists news about the GCC-2.95 version (and some other ! versions) of the GNU Fortran compiler. Copyright (C) 1995-1999 Free ! Software Foundation, Inc. You may copy, distribute, and modify it ! freely as long as you preserve this copyright notice and permission ! notice. News About GNU Fortran ********************** *************** clarify how they differ from other versi *** 38,53 **** getting a complete picture of what a particular `egcs' version contains somewhat more difficult. An online, "live" version of this document (derived directly from ! the up-to-date mainline version of `g77' within `egcs') is available at ! `http://egcs.cygnus.com/onlinedocs/g77_news.html'. ! In 0.5.24 and `egcs' 1.1.2 (versus 0.5.23 and 1.1.1): ! ===================================================== ! * Fix the `IDate' Intrinsic (VXT) so the returned year is in the ! documented, non-Y2K-compliant range of 0-99, instead of being ! returned as 100 in the year 2000. * Fix the `Date_and_Time' intrinsic (in `libg2c') to return the milliseconds value properly in VALUES(8). --- 43,211 ---- getting a complete picture of what a particular `egcs' version contains somewhat more difficult. + *Warning:* The information below is still under development, and + might not accurately reflect the `g77' code base of which it is a part. + Efforts are made to keep it somewhat up-to-date, but they are + particularly concentrated on any version of this information that is + distributed as part of a *released* `g77'. + + In particular, while this information is intended to apply to the + GCC-2.95 version of `g77', only an official *release* of that version + is expected to contain documentation that is most consistent with the + `g77' product in that version. + + Nevertheless, information on *previous* releases of `g77', below, is + likely to be more up-to-date and accurate than the equivalent + information that accompanied those releases, assuming the last-updated + date of the information below is later than the dates of those releases. + + That's due to attempts to keep this development version of news + about previous `g77' versions up-to-date. + An online, "live" version of this document (derived directly from ! the mainline, development version of `g77' within `egcs') is available ! at `http://egcs.cygnus.com/onlinedocs/g77_news.html'. ! ! The following information was last updated on 1999-07-08: ! ! In 0.5.25, `GCC' 2.95 (`EGCS' 1.2) versus `EGCS' 1.1.2: ! ======================================================= ! ! 1. `g77' no longer generates bad code for assignments, or other ! conversions, of `REAL' or `COMPLEX' constant expressions to type ! `INTEGER(KIND=2)' (often referred to as `INTEGER*8'). ! ! For example, `INTEGER*8 J; J = 4E10' now works as documented. ! ! 2. `g77' no longer truncates `INTEGER(KIND=2)' (usually `INTEGER*8') ! subscript expressions when evaluating array references on systems ! with pointers widers than `INTEGER(KIND=1)' (such as Alphas). ! ! 3. `g77' no longer generates bad code for an assignment to a ! `COMPLEX' variable or array that partially overlaps one or more of ! the sources of the same assignment (a very rare construction). It ! now assigns through a temporary, in cases where such partial ! overlap is deemed possible. ! ! 4. `libg2c' (`libf2c') no longer loses track of the file being worked ! on during a `BACKSPACE' operation. ! ! 5. `libg2c' (`libf2c') fixes a bug whereby input to a `NAMELIST' read ! involving a repeat count, such as `K(5)=10*3', was not properly ! handled by `libf2c'. The first item was written to `K(5)', but ! the remaining nine were written elsewhere (still within the array), ! not necessarily starting at `K(6)'. ! ! 6. Automatic arrays now seem to be working on HP-UX systems. ! ! 7. The `Date' intrinsic now returns the correct result on big-endian ! systems. ! ! 8. Fix `g77' so it no longer crashes when compiling I/O statements ! using keywords that define `INTEGER' values, such as `IOSTAT=J', ! where J is other than default `INTEGER' (such as `INTEGER*2'). ! Instead, it issues a diagnostic. ! ! 9. Fix `g77' so it properly handles `DATA A/RPT*VAL/', where RPT is ! not default `INTEGER', such as `INTEGER*2', instead of producing a ! spurious diagnostic. Also fix `DATA (A(I),I=1,N)', where `N' is ! not default `INTEGER' to work instead of crashing `g77'. ! ! 10. The `-ax' option is now obeyed when compiling Fortran programs. ! (It is passed to the `f771' driver.) ! ! * The new `-fbounds-check' option causes `g77' to compile run-time ! bounds checks of array subscripts, as well as of substring start ! and end points. ! ! * `libg2c' now supports building as multilibbed library, which ! provides better support for systems that require options such as ! `-mieee' to work properly. ! ! * Source file names with the suffixes `.FOR' and `.FPP' now are ! recognized by `g77' as if they ended in `.for' and `.fpp', ! respectively. ! ! * The order of arguments to the *subroutine* forms of the `CTime', ! `DTime', `ETime', and `TtyNam' intrinsics has been swapped. The ! argument serving as the returned value for the corresponding ! function forms now is the *second* argument, making these ! consistent with the other subroutine forms of `libU77' intrinsics. ! ! * `g77' now warns about a reference to an intrinsic that has an ! interface that is not Year 2000 (Y2K) compliant. Also, `libg2c' ! has been changed to increase the likelihood of catching references ! to the implementations of these intrinsics using the `EXTERNAL' ! mechanism (which would avoid the new warnings). ! ! 11. `g77' now warns about a reference to a function when the ! corresponding *subsequent* function program unit disagrees with ! the reference concerning the type of the function. ! ! * `-fno-emulate-complex' is now the default option. This should ! result in improved performance of code that uses the `COMPLEX' ! data type. ! ! * The `-malign-double' option now reliably aligns *all* ! double-precision variables and arrays on Intel x86 targets. ! ! 12. Even without the `-malign-double' option, `g77' reliably aligns ! local double-precision variables that are not in `EQUIVALENCE' ! areas and not `SAVE''d. ! ! 13. `g77' now open-codes ("inlines") division of `COMPLEX' operands ! instead of generating a run-time call to the `libf2c' routines ! `c_div' or `z_div', unless the `-Os' option is specified. ! ! * `g77' no longer generates code to maintain `errno', a C-language ! concept, when performing operations such as the `SqRt' intrinsic. ! ! 14. `g77' developers can temporarily use the `-fflatten-arrays' option ! to compare how the compiler handles code generation using C-like ! constructs as compared to the Fortran-like method constructs ! normally used. ! ! 15. A substantial portion of the `g77' front end's code-generation ! component was rewritten. It now generates code using facilities ! more robustly supported by the `gcc' back end. One effect of this ! rewrite is that some codes no longer produce a spurious "label LAB ! used before containing binding contour" message. ! ! * Support for the `-fugly' option has been removed. ! ! 16. Improve documentation and indexing, including information on Year ! 2000 (Y2K) compliance, and providing more information on internals ! of the front end. ! ! 17. Upgrade to `libf2c' as of 1999-05-10. ! ! In 0.5.24 versus 0.5.23: ! ======================== ! There is no `g77' version 0.5.24 at this time, or planned. 0.5.24 ! is the version number designated for bug fixes and, perhaps, some new ! features added, to 0.5.23. Version 0.5.23 requires `gcc' 2.8.1, as ! 0.5.24 was planned to require. ! Due to `EGCS' becoming `GCC' (which is now an acronym for "GNU ! Compiler Collection"), and `EGCS' 1.2 becoming officially designated ! `GCC' 2.95, there seems to be no need for an actual 0.5.24 release. ! ! To reduce the confusion already resulting from use of 0.5.24 to ! designate `g77' versions within `EGCS' versions 1.0 and 1.1, as well as ! in versions of `g77' documentation and notices during that period, ! "mainline" `g77' version numbering resumes at 0.5.25 with `GCC' 2.95 ! (`EGCS' 1.2), skipping over 0.5.24 as a placeholder version number. ! ! To repeat, there is no `g77' 0.5.24, but there is now a 0.5.25. ! Please remain calm and return to your keypunch units. ! ! In `EGCS' 1.1.2 versus `EGCS' 1.1.1: ! ==================================== ! ! * Fix the `IDate' intrinsic (VXT) (in `libg2c') so the returned year ! is in the documented, non-Y2K-compliant range of 0-99, instead of ! being returned as 100 in the year 2000. * Fix the `Date_and_Time' intrinsic (in `libg2c') to return the milliseconds value properly in VALUES(8). *************** In 0.5.24 and `egcs' 1.1.2 (versus 0.5.2 *** 57,64 **** * Improve documentation. ! In 0.5.24 and `egcs' 1.1.1 (versus 0.5.23 and 1.1): ! =================================================== * Fix `libg2c' so it performs an implicit `ENDFILE' operation (as appropriate) whenever a `REWIND' is done. --- 215,222 ---- * Improve documentation. ! In `EGCS' 1.1.1 versus `EGCS' 1.1: ! ================================== * Fix `libg2c' so it performs an implicit `ENDFILE' operation (as appropriate) whenever a `REWIND' is done. *************** In 0.5.24 and `egcs' 1.1.1 (versus 0.5.2 *** 79,129 **** some systems (those with shells requiring `else true' clauses on `if' constructs for the completion code to be set properly). ! In `egcs' 1.1 (versus 0.5.24): ! ============================== ! ! * Fix `g77' crash compiling code containing the construct ! `CMPLX(0.)' or similar. ! ! * Fix `g77' crash (or apparently infinite run-time) when compiling ! certain complicated expressions involving `COMPLEX' arithmetic ! (especially multiplication). ! ! * Fix a code-generation bug that afflicted Intel x86 targets when ! `-O2' was specified compiling, for example, an old version of the ! `DNRM2' routine. ! ! The x87 coprocessor stack was being mismanaged in cases involving ! assigned `GOTO' and `ASSIGN'. ! * Align static double-precision variables and arrays on Intel x86 ! targets regardless of whether `-malign-double' is specified. ! ! Generally, this affects only local variables and arrays having the ! `SAVE' attribute or given initial values via `DATA'. ! ! In `egcs' 1.1 (versus `egcs' 1.0.3): ! ==================================== ! ! * Fix bugs in the `libU77' intrinsic `HostNm' that wrote one byte beyond the end of its `CHARACTER' argument, and in the `libU77' intrinsics `GMTime' and `LTime' that overwrote their arguments. ! * Assumed arrays with negative bounds (such as `REAL A(-1:*)') no longer elicit spurious diagnostics from `g77', even on systems with pointers having different sizes than integers. This bug is not known to have existed in any recent version of `gcc'. It was introduced in an early release of `egcs'. ! * Valid combinations of `EXTERNAL', passing that external as a dummy argument without explicitly giving it a type, and, in a subsequent program unit, referencing that external as an external function with a different type no longer crash `g77'. ! * `CASE DEFAULT' no longer crashes `g77'. ! * The `-Wunused' option no longer issues a spurious warning about the "master" procedure generated by `g77' for procedures containing `ENTRY' statements. --- 237,264 ---- some systems (those with shells requiring `else true' clauses on `if' constructs for the completion code to be set properly). ! In `EGCS' 1.1 versus `EGCS' 1.0.3: ! ================================== ! 18. Fix bugs in the `libU77' intrinsic `HostNm' that wrote one byte beyond the end of its `CHARACTER' argument, and in the `libU77' intrinsics `GMTime' and `LTime' that overwrote their arguments. ! 19. Assumed arrays with negative bounds (such as `REAL A(-1:*)') no longer elicit spurious diagnostics from `g77', even on systems with pointers having different sizes than integers. This bug is not known to have existed in any recent version of `gcc'. It was introduced in an early release of `egcs'. ! 20. Valid combinations of `EXTERNAL', passing that external as a dummy argument without explicitly giving it a type, and, in a subsequent program unit, referencing that external as an external function with a different type no longer crash `g77'. ! 21. `CASE DEFAULT' no longer crashes `g77'. ! 22. The `-Wunused' option no longer issues a spurious warning about the "master" procedure generated by `g77' for procedures containing `ENTRY' statements. *************** In `egcs' 1.1 (versus `egcs' 1.0.3): *** 148,172 **** `libf2c' environment, even when `libf2c' (now `libg2c') is a shared library. ! * `g77' no longer installs the `f77' command and `f77.1' man page in the `/usr' or `/usr/local' heirarchy, even if the `f77-install-ok' file exists in the source or build directory. See the installation documentation for more information. ! * `g77' no longer installs the `libf2c.a' library and `f2c.h' include file in the `/usr' or `/usr/local' heirarchy, even if the `f2c-install-ok' or `f2c-exists-ok' files exist in the source or build directory. See the installation documentation for more information. ! * The `libf2c.a' library produced by `g77' has been renamed to `libg2c.a'. It is installed only in the `gcc' "private" directory heirarchy, `gcc-lib'. This allows system administrators and users to choose which version of the `libf2c' library from `netlib' they wish to use on a case-by-case basis. See the installation documentation for more information. ! * The `f2c.h' include (header) file produced by `g77' has been renamed to `g2c.h'. It is installed only in the `gcc' "private" directory heirarchy, `gcc-lib'. This allows system administrators and users to choose which version of the include file from --- 283,307 ---- `libf2c' environment, even when `libf2c' (now `libg2c') is a shared library. ! 23. `g77' no longer installs the `f77' command and `f77.1' man page in the `/usr' or `/usr/local' heirarchy, even if the `f77-install-ok' file exists in the source or build directory. See the installation documentation for more information. ! 24. `g77' no longer installs the `libf2c.a' library and `f2c.h' include file in the `/usr' or `/usr/local' heirarchy, even if the `f2c-install-ok' or `f2c-exists-ok' files exist in the source or build directory. See the installation documentation for more information. ! 25. The `libf2c.a' library produced by `g77' has been renamed to `libg2c.a'. It is installed only in the `gcc' "private" directory heirarchy, `gcc-lib'. This allows system administrators and users to choose which version of the `libf2c' library from `netlib' they wish to use on a case-by-case basis. See the installation documentation for more information. ! 26. The `f2c.h' include (header) file produced by `g77' has been renamed to `g2c.h'. It is installed only in the `gcc' "private" directory heirarchy, `gcc-lib'. This allows system administrators and users to choose which version of the include file from *************** In `egcs' 1.1 (versus `egcs' 1.0.3): *** 178,188 **** than the one built and installed as part of the same `g77' version is picked up. ! * During the configuration and build process, `g77' creates subdirectories it needs only as it needs them. Other cleaning up of the configuration and build process has been performed as well. ! * `install-info' now used to update the directory of Info documentation to contain an entry for `g77' (during installation). * Some diagnostics have been changed from warnings to errors, to --- 313,323 ---- than the one built and installed as part of the same `g77' version is picked up. ! 27. During the configuration and build process, `g77' creates subdirectories it needs only as it needs them. Other cleaning up of the configuration and build process has been performed as well. ! 28. `install-info' now used to update the directory of Info documentation to contain an entry for `g77' (during installation). * Some diagnostics have been changed from warnings to errors, to *************** In `egcs' 1.1 (versus `egcs' 1.0.3): *** 191,218 **** in the `OPEN', `INQUIRE', `READ', and `WRITE' statements, and about truncations of various sorts of constants. ! * Improve compilation of `FORMAT' expressions so that a null byte is appended to the last operand if it is a constant. This provides a cleaner run-time diagnostic as provided by `libf2c' for statements like `PRINT '(I1', 42'. ! * Improve documentation and indexing. ! * The upgrade to `libf2c' as of 1998-06-18 should fix a variety of problems, including those involving some uses of the `T' format specifier, and perhaps some build (porting) problems as well. ! In 0.5.24 and `egcs' 1.1 (versus 0.5.23): ! ========================================= ! * `g77' no longer produces incorrect code and initial values for `EQUIVALENCE' and `COMMON' aggregates that, due to "unnatural" ordering of members vis-a-vis their types, require initial padding. ! * `g77' no longer crashes when compiling code containing specification statements such as `INTEGER(KIND=7) PTR'. ! * `g77' no longer crashes when compiling code such as `J = SIGNAL(1, 2)'. * `g77' now treats `%LOC(EXPR)' and `LOC(EXPR)' as "ordinary" --- 326,363 ---- in the `OPEN', `INQUIRE', `READ', and `WRITE' statements, and about truncations of various sorts of constants. ! 29. Improve compilation of `FORMAT' expressions so that a null byte is appended to the last operand if it is a constant. This provides a cleaner run-time diagnostic as provided by `libf2c' for statements like `PRINT '(I1', 42'. ! 30. Improve documentation and indexing. ! 31. The upgrade to `libf2c' as of 1998-06-18 should fix a variety of problems, including those involving some uses of the `T' format specifier, and perhaps some build (porting) problems as well. ! In `EGCS' 1.1 versus `g77' 0.5.23: ! ================================== ! 32. Fix a code-generation bug that afflicted Intel x86 targets when ! `-O2' was specified compiling, for example, an old version of the ! `DNRM2' routine. ! ! The x87 coprocessor stack was being mismanaged in cases involving ! assigned `GOTO' and `ASSIGN'. ! ! 33. `g77' no longer produces incorrect code and initial values for `EQUIVALENCE' and `COMMON' aggregates that, due to "unnatural" ordering of members vis-a-vis their types, require initial padding. ! 34. Fix `g77' crash compiling code containing the construct ! `CMPLX(0.)' or similar. ! ! 35. `g77' no longer crashes when compiling code containing specification statements such as `INTEGER(KIND=7) PTR'. ! 36. `g77' no longer crashes when compiling code such as `J = SIGNAL(1, 2)'. * `g77' now treats `%LOC(EXPR)' and `LOC(EXPR)' as "ordinary" *************** In 0.5.24 and `egcs' 1.1 (versus 0.5.23) *** 223,228 **** --- 368,383 ---- Previously, `g77' treated these expressions as denoting special "pointer" arguments for the purposes of filewide analysis. + 37. Fix `g77' crash (or apparently infinite run-time) when compiling + certain complicated expressions involving `COMPLEX' arithmetic + (especially multiplication). + + * Align static double-precision variables and arrays on Intel x86 + targets regardless of whether `-malign-double' is specified. + + Generally, this affects only local variables and arrays having the + `SAVE' attribute or given initial values via `DATA'. + * The `g77' driver now ensures that `-lg2c' is specified in the link phase prior to any occurrence of `-lm'. This prevents accidentally linking to a routine in the SunOS4 `-lm' library when *************** In 0.5.24 and `egcs' 1.1 (versus 0.5.23) *** 243,1623 **** * The F90 `System_Clock' intrinsic allows the optional arguments (except for the `Count' argument) to be omitted. ! * Upgrade to `libf2c' as of 1998-06-18. ! ! * Improve documentation and indexing. ! ! In 0.5.23 (versus 0.5.22): ! ========================== ! ! * This release contains several regressions against version 0.5.22 ! of `g77', due to using the "vanilla" `gcc' back end instead of ! patching it to fix a few bugs and improve performance in a few ! cases. ! ! See `egcs/gcc/f/BUGS', for information on the known bugs in this ! version, including the regressions. ! ! Features that have been dropped from this version of `g77' due to ! their being implemented via `g77'-specific patches to the `gcc' ! back end in previous releases include: ! ! - Support for `__restrict__' keyword, the options ! `-fargument-alias', `-fargument-noalias', and ! `-fargument-noalias-global', and the corresponding ! alias-analysis code. ! ! (`egcs' has the alias-analysis code, but not the ! `__restrict__' keyword. `egcs' `g77' users benefit from the ! alias-analysis code despite the lack of the `__restrict__' ! keyword, which is a C-language construct.) ! ! - Support for the GNU compiler options `-fmove-all-movables', ! `-freduce-all-givs', and `-frerun-loop-opt'. ! ! (`egcs' supports these options. `g77' users of `egcs' ! benefit from them even if they are not explicitly specified, ! because the defaults are optimized for `g77' users.) ! ! - Support for the `-W' option warning about integer division by ! zero. ! ! - The Intel x86-specific option `-malign-double' applying to ! stack-allocated data as well as statically-allocate data. ! ! Note that the `gcc/f/gbe/' subdirectory has been removed from this ! distribution as a result of `g77' no longer including patches for ! the `gcc' back end. ! ! * Fix bugs in the `libU77' intrinsic `HostNm' that wrote one byte ! beyond the end of its `CHARACTER' argument, and in the `libU77' ! intrinsics `GMTime' and `LTime' that overwrote their arguments. ! ! * Support `gcc' version 2.8, and remove support for prior versions ! of `gcc'. ! ! * Remove support for the `--driver' option, as `g77' now does all ! the driving, just like `gcc'. ! ! * `CASE DEFAULT' no longer crashes `g77'. ! ! * Valid combinations of `EXTERNAL', passing that external as a dummy ! argument without explicitly giving it a type, and, in a subsequent ! program unit, referencing that external as an external function ! with a different type no longer crash `g77'. ! ! * `g77' no longer installs the `f77' command and `f77.1' man page in ! the `/usr' or `/usr/local' heirarchy, even if the `f77-install-ok' ! file exists in the source or build directory. See the ! installation documentation for more information. ! ! * `g77' no longer installs the `libf2c.a' library and `f2c.h' ! include file in the `/usr' or `/usr/local' heirarchy, even if the ! `f2c-install-ok' or `f2c-exists-ok' files exist in the source or ! build directory. See the installation documentation for more ! information. ! ! * The `libf2c.a' library produced by `g77' has been renamed to ! `libg2c.a'. It is installed only in the `gcc' "private" directory ! heirarchy, `gcc-lib'. This allows system administrators and users ! to choose which version of the `libf2c' library from `netlib' they ! wish to use on a case-by-case basis. See the installation ! documentation for more information. ! ! * The `f2c.h' include (header) file produced by `g77' has been ! renamed to `g2c.h'. It is installed only in the `gcc' "private" ! directory heirarchy, `gcc-lib'. This allows system administrators ! and users to choose which version of the include file from ! `netlib' they wish to use on a case-by-case basis. See the ! installation documentation for more information. ! ! * The `g77' command now expects the run-time library to be named ! `libg2c.a' instead of `libf2c.a', to ensure that a version other ! than the one built and installed as part of the same `g77' version ! is picked up. ! ! * The `-Wunused' option no longer issues a spurious warning about ! the "master" procedure generated by `g77' for procedures ! containing `ENTRY' statements. ! ! * `g77''s version of `libf2c' separates out the setting of global ! state (such as command-line arguments and signal handling) from ! `main.o' into distinct, new library archive members. ! ! This should make it easier to write portable applications that ! have their own (non-Fortran) `main()' routine properly set up the ! `libf2c' environment, even when `libf2c' (now `libg2c') is a ! shared library. ! ! * During the configuration and build process, `g77' creates ! subdirectories it needs only as it needs them, thus avoiding ! unnecessary creation of, for example, `stage1/f/runtime' when ! doing a non-bootstrap build. Other cleaning up of the ! configuration and build process has been performed as well. ! ! * `install-info' now used to update the directory of Info ! documentation to contain an entry for `g77' (during installation). ! ! * Some diagnostics have been changed from warnings to errors, to ! prevent inadvertent use of the resulting, probably buggy, programs. ! These mostly include diagnostics about use of unsupported features ! in the `OPEN', `INQUIRE', `READ', and `WRITE' statements, and ! about truncations of various sorts of constants. ! ! * Improve documentation and indexing. ! ! * Upgrade to `libf2c' as of 1998-04-20. ! ! This should fix a variety of problems, including those involving ! some uses of the `T' format specifier, and perhaps some build ! (porting) problems as well. ! ! In 0.5.22 (versus 0.5.21): ! ========================== ! ! * Fix code generation for iterative `DO' loops that have one or more ! references to the iteration variable, or to aliases of it, in ! their control expressions. For example, `DO 10 J=2,J' now is ! compiled correctly. ! ! * Fix a code-generation bug that afflicted Intel x86 targets when ! `-O2' was specified compiling, for example, an old version of the ! `DNRM2' routine. ! ! The x87 coprocessor stack was being mismanaged in cases involving ! assigned `GOTO' and `ASSIGN'. ! ! * Fix `DTime' intrinsic so as not to truncate results to integer ! values (on some systems). ! ! * Fix `Signal' intrinsic so it offers portable support for 64-bit ! systems (such as Digital Alphas running GNU/Linux). ! ! * Fix run-time crash involving `NAMELIST' on 64-bit machines such as ! Alphas. ! ! * Fix `g77' version of `libf2c' so it no longer produces a spurious ! `I/O recursion' diagnostic at run time when an I/O operation (such ! as `READ *,I') is interrupted in a manner that causes the program ! to be terminated via the `f_exit' routine (such as via `C-c'). ! ! * Fix `g77' crash triggered by `CASE' statement with an omitted ! lower or upper bound. ! ! * Fix `g77' crash compiling references to `CPU_Time' intrinsic. ! ! * Fix `g77' crash (or apparently infinite run-time) when compiling ! certain complicated expressions involving `COMPLEX' arithmetic ! (especially multiplication). ! ! * Fix `g77' crash on statements such as `PRINT *, ! (REAL(Z(I)),I=1,2)', where `Z' is `DOUBLE COMPLEX'. ! ! * Fix a `g++' crash. ! ! * Support `FORMAT(I)' when EXPR is a compile-time constant ! `INTEGER' expression. ! ! * Fix `g77' `-g' option so procedures that use `ENTRY' can be ! stepped through, line by line, in `gdb'. ! ! * Fix a profiling-related bug in `gcc' back end for Intel x86 ! architecture. ! ! * Allow any `REAL' argument to intrinsics `Second' and `CPU_Time'. ! ! * Allow any numeric argument to intrinsics `Int2' and `Int8'. ! ! * Use `tempnam', if available, to open scratch files (as in ! `OPEN(STATUS='SCRATCH')') so that the `TMPDIR' environment ! variable, if present, is used. ! ! * Rename the `gcc' keyword `restrict' to `__restrict__', to avoid ! rejecting valid, existing, C programs. Support for `restrict' is ! now more like support for `complex'. ! ! * Fix `-fpedantic' to not reject procedure invocations such as ! `I=J()' and `CALL FOO()'. ! ! * Fix `-fugly-comma' to affect invocations of only external ! procedures. Restore rejection of gratuitous trailing omitted ! arguments to intrinsics, as in `I=MAX(3,4,,)'. ! ! * Fix compiler so it accepts `-fgnu-intrinsics-*' and ! `-fbadu77-intrinsics-*' options. ! ! * Improve diagnostic messages from `libf2c' so it is more likely ! that the printing of the active format string is limited to the ! string, with no trailing garbage being printed. ! ! (Unlike `f2c', `g77' did not append a null byte to its compiled ! form of every format string specified via a `FORMAT' statement. ! However, `f2c' would exhibit the problem anyway for a statement ! like `PRINT '(I)garbage', 1' by printing `(I)garbage' as the ! format string.) ! ! * Improve compilation of `FORMAT' expressions so that a null byte is ! appended to the last operand if it is a constant. This provides a ! cleaner run-time diagnostic as provided by `libf2c' for statements ! like `PRINT '(I1', 42'. ! ! * Fix various crashes involving code with diagnosed errors. ! ! * Fix cross-compilation bug when configuring `libf2c'. ! ! * Improve diagnostics. ! ! * Improve documentation and indexing. ! ! * Upgrade to `libf2c' as of 1997-09-23. This fixes a formatted-I/O ! bug that afflicted 64-bit systems with 32-bit integers (such as ! Digital Alpha running GNU/Linux). ! ! In `egcs' 1.0.2 (versus `egcs' 1.0.1): ! ====================================== ! ! * Fix `g77' crash triggered by `CASE' statement with an omitted ! lower or upper bound. ! ! * Fix `g77' crash on statements such as `PRINT *, ! (REAL(Z(I)),I=1,2)', where `Z' is `DOUBLE COMPLEX'. ! ! * Fix `-fPIC' (such as compiling for ELF targets) on the Intel x86 ! architecture target so invalid assembler code is no longer ! produced. ! ! * Fix `-fpedantic' to not reject procedure invocations such as ! `I=J()' and `CALL FOO()'. ! ! * Fix `-fugly-comma' to affect invocations of only external ! procedures. Restore rejection of gratuitous trailing omitted ! arguments to intrinsics, as in `I=MAX(3,4,,)'. ! ! * Fix compiler so it accepts `-fgnu-intrinsics-*' and ! `-fbadu77-intrinsics-*' options. ! ! In `egcs' 1.0.1 (versus `egcs' 1.0): ! ==================================== ! ! * Fix run-time crash involving `NAMELIST' on 64-bit machines such as ! Alphas. ! ! In `egcs' 1.0 (versus 0.5.21): ! ============================== ! ! * Version 1.0 of `egcs' contains several regressions against version ! 0.5.21 of `g77', due to using the "vanilla" `gcc' back end instead ! of patching it to fix a few bugs and improve performance in a few ! cases. ! ! See `egcs/gcc/f/BUGS', for information on the known bugs in this ! version, including the regressions. ! ! Features that have been dropped from this version of `g77' due to ! their being implemented via `g77'-specific patches to the `gcc' ! back end in previous releases include: ! ! - Support for the C-language `restrict' keyword. ! ! - Support for the `-W' option warning about integer division by ! zero. ! ! - The Intel x86-specific option `-malign-double' applying to ! stack-allocated data as well as statically-allocate data. ! ! Note that the `gcc/f/gbe/' subdirectory has been removed from this ! distribution as a result of `g77' being fully integrated with the ! `egcs' variant of the `gcc' back end. ! ! * Fix code generation for iterative `DO' loops that have one or more ! references to the iteration variable, or to aliases of it, in ! their control expressions. For example, `DO 10 J=2,J' now is ! compiled correctly. ! ! * Fix `DTime' intrinsic so as not to truncate results to integer ! values (on some systems). ! ! * Remove support for non-`egcs' versions of `gcc'. ! ! * Remove support for the `--driver' option, as `g77' now does all ! the driving, just like `gcc'. ! ! * Allow any numeric argument to intrinsics `Int2' and `Int8'. ! ! * Improve diagnostic messages from `libf2c' so it is more likely ! that the printing of the active format string is limited to the ! string, with no trailing garbage being printed. ! ! (Unlike `f2c', `g77' did not append a null byte to its compiled ! form of every format string specified via a `FORMAT' statement. ! However, `f2c' would exhibit the problem anyway for a statement ! like `PRINT '(I)garbage', 1' by printing `(I)garbage' as the ! format string.) ! ! * Upgrade to `libf2c' as of 1997-09-23. This fixes a formatted-I/O ! bug that afflicted 64-bit systems with 32-bit integers (such as ! Digital Alpha running GNU/Linux). ! ! In 0.5.21: ! ========== ! ! * Fix a code-generation bug introduced by 0.5.20 caused by loop ! unrolling (by specifying `-funroll-loops' or similar). This bug ! afflicted all code compiled by version 2.7.2.2.f.2 of `gcc' (C, ! C++, Fortran, and so on). ! ! * Fix a code-generation bug manifested when combining local ! `EQUIVALENCE' with a `DATA' statement that follows the first ! executable statement (or is treated as an executable-context ! statement as a result of using the `-fpedantic' option). ! ! * Fix a compiler crash that occured when an integer division by a ! constant zero is detected. Instead, when the `-W' option is ! specified, the `gcc' back end issues a warning about such a case. ! This bug afflicted all code compiled by version 2.7.2.2.f.2 of ! `gcc' (C, C++, Fortran, and so on). ! ! * Fix a compiler crash that occurred in some cases of procedure ! inlining. (Such cases became more frequent in 0.5.20.) ! ! * Fix a compiler crash resulting from using `DATA' or similar to ! initialize a `COMPLEX' variable or array to zero. ! ! * Fix compiler crashes involving use of `AND', `OR', or `XOR' ! intrinsics. ! ! * Fix compiler bug triggered when using a `COMMON' or `EQUIVALENCE' ! variable as the target of an `ASSIGN' or assigned-`GOTO' statement. ! ! * Fix compiler crashes due to using the name of a some non-standard ! intrinsics (such as `FTELL' or `FPUTC') as such and as the name of ! a procedure or common block. Such dual use of a name in a program ! is allowed by the standard. ! ! * Place automatic arrays on the stack, even if `SAVE' or the ! `-fno-automatic' option is in effect. This avoids a compiler ! crash in some cases. ! ! * The `-malign-double' option now reliably aligns `DOUBLE PRECISION' ! optimally on Pentium and Pentium Pro architectures (586 and 686 in ! `gcc'). ! ! * New option `-Wno-globals' disables warnings about "suspicious" use ! of a name both as a global name and as the implicit name of an ! intrinsic, and warnings about disagreements over the number or ! natures of arguments passed to global procedures, or the natures ! of the procedures themselves. ! ! The default is to issue such warnings, which are new as of this ! version of `g77'. ! ! * New option `-fno-globals' disables diagnostics about potentially ! fatal disagreements analysis problems, such as disagreements over ! the number or natures of arguments passed to global procedures, or ! the natures of those procedures themselves. ! ! The default is to issue such diagnostics and flag the compilation ! as unsuccessful. With this option, the diagnostics are issued as ! warnings, or, if `-Wno-globals' is specified, are not issued at ! all. ! ! This option also disables inlining of global procedures, to avoid ! compiler crashes resulting from coding errors that these ! diagnostics normally would identify. ! ! * Diagnose cases where a reference to a procedure disagrees with the ! type of that procedure, or where disagreements about the number or ! nature of arguments exist. This avoids a compiler crash. ! ! * Fix parsing bug whereby `g77' rejected a second initialization ! specification immediately following the first's closing `/' without ! an intervening comma in a `DATA' statement, and the second ! specification was an implied-DO list. ! ! * Improve performance of the `gcc' back end so certain complicated ! expressions involving `COMPLEX' arithmetic (especially ! multiplication) don't appear to take forever to compile. ! ! * Fix a couple of profiling-related bugs in `gcc' back end. ! ! * Integrate GNU Ada's (GNAT's) changes to the back end, which ! consist almost entirely of bug fixes. These fixes are circa ! version 3.10p of GNAT. ! ! * Include some other `gcc' fixes that seem useful in `g77''s version ! of `gcc'. (See `gcc/ChangeLog' for details--compare it to that ! file in the vanilla `gcc-2.7.2.3.tar.gz' distribution.) ! ! * Fix `libU77' routines that accept file and other names to strip ! trailing blanks from them, for consistency with other ! implementations. Blanks may be forcibly appended to such names by ! appending a single null character (`CHAR(0)') to the significant ! trailing blanks. ! ! * Fix `CHMOD' intrinsic to work with file names that have embedded ! blanks, commas, and so on. ! ! * Fix `SIGNAL' intrinsic so it accepts an optional third `Status' ! argument. ! ! * Fix `IDATE()' intrinsic subroutine (VXT form) so it accepts ! arguments in the correct order. Documentation fixed accordingly, ! and for `GMTIME()' and `LTIME()' as well. ! ! * Make many changes to `libU77' intrinsics to support existing code ! more directly. ! ! Such changes include allowing both subroutine and function forms ! of many routines, changing `MCLOCK()' and `TIME()' to return ! `INTEGER(KIND=1)' values, introducing `MCLOCK8()' and `TIME8()' to ! return `INTEGER(KIND=2)' values, and placing functions that are ! intended to perform side effects in a new intrinsic group, ! `badu77'. ! ! * Improve `libU77' so it is more portable. ! ! * Add options `-fbadu77-intrinsics-delete', ! `-fbadu77-intrinsics-hide', and so on. ! ! * Fix crashes involving diagnosed or invalid code. ! ! * `g77' and `gcc' now do a somewhat better job detecting and ! diagnosing arrays that are too large to handle before these cause ! diagnostics during the assembler or linker phase, a compiler ! crash, or generation of incorrect code. ! ! * Make some fixes to alias analysis code. ! ! * Add support for `restrict' keyword in `gcc' front end. ! ! * Support `gcc' version 2.7.2.3 (modified by `g77' into version ! 2.7.2.3.f.1), and remove support for prior versions of `gcc'. ! ! * Incorporate GNAT's patches to the `gcc' back end into `g77''s, so ! GNAT users do not need to apply GNAT's patches to build both GNAT ! and `g77' from the same source tree. ! ! * Modify `make' rules and related code so that generation of Info ! documentation doesn't require compilation using `gcc'. Now, any ! ANSI C compiler should be adequate to produce the `g77' ! documentation (in particular, the tables of intrinsics) from ! scratch. ! ! * Add `INT2' and `INT8' intrinsics. ! ! * Add `CPU_TIME' intrinsic. ! ! * Add `ALARM' intrinsic. ! ! * `CTIME' intrinsic now accepts any `INTEGER' argument, not just ! `INTEGER(KIND=2)'. ! ! * Warn when explicit type declaration disagrees with the type of an ! intrinsic invocation. ! ! * Support `*f771' entry in `gcc' `specs' file. ! ! * Fix typo in `make' rule `g77-cross', used only for cross-compiling. ! ! * Fix `libf2c' build procedure to re-archive library if previous ! attempt to archive was interrupted. ! ! * Change `gcc' to unroll loops only during the last invocation (of ! as many as two invocations) of loop optimization. ! ! * Improve handling of `-fno-f2c' so that code that attempts to pass ! an intrinsic as an actual argument, such as `CALL FOO(ABS)', is ! rejected due to the fact that the run-time-library routine is, ! effectively, compiled with `-ff2c' in effect. ! ! * Fix `g77' driver to recognize `-fsyntax-only' as an option that ! inhibits linking, just like `-c' or `-S', and to recognize and ! properly handle the `-nostdlib', `-M', `-MM', `-nodefaultlibs', ! and `-Xlinker' options. ! ! * Upgrade to `libf2c' as of 1997-08-16. ! ! * Modify `libf2c' to consistently and clearly diagnose recursive I/O ! (at run time). ! ! * `g77' driver now prints version information (such as produced by ! `g77 -v') to `stderr' instead of `stdout'. ! ! * The `.r' suffix now designates a Ratfor source file, to be ! preprocessed via the `ratfor' command, available separately. ! ! * Fix some aspects of how `gcc' determines what kind of system is ! being configured and what kinds are supported. For example, GNU ! Linux/Alpha ELF systems now are directly supported. ! ! * Improve diagnostics. ! ! * Improve documentation and indexing. ! ! * Include all pertinent files for `libf2c' that come from ! `netlib.bell-labs.com'; give any such files that aren't quite ! accurate in `g77''s version of `libf2c' the suffix `.netlib'. ! ! * Reserve `INTEGER(KIND=0)' for future use. ! ! In 0.5.20: ! ========== ! ! * The `-fno-typeless-boz' option is now the default. ! ! This option specifies that non-decimal-radix constants using the ! prefixed-radix form (such as `Z'1234'') are to be interpreted as ! `INTEGER' constants. Specify `-ftypeless-boz' to cause such ! constants to be interpreted as typeless. ! ! (Version 0.5.19 introduced `-fno-typeless-boz' and its inverse.) ! ! * Options `-ff90-intrinsics-enable' and `-fvxt-intrinsics-enable' ! now are the defaults. ! ! Some programs might use names that clash with intrinsic names ! defined (and now enabled) by these options or by the new `libU77' ! intrinsics. Users of such programs might need to compile them ! differently (using, for example, `-ff90-intrinsics-disable') or, ! better yet, insert appropriate `EXTERNAL' statements specifying ! that these names are not intended to be names of intrinsics. ! ! * The `ALWAYS_FLUSH' macro is no longer defined when building ! `libf2c', which should result in improved I/O performance, ! especially over NFS. ! ! *Note:* If you have code that depends on the behavior of `libf2c' ! when built with `ALWAYS_FLUSH' defined, you will have to modify ! `libf2c' accordingly before building it from this and future ! versions of `g77'. ! ! * Dave Love's implementation of `libU77' has been added to the ! version of `libf2c' distributed with and built as part of `g77'. ! `g77' now knows about the routines in this library as intrinsics. ! ! * New option `-fvxt' specifies that the source file is written in ! VXT Fortran, instead of GNU Fortran. ! ! * The `-fvxt-not-f90' option has been deleted, along with its ! inverse, `-ff90-not-vxt'. ! ! If you used one of these deleted options, you should re-read the ! pertinent documentation to determine which options, if any, are ! appropriate for compiling your code with this version of `g77'. ! ! * The `-fugly' option now issues a warning, as it likely will be ! removed in a future version. ! ! (Enabling all the `-fugly-*' options is unlikely to be feasible, ! or sensible, in the future, so users should learn to specify only ! those `-fugly-*' options they really need for a particular source ! file.) ! ! * The `-fugly-assumed' option, introduced in version 0.5.19, has ! been changed to better accommodate old and new code. ! ! * Make a number of fixes to the `g77' front end and the `gcc' back ! end to better support Alpha (AXP) machines. This includes ! providing at least one bug-fix to the `gcc' back end for Alphas. ! ! * Related to supporting Alpha (AXP) machines, the `LOC()' intrinsic ! and `%LOC()' construct now return values of integer type that is ! the same width (holds the same number of bits) as the pointer type ! on the machine. ! ! On most machines, this won't make a difference, whereas on Alphas, ! the type these constructs return is `INTEGER*8' instead of the ! more common `INTEGER*4'. ! ! * Emulate `COMPLEX' arithmetic in the `g77' front end, to avoid bugs ! in `complex' support in the `gcc' back end. New option ! `-fno-emulate-complex' causes `g77' to revert the 0.5.19 behavior. ! ! * Fix bug whereby `REAL A(1)', for example, caused a compiler crash ! if `-fugly-assumed' was in effect and A was a local (automatic) ! array. That case is no longer affected by the new handling of ! `-fugly-assumed'. ! ! * Fix `g77' command driver so that `g77 -o foo.f' no longer deletes ! `foo.f' before issuing other diagnostics, and so the `-x' option ! is properly handled. ! ! * Enable inlining of subroutines and functions by the `gcc' back end. ! This works as it does for `gcc' itself--program units may be ! inlined for invocations that follow them in the same program unit, ! as long as the appropriate compile-time options are specified. ! ! * Dummy arguments are no longer assumed to potentially alias ! (overlap) other dummy arguments or `COMMON' areas when any of ! these are defined (assigned to) by Fortran code. ! ! This can result in faster and/or smaller programs when compiling ! with optimization enabled, though on some systems this effect is ! observed only when `-fforce-addr' also is specified. ! ! New options `-falias-check', `-fargument-alias', ! `-fargument-noalias', and `-fno-argument-noalias-global' control ! the way `g77' handles potential aliasing. ! ! * The `CONJG()' and `DCONJG()' intrinsics now are compiled in-line. ! ! * The bug-fix for 0.5.19.1 has been re-done. The `g77' compiler has ! been changed back to assume `libf2c' has no aliasing problems in ! its implementations of the `COMPLEX' (and `DOUBLE COMPLEX') ! intrinsics. The `libf2c' has been changed to have no such ! problems. ! ! As a result, 0.5.20 is expected to offer improved performance over ! 0.5.19.1, perhaps as good as 0.5.19 in most or all cases, due to ! this change alone. ! ! *Note:* This change requires version 0.5.20 of `libf2c', at least, ! when linking code produced by any versions of `g77' other than ! 0.5.19.1. Use `g77 -v' to determine the version numbers of the ! `libF77', `libI77', and `libU77' components of the `libf2c' ! library. (If these version numbers are not printed--in ! particular, if the linker complains about unresolved references to ! names like `g77__fvers__'--that strongly suggests your ! installation has an obsolete version of `libf2c'.) ! ! * New option `-fugly-assign' specifies that the same memory ! locations are to be used to hold the values assigned by both ! statements `I = 3' and `ASSIGN 10 TO I', for example. (Normally, ! `g77' uses a separate memory location to hold assigned statement ! labels.) ! ! * `FORMAT' and `ENTRY' statements now are allowed to precede ! `IMPLICIT NONE' statements. ! ! * Produce diagnostic for unsupported `SELECT CASE' on `CHARACTER' ! type, instead of crashing, at compile time. ! ! * Fix crashes involving diagnosed or invalid code. ! ! * Change approach to building `libf2c' archive (`libf2c.a') so that ! members are added to it only when truly necessary, so the user ! that installs an already-built `g77' doesn't need to have write ! access to the build tree (whereas the user doing the build might ! not have access to install new software on the system). ! ! * Support `gcc' version 2.7.2.2 (modified by `g77' into version ! 2.7.2.2.f.2), and remove support for prior versions of `gcc'. ! ! * Upgrade to `libf2c' as of 1997-02-08, and fix up some of the build ! procedures. ! ! * Improve general build procedures for `g77', fixing minor bugs ! (such as deletion of any file named `f771' in the parent directory ! of `gcc/'). ! ! * Enable full support of `INTEGER*8' available in `libf2c' and ! `f2c.h' so that `f2c' users may make full use of its features via ! the `g77' version of `f2c.h' and the `INTEGER*8' support routines ! in the `g77' version of `libf2c'. ! ! * Improve `g77' driver and `libf2c' so that `g77 -v' yields version ! information on the library. ! ! * The `SNGL' and `FLOAT' intrinsics now are specific intrinsics, ! instead of synonyms for the generic intrinsic `REAL'. ! ! * New intrinsics have been added. These are `REALPART', `IMAGPART', ! `COMPLEX', `LONG', and `SHORT'. ! ! * A new group of intrinsics, `gnu', has been added to contain the ! new `REALPART', `IMAGPART', and `COMPLEX' intrinsics. An old ! group, `dcp', has been removed. ! ! * Complain about industry-wide ambiguous references `REAL(EXPR)' and ! `AIMAG(EXPR)', where EXPR is `DOUBLE COMPLEX' (or any complex type ! other than `COMPLEX'), unless `-ff90' option specifies Fortran 90 ! interpretation or new `-fugly-complex' option, in conjunction with ! `-fnot-f90', specifies `f2c' interpretation. ! ! * Make improvements to diagnostics. ! ! * Speed up compiler a bit. ! ! * Improvements to documentation and indexing, including a new ! chapter containing information on one, later more, diagnostics ! that users are directed to pull up automatically via a message in ! the diagnostic itself. ! ! (Hence the menu item `M' for the node `Diagnostics' in the ! top-level menu of the Info documentation.) ! ! In 0.5.19.1: ! ============ ! ! * Code-generation bugs afflicting operations on complex data have ! been fixed. ! ! These bugs occurred when assigning the result of an operation to a ! complex variable (or array element) that also served as an input ! to that operation. ! ! The operations affected by this bug were: `CONJG()', `DCONJG()', ! `CCOS()', `CDCOS()', `CLOG()', `CDLOG()', `CSIN()', `CDSIN()', ! `CSQRT()', `CDSQRT()', complex division, and raising a `DOUBLE ! COMPLEX' operand to an `INTEGER' power. (The related generic and ! `Z'-prefixed intrinsics, such as `ZSIN()', also were affected.) ! ! For example, `C = CSQRT(C)', `Z = Z/C', and `Z = Z**I' (where `C' ! is `COMPLEX' and `Z' is `DOUBLE COMPLEX') have been fixed. ! ! In 0.5.19: ! ========== ! ! * Fix `FORMAT' statement parsing so negative values for specifiers ! such as `P' (e.g. `FORMAT(-1PF8.1)') are correctly processed as ! negative. ! ! * Fix `SIGNAL' intrinsic so it once again accepts a procedure as its ! second argument. ! ! * A temporary kludge option provides bare-bones information on ! `COMMON' and `EQUIVALENCE' members at debug time. ! ! * New `-fonetrip' option specifies FORTRAN-66-style one-trip `DO' ! loops. ! ! * New `-fno-silent' option causes names of program units to be ! printed as they are compiled, in a fashion similar to UNIX `f77' ! and `f2c'. ! ! * New `-fugly-assumed' option specifies that arrays dimensioned via ! `DIMENSION X(1)', for example, are to be treated as assumed-size. ! ! * New `-fno-typeless-boz' option specifies that non-decimal-radix ! constants using the prefixed-radix form (such as `Z'1234'') are to ! be interpreted as `INTEGER' constants. ! ! * New `-ff66' option is a "shorthand" option that specifies ! behaviors considered appropriate for FORTRAN 66 programs. ! ! * New `-ff77' option is a "shorthand" option that specifies ! behaviors considered appropriate for UNIX `f77' programs. ! ! * New `-fugly-comma' and `-fugly-logint' options provided to perform ! some of what `-fugly' used to do. `-fugly' and `-fno-ugly' are ! now "shorthand" options, in that they do nothing more than enable ! (or disable) other `-fugly-*' options. ! ! * Fix parsing of assignment statements involving targets that are ! substrings of elements of `CHARACTER' arrays having names such as ! `READ', `WRITE', `GOTO', and `REALFUNCTIONFOO'. ! ! * Fix crashes involving diagnosed code. ! ! * Fix handling of local `EQUIVALENCE' areas so certain cases of ! valid Fortran programs are not misdiagnosed as improperly ! extending the area backwards. ! ! * Support `gcc' version 2.7.2.1. ! ! * Upgrade to `libf2c' as of 1996-09-26, and fix up some of the build ! procedures. ! ! * Change code generation for list-directed I/O so it allows for new ! versions of `libf2c' that might return non-zero status codes for ! some operations previously assumed to always return zero. ! ! This change not only affects how `IOSTAT=' variables are set by ! list-directed I/O, it also affects whether `END=' and `ERR=' ! labels are reached by these operations. ! ! * Add intrinsic support for new `FTELL' and `FSEEK' procedures in ! `libf2c'. ! ! * Modify `fseek_()' in `libf2c' to be more portable (though, in ! practice, there might be no systems where this matters) and to ! catch invalid `whence' arguments. ! ! * Some useless warnings from the `-Wunused' option have been ! eliminated. ! ! * Fix a problem building the `f771' executable on AIX systems by ! linking with the `-bbigtoc' option. ! ! * Abort configuration if `gcc' has not been patched using the patch ! file provided in the `gcc/f/gbe/' subdirectory. ! ! * Add options `--help' and `--version' to the `g77' command, to ! conform to GNU coding guidelines. Also add printing of `g77' ! version number when the `--verbose' (`-v') option is used. ! ! * Change internally generated name for local `EQUIVALENCE' areas to ! one based on the alphabetically sorted first name in the list of ! names for entities placed at the beginning of the areas. ! ! * Improvements to documentation and indexing. ! ! In 0.5.18: ! ========== ! ! * Add some rudimentary support for `INTEGER*1', `INTEGER*2', ! `INTEGER*8', and their `LOGICAL' equivalents. (This support works ! on most, maybe all, `gcc' targets.) ! ! Thanks to Scott Snyder () for providing ! the patch for this! ! ! Among the missing elements from the support for these features are ! full intrinsic support and constants. ! ! * Add some rudimentary support for the `BYTE' and `WORD' ! type-declaration statements. `BYTE' corresponds to `INTEGER*1', ! while `WORD' corresponds to `INTEGER*2'. ! ! Thanks to Scott Snyder () for providing ! the patch for this! ! ! * The compiler code handling intrinsics has been largely rewritten ! to accommodate the new types. No new intrinsics or arguments for ! existing intrinsics have been added, so there is, at this point, ! no intrinsic to convert to `INTEGER*8', for example. ! ! * Support automatic arrays in procedures. ! ! * Reduce space/time requirements for handling large *sparsely* ! initialized aggregate arrays. This improvement applies to only a ! subset of the general problem to be addressed in 0.6. ! ! * Treat initial values of zero as if they weren't specified (in DATA ! and type-declaration statements). The initial values will be set ! to zero anyway, but the amount of compile time processing them ! will be reduced, in some cases significantly (though, again, this ! is only a subset of the general problem to be addressed in 0.6). ! ! A new option, `-fzeros', is introduced to enable the traditional ! treatment of zeros as any other value. ! ! * With `-ff90' in force, `g77' incorrectly interpreted `REAL(Z)' as ! returning a `REAL' result, instead of as a `DOUBLE PRECISION' ! result. (Here, `Z' is `DOUBLE COMPLEX'.) ! ! With `-fno-f90' in force, the interpretation remains unchanged, ! since this appears to be how at least some F77 code using the ! `DOUBLE COMPLEX' extension expected it to work. ! ! Essentially, `REAL(Z)' in F90 is the same as `DBLE(Z)', while in ! extended F77, it appears to be the same as `REAL(REAL(Z))'. ! ! * An expression involving exponentiation, where both operands were ! type `INTEGER' and the right-hand operand was negative, was ! erroneously evaluated. ! ! * Fix bugs involving `DATA' implied-`DO' constructs (these involved ! an errant diagnostic and a crash, both on good code, one involving ! subsequent statement-function definition). ! ! * Close `INCLUDE' files after processing them, so compiling source ! files with lots of `INCLUDE' statements does not result in being ! unable to open `INCLUDE' files after all the available file ! descriptors are used up. ! ! * Speed up compiling, especially of larger programs, and perhaps ! slightly reduce memory utilization while compiling (this is *not* ! the improvement planned for 0.6 involving large aggregate ! areas)--these improvements result from simply turning off some ! low-level code to do self-checking that hasn't been triggered in a ! long time. ! ! * Introduce three new options that implement optimizations in the ! `gcc' back end (GBE). These options are `-fmove-all-movables', ! `-freduce-all-givs', and `-frerun-loop-opt', which are enabled, by ! default, for Fortran compilations. These optimizations are ! intended to help toon Fortran programs. ! ! * Patch the GBE to do a better job optimizing certain kinds of ! references to array elements. ! ! * Due to patches to the GBE, the version number of `gcc' also is ! patched to make it easier to manage installations, especially ! useful if it turns out a `g77' change to the GBE has a bug. ! ! The `g77'-modified version number is the `gcc' version number with ! the string `.f.N' appended, where `f' identifies the version as ! enhanced for Fortran, and N is `1' for the first Fortran patch for ! that version of `gcc', `2' for the second, and so on. ! ! So, this introduces version 2.7.2.f.1 of `gcc'. ! ! * Make several improvements and fixes to diagnostics, including the ! removal of two that were inappropriate or inadequate. ! ! * Warning about two successive arithmetic operators, produced by ! `-Wsurprising', now produced *only* when both operators are, ! indeed, arithmetic (not relational/boolean). ! ! * `-Wsurprising' now warns about the remaining cases of using ! non-integral variables for implied-`DO' loops, instead of these ! being rejected unless `-fpedantic' or `-fugly' specified. ! ! * Allow `SAVE' of a local variable or array, even after it has been ! given an initial value via `DATA', for example. ! ! * Introduce an Info version of `g77' documentation, which supercedes ! `gcc/f/CREDITS', `gcc/f/DOC', and `gcc/f/PROJECTS'. These files ! will be removed in a future release. The files `gcc/f/BUGS', ! `gcc/f/INSTALL', and `gcc/f/NEWS' now are automatically built from ! the texinfo source when distributions are made. ! ! This effort was inspired by a first pass at translating ! `g77-0.5.16/f/DOC' that was contributed to Craig by David Ronis ! (). ! ! * New `-fno-second-underscore' option to specify that, when ! `-funderscoring' is in effect, a second underscore is not to be ! appended to Fortran names already containing an underscore. ! ! * Change the way iterative `DO' loops work to follow the F90 ! standard. In particular, calculation of the iteration count is ! still done by converting the start, end, and increment parameters ! to the type of the `DO' variable, but the result of the ! calculation is always converted to the default `INTEGER' type. ! ! (This should have no effect on existing code compiled by `g77', ! but code written to assume that use of a *wider* type for the `DO' ! variable will result in an iteration count being fully calculated ! using that wider type (wider than default `INTEGER') must be ! rewritten.) ! ! * Support `gcc' version 2.7.2. ! ! * Upgrade to `libf2c' as of 1996-03-23, and fix up some of the build ! procedures. ! ! Note that the email addresses related to `f2c' have changed--the ! distribution site now is named `netlib.bell-labs.com', and the ! maintainer's new address is . ! ! In 0.5.17: ! ========== ! ! * *Fix serious bug* in `g77 -v' command that can cause removal of a ! system's `/dev/null' special file if run by user `root'. ! ! *All users* of version 0.5.16 should ensure that they have not ! removed `/dev/null' or replaced it with an ordinary file (e.g. by ! comparing the output of `ls -l /dev/null' with `ls -l /dev/zero'. ! If the output isn't basically the same, contact your system ! administrator about restoring `/dev/null' to its proper status). ! ! This bug is particularly insidious because removing `/dev/null' as ! a special file can go undetected for quite a while, aside from ! various applications and programs exhibiting sudden, strange ! behaviors. ! ! I sincerely apologize for not realizing the implications of the ! fact that when `g77 -v' runs the `ld' command with `-o /dev/null' ! that `ld' tries to *remove* the executable it is supposed to build ! (especially if it reports unresolved references, which it should ! in this case)! ! ! * Fix crash on `CHARACTER*(*) FOO' in a main or block data program ! unit. ! ! * Fix crash that can occur when diagnostics given outside of any ! program unit (such as when input file contains `@foo'). ! ! * Fix crashes, infinite loops (hangs), and such involving diagnosed ! code. ! ! * Fix `ASSIGN''ed variables so they can be `SAVE''d or dummy ! arguments, and issue clearer error message in cases where target ! of `ASSIGN' or `ASSIGN'ed `GOTO'/`FORMAT' is too small (which ! should never happen). ! ! * Make `libf2c' build procedures work on more systems again by ! eliminating unnecessary invocations of `ld -r -x' and `mv'. ! ! * Fix omission of `-funix-intrinsics-...' options in list of ! permitted options to compiler. ! ! * Fix failure to always diagnose missing type declaration for ! `IMPLICIT NONE'. ! ! * Fix compile-time performance problem (which could sometimes crash ! the compiler, cause a hang, or whatever, due to a bug in the back ! end) involving exponentiation with a large `INTEGER' constant for ! the right-hand operator (e.g. `I**32767'). ! ! * Fix build procedures so cross-compiling `g77' (the `fini' utility ! in particular) is properly built using the host compiler. ! ! * Add new `-Wsurprising' option to warn about constructs that are ! interpreted by the Fortran standard (and `g77') in ways that are ! surprising to many programmers. ! ! * Add `ERF()' and `ERFC()' as generic intrinsics mapping to existing ! `ERF'/`DERF' and `ERFC'/`DERFC' specific intrinsics. ! ! *Note:* You should specify `INTRINSIC ERF,ERFC' in any code where ! you might use these as generic intrinsics, to improve likelihood ! of diagnostics (instead of subtle run-time bugs) when using a ! compiler that doesn't support these as intrinsics (e.g. `f2c'). ! ! * Remove from `-fno-pedantic' the diagnostic about `DO' with ! non-`INTEGER' index variable; issue that under `-Wsurprising' ! instead. ! ! * Clarify some diagnostics that say things like "ignored" when that's ! misleading. ! ! * Clarify diagnostic on use of `.EQ.'/`.NE.' on `LOGICAL' operands. ! ! * Minor improvements to code generation for various operations on ! `LOGICAL' operands. ! ! * Minor improvement to code generation for some `DO' loops on some ! machines. ! ! * Support `gcc' version 2.7.1. ! ! * Upgrade to `libf2c' as of 1995-11-15. ! ! In 0.5.16: ! ========== ! ! * Fix a code-generation bug involving complicated `EQUIVALENCE' ! statements not involving `COMMON'. ! ! * Fix code-generation bugs involving invoking "gratis" library ! procedures in `libf2c' from code compiled with `-fno-f2c' by ! making these procedures known to `g77' as intrinsics (not affected ! by -fno-f2c). This is known to fix code invoking `ERF()', ! `ERFC()', `DERF()', and `DERFC()'. ! ! * Update `libf2c' to include netlib patches through 1995-08-16, and ! `#define' `WANT_LEAD_0' to 1 to make `g77'-compiled code more ! consistent with other Fortran implementations by outputting ! leading zeros in formatted and list-directed output. ! ! * Fix a code-generation bug involving adjustable dummy arrays with ! high bounds whose primaries are changed during procedure ! execution, and which might well improve code-generation ! performance for such arrays compared to `f2c' plus `gcc' (but ! apparently only when using `gcc-2.7.0' or later). ! ! * Fix a code-generation bug involving invocation of `COMPLEX' and ! `DOUBLE COMPLEX' `FUNCTION's and doing `COMPLEX' and `DOUBLE ! COMPLEX' divides, when the result of the invocation or divide is ! assigned directly to a variable that overlaps one or more of the ! arguments to the invocation or divide. ! ! * Fix crash by not generating new optimal code for `X**I' if `I' is ! nonconstant and the expression is used to dimension a dummy array, ! since the `gcc' back end does not support the necessary mechanics ! (and the `gcc' front end rejects the equivalent construct, as it ! turns out). ! ! * Fix crash on expressions like `COMPLEX**INTEGER'. ! ! * Fix crash on expressions like `(1D0,2D0)**2', i.e. raising a ! `DOUBLE COMPLEX' constant to an `INTEGER' constant power. ! ! * Fix crashes and such involving diagnosed code. ! ! * Diagnose, instead of crashing on, statement function definitions ! having duplicate dummy argument names. ! ! * Fix bug causing rejection of good code involving statement function ! definitions. ! ! * Fix bug resulting in debugger not knowing size of local equivalence ! area when any member of area has initial value (via `DATA', for ! example). ! ! * Fix installation bug that prevented installation of `g77' driver. ! Provide for easy selection of whether to install copy of `g77' as ! `f77' to replace the broken code. ! ! * Fix `gcc' driver (affects `g77' thereby) to not gratuitously ! invoke the `f771' program (e.g. when `-E' is specified). ! ! * Fix diagnostic to point to correct source line when it immediately ! follows an `INCLUDE' statement. ! ! * Support more compiler options in `gcc'/`g77' when compiling ! Fortran files. These options include `-p', `-pg', `-aux-info', ! `-P', correct setting of version-number macros for preprocessing, ! full recognition of `-O0', and automatic insertion of ! configuration-specific linker specs. ! ! * Add new intrinsics that interface to existing routines in `libf2c': ! `ABORT', `DERF', `DERFC', `ERF', `ERFC', `EXIT', `FLUSH', ! `GETARG', `GETENV', `IARGC', `SIGNAL', and `SYSTEM'. Note that ! `ABORT', `EXIT', `FLUSH', `SIGNAL', and `SYSTEM' are intrinsic ! subroutines, not functions (since they have side effects), so to ! get the return values from `SIGNAL' and `SYSTEM', append a final ! argument specifying an `INTEGER' variable or array element (e.g. ! `CALL SYSTEM('rm foo',ISTAT)'). ! ! * Add new intrinsic group named `unix' to contain the new intrinsics, ! and by default enable this new group. ! ! * Move `LOC()' intrinsic out of the `vxt' group to the new `unix' ! group. ! ! * Improve `g77' so that `g77 -v' by itself (or with certain other ! options, including `-B', `-b', `-i', `-nostdlib', and `-V') ! reports lots more useful version info, and so that long-form ! options `gcc' accepts are understood by `g77' as well (even in ! truncated, unambiguous forms). ! ! * Add new `g77' option `--driver=name' to specify driver when ! default, `gcc', isn't appropriate. ! ! * Add support for `#' directives (as output by the preprocessor) in ! the compiler, and enable generation of those directives by the ! preprocessor (when compiling `.F' files) so diagnostics and ! debugging info are more useful to users of the preprocessor. ! ! * Produce better diagnostics, more like `gcc', with info such as `In ! function `foo':' and `In file included from...:'. ! ! * Support `gcc''s `-fident' and `-fno-ident' options. ! ! * When `-Wunused' in effect, don't warn about local variables used as ! statement-function dummy arguments or `DATA' implied-`DO' iteration ! variables, even though, strictly speaking, these are not uses of ! the variables themselves. ! ! * When `-W -Wunused' in effect, don't warn about unused dummy ! arguments at all, since there's no way to turn this off for ! individual cases (`g77' might someday start warning about ! these)--applies to `gcc' versions 2.7.0 and later, since earlier ! versions didn't warn about unused dummy arguments. ! ! * New option `-fno-underscoring' that inhibits transformation of ! names (by appending one or two underscores) so users may experiment ! with implications of such an environment. ! ! * Minor improvement to `gcc/f/info' module to make it easier to build ! `g77' using the native (non-`gcc') compiler on certain machines ! (but definitely not all machines nor all non-`gcc' compilers). ! Please do not report bugs showing problems compilers have with ! macros defined in `gcc/f/target.h' and used in places like ! `gcc/f/expr.c'. ! ! * Add warning to be printed for each invocation of the compiler if ! the target machine `INTEGER', `REAL', or `LOGICAL' size is not 32 ! bits, since `g77' is known to not work well for such cases (to be ! fixed in Version 0.6--*note Actual Bugs We Haven't Fixed Yet: ! Actual Bugs.). ! ! * Lots of new documentation (though work is still needed to put it ! into canonical GNU format). ! ! * Build `libf2c' with `-g0', not `-g2', in effect (by default), to ! produce smaller library without lots of debugging clutter. ! ! In 0.5.15: ! ========== ! ! * Fix bad code generation involving `X**I' and temporary, internal ! variables generated by `g77' and the back end (such as for `DO' ! loops). ! ! * Fix crash given `CHARACTER A;DATA A/.TRUE./'. ! ! * Replace crash with diagnostic given `CHARACTER A;DATA A/1.0/'. ! ! * Fix crash or other erratic behavior when null character constant ! (`''') is encountered. ! ! * Fix crash or other erratic behavior involving diagnosed code. ! ! * Fix code generation for external functions returning type `REAL' ! when the `-ff2c' option is in force (which it is by default) so ! that `f2c' compatibility is indeed provided. ! ! * Disallow `COMMON I(10)' if `I' has previously been specified with ! an array declarator. ! ! * New `-ffixed-line-length-N' option, where N is the maximum length ! of a typical fixed-form line, defaulting to 72 columns, such that ! characters beyond column N are ignored, or N is `none', meaning no ! characters are ignored. does not affect lines with `&' in column ! 1, which are always processed as if `-ffixed-line-length-none' was ! in effect. ! ! * No longer generate better code for some kinds of array references, ! as `gcc' back end is to be fixed to do this even better, and it ! turned out to slow down some code in some cases after all. ! ! * In `COMMON' and `EQUIVALENCE' areas with any members given initial ! values (e.g. via `DATA'), uninitialized members now always ! initialized to binary zeros (though this is not required by the ! standard, and might not be done in future versions of `g77'). ! Previously, in some `COMMON'/`EQUIVALENCE' areas (essentially ! those with members of more than one type), the uninitialized ! members were initialized to spaces, to cater to `CHARACTER' types, ! but it seems no existing code expects that, while much existing ! code expects binary zeros. ! ! In 0.5.14: ! ========== ! ! * Don't emit bad code when low bound of adjustable array is ! nonconstant and thus might vary as an expression at run time. ! ! * Emit correct code for calculation of number of trips in `DO' loops ! for cases where the loop should not execute at all. (This bug ! affected cases where the difference between the begin and end ! values was less than the step count, though probably not for ! floating-point cases.) ! ! * Fix crash when extra parentheses surround item in `DATA' ! implied-`DO' list. ! ! * Fix crash over minor internal inconsistencies in handling ! diagnostics, just substitute dummy strings where necessary. ! ! * Fix crash on some systems when compiling call to `MVBITS()' ! intrinsic. ! ! * Fix crash on array assignment `TYPEDDD(...)=...', where DDD is a ! string of one or more digits. ! ! * Fix crash on `DCMPLX()' with a single `INTEGER' argument. ! ! * Fix various crashes involving code with diagnosed errors. ! ! * Support `-I' option for `INCLUDE' statement, plus `gcc''s ! `header.gcc' facility for handling systems like MS-DOS. ! ! * Allow `INCLUDE' statement to be continued across multiple lines, ! even allow it to coexist with other statements on the same line. ! ! * Incorporate Bellcore fixes to `libf2c' through 1995-03-15--this ! fixes a bug involving infinite loops reading EOF with empty ! list-directed I/O list. ! ! * Remove all the `g77'-specific auto-configuration scripts, code, ! and so on, except for temporary substitutes for bsearch() and ! strtoul(), as too many configure/build problems were reported in ! these areas. People will have to fix their systems' problems ! themselves, or at least somewhere other than `g77', which expects ! a working ANSI C environment (and, for now, a GNU C compiler to ! compile `g77' itself). ! ! * Complain if initialized common redeclared as larger in subsequent ! program unit. ! ! * Warn if blank common initialized, since its size can vary and hence ! related warnings that might be helpful won't be seen. ! ! * New `-fbackslash' option, on by default, that causes `\' within ! `CHARACTER' and Hollerith constants to be interpreted a la GNU C. ! Note that this behavior is somewhat different from `f2c''s, which ! supports only a limited subset of backslash (escape) sequences. ! ! * Make `-fugly-args' the default. ! ! * New `-fugly-init' option, on by default, that allows ! typeless/Hollerith to be specified as initial values for variables ! or named constants (`PARAMETER'), and also allows ! character<->numeric conversion in those contexts--turn off via ! `-fno-ugly-init'. ! ! * New `-finit-local-zero' option to initialize local variables to ! binary zeros. This does not affect whether they are `SAVE'd, i.e. ! made automatic or static. ! ! * New `-Wimplicit' option to warn about implicitly typed variables, ! arrays, and functions. (Basically causes all program units to ! default to `IMPLICIT NONE'.) ! ! * `-Wall' now implies `-Wuninitialized' as with `gcc' (i.e. unless ! `-O' not specified, since `-Wuninitialized' requires `-O'), and ! implies `-Wunused' as well. ! ! * `-Wunused' no longer gives spurious messages for unused `EXTERNAL' ! names (since they are assumed to refer to block data program ! units, to make use of libraries more reliable). ! ! * Support `%LOC()' and `LOC()' of character arguments. ! ! * Support null (zero-length) character constants and expressions. ! ! * Support `f2c''s `IMAG()' generic intrinsic. ! ! * Support `ICHAR()', `IACHAR()', and `LEN()' of character ! expressions that are valid in assignments but not normally as ! actual arguments. ! ! * Support `f2c'-style `&' in column 1 to mean continuation line. ! ! * Allow `NAMELIST', `EXTERNAL', `INTRINSIC', and `VOLATILE' in ! `BLOCK DATA', even though these are not allowed by the standard. ! ! * Allow `RETURN' in main program unit. ! ! * Changes to Hollerith-constant support to obey Appendix C of the ! standard: ! ! - Now padded on the right with zeros, not spaces. ! ! - Hollerith "format specifications" in the form of arrays of ! non-character allowed. ! ! - Warnings issued when non-space truncation occurs when ! converting to another type. ! ! - When specified as actual argument, now passed by reference to ! `INTEGER' (padded on right with spaces if constant too small, ! otherwise fully intact if constant wider the `INTEGER' type) ! instead of by value. ! ! *Warning:* `f2c' differs on the interpretation of `CALL FOO(1HX)', ! which it treats exactly the same as `CALL FOO('X')', but which the ! standard and `g77' treat as `CALL FOO(%REF('X '))' (padded with ! as many spaces as necessary to widen to `INTEGER'), essentially. ! ! * Changes and fixes to typeless-constant support: ! ! - Now treated as a typeless double-length `INTEGER' value. ! ! - Warnings issued when overflow occurs. ! ! - Padded on the left with zeros when converting to a larger ! type. ! ! - Should be properly aligned and ordered on the target machine ! for whatever type it is turned into. ! ! - When specified as actual argument, now passed as reference to ! a default `INTEGER' constant. ! ! * `%DESCR()' of a non-`CHARACTER' expression now passes a pointer to ! the expression plus a length for the expression just as if it were ! a `CHARACTER' expression. For example, `CALL FOO(%DESCR(D))', ! where `D' is `REAL*8', is the same as `CALL FOO(D,%VAL(8)))'. ! ! * Name of multi-entrypoint master function changed to incorporate ! the name of the primary entry point instead of a decimal value, so ! the name of the master function for `SUBROUTINE X' with alternate ! entry points is now `__g77_masterfun_x'. ! ! * Remove redundant message about zero-step-count `DO' loops. ! ! * Clean up diagnostic messages, shortening many of them. ! ! * Fix typo in `g77' man page. ! ! * Clarify implications of constant-handling bugs in `f/BUGS'. ! ! * Generate better code for `**' operator with a right-hand operand of ! type `INTEGER'. ! * Generate better code for `SQRT()' and `DSQRT()', also when ! `-ffast-math' specified, enable better code generation for `SIN()' ! and `COS()'. ! * Generate better code for some kinds of array references. ! * Speed up lexing somewhat (this makes the compilation phase ! noticeably faster). --- 398,412 ---- * The F90 `System_Clock' intrinsic allows the optional arguments (except for the `Count' argument) to be omitted. ! 38. Upgrade to `libf2c' as of 1998-06-18. ! 39. Improve documentation and indexing. ! In previous versions: ! ===================== ! Information on previous versions is not provided in this ! `egcs/gcc/f/NEWS' file, to keep it short. See `egcs/gcc/f/news.texi', ! or any of its other derivations (Info, HTML, dvi forms) for such ! information. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/RELEASE-PREP gcc-2.95/gcc/f/RELEASE-PREP *** egcs-1.1.2/gcc/f/RELEASE-PREP Wed Dec 31 16:00:00 1969 --- gcc-2.95/gcc/f/RELEASE-PREP Sat Mar 13 04:03:55 1999 *************** *** 0 **** --- 1,5 ---- + 1999-03-13 RELEASE-PREP + + Things to do to prepare a g77 release (FSF, egcs, whatever). + + - Update root.texi: clear DEVELOPMENT flag, set version info. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/ansify.c gcc-2.95/gcc/f/ansify.c *** egcs-1.1.2/gcc/f/ansify.c Wed Jul 15 02:35:56 1998 --- gcc-2.95/gcc/f/ansify.c Tue Apr 6 23:48:34 1999 *************** *** 1,6 **** /* ansify.c Copyright (C) 1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* ansify.c Copyright (C) 1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** typedef enum *** 51,57 **** while(0) static void ! die () { exit (1); } --- 51,57 ---- while(0) static void ! die (void) { exit (1); } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/assert.j gcc-2.95/gcc/f/assert.j *** egcs-1.1.2/gcc/f/assert.j Tue May 19 03:49:09 1998 --- gcc-2.95/gcc/f/assert.j Mon Feb 15 10:16:22 1999 *************** *** 1,6 **** /* assert.j -- Wrapper for GCC's assert.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* assert.j -- Wrapper for GCC's assert.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/bad.c gcc-2.95/gcc/f/bad.c *** egcs-1.1.2/gcc/f/bad.c Mon Jun 15 19:23:10 1998 --- gcc-2.95/gcc/f/bad.c Sat Mar 27 02:23:37 1999 *************** *** 1,6 **** /* bad.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* bad.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** bool ffebad_is_inhibited_ = FALSE; *** 62,68 **** struct _ffebad_message_ { ffebadSeverity severity; ! char *message; }; /* Static objects accessed by functions in this module. */ --- 62,68 ---- struct _ffebad_message_ { ffebadSeverity severity; ! const char *message; }; /* Static objects accessed by functions in this module. */ *************** static struct *** 89,99 **** } ffebad_here_[FFEBAD_MAX_]; ! static char *ffebad_string_[FFEBAD_MAX_]; static ffebadIndex ffebad_order_[FFEBAD_MAX_]; static ffebad ffebad_errnum_; static ffebadSeverity ffebad_severity_; ! static char *ffebad_message_; static unsigned char ffebad_index_; static ffebadIndex ffebad_places_; static bool ffebad_is_temp_inhibited_; /* Effective setting of --- 89,99 ---- } ffebad_here_[FFEBAD_MAX_]; ! static const char *ffebad_string_[FFEBAD_MAX_]; static ffebadIndex ffebad_order_[FFEBAD_MAX_]; static ffebad ffebad_errnum_; static ffebadSeverity ffebad_severity_; ! static const char *ffebad_message_; static unsigned char ffebad_index_; static ffebadIndex ffebad_places_; static bool ffebad_is_temp_inhibited_; /* Effective setting of *************** static bool ffebad_is_temp_inhibited_; / *** 102,108 **** /* Static functions (internal). */ ! static int ffebad_bufputs_ (char buf[], int bufi, char *s); /* Internal macros. */ --- 102,108 ---- /* Static functions (internal). */ ! static int ffebad_bufputs_ (char buf[], int bufi, const char *s); /* Internal macros. */ *************** static int ffebad_bufputs_ (char buf[], *** 115,121 **** static int ! ffebad_bufputs_ (char buf[], int bufi, char *s) { for (; *s != '\0'; ++s) bufi = ffebad_bufputc_ (buf, bufi, *s); --- 115,121 ---- static int ! ffebad_bufputs_ (char buf[], int bufi, const char *s) { for (; *s != '\0'; ++s) bufi = ffebad_bufputc_ (buf, bufi, *s); *************** ffebad_severity (ffebad errnum) *** 161,167 **** bool ffebad_start_ (bool lex_override, ffebad errnum, ffebadSeverity sev, ! char *message) { unsigned char i; --- 161,167 ---- bool ffebad_start_ (bool lex_override, ffebad errnum, ffebadSeverity sev, ! const char *message) { unsigned char i; *************** ffebad_here (ffebadIndex index, ffewhere *** 321,327 **** /* Establish string for next index (always in order) of message ! ffebad_string(char *string); Call ffebad_start to establish the message, ffebad_here and ffebad_string to send run-time data to it as necessary, then ffebad_finish when through --- 321,327 ---- /* Establish string for next index (always in order) of message ! ffebad_string(const char *string); Call ffebad_start to establish the message, ffebad_here and ffebad_string to send run-time data to it as necessary, then ffebad_finish when through *************** ffebad_here (ffebadIndex index, ffewhere *** 330,336 **** the argument passed in until then. */ void ! ffebad_string (char *string) { if (ffebad_is_temp_inhibited_) return; --- 330,336 ---- the argument passed in until then. */ void ! ffebad_string (const char *string) { if (ffebad_is_temp_inhibited_) return; *************** void *** 351,357 **** ffebad_finish () { #define MAX_SPACES 132 ! static char *spaces = "...>\ \040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\ \040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\ --- 351,357 ---- ffebad_finish () { #define MAX_SPACES 132 ! static const char *spaces = "...>\ \040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\ \040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\ *************** ffebad_finish () *** 372,380 **** ffebadIndex bi; unsigned short i; char pointer; ! char c; ! char *s; ! char *fn; static char buf[1024]; int bufi; int index; --- 372,380 ---- ffebadIndex bi; unsigned short i; char pointer; ! unsigned char c; ! unsigned const char *s; ! const char *fn; static char buf[1024]; int bufi; int index; diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/bad.def gcc-2.95/gcc/f/bad.def *** egcs-1.1.2/gcc/f/bad.def Sun May 24 01:33:15 1998 --- gcc-2.95/gcc/f/bad.def Sat Mar 13 07:14:23 1999 *************** *** 1,6 **** /* bad.def -- Public #include File (module.h template V1.0) Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* bad.def -- Public #include File (module.h template V1.0) Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** FFEBAD_MSGS1 (FFEBAD_ARRAY_LARGE, FATAL, *** 700,705 **** --- 700,709 ---- "Array `%A' at %0 is too large to handle") FFEBAD_MSGS1 (FFEBAD_SFUNC_UNUSED, WARN, "Statement function `%A' defined at %0 is not used") + FFEBAD_MSGS1 (FFEBAD_INTRINSIC_Y2KBAD, WARN, + "Intrinsic `%A', invoked at %0, known to be non-Y2K-compliant [info -f g77 M Y2KBAD]") + FFEBAD_MSGS1 (FFEBAD_NOCANDO, DISASTER, + "Internal compiler error -- cannot perform operation") #undef INFORM #undef TRIVIAL diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/bad.h gcc-2.95/gcc/f/bad.h *** egcs-1.1.2/gcc/f/bad.h Tue May 19 03:49:12 1998 --- gcc-2.95/gcc/f/bad.h Sat Mar 27 02:23:38 1999 *************** *** 1,6 **** /* bad.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* bad.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** void ffebad_init_0 (void); *** 82,89 **** bool ffebad_is_fatal (ffebad errnum); ffebadSeverity ffebad_severity (ffebad errnum); bool ffebad_start_ (bool lex_override, ffebad errnum, ffebadSeverity sev, ! char *message); ! void ffebad_string (char *string); /* Define macros. */ --- 82,89 ---- bool ffebad_is_fatal (ffebad errnum); ffebadSeverity ffebad_severity (ffebad errnum); bool ffebad_start_ (bool lex_override, ffebad errnum, ffebadSeverity sev, ! const char *message); ! void ffebad_string (const char *string); /* Define macros. */ diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/bit.c gcc-2.95/gcc/f/bit.c *** egcs-1.1.2/gcc/f/bit.c Tue May 19 03:49:13 1998 --- gcc-2.95/gcc/f/bit.c Mon Feb 15 10:16:26 1999 *************** *** 1,6 **** /* bit.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* bit.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/bit.h gcc-2.95/gcc/f/bit.h *** egcs-1.1.2/gcc/f/bit.h Tue May 19 03:49:14 1998 --- gcc-2.95/gcc/f/bit.h Mon Feb 15 10:16:27 1999 *************** *** 1,6 **** /* bit.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* bit.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/bld-op.def gcc-2.95/gcc/f/bld-op.def *** egcs-1.1.2/gcc/f/bld-op.def Tue May 19 03:49:15 1998 --- gcc-2.95/gcc/f/bld-op.def Mon Feb 15 10:16:28 1999 *************** *** 1,6 **** /* bld-op.def -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* bld-op.def -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/bld.c gcc-2.95/gcc/f/bld.c *** egcs-1.1.2/gcc/f/bld.c Tue Jun 30 00:59:29 1998 --- gcc-2.95/gcc/f/bld.c Sat Apr 17 03:58:21 1999 *************** *** 1,6 **** /* bld.c -- Implementation File (module.c template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* bld.c -- Implementation File (module.c template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** static ffebldConstant ffebld_constant_ho *** 203,209 **** static ffebldConstant ffebld_constant_typeless_[FFEBLD_constTYPELESS_LAST - FFEBLD_constTYPELESS_FIRST + 1]; ! static char *ffebld_op_string_[] = { #define FFEBLD_OP(KWD,NAME,ARITY) NAME, --- 203,209 ---- static ffebldConstant ffebld_constant_typeless_[FFEBLD_constTYPELESS_LAST - FFEBLD_constTYPELESS_FIRST + 1]; ! static const char *ffebld_op_string_[] = { #define FFEBLD_OP(KWD,NAME,ARITY) NAME, *************** ffebld_new_item (ffebld head, ffebld tra *** 5573,5578 **** --- 5573,5581 ---- x->op = FFEBLD_opITEM; x->u.item.head = head; x->u.item.trail = trail; + #ifdef FFECOM_itemHOOK + x->u.item.hook = FFECOM_itemNULL; + #endif return x; } *************** ffebld_new_one (ffebldOp o, ffebld left) *** 5655,5660 **** --- 5658,5666 ---- #endif x->op = o; x->u.nonter.left = left; + #ifdef FFECOM_nonterHOOK + x->u.nonter.hook = FFECOM_nonterNULL; + #endif return x; } *************** ffebld_new_two (ffebldOp o, ffebld left, *** 5703,5708 **** --- 5709,5717 ---- x->op = o; x->u.nonter.left = left; x->u.nonter.right = right; + #ifdef FFECOM_nonterHOOK + x->u.nonter.hook = FFECOM_nonterNULL; + #endif return x; } *************** ffebld_pool_push (mallocPool pool) *** 5745,5751 **** Returns a short string (uppercase) containing the name of the op. */ ! char * ffebld_op_string (ffebldOp o) { if (o >= ARRAY_SIZE (ffebld_op_string_)) --- 5754,5760 ---- Returns a short string (uppercase) containing the name of the op. */ ! const char * ffebld_op_string (ffebldOp o) { if (o >= ARRAY_SIZE (ffebld_op_string_)) diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/bld.h gcc-2.95/gcc/f/bld.h *** egcs-1.1.2/gcc/f/bld.h Tue Jun 30 00:59:30 1998 --- gcc-2.95/gcc/f/bld.h Sat Apr 17 03:58:22 1999 *************** *** 1,6 **** /* bld.h -- Public #include File (module.h template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* bld.h -- Public #include File (module.h template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** struct _ffebld_ *** 406,417 **** --- 406,423 ---- { ffebld left; ffebld right; + #ifdef FFECOM_nonterHOOK + ffecomNonter hook; /* Whatever the compiler/backend wants! */ + #endif } nonter; struct { ffebld head; ffebld trail; + #ifdef FFECOM_itemHOOK + ffecomItem hook; /* Whatever the compiler/backend wants! */ + #endif } item; struct *************** ffebld ffebld_new_symter (ffesymbol s, f *** 726,732 **** ffeintrinImp imp); ffebld ffebld_new_one (ffebldOp o, ffebld left); ffebld ffebld_new_two (ffebldOp o, ffebld left, ffebld right); ! char *ffebld_op_string (ffebldOp o); void ffebld_pool_pop (void); void ffebld_pool_push (mallocPool pool); ffetargetCharacterSize ffebld_size_max (ffebld b); --- 732,738 ---- ffeintrinImp imp); ffebld ffebld_new_one (ffebldOp o, ffebld left); ffebld ffebld_new_two (ffebldOp o, ffebld left, ffebld right); ! const char *ffebld_op_string (ffebldOp o); void ffebld_pool_pop (void); void ffebld_pool_push (mallocPool pool); ffetargetCharacterSize ffebld_size_max (ffebld b); *************** ffetargetCharacterSize ffebld_size_max ( *** 748,753 **** --- 754,760 ---- #define ffebld_arrter_set_pad(b,p) ((b)->u.arrter.pad = (p)) #define ffebld_arrter_set_size(b,s) ((b)->u.arrter.size = (s)) #define ffebld_arrter_size(b) ((b)->u.arrter.size) + #define ffebld_basictype(b) (ffeinfo_basictype (ffebld_info ((b)))) #if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_ #define ffebld_constant_pool() ffe_pool_program_unit() #elif FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstFILE_ *************** ffetargetCharacterSize ffebld_size_max ( *** 944,949 **** --- 951,960 ---- #define ffebld_init_3() #define ffebld_init_4() #define ffebld_init_list(l,b) (*(l) = NULL, *(b) = (l)) + #define ffebld_item_hook(b) ((b)->u.item.hook) + #define ffebld_item_set_hook(b,h) ((b)->u.item.hook = (h)) + #define ffebld_kind(b) (ffeinfo_kind (ffebld_info ((b)))) + #define ffebld_kindtype(b) (ffeinfo_kindtype (ffebld_info ((b)))) #define ffebld_labter(b) ((b)->u.labter) #define ffebld_labtok(b) ((b)->u.labtok) #define ffebld_left(b) ((b)->u.nonter.left) *************** ffetargetCharacterSize ffebld_size_max ( *** 987,994 **** --- 998,1008 ---- #define ffebld_new_arrayref(l,r) ffebld_new_two(FFEBLD_opARRAYREF,(l),(r)) #define ffebld_new_substr(l,r) ffebld_new_two(FFEBLD_opSUBSTR,(l),(r)) #define ffebld_new_impdo(l,r) ffebld_new_two(FFEBLD_opIMPDO,(l),(r)) + #define ffebld_nonter_hook(b) ((b)->u.nonter.hook) + #define ffebld_nonter_set_hook(b,h) ((b)->u.nonter.hook = (h)) #define ffebld_op(b) ((b)->op) #define ffebld_pool() (ffebld_pool_stack_.pool) + #define ffebld_rank(b) (ffeinfo_rank (ffebld_info ((b)))) #define ffebld_right(b) ((b)->u.nonter.right) #define ffebld_set_accter(b,a) ((b)->u.accter.array = (a)) #define ffebld_set_arrter(b,a) ((b)->u.arrter.array = (a)) *************** ffetargetCharacterSize ffebld_size_max ( *** 1000,1007 **** #define ffebld_set_left(b,l) ((b)->u.nonter.left = (l)) #define ffebld_set_right(b,r) ((b)->u.nonter.right = (r)) #define ffebld_set_trail(b,t) ((b)->u.item.trail = (t)) ! #define ffebld_size(b) (ffeinfo_size((b)->info)) ! #define ffebld_size_known(b) ffebld_size(b) #define ffebld_symter(b) ((b)->u.symter.symbol) #define ffebld_symter_generic(b) ((b)->u.symter.generic) #define ffebld_symter_doiter(b) ((b)->u.symter.do_iter) --- 1014,1021 ---- #define ffebld_set_left(b,l) ((b)->u.nonter.left = (l)) #define ffebld_set_right(b,r) ((b)->u.nonter.right = (r)) #define ffebld_set_trail(b,t) ((b)->u.item.trail = (t)) ! #define ffebld_size(b) (ffeinfo_size (ffebld_info ((b)))) ! #define ffebld_size_known(b) ffebld_size((b)) #define ffebld_symter(b) ((b)->u.symter.symbol) #define ffebld_symter_generic(b) ((b)->u.symter.generic) #define ffebld_symter_doiter(b) ((b)->u.symter.do_iter) *************** ffetargetCharacterSize ffebld_size_max ( *** 1018,1023 **** --- 1032,1038 ---- #define ffebld_terminate_3() #define ffebld_terminate_4() #define ffebld_trail(b) ((b)->u.item.trail) + #define ffebld_where(b) (ffeinfo_where (ffebld_info ((b)))) /* End of #include file. */ diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/bugs.texi gcc-2.95/gcc/f/bugs.texi *** egcs-1.1.2/gcc/f/bugs.texi Sat Mar 13 07:20:22 1999 --- gcc-2.95/gcc/f/bugs.texi Tue Jun 29 00:15:54 1999 *************** *** 1,20 **** ! @c Copyright (C) 1995-1998 Free Software Foundation, Inc. @c This is part of the G77 manual. @c For copying conditions, see the file g77.texi. @c The text of this file appears in the file BUGS @c in the G77 distribution, as well as in the G77 manual. ! @c 1999-03-13 ! @ifset BUGSONLY ! @set which-g77 @code{egcs}-1.1.2 @end ifset ! @ifclear BUGSONLY ! @node Actual Bugs ! @section Actual Bugs We Haven't Fixed Yet ! @end ifclear This section identifies bugs that @code{g77} @emph{users} might run into in the @value{which-g77} version --- 1,40 ---- ! @c Copyright (C) 1995-1999 Free Software Foundation, Inc. @c This is part of the G77 manual. @c For copying conditions, see the file g77.texi. @c The text of this file appears in the file BUGS @c in the G77 distribution, as well as in the G77 manual. ! @c Keep this the same as the dates above, since it's used ! @c in the standalone derivations of this file (e.g. BUGS). ! @set copyrights-bugs 1995-1999 ! ! @set last-update-bugs 1999-06-29 ! ! @include root.texi ! ! @ifset DOC-BUGS ! @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 ! @file{bugs0.texi} and @file{bugs.texi}. ! @file{BUGS} is @emph{not} a source file, ! although it is normally included within source distributions. ! ! This file lists known bugs in the @value{which-g77} version ! of the GNU Fortran compiler. ! Copyright (C) @value{copyrights-bugs} Free Software Foundation, Inc. ! You may copy, distribute, and modify it freely as long as you preserve ! this copyright notice and permission notice. ! @node Top,,, (dir) ! @chapter Known Bugs In GNU Fortran @end ifset ! @ifset DOC-G77 ! @node Known Bugs ! @section Known Bugs In GNU Fortran ! @end ifset This section identifies bugs that @code{g77} @emph{users} might run into in the @value{which-g77} version *************** sets of code are at least somewhat under *** 25,121 **** of (and necessarily intertwined with) @code{g77}, so it isn't worth separating them out. ! @ifset last-up-date For information on bugs in @emph{other} versions of @code{g77}, ! @ref{News,,News About GNU Fortran}. @end ifset ! @ifset BUGSONLY For information on bugs in @emph{other} versions of @code{g77}, ! see @file{egcs/gcc/f/NEWS}. @end ifset An online, ``live'' version of this document ! (derived directly from the up-to-date mainline version of @code{g77} within @code{egcs}) ! is available at @uref{http://egcs.cygnus.com/onlinedocs/g77_bugs.html}. ! @ifset last-up-date For information on bugs that might afflict people who configure, port, build, and install @code{g77}, ! @ref{Problems Installing}. @end ifset ! @ifset BUGSONLY For information on bugs that might afflict people who configure, port, build, and install @code{g77}, ! see ``Problems Installing'' in @file{egcs/gcc/f/INSTALL}. @end ifset ! @itemize @bullet ! @item ! @code{g77} generates bad code for assignments, ! or other conversions, ! of @code{REAL} or @code{COMPLEX} constant expressions ! to type @code{INTEGER(KIND=2)} ! (often referred to as @code{INTEGER*8}). ! ! For example, @samp{INTEGER*8 J; J = 4E10} is miscompiled ! on some systems---the wrong value is stored in @var{J}. ! ! @item ! The @code{IDate} Intrinsic (VXT) ! fails to return the year in the documented, non-Y2K-compliant range ! of 0--99, ! instead returning 100 for the year 2000. ! ! @c Fixed in @code{egcs} 1.2. ! ! @item ! Year 2000 (Y2K) compliance information ! is missing from the documentation. ! ! @c Fixed in @code{egcs} 1.2. ! ! @item ! @code{g77} crashes when compiling ! I/O statements using keywords that define @code{INTEGER} values, ! such as @samp{IOSTAT=@var{j}}, ! where @var{j} is other than default @code{INTEGER} ! (such as @code{INTEGER*2}). ! ! @c Fixed in @code{egcs} 1.2. ! ! @item ! The @samp{-ax} option is not obeyed when compiling Fortran programs. ! (It is not passed to the @file{f771} driver.) ! ! @c Fixed in @code{egcs} 1.2. ! ! @item ! @code{g77} fails to warn about a reference to a function ! when the corresponding @emph{subsequent} function program unit ! disagrees with the reference concerning the type of the function. ! ! @c Fixed in @code{egcs} 1.2. ! ! @item ! @c Tim Prince discovered this. ! Automatic arrays possibly aren't working on HP-UX systems, ! at least in HP-UX version 10.20. ! Writing into them apparently causes over-writing ! of statically declared data in the main program. ! This probably means the arrays themselves are being under-allocated, ! or pointers to them being improperly handled, ! e.g. not passed to other procedures as they should be. @item @code{g77} fails to warn about use of a ``live'' iterative-DO variable as an implied-DO variable ! in a @samp{WRITE} or @samp{PRINT} statement ! (although it does warn about this in a @samp{READ} statement). @item Something about @code{g77}'s straightforward handling of --- 45,108 ---- of (and necessarily intertwined with) @code{g77}, so it isn't worth separating them out. ! @ifset DOC-G77 For information on bugs in @emph{other} versions of @code{g77}, ! see @ref{News,,News About GNU Fortran}. ! There, lists of bugs fixed in various versions of @code{g77} ! can help determine what bugs existed in prior versions. @end ifset ! @ifset DOC-BUGS For information on bugs in @emph{other} versions of @code{g77}, ! see @file{@value{path-g77}/NEWS}. ! There, lists of bugs fixed in various versions of @code{g77} ! can help determine what bugs existed in prior versions. ! @end ifset ! ! @ifset DEVELOPMENT ! @emph{Warning:} The information below is still under development, ! and might not accurately reflect the @code{g77} code base ! of which it is a part. ! Efforts are made to keep it somewhat up-to-date, ! but they are particularly concentrated ! on any version of this information ! that is distributed as part of a @emph{released} @code{g77}. ! ! In particular, while this information is intended to apply to ! the @value{which-g77} version of @code{g77}, ! only an official @emph{release} of that version ! is expected to contain documentation that is ! most consistent with the @code{g77} product in that version. @end ifset An online, ``live'' version of this document ! (derived directly from the mainline, development version of @code{g77} within @code{egcs}) ! is available via @uref{http://egcs.cygnus.com/onlinedocs/g77_bugs.html}. + Follow the ``Known Bugs'' link. ! @ifset DOC-G77 For information on bugs that might afflict people who configure, port, build, and install @code{g77}, ! see @ref{Problems Installing}. @end ifset ! @ifset DOC-BUGS For information on bugs that might afflict people who configure, port, build, and install @code{g77}, ! see "Problems Installing" in @file{@value{path-g77}/INSTALL}. @end ifset ! The following information was last updated on @value{last-update-bugs}: + @itemize @bullet @item @code{g77} fails to warn about use of a ``live'' iterative-DO variable as an implied-DO variable ! in a @code{WRITE} or @code{PRINT} statement ! (although it does warn about this in a @code{READ} statement). @item Something about @code{g77}'s straightforward handling of *************** This is to be fixed in version 0.6, when *** 153,159 **** @cindex compiler memory usage @cindex memory usage, of compiler @cindex large aggregate areas ! @cindex initialization @cindex DATA statement @cindex statements, DATA @item --- 140,146 ---- @cindex compiler memory usage @cindex memory usage, of compiler @cindex large aggregate areas ! @cindex initialization, bug @cindex DATA statement @cindex statements, DATA @item *************** improvements to the compiler.) *** 179,185 **** Note that @code{g77} does display a warning message to notify the user before the compiler appears to hang. ! @ifset last-up-date @xref{Large Initialization,,Initialization of Large Aggregate Areas}, for information on how to change the point at which @code{g77} decides to issue this warning. --- 166,172 ---- Note that @code{g77} does display a warning message to notify the user before the compiler appears to hang. ! @ifset DOC-G77 @xref{Large Initialization,,Initialization of Large Aggregate Areas}, for information on how to change the point at which @code{g77} decides to issue this warning. *************** As of Version 0.5.19, a temporary kludge *** 201,207 **** some rudimentary information on a member is written as a string that is the member's value as a character string. ! @ifset last-up-date @xref{Code Gen Options,,Options for Code Generation Conventions}, for information on the @samp{-fdebug-kludge} option. @end ifset --- 188,194 ---- some rudimentary information on a member is written as a string that is the member's value as a character string. ! @ifset DOC-G77 @xref{Code Gen Options,,Options for Code Generation Conventions}, for information on the @samp{-fdebug-kludge} option. @end ifset *************** for information on the @samp{-fdebug-klu *** 213,220 **** @item When debugging, after starting up the debugger but before being able to see the source code for the main program unit, the user must currently ! set a breakpoint at @samp{MAIN__} (or @samp{MAIN___} or @samp{MAIN_} if ! @samp{MAIN__} doesn't exist) and run the program until it hits the breakpoint. At that point, the main program unit is activated and about to execute its first --- 200,207 ---- @item When debugging, after starting up the debugger but before being able to see the source code for the main program unit, the user must currently ! set a breakpoint at @code{MAIN__} (or @code{MAIN___} or @code{MAIN_} if ! @code{MAIN__} doesn't exist) and run the program until it hits the breakpoint. At that point, the main program unit is activated and about to execute its first *************** This problem is largely resolved as of v *** 250,272 **** Version 0.6 should solve most or all remaining problems (such as cross-compiling involving 64-bit machines). - @cindex COMPLEX support - @cindex support, COMPLEX - @item - Maintainers of gcc report that the back end definitely has ``broken'' - support for @code{COMPLEX} types. - Based on their input, it seems many of - the problems affect only the more-general facilities for gcc's - @code{__complex__} type, such as @code{__complex__ int} - (where the real and imaginary parts are integers) that GNU - Fortran does not use. - - Version 0.5.20 of @code{g77} works around this - problem by not using the back end's support for @code{COMPLEX}. - The new option @samp{-fno-emulate-complex} avoids the work-around, - reverting to using the same ``broken'' mechanism as that used - by versions of @code{g77} prior to 0.5.20. - @cindex padding @cindex structures @cindex common blocks --- 237,242 ---- *************** The @code{gcc} back end needs to provide *** 284,325 **** of specifications of alignment requirements and preferences for targets, and front ends like @code{g77} should take advantage of this when it becomes available. - - @cindex alignment - @cindex double-precision performance - @cindex -malign-double - @item - The x86 target's @samp{-malign-double} option - no longer reliably aligns double-precision variables and arrays - when they are placed in the stack frame. - - This can significantly reduce the performance of some applications, - even on a run-to-run basis - (that is, performance measurements can vary fairly widely - depending on whether frequently used variables are properly aligned, - and that can change from one program run to the next, - even from one procedure call to the next). - - Versions 0.5.22 and earlier of @code{g77} - included a patch to @code{gcc} that enabled this, - but that patch has been deemed an improper (probably buggy) one - for version 2.8 of @code{gcc} and for @code{egcs}. - - Note that version 1.1 of @code{egcs} - aligns double-precision variables and arrays - when they are in static storage - even if @samp{-malign-double} is not specified. - - There is ongoing investigation into - how to make @samp{-malign-double} work properly, - also into how to make it unnecessary to get - all double-precision variables and arrays aligned - when such alignment would not violate - the relevant specifications for processor - and inter-procedural interfaces. - - For a suite of programs to test double-precision alignment, - see @uref{ftp://alpha.gnu.org/gnu/g77/align/}. @cindex complex performance @cindex aliasing --- 254,259 ---- diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/bugs0.texi gcc-2.95/gcc/f/bugs0.texi *** egcs-1.1.2/gcc/f/bugs0.texi Tue Aug 12 00:47:33 1997 --- gcc-2.95/gcc/f/bugs0.texi Sat Mar 13 04:03:56 1999 *************** *** 1,17 **** \input texinfo @c -*-texinfo-*- ! @c %**start of header @setfilename BUGS - @set BUGSONLY @c %**end of header ! @c The immediately following lines apply to the BUGS file ! @c which is generated using this file. ! This file lists known bugs in the GNU Fortran compiler. ! Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! You may copy, distribute, and modify it freely as long as you preserve ! this copyright notice and permission notice. ! ! @node Top,,, (dir) ! @chapter Bugs in GNU Fortran @include bugs.texi @bye --- 1,9 ---- \input texinfo @c -*-texinfo-*- ! @c %**start of header @setfilename BUGS @c %**end of header ! @c This tells bugs.texi that it's generating just the BUGS file. ! @set DOC-BUGS @include bugs.texi @bye diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/com-rt.def gcc-2.95/gcc/f/com-rt.def *** egcs-1.1.2/gcc/f/com-rt.def Mon Jul 6 01:29:25 1998 --- gcc-2.95/gcc/f/com-rt.def Thu Apr 22 16:01:32 1999 *************** *** 1,6 **** /* com-rt.def -- Public #include File (module.h template V1.0) Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* com-rt.def -- Public #include File (module.h template V1.0) Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** DEFGFRT (FFECOM_gfrtCMP, "s_cmp", FFECOM *** 66,71 **** --- 66,72 ---- DEFGFRT (FFECOM_gfrtCOPY, "s_copy", FFECOM_rttypeVOID_, 0, FALSE, FALSE) DEFGFRT (FFECOM_gfrtPAUSE, "s_paus", FFECOM_rttypeVOID_, 0, FALSE, FALSE) DEFGFRT (FFECOM_gfrtSTOP, "s_stop", FFECOM_rttypeVOID_, 0, TRUE, FALSE) + DEFGFRT (FFECOM_gfrtRANGE, "s_rnge", FFECOM_rttypeINTEGER_, 0, TRUE, FALSE) DEFGFRT (FFECOM_gfrtSRDUE, "s_rdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE) DEFGFRT (FFECOM_gfrtERDUE, "e_rdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE) *************** DEFGFRT (FFECOM_gfrtDACOS, "d_acos", FFE *** 142,148 **** DEFGFRT (FFECOM_gfrtDASIN, "d_asin", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDATAN, "d_atan", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDATAN2, "d_atn2", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtDATE, "G77_date_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDATE_AND_TIME, "G77_date_and_time_0", FFECOM_rttypeVOID_, "&a&a&a&i", FALSE, FALSE) DEFGFRT (FFECOM_gfrtL_BESJ0, "j0", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtL_BESJ1, "j1", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE) --- 143,149 ---- DEFGFRT (FFECOM_gfrtDASIN, "d_asin", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDATAN, "d_atan", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDATAN2, "d_atn2", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtDATE, "G77_date_y2kbug_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDATE_AND_TIME, "G77_date_and_time_0", FFECOM_rttypeVOID_, "&a&a&a&i", FALSE, FALSE) DEFGFRT (FFECOM_gfrtL_BESJ0, "j0", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtL_BESJ1, "j1", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE) *************** DEFGFRT (FFECOM_gfrtTIME, "G77_time_0", *** 242,248 **** DEFGFRT (FFECOM_gfrtTTYNAM, "G77_ttynam_0", FFECOM_rttypeCHARACTER_, "&i", FALSE, FALSE) DEFGFRT (FFECOM_gfrtUNLINK, "G77_unlink_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE) DEFGFRT (FFECOM_gfrtUMASK, "G77_umask_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtVXTIDATE, "G77_vxtidate_0", FFECOM_rttypeVOID_, "&i&i&i", FALSE, FALSE) DEFGFRT (FFECOM_gfrtVXTTIME, "G77_vxttime_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE) DEFGFRT (FFECOM_gfrtCDABS, "z_abs", FFECOM_rttypeDOUBLE_, "&e", FALSE, FALSE) DEFGFRT (FFECOM_gfrtCDCOS, "z_cos", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE) --- 243,249 ---- DEFGFRT (FFECOM_gfrtTTYNAM, "G77_ttynam_0", FFECOM_rttypeCHARACTER_, "&i", FALSE, FALSE) DEFGFRT (FFECOM_gfrtUNLINK, "G77_unlink_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE) DEFGFRT (FFECOM_gfrtUMASK, "G77_umask_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtVXTIDATE, "G77_vxtidate_y2kbug_0", FFECOM_rttypeVOID_, "&i&i&i", FALSE, FALSE) DEFGFRT (FFECOM_gfrtVXTTIME, "G77_vxttime_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE) DEFGFRT (FFECOM_gfrtCDABS, "z_abs", FFECOM_rttypeDOUBLE_, "&e", FALSE, FALSE) DEFGFRT (FFECOM_gfrtCDCOS, "z_cos", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE) diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/com.c gcc-2.95/gcc/f/com.c *** egcs-1.1.2/gcc/f/com.c Wed Oct 7 23:34:34 1998 --- gcc-2.95/gcc/f/com.c Mon Jun 28 19:27:42 1999 *************** *** 1,6 **** /* com.c -- Implementation File (module.c template V1.0) Copyright (C) 1995-1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* com.c -- Implementation File (module.c template V1.0) Copyright (C) 1995-1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** the Free Software Foundation, 59 Temple *** 60,68 **** is_nested, is_public); // for each arg, build PARM_DECL and call push_parm_decl (decl) with it; store_parm_decls (is_main_program); ! ffecom_start_compstmt_ (); // for stmts and decls inside function, do appropriate things; ! ffecom_end_compstmt_ (); finish_function (is_nested); if (is_nested) pop_f_function_context (); if (is_nested) resume_momentary (yes); --- 60,68 ---- is_nested, is_public); // for each arg, build PARM_DECL and call push_parm_decl (decl) with it; store_parm_decls (is_main_program); ! ffecom_start_compstmt (); // for stmts and decls inside function, do appropriate things; ! ffecom_end_compstmt (); finish_function (is_nested); if (is_nested) pop_f_function_context (); if (is_nested) resume_momentary (yes); *************** typedef struct { unsigned :16, :16, :16; *** 213,220 **** /* Externals defined here. */ - #define FFECOM_FASTER_ARRAY_REFS 0 /* Generates faster code? */ - #if FFECOM_targetCURRENT == FFECOM_targetGCC /* tree.h declares a bunch of stuff that it expects the front end to --- 213,218 ---- *************** tree unsigned_type_node; *** 231,238 **** tree char_type_node; tree current_function_decl; ! /* ~~tree.h SHOULD declare this, because toplev.c and dwarfout.c reference ! it. */ char *language_string = "GNU F77"; --- 229,236 ---- tree char_type_node; tree current_function_decl; ! /* ~~gcc/tree.h *should* declare this, because toplev.c and dwarfout.c ! reference it. */ char *language_string = "GNU F77"; *************** ffecomSymbol ffecom_symbol_null_ *** 302,307 **** --- 300,307 ---- NULL_TREE, NULL_TREE, NULL_TREE, + NULL_TREE, + false }; ffeinfoKindtype ffecom_pointer_kind_ = FFEINFO_basictypeNONE; ffeinfoKindtype ffecom_label_kind_ = FFEINFO_basictypeNONE; *************** typedef enum *** 367,373 **** #if FFECOM_targetCURRENT == FFECOM_targetGCC typedef struct _ffecom_concat_list_ ffecomConcatList_; - typedef struct _ffecom_temp_ *ffecomTemp_; #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Private include files. */ --- 367,372 ---- *************** struct _ffecom_concat_list_ *** 384,407 **** ffetargetCharacterSize minlen; ffetargetCharacterSize maxlen; }; - - struct _ffecom_temp_ - { - ffecomTemp_ next; - tree type; /* Base type (w/o size/array applied). */ - tree t; - ffetargetCharacterSize size; - int elements; - bool in_use; - bool auto_pop; - }; - #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Static functions (internal). */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ffecom_arglist_expr_ (char *argstring, ffebld args); static tree ffecom_widest_expr_type_ (ffebld list); static bool ffecom_overlap_ (tree dest_decl, tree dest_offset, tree dest_size, tree source_tree, --- 383,394 ---- ffetargetCharacterSize minlen; ffetargetCharacterSize maxlen; }; #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Static functions (internal). */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ffecom_arglist_expr_ (const char *argstring, ffebld args); static tree ffecom_widest_expr_type_ (ffebld list); static bool ffecom_overlap_ (tree dest_decl, tree dest_offset, tree dest_size, tree source_tree, *************** static bool ffecom_overlap_ (tree dest_d *** 409,426 **** static bool ffecom_args_overlapping_ (tree dest_tree, ffebld dest, tree args, tree callee_commons, bool scalar_args); ! static tree ffecom_build_f2c_string_ (int i, char *s); static tree ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, tree type, tree args, tree dest_tree, ffebld dest, bool *dest_used, ! tree callee_commons, bool scalar_args); static tree ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, tree type, ffebld left, ffebld right, tree dest_tree, ffebld dest, bool *dest_used, tree callee_commons, ! bool scalar_args); static void ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null); static tree ffecom_check_size_overflow_ (ffesymbol s, tree type, bool dummy); --- 396,413 ---- static bool ffecom_args_overlapping_ (tree dest_tree, ffebld dest, tree args, tree callee_commons, bool scalar_args); ! static tree ffecom_build_f2c_string_ (int i, const char *s); static tree ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, tree type, tree args, tree dest_tree, ffebld dest, bool *dest_used, ! tree callee_commons, bool scalar_args, tree hook); static tree ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, tree type, ffebld left, ffebld right, tree dest_tree, ffebld dest, bool *dest_used, tree callee_commons, ! bool scalar_args, tree hook); static void ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null); static tree ffecom_check_size_overflow_ (ffesymbol s, tree type, bool dummy); *************** static ffecomConcatList_ *** 432,458 **** static void ffecom_concat_list_kill_ (ffecomConcatList_ catlist); static ffecomConcatList_ ffecom_concat_list_new_ (ffebld expr, ffetargetCharacterSize max); ! static void ffecom_debug_kludge_ (tree aggr, char *aggr_type, ffesymbol member, ! tree member_type, ffetargetOffset offset); static void ffecom_do_entry_ (ffesymbol fn, int entrynum); static tree ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, bool *dest_used, bool assignp, bool widenp); static tree ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree, ffebld dest, bool *dest_used); ! static tree ffecom_expr_power_integer_ (ffebld left, ffebld right); static void ffecom_expr_transform_ (ffebld expr); ! static void ffecom_f2c_make_type_ (tree *type, int tcode, char *name); static void ffecom_f2c_set_lio_code_ (ffeinfoBasictype bt, int size, int code); static ffeglobal ffecom_finish_global_ (ffeglobal global); static ffesymbol ffecom_finish_symbol_transform_ (ffesymbol s); ! static tree ffecom_get_appended_identifier_ (char us, char *text); static tree ffecom_get_external_identifier_ (ffesymbol s); ! static tree ffecom_get_identifier_ (char *text); static tree ffecom_gen_sfuncdef_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt); ! static char *ffecom_gfrt_args_ (ffecomGfrt ix); static tree ffecom_gfrt_tree_ (ffecomGfrt ix); static tree ffecom_init_zero_ (tree decl); static tree ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg, --- 419,446 ---- static void ffecom_concat_list_kill_ (ffecomConcatList_ catlist); static ffecomConcatList_ ffecom_concat_list_new_ (ffebld expr, ffetargetCharacterSize max); ! static void ffecom_debug_kludge_ (tree aggr, const char *aggr_type, ! ffesymbol member, tree member_type, ! ffetargetOffset offset); static void ffecom_do_entry_ (ffesymbol fn, int entrynum); static tree ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, bool *dest_used, bool assignp, bool widenp); static tree ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree, ffebld dest, bool *dest_used); ! static tree ffecom_expr_power_integer_ (ffebld expr); static void ffecom_expr_transform_ (ffebld expr); ! static void ffecom_f2c_make_type_ (tree *type, int tcode, const char *name); static void ffecom_f2c_set_lio_code_ (ffeinfoBasictype bt, int size, int code); static ffeglobal ffecom_finish_global_ (ffeglobal global); static ffesymbol ffecom_finish_symbol_transform_ (ffesymbol s); ! static tree ffecom_get_appended_identifier_ (char us, const char *text); static tree ffecom_get_external_identifier_ (ffesymbol s); ! static tree ffecom_get_identifier_ (const char *text); static tree ffecom_gen_sfuncdef_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt); ! static const char *ffecom_gfrt_args_ (ffecomGfrt ix); static tree ffecom_gfrt_tree_ (ffecomGfrt ix); static tree ffecom_init_zero_ (tree decl); static tree ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg, *************** static void ffecom_member_phase1_ (ffest *** 467,472 **** --- 455,462 ---- #ifdef SOMEONE_GETS_DEBUG_SUPPORT_WORKING static void ffecom_member_phase2_ (ffestorag mst, ffestorag st); #endif + static void ffecom_prepare_let_char_ (ffetargetCharacterSize dest_size, + ffebld source); static void ffecom_push_dummy_decls_ (ffebld dumlist, bool stmtfunc); static void ffecom_start_progunit_ (void); *************** static void ffecom_tree_canonize_ref_ (t *** 481,487 **** tree *size, tree tree); static tree ffecom_tree_divide_ (tree tree_type, tree left, tree right, tree dest_tree, ffebld dest, ! bool *dest_used); static tree ffecom_type_localvar_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt); --- 471,477 ---- tree *size, tree tree); static tree ffecom_tree_divide_ (tree tree_type, tree left, tree right, tree dest_tree, ffebld dest, ! bool *dest_used, tree hook); static tree ffecom_type_localvar_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt); *************** static tree ffecom_type_vardesc_ (void); *** 493,509 **** static tree ffecom_vardesc_ (ffebld expr); static tree ffecom_vardesc_array_ (ffesymbol s); static tree ffecom_vardesc_dims_ (ffesymbol s); #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* These are static functions that parallel those found in the C front end and thus have the same names. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void bison_rule_compstmt_ (void); static void bison_rule_pushlevel_ (void); ! static tree builtin_function (char *name, tree type, enum built_in_function function_code, ! char *library_name); 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); --- 483,502 ---- static tree ffecom_vardesc_ (ffebld expr); static tree ffecom_vardesc_array_ (ffesymbol s); static tree ffecom_vardesc_dims_ (ffesymbol s); + static tree ffecom_convert_narrow_ (tree type, tree expr); + static tree ffecom_convert_widen_ (tree type, tree expr); #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* These are static functions that parallel those found in the C front end and thus have the same names. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree bison_rule_compstmt_ (void); static void bison_rule_pushlevel_ (void); ! static tree builtin_function (const char *name, tree type, enum built_in_function function_code, ! const char *library_name); ! 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 void pop_f_function_context (void *** 514,519 **** --- 507,513 ---- static void push_f_function_context (void); static void push_parm_decl (tree parm); static tree pushdecl_top_level (tree decl); + static int kept_level_p (void); static tree storedecls (tree decls); static void store_parm_decls (int is_main_program); static tree start_decl (tree decl, bool is_top_level); *************** static bool ffecom_primary_entry_is_proc *** 538,545 **** static tree ffecom_outer_function_decl_; static tree ffecom_previous_function_decl_; static tree ffecom_which_entrypoint_decl_; - static ffecomTemp_ ffecom_latest_temp_; - static int ffecom_pending_calls_ = 0; static tree ffecom_float_zero_ = NULL_TREE; static tree ffecom_float_half_ = NULL_TREE; static tree ffecom_double_zero_ = NULL_TREE; --- 532,537 ---- *************** static tree *** 562,567 **** --- 554,561 ---- static bool ffecom_member_namelisted_; /* _member_phase1_ namelisted? */ static bool ffecom_doing_entry_ = FALSE; static bool ffecom_transform_only_dummies_ = FALSE; + static int ffecom_typesize_pointer_; + static int ffecom_typesize_integer1_; /* Holds pointer-to-function expressions. */ *************** static tree ffecom_gfrt_[FFECOM_gfrt] *** 575,581 **** /* Holds the external names of the functions. */ ! static char *ffecom_gfrt_name_[FFECOM_gfrt] = { #define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) NAME, --- 569,575 ---- /* Holds the external names of the functions. */ ! static const char *ffecom_gfrt_name_[FFECOM_gfrt] = { #define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) NAME, *************** static ffecomRttype_ ffecom_gfrt_type_[F *** 615,621 **** /* String of codes for the function's arguments. */ ! static char *ffecom_gfrt_argstring_[FFECOM_gfrt] = { #define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) ARGS, --- 609,615 ---- /* String of codes for the function's arguments. */ ! static const char *ffecom_gfrt_argstring_[FFECOM_gfrt] = { #define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) ARGS, *************** static char *ffecom_gfrt_argstring_[FFEC *** 634,650 **** it would be best to do something here to figure out automatically from other information what type to use. */ ! /* NOTE: g77 currently doesn't use these; see setting of sizetype and ! change that if you need to. -- jcb 09/01/91. */ #define ffecom_concat_list_count_(catlist) ((catlist).count) #define ffecom_concat_list_expr_(catlist,i) ((catlist).exprs[(i)]) #define ffecom_concat_list_maxlen_(catlist) ((catlist).maxlen) #define ffecom_concat_list_minlen_(catlist) ((catlist).minlen) - #define ffecom_start_compstmt_ bison_rule_pushlevel_ - #define ffecom_end_compstmt_ bison_rule_compstmt_ - #define ffecom_char_args_(i,l,e) ffecom_char_args_x_((i),(l),(e),FALSE) #define ffecom_char_args_with_null_(i,l,e) ffecom_char_args_x_((i),(l),(e),TRUE) --- 628,642 ---- it would be best to do something here to figure out automatically from other information what type to use. */ ! #ifndef SIZE_TYPE ! #define SIZE_TYPE "long unsigned int" ! #endif #define ffecom_concat_list_count_(catlist) ((catlist).count) #define ffecom_concat_list_expr_(catlist,i) ((catlist).exprs[(i)]) #define ffecom_concat_list_maxlen_(catlist) ((catlist).maxlen) #define ffecom_concat_list_minlen_(catlist) ((catlist).minlen) #define ffecom_char_args_(i,l,e) ffecom_char_args_x_((i),(l),(e),FALSE) #define ffecom_char_args_with_null_(i,l,e) ffecom_char_args_x_((i),(l),(e),TRUE) *************** static char *ffecom_gfrt_argstring_[FFEC *** 664,683 **** struct binding_level { ! /* A chain of _DECL nodes for all variables, constants, functions, and ! typedef types. These are in the reverse of the order supplied. */ tree names; ! /* For each level (except not the global one), a chain of BLOCK nodes for ! all the levels that were entered and exited one level down. */ tree blocks; ! /* The BLOCK node for this level, if one has been preallocated. If 0, the ! BLOCK is allocated (if needed) when the level is popped. */ tree this_block; /* The binding level which this one is contained in (inherits from). */ struct binding_level *level_chain; }; #define NULL_BINDING_LEVEL (struct binding_level *) NULL --- 656,682 ---- struct binding_level { ! /* A chain of _DECL nodes for all variables, constants, functions, ! and typedef types. These are in the reverse of the order supplied. ! */ tree names; ! /* For each level (except not the global one), ! a chain of BLOCK nodes for all the levels ! that were entered and exited one level down. */ tree blocks; ! /* The BLOCK node for this level, if one has been preallocated. ! If 0, the BLOCK is allocated (if needed) when the level is popped. */ tree this_block; /* The binding level which this one is contained in (inherits from). */ struct binding_level *level_chain; + + /* 0: no ffecom_prepare_* functions called at this level yet; + 1: ffecom_prepare* functions called, except not ffecom_prepare_end; + 2: ffecom_prepare_end called. */ + int prep_state; }; #define NULL_BINDING_LEVEL (struct binding_level *) NULL *************** static struct binding_level *global_bind *** 700,706 **** static struct binding_level clear_binding_level = ! {NULL, NULL, NULL, NULL_BINDING_LEVEL}; /* Language-dependent contents of an identifier. */ --- 699,705 ---- static struct binding_level clear_binding_level = ! {NULL, NULL, NULL, NULL_BINDING_LEVEL, 0}; /* Language-dependent contents of an identifier. */ *************** static tree shadowed_labels; *** 747,752 **** --- 746,1059 ---- #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ + /* Return the subscript expression, modified to do range-checking. + + `array' is the array to be checked against. + `element' is the subscript expression to check. + `dim' is the dimension number (starting at 0). + `total_dims' is the total number of dimensions (0 for CHARACTER substring). + */ + + static tree + ffecom_subscript_check_ (tree array, tree element, int dim, int total_dims, + char *array_name) + { + tree low = TYPE_MIN_VALUE (TYPE_DOMAIN (array)); + tree high = TYPE_MAX_VALUE (TYPE_DOMAIN (array)); + tree cond; + tree die; + tree args; + + if (element == error_mark_node) + return element; + + if (TREE_TYPE (low) != TREE_TYPE (element)) + { + if (TYPE_PRECISION (TREE_TYPE (low)) + > TYPE_PRECISION (TREE_TYPE (element))) + element = convert (TREE_TYPE (low), element); + else + { + low = convert (TREE_TYPE (element), low); + if (high) + high = convert (TREE_TYPE (element), high); + } + } + + element = ffecom_save_tree (element); + cond = ffecom_2 (LE_EXPR, integer_type_node, + low, + element); + if (high) + { + cond = ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node, + cond, + ffecom_2 (LE_EXPR, integer_type_node, + element, + high)); + } + + { + int len; + char *proc; + char *var; + tree arg3; + tree arg2; + tree arg1; + tree arg4; + + switch (total_dims) + { + case 0: + var = xmalloc (strlen (array_name) + 20); + sprintf (&var[0], "%s[%s-substring]", + array_name, + dim ? "end" : "start"); + len = strlen (var) + 1; + break; + + case 1: + len = strlen (array_name) + 1; + var = array_name; + break; + + default: + var = xmalloc (strlen (array_name) + 40); + sprintf (&var[0], "%s[subscript-%d-of-%d]", + array_name, + dim + 1, total_dims); + len = strlen (var) + 1; + break; + } + + arg1 = build_string (len, var); + + if (total_dims != 1) + free (var); + + TREE_TYPE (arg1) + = build_type_variant (build_array_type (char_type_node, + build_range_type + (integer_type_node, + integer_one_node, + build_int_2 (len, 0))), + 1, 0); + TREE_CONSTANT (arg1) = 1; + TREE_STATIC (arg1) = 1; + arg1 = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (arg1)), + arg1); + + /* s_rnge adds one to the element to print it, so bias against + that -- want to print a faithful *subscript* value. */ + arg2 = convert (ffecom_f2c_ftnint_type_node, + ffecom_2 (MINUS_EXPR, + TREE_TYPE (element), + element, + convert (TREE_TYPE (element), + integer_one_node))); + + proc = xmalloc ((len = strlen (input_filename) + + IDENTIFIER_LENGTH (DECL_NAME (current_function_decl)) + + 2)); + + sprintf (&proc[0], "%s/%s", + input_filename, + IDENTIFIER_POINTER (DECL_NAME (current_function_decl))); + arg3 = build_string (len, proc); + + free (proc); + + TREE_TYPE (arg3) + = build_type_variant (build_array_type (char_type_node, + build_range_type + (integer_type_node, + integer_one_node, + build_int_2 (len, 0))), + 1, 0); + TREE_CONSTANT (arg3) = 1; + TREE_STATIC (arg3) = 1; + arg3 = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (arg3)), + arg3); + + arg4 = convert (ffecom_f2c_ftnint_type_node, + build_int_2 (lineno, 0)); + + arg1 = build_tree_list (NULL_TREE, arg1); + arg2 = build_tree_list (NULL_TREE, arg2); + arg3 = build_tree_list (NULL_TREE, arg3); + arg4 = build_tree_list (NULL_TREE, arg4); + TREE_CHAIN (arg3) = arg4; + TREE_CHAIN (arg2) = arg3; + TREE_CHAIN (arg1) = arg2; + + args = arg1; + } + die = ffecom_call_gfrt (FFECOM_gfrtRANGE, + args, NULL_TREE); + TREE_SIDE_EFFECTS (die) = 1; + + element = ffecom_3 (COND_EXPR, + TREE_TYPE (element), + cond, + element, + die); + + return element; + } + + /* Return the computed element of an array reference. + + `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 + the element itself, is to be returned. */ + + static tree + ffecom_arrayref_ (tree item, ffebld expr, int want_ptr) + { + ffebld dims[FFECOM_dimensionsMAX]; + int i; + int total_dims; + int flatten = ffe_is_flatten_arrays (); + int need_ptr; + tree array; + tree element; + tree tree_type; + tree tree_type_x; + char *array_name; + ffetype type; + ffebld list; + + if (ffebld_op (ffebld_left (expr)) == FFEBLD_opSYMTER) + array_name = ffesymbol_text (ffebld_symter (ffebld_left (expr))); + else + array_name = "[expr?]"; + + /* Build up ARRAY_REFs in reverse order (since we're column major + here in Fortran land). */ + + for (i = 0, list = ffebld_right (expr); + list != NULL; + ++i, list = ffebld_trail (list)) + { + dims[i] = ffebld_head (list); + type = ffeinfo_type (ffebld_basictype (dims[i]), + ffebld_kindtype (dims[i])); + if (! flatten + && ffecom_typesize_pointer_ > ffecom_typesize_integer1_ + && ffetype_size (type) > ffecom_typesize_integer1_) + /* E.g. ARRAY(INDEX), given INTEGER*8 INDEX, on a system with 64-bit + pointers and 32-bit integers. Do the full 64-bit pointer + arithmetic, for codes using arrays for nonstandard heap-like + work. */ + flatten = 1; + } + + total_dims = i; + + need_ptr = want_ptr || flatten; + + if (! item) + { + if (need_ptr) + item = ffecom_ptr_to_expr (ffebld_left (expr)); + else + item = ffecom_expr (ffebld_left (expr)); + + if (item == error_mark_node) + return item; + + if (ffeinfo_where (ffebld_info (expr)) == FFEINFO_whereFLEETING + && ! mark_addressable (item)) + return error_mark_node; + } + + if (item == error_mark_node) + return item; + + if (need_ptr) + { + tree min; + + for (--i, array = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item))); + i >= 0; + --i, array = TYPE_MAIN_VARIANT (TREE_TYPE (array))) + { + min = TYPE_MIN_VALUE (TYPE_DOMAIN (array)); + element = ffecom_expr_ (dims[i], NULL, NULL, NULL, FALSE, TRUE); + if (ffe_is_subscript_check ()) + element = ffecom_subscript_check_ (array, element, i, total_dims, + array_name); + if (element == error_mark_node) + return element; + + /* Widen integral arithmetic as desired while preserving + signedness. */ + tree_type = TREE_TYPE (element); + tree_type_x = tree_type; + if (tree_type + && GET_MODE_CLASS (TYPE_MODE (tree_type)) == MODE_INT + && TYPE_PRECISION (tree_type) < TYPE_PRECISION (sizetype)) + tree_type_x = (TREE_UNSIGNED (tree_type) ? usizetype : ssizetype); + + if (TREE_TYPE (min) != tree_type_x) + min = convert (tree_type_x, min); + if (TREE_TYPE (element) != tree_type_x) + element = convert (tree_type_x, element); + + item = ffecom_2 (PLUS_EXPR, + build_pointer_type (TREE_TYPE (array)), + item, + size_binop (MULT_EXPR, + size_in_bytes (TREE_TYPE (array)), + fold (build (MINUS_EXPR, + tree_type_x, + element, + min)))); + } + if (! want_ptr) + { + item = ffecom_1 (INDIRECT_REF, + TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item))), + item); + } + } + else + { + for (--i; + i >= 0; + --i) + { + array = TYPE_MAIN_VARIANT (TREE_TYPE (item)); + + element = ffecom_expr_ (dims[i], NULL, NULL, NULL, FALSE, TRUE); + if (ffe_is_subscript_check ()) + element = ffecom_subscript_check_ (array, element, i, total_dims, + array_name); + if (element == error_mark_node) + return element; + + /* Widen integral arithmetic as desired while preserving + signedness. */ + tree_type = TREE_TYPE (element); + tree_type_x = tree_type; + if (tree_type + && GET_MODE_CLASS (TYPE_MODE (tree_type)) == MODE_INT + && TYPE_PRECISION (tree_type) < TYPE_PRECISION (sizetype)) + tree_type_x = (TREE_UNSIGNED (tree_type) ? usizetype : ssizetype); + + element = convert (tree_type_x, element); + + item = ffecom_2 (ARRAY_REF, + TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item))), + item, + element); + } + } + + return item; + } /* This is like gcc's stabilize_reference -- in fact, most of the code comes from that -- but it handles the situation where the reference *************** ffecom_build_complex_constant_ (tree typ *** 1095,1101 **** #if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ! ffecom_arglist_expr_ (char *c, ffebld expr) { tree list; tree *plist = &list; --- 1402,1408 ---- #if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ! ffecom_arglist_expr_ (const char *c, ffebld expr) { tree list; tree *plist = &list; *************** ffecom_widest_expr_type_ (ffebld list) *** 1279,1284 **** --- 1586,1633 ---- } #endif + /* Check whether a partial overlap between two expressions is possible. + + Can *starting* to write a portion of expr1 change the value + computed (perhaps already, *partially*) by expr2? + + Currently, this is a concern only for a COMPLEX expr1. But if it + isn't in COMMON or local EQUIVALENCE, since we don't support + aliasing of arguments, it isn't a concern. */ + + static bool + ffecom_possible_partial_overlap_ (ffebld expr1, ffebld expr2) + { + ffesymbol sym; + ffestorag st; + + switch (ffebld_op (expr1)) + { + case FFEBLD_opSYMTER: + sym = ffebld_symter (expr1); + break; + + case FFEBLD_opARRAYREF: + if (ffebld_op (ffebld_left (expr1)) != FFEBLD_opSYMTER) + return FALSE; + sym = ffebld_symter (ffebld_left (expr1)); + break; + + default: + return FALSE; + } + + if (ffesymbol_where (sym) != FFEINFO_whereCOMMON + && (ffesymbol_where (sym) != FFEINFO_whereLOCAL + || ! (st = ffesymbol_storage (sym)) + || ! ffestorag_parent (st))) + return FALSE; + + /* It's in COMMON or local EQUIVALENCE. */ + + return TRUE; + } + /* Check whether dest and source might overlap. ffebld versions of these might or might not be passed, will be NULL if not. *************** ffecom_args_overlapping_ (tree dest_tree *** 1517,1530 **** #if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ! ffecom_build_f2c_string_ (int i, char *s) { if (!ffe_is_f2c_library ()) return build_string (i, s); { char *tmp; ! char *p; char *q; char space[34]; tree t; --- 1866,1879 ---- #if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ! ffecom_build_f2c_string_ (int i, const char *s) { if (!ffe_is_f2c_library ()) return build_string (i, s); { char *tmp; ! const char *p; char *q; char space[34]; tree t; *************** static tree *** 1558,1564 **** ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, tree type, tree args, tree dest_tree, ffebld dest, bool *dest_used, tree callee_commons, ! bool scalar_args) { tree item; tree tempvar; --- 1907,1913 ---- ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, tree type, tree args, tree dest_tree, ffebld dest, bool *dest_used, tree callee_commons, ! bool scalar_args, tree hook) { tree item; tree tempvar; *************** ffecom_call_ (tree fn, ffeinfoKindtype k *** 1578,1587 **** callee_commons, scalar_args)) { ! tempvar = ffecom_push_tempvar (ffecom_tree_type [FFEINFO_basictypeCOMPLEX][kt], FFETARGET_charactersizeNONE, ! -1, TRUE); } else { --- 1927,1941 ---- 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 { *************** ffecom_call_ (tree fn, ffeinfoKindtype k *** 1593,1599 **** item = build_tree_list (NULL_TREE, ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (tempvar)), tempvar)); TREE_CHAIN (item) = args; --- 1947,1953 ---- item = build_tree_list (NULL_TREE, ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (tempvar)), tempvar)); TREE_CHAIN (item) = args; *************** static tree *** 1622,1638 **** ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, tree type, ffebld left, ffebld right, tree dest_tree, ffebld dest, bool *dest_used, ! tree callee_commons, bool scalar_args) { tree left_tree; tree right_tree; tree left_length; tree right_length; - ffecom_push_calltemps (); left_tree = ffecom_arg_ptr_to_expr (left, &left_length); right_tree = ffecom_arg_ptr_to_expr (right, &right_length); - ffecom_pop_calltemps (); left_tree = build_tree_list (NULL_TREE, left_tree); right_tree = build_tree_list (NULL_TREE, right_tree); --- 1976,1990 ---- ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, tree type, ffebld left, ffebld right, tree dest_tree, ffebld dest, bool *dest_used, ! tree callee_commons, bool scalar_args, tree hook) { tree left_tree; tree right_tree; tree left_length; tree right_length; left_tree = ffecom_arg_ptr_to_expr (left, &left_length); right_tree = ffecom_arg_ptr_to_expr (right, &right_length); left_tree = build_tree_list (NULL_TREE, left_tree); right_tree = build_tree_list (NULL_TREE, right_tree); *************** ffecom_call_binop_ (tree fn, ffeinfoKind *** 1655,1671 **** return ffecom_call_ (fn, kt, is_f2c_complex, type, left_tree, dest_tree, dest, dest_used, callee_commons, ! scalar_args); } #endif ! /* ffecom_char_args_x_ -- Return ptr/length args for char subexpression ! ! tree ptr_arg; ! tree length_arg; ! ffebld expr; ! bool with_null; ! ffecom_char_args_x_(&ptr_arg,&length_arg,expr,with_null); Handles CHARACTER-type CONTER, SYMTER, SUBSTR, ARRAYREF, and FUNCREF subexpressions by constructing the appropriate trees for the ptr-to- --- 2007,2017 ---- return ffecom_call_ (fn, kt, is_f2c_complex, type, left_tree, dest_tree, dest, dest_used, callee_commons, ! scalar_args, hook); } #endif ! /* Return ptr/length args for char subexpression Handles CHARACTER-type CONTER, SYMTER, SUBSTR, ARRAYREF, and FUNCREF subexpressions by constructing the appropriate trees for the ptr-to- *************** ffecom_char_args_x_ (tree *xitem, tree * *** 1691,1705 **** newlen = ffetarget_length_character1 (val); if (with_null) { if (newlen != 0) ! ++newlen; /* begin FFETARGET-NULL-KLUDGE. */ } *length = build_int_2 (newlen, 0); TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node; high = build_int_2 (newlen, 0); TREE_TYPE (high) = ffecom_f2c_ftnlen_type_node; ! item = build_string (newlen, /* end FFETARGET-NULL-KLUDGE. */ ffetarget_text_character1 (val)); TREE_TYPE (item) = build_type_variant (build_array_type --- 2037,2053 ---- newlen = ffetarget_length_character1 (val); if (with_null) { + /* Begin FFETARGET-NULL-KLUDGE. */ if (newlen != 0) ! ++newlen; } *length = build_int_2 (newlen, 0); TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node; high = build_int_2 (newlen, 0); TREE_TYPE (high) = ffecom_f2c_ftnlen_type_node; ! item = build_string (newlen, ffetarget_text_character1 (val)); + /* End FFETARGET-NULL-KLUDGE. */ TREE_TYPE (item) = build_type_variant (build_array_type *************** ffecom_char_args_x_ (tree *xitem, tree * *** 1737,1743 **** } else if (item == error_mark_node) *length = error_mark_node; ! else /* FFEINFO_kindFUNCTION: */ *length = NULL_TREE; if (!ffesymbol_hook (s).addr && (item != error_mark_node)) --- 2085,2092 ---- } else if (item == error_mark_node) *length = error_mark_node; ! else ! /* FFEINFO_kindFUNCTION. */ *length = NULL_TREE; if (!ffesymbol_hook (s).addr && (item != error_mark_node)) *************** ffecom_char_args_x_ (tree *xitem, tree * *** 1749,1761 **** case FFEBLD_opARRAYREF: { - ffebld dims[FFECOM_dimensionsMAX]; - tree array; - int i; - - ffecom_push_calltemps (); ffecom_char_args_ (&item, length, ffebld_left (expr)); - ffecom_pop_calltemps (); if (item == error_mark_node || *length == error_mark_node) { --- 2098,2104 ---- *************** ffecom_char_args_x_ (tree *xitem, tree * *** 1763,1788 **** break; } ! /* Build up ARRAY_REFs in reverse order (since we're column major ! here in Fortran land). */ ! ! for (i = 0, expr = ffebld_right (expr); ! expr != NULL; ! expr = ffebld_trail (expr)) ! dims[i++] = ffebld_head (expr); ! ! for (--i, array = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item))); ! i >= 0; ! --i, array = TYPE_MAIN_VARIANT (TREE_TYPE (array))) ! { ! item = ffecom_2 (PLUS_EXPR, build_pointer_type (TREE_TYPE (array)), ! item, ! size_binop (MULT_EXPR, ! size_in_bytes (TREE_TYPE (array)), ! size_binop (MINUS_EXPR, ! ffecom_expr (dims[i]), ! TYPE_MIN_VALUE (TYPE_DOMAIN (array))))); ! } } break; --- 2106,2112 ---- break; } ! item = ffecom_arrayref_ (item, expr, 1); } break; *************** ffecom_char_args_x_ (tree *xitem, tree * *** 1793,1798 **** --- 2117,2125 ---- ffebld thing = ffebld_right (expr); tree start_tree; tree end_tree; + char *char_name; + ffebld left_symter; + tree array; assert (ffebld_op (thing) == FFEBLD_opITEM); start = ffebld_head (thing); *************** ffecom_char_args_x_ (tree *xitem, tree * *** 1800,1808 **** assert (ffebld_trail (thing) == NULL); end = ffebld_head (thing); ! ffecom_push_calltemps (); ffecom_char_args_ (&item, length, ffebld_left (expr)); - ffecom_pop_calltemps (); if (item == error_mark_node || *length == error_mark_node) { --- 2127,2143 ---- assert (ffebld_trail (thing) == NULL); end = ffebld_head (thing); ! /* Determine name for pretty-printing range-check errors. */ ! for (left_symter = ffebld_left (expr); ! left_symter && ffebld_op (left_symter) == FFEBLD_opARRAYREF; ! left_symter = ffebld_left (left_symter)) ! ; ! if (ffebld_op (left_symter) == FFEBLD_opSYMTER) ! char_name = ffesymbol_text (ffebld_symter (left_symter)); ! else ! char_name = "[expr?]"; ! ffecom_char_args_ (&item, length, ffebld_left (expr)); if (item == error_mark_node || *length == error_mark_node) { *************** ffecom_char_args_x_ (tree *xitem, tree * *** 1810,1823 **** break; } if (start == NULL) { if (end == NULL) ; else { end_tree = convert (ffecom_f2c_ftnlen_type_node, ! ffecom_expr (end)); if (end_tree == error_mark_node) { --- 2145,2166 ---- break; } + array = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item))); + + /* ~~~~Handle INTEGER*8 start/end, a la FFEBLD_opARRAYREF. */ + if (start == NULL) { if (end == NULL) ; else { + end_tree = ffecom_expr (end); + if (ffe_is_subscript_check ()) + end_tree = ffecom_subscript_check_ (array, end_tree, 1, 0, + char_name); end_tree = convert (ffecom_f2c_ftnlen_type_node, ! end_tree); if (end_tree == error_mark_node) { *************** ffecom_char_args_x_ (tree *xitem, tree * *** 1830,1837 **** } else { start_tree = convert (ffecom_f2c_ftnlen_type_node, ! ffecom_expr (start)); if (start_tree == error_mark_node) { --- 2173,2184 ---- } else { + start_tree = ffecom_expr (start); + if (ffe_is_subscript_check ()) + start_tree = ffecom_subscript_check_ (array, start_tree, 0, 0, + char_name); start_tree = convert (ffecom_f2c_ftnlen_type_node, ! start_tree); if (start_tree == error_mark_node) { *************** ffecom_char_args_x_ (tree *xitem, tree * *** 1859,1866 **** } else { end_tree = convert (ffecom_f2c_ftnlen_type_node, ! ffecom_expr (end)); if (end_tree == error_mark_node) { --- 2206,2217 ---- } else { + end_tree = ffecom_expr (end); + if (ffe_is_subscript_check ()) + end_tree = ffecom_subscript_check_ (array, end_tree, 1, 0, + char_name); end_tree = convert (ffecom_f2c_ftnlen_type_node, ! end_tree); if (end_tree == error_mark_node) { *************** ffecom_char_args_x_ (tree *xitem, tree * *** 1887,1893 **** ffecomGfrt ix; if (size == FFETARGET_charactersizeNONE) ! size = 24; /* ~~~~ Kludge alert! This should someday be fixed. */ *length = build_int_2 (size, 0); TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node; --- 2238,2245 ---- ffecomGfrt ix; if (size == FFETARGET_charactersizeNONE) ! /* ~~Kludge alert! This should someday be fixed. */ ! size = 24; *length = build_int_2 (size, 0); TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node; *************** ffecom_char_args_x_ (tree *xitem, tree * *** 1896,1902 **** == FFEINFO_whereINTRINSIC) { if (size == 1) ! { /* Invocation of an intrinsic returning CHARACTER*1. */ item = ffecom_expr_intrinsic_ (expr, NULL_TREE, NULL, NULL); break; --- 2248,2255 ---- == FFEINFO_whereINTRINSIC) { if (size == 1) ! { ! /* Invocation of an intrinsic returning CHARACTER*1. */ item = ffecom_expr_intrinsic_ (expr, NULL_TREE, NULL, NULL); break; *************** ffecom_char_args_x_ (tree *xitem, tree * *** 1924,1937 **** item = ffecom_1_fn (item); } ! assert (ffecom_pending_calls_ != 0); tempvar = ffecom_push_tempvar (char_type_node, size, -1, TRUE); tempvar = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (tempvar)), tempvar); - ffecom_push_calltemps (); - args = build_tree_list (NULL_TREE, tempvar); if (ffesymbol_where (s) == FFEINFO_whereCONSTANT) /* Sfunc args by value. */ --- 2277,2292 ---- 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); args = build_tree_list (NULL_TREE, tempvar); if (ffesymbol_where (s) == FFEINFO_whereCONSTANT) /* Sfunc args by value. */ *************** ffecom_char_args_x_ (tree *xitem, tree * *** 1957,1972 **** item, args, NULL_TREE); item = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (tempvar), item, tempvar); - - ffecom_pop_calltemps (); } break; case FFEBLD_opCONVERT: - ffecom_push_calltemps (); ffecom_char_args_ (&item, length, ffebld_left (expr)); - ffecom_pop_calltemps (); if (item == error_mark_node || *length == error_mark_node) { --- 2312,2323 ---- *************** ffecom_char_args_x_ (tree *xitem, tree * *** 1983,1991 **** tree args; tree newlen; ! assert (ffecom_pending_calls_ != 0); ! tempvar = ffecom_push_tempvar (char_type_node, ! ffebld_size (expr), -1, TRUE); tempvar = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (tempvar)), tempvar); --- 2334,2346 ---- 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); *************** ffecom_char_args_x_ (tree *xitem, tree * *** 1999,2005 **** TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (args))) = build_tree_list (NULL_TREE, *length); ! item = ffecom_call_gfrt (FFECOM_gfrtCOPY, args); TREE_SIDE_EFFECTS (item) = 1; item = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (tempvar), fold (item), tempvar); --- 2354,2360 ---- TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (args))) = build_tree_list (NULL_TREE, *length); ! item = ffecom_call_gfrt (FFECOM_gfrtCOPY, args, NULL_TREE); TREE_SIDE_EFFECTS (item) = 1; item = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (tempvar), fold (item), tempvar); *************** ffecom_char_enhance_arg_ (tree *xtype, f *** 2077,2086 **** { if (ffesymbol_where (s) == FFEINFO_whereDUMMY) tlen = ffecom_get_invented_identifier ("__g77_length_%s", ! ffesymbol_text (s), 0); else tlen = ffecom_get_invented_identifier ("__g77_%s", ! "length", 0); tlen = build_decl (PARM_DECL, tlen, ffecom_f2c_ftnlen_type_node); #if BUILT_FOR_270 DECL_ARTIFICIAL (tlen) = 1; --- 2432,2441 ---- { if (ffesymbol_where (s) == FFEINFO_whereDUMMY) tlen = ffecom_get_invented_identifier ("__g77_length_%s", ! ffesymbol_text (s), -1); else tlen = ffecom_get_invented_identifier ("__g77_%s", ! "length", -1); tlen = build_decl (PARM_DECL, tlen, ffecom_f2c_ftnlen_type_node); #if BUILT_FOR_270 DECL_ARTIFICIAL (tlen) = 1; *************** recurse: /* :::::::::::::::::::: */ *** 2177,2183 **** case FFEBLD_opARRAYREF: case FFEBLD_opFUNCREF: case FFEBLD_opSUBSTR: ! break; /* ~~Do useful truncations here. */ default: assert ("op changed or inconsistent switches!" == NULL); --- 2532,2539 ---- case FFEBLD_opARRAYREF: case FFEBLD_opFUNCREF: case FFEBLD_opSUBSTR: ! /* ~~Do useful truncations here. */ ! break; default: assert ("op changed or inconsistent switches!" == NULL); *************** ffecom_concat_list_kill_ (ffecomConcatLi *** 2238,2249 **** } #endif ! /* ffecom_concat_list_new_ -- Make list of concatenated string exprs ! ! ffecomConcatList_ catlist; ! ffebld expr; // Root expr of CHARACTER basictype. ! ffetargetCharacterSize max; // max chars to gather or _...NONE if no max ! catlist = ffecom_concat_list_new_(expr,max); Returns a flattened list of concatenated subexpressions given a tree of such expressions. */ --- 2594,2600 ---- } #endif ! /* Make list of concatenated string exprs. Returns a flattened list of concatenated subexpressions given a tree of such expressions. */ *************** ffecom_concat_list_new_ (ffebld expr, ff *** 2266,2272 **** #if FFECOM_targetCURRENT == FFECOM_targetGCC static void ! ffecom_debug_kludge_ (tree aggr, char *aggr_type, ffesymbol member, tree member_type UNUSED, ffetargetOffset offset) { tree value; --- 2617,2623 ---- #if FFECOM_targetCURRENT == FFECOM_targetGCC static void ! ffecom_debug_kludge_ (tree aggr, const char *aggr_type, ffesymbol member, tree member_type UNUSED, ffetargetOffset offset) { tree value; *************** ffecom_do_entry_ (ffesymbol fn, int entr *** 2521,2527 **** type = ffecom_tree_type[FFEINFO_basictypeCOMPLEX][kt]; result = ffecom_get_invented_identifier ("__g77_%s", ! "result", 0); /* Make length arg _and_ enhance type info for CHAR arg itself. */ --- 2872,2878 ---- type = ffecom_tree_type[FFEINFO_basictypeCOMPLEX][kt]; result = ffecom_get_invented_identifier ("__g77_%s", ! "result", -1); /* Make length arg _and_ enhance type info for CHAR arg itself. */ *************** ffecom_do_entry_ (ffesymbol fn, int entr *** 2551,2557 **** store_parm_decls (0); ! ffecom_start_compstmt_ (); /* Make local var to hold return type for multi-type master fn. */ --- 2902,2910 ---- store_parm_decls (0); ! ffecom_start_compstmt (); ! /* Disallow temp vars at this level. */ ! current_binding_level->prep_state = 2; /* Make local var to hold return type for multi-type master fn. */ *************** ffecom_do_entry_ (ffesymbol fn, int entr *** 2560,2566 **** yes = suspend_momentary (); multi_retval = ffecom_get_invented_identifier ("__g77_%s", ! "multi_retval", 0); multi_retval = build_decl (VAR_DECL, multi_retval, ffecom_multi_type_node_); multi_retval = start_decl (multi_retval, FALSE); --- 2913,2919 ---- yes = suspend_momentary (); multi_retval = ffecom_get_invented_identifier ("__g77_%s", ! "multi_retval", -1); multi_retval = build_decl (VAR_DECL, multi_retval, ffecom_multi_type_node_); multi_retval = start_decl (multi_retval, FALSE); *************** ffecom_do_entry_ (ffesymbol fn, int entr *** 2594,2600 **** if (ffebld_op (arg) != FFEBLD_opSYMTER) continue; s = ffebld_symter (arg); ! if (ffesymbol_hook (s).decl_tree == NULL_TREE) actarg = null_pointer_node; /* We don't have this arg. */ else actarg = ffesymbol_hook (s).decl_tree; --- 2947,2954 ---- if (ffebld_op (arg) != FFEBLD_opSYMTER) continue; s = ffebld_symter (arg); ! if (ffesymbol_hook (s).decl_tree == NULL_TREE ! || ffesymbol_hook (s).decl_tree == error_mark_node) actarg = null_pointer_node; /* We don't have this arg. */ else actarg = ffesymbol_hook (s).decl_tree; *************** ffecom_do_entry_ (ffesymbol fn, int entr *** 2617,2623 **** continue; /* Only looking for CHARACTER arguments. */ if (ffesymbol_kind (s) != FFEINFO_kindENTITY) continue; /* Only looking for variables and arrays. */ ! if (ffesymbol_hook (s).length_tree == NULL_TREE) actarg = ffecom_f2c_ftnlen_zero_node; /* We don't have this arg. */ else actarg = ffesymbol_hook (s).length_tree; --- 2971,2978 ---- continue; /* Only looking for CHARACTER arguments. */ if (ffesymbol_kind (s) != FFEINFO_kindENTITY) continue; /* Only looking for variables and arrays. */ ! if (ffesymbol_hook (s).length_tree == NULL_TREE ! || ffesymbol_hook (s).length_tree == error_mark_node) actarg = ffecom_f2c_ftnlen_zero_node; /* We don't have this arg. */ else actarg = ffesymbol_hook (s).length_tree; *************** ffecom_do_entry_ (ffesymbol fn, int entr *** 2719,2725 **** clear_momentary (); } ! ffecom_end_compstmt_ (); finish_function (0); --- 3074,3080 ---- clear_momentary (); } ! ffecom_end_compstmt (); finish_function (0); *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 2975,3039 **** return t; case FFEBLD_opARRAYREF: ! { ! ffebld dims[FFECOM_dimensionsMAX]; ! #if FFECOM_FASTER_ARRAY_REFS ! tree array; ! #endif ! int i; ! ! #if FFECOM_FASTER_ARRAY_REFS ! t = ffecom_ptr_to_expr (ffebld_left (expr)); ! #else ! t = ffecom_expr (ffebld_left (expr)); ! #endif ! if (t == error_mark_node) ! return t; ! ! if ((ffeinfo_where (ffebld_info (expr)) == FFEINFO_whereFLEETING) ! && !mark_addressable (t)) ! return error_mark_node; /* Make sure non-const ref is to ! non-reg. */ ! ! /* Build up ARRAY_REFs in reverse order (since we're column major ! here in Fortran land). */ ! ! for (i = 0, expr = ffebld_right (expr); ! expr != NULL; ! expr = ffebld_trail (expr)) ! dims[i++] = ffebld_head (expr); ! ! #if FFECOM_FASTER_ARRAY_REFS ! for (--i, array = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (t))); ! i >= 0; ! --i, array = TYPE_MAIN_VARIANT (TREE_TYPE (array))) ! t = ffecom_2 (PLUS_EXPR, ! build_pointer_type (TREE_TYPE (array)), ! t, ! size_binop (MULT_EXPR, ! size_in_bytes (TREE_TYPE (array)), ! size_binop (MINUS_EXPR, ! ffecom_expr (dims[i]), ! TYPE_MIN_VALUE (TYPE_DOMAIN (array))))); ! t = ffecom_1 (INDIRECT_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (t))), ! t); ! #else ! while (i > 0) ! t = ffecom_2 (ARRAY_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (t))), ! t, ! ffecom_expr_ (dims[--i], NULL, NULL, NULL, FALSE, TRUE)); ! #endif ! ! return t; ! } case FFEBLD_opUPLUS: left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp); return ffecom_1 (NOP_EXPR, tree_type, left); ! case FFEBLD_opPAREN: /* ~~~Make sure Fortran rules respected here */ left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp); return ffecom_1 (NOP_EXPR, tree_type, left); --- 3330,3343 ---- return t; case FFEBLD_opARRAYREF: ! return ffecom_arrayref_ (NULL_TREE, expr, 0); case FFEBLD_opUPLUS: left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp); return ffecom_1 (NOP_EXPR, tree_type, left); ! case FFEBLD_opPAREN: ! /* ~~~Make sure Fortran rules respected here */ left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp); return ffecom_1 (NOP_EXPR, tree_type, left); *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 3089,3095 **** right = convert (tree_type, right); } return ffecom_tree_divide_ (tree_type, left, right, ! dest_tree, dest, dest_used); case FFEBLD_opPOWER: { --- 3393,3400 ---- right = convert (tree_type, right); } return ffecom_tree_divide_ (tree_type, left, right, ! dest_tree, dest, dest_used, ! ffebld_nonter_hook (expr)); case FFEBLD_opPOWER: { *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 3104,3110 **** case FFEINFO_basictypeINTEGER: if (1 || optimize) { ! item = ffecom_expr_power_integer_ (left, right); if (item != NULL_TREE) return item; } --- 3409,3415 ---- case FFEINFO_basictypeINTEGER: if (1 || optimize) { ! item = ffecom_expr_power_integer_ (expr); if (item != NULL_TREE) return item; } *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 3221,3227 **** && ffecom_gfrt_complex_[code]), tree_type, left, right, dest_tree, dest, dest_used, ! NULL_TREE, FALSE); } case FFEBLD_opNOT: --- 3526,3533 ---- && ffecom_gfrt_complex_[code]), tree_type, left, right, dest_tree, dest, dest_used, ! NULL_TREE, FALSE, ! ffebld_nonter_hook (expr)); } case FFEBLD_opNOT: *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 3270,3281 **** else item = ffecom_1_fn (dt); - ffecom_push_calltemps (); if (ffesymbol_where (s) == FFEINFO_whereCONSTANT) args = ffecom_list_expr (ffebld_right (expr)); else args = ffecom_list_ptr_to_expr (ffebld_right (expr)); ! ffecom_pop_calltemps (); item = ffecom_call_ (item, kt, ffesymbol_is_f2c (s) --- 3576,3588 ---- else item = ffecom_1_fn (dt); if (ffesymbol_where (s) == FFEINFO_whereCONSTANT) args = ffecom_list_expr (ffebld_right (expr)); else args = ffecom_list_ptr_to_expr (ffebld_right (expr)); ! ! if (args == error_mark_node) ! return error_mark_node; item = ffecom_call_ (item, kt, ffesymbol_is_f2c (s) *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 3285,3291 **** tree_type, args, dest_tree, dest, dest_used, ! error_mark_node, FALSE); TREE_SIDE_EFFECTS (item) = 1; return item; --- 3592,3599 ---- tree_type, args, dest_tree, dest, dest_used, ! error_mark_node, FALSE, ! ffebld_nonter_hook (expr)); TREE_SIDE_EFFECTS (item) = 1; return item; *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 3503,3510 **** } case FFEINFO_basictypeCHARACTER: - ffecom_push_calltemps (); /* Even though we might not call. */ - { ffebld left = ffebld_left (expr); ffebld right = ffebld_right (expr); --- 3811,3816 ---- *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 3536,3545 **** if (left_tree == error_mark_node || left_length == error_mark_node || right_tree == error_mark_node || right_length == error_mark_node) ! { ! ffecom_pop_calltemps (); ! return error_mark_node; ! } if ((ffebld_size_known (left) == 1) && (ffebld_size_known (right) == 1)) --- 3842,3848 ---- if (left_tree == error_mark_node || left_length == error_mark_node || right_tree == error_mark_node || right_length == error_mark_node) ! return error_mark_node; if ((ffebld_size_known (left) == 1) && (ffebld_size_known (right) == 1)) *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 3572,3578 **** left_length); TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (item))) = build_tree_list (NULL_TREE, right_length); ! item = ffecom_call_gfrt (FFECOM_gfrtCMP, item); item = ffecom_2 (code, integer_type_node, item, convert (TREE_TYPE (item), --- 3875,3881 ---- left_length); TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (item))) = build_tree_list (NULL_TREE, right_length); ! item = ffecom_call_gfrt (FFECOM_gfrtCMP, item, NULL_TREE); item = ffecom_2 (code, integer_type_node, item, convert (TREE_TYPE (item), *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 3581,3587 **** item = convert (tree_type, item); } - ffecom_pop_calltemps (); return item; default: --- 3884,3889 ---- *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3783,3790 **** case FFEINTRIN_impAINT: case FFEINTRIN_impDINT: ! #if 0 /* ~~ someday implement FIX_TRUNC_EXPR ! yielding same type as arg */ return ffecom_1 (FIX_TRUNC_EXPR, tree_type, ffecom_expr (arg1)); #else /* in the meantime, must use floor to avoid range problems with ints */ /* r__1 = r1 >= 0 ? floor(r1) : -floor(-r1); */ --- 4085,4092 ---- case FFEINTRIN_impAINT: case FFEINTRIN_impDINT: ! #if 0 ! /* ~~Someday implement FIX_TRUNC_EXPR yielding same type as arg. */ return ffecom_1 (FIX_TRUNC_EXPR, tree_type, ffecom_expr (arg1)); #else /* in the meantime, must use floor to avoid range problems with ints */ /* r__1 = r1 >= 0 ? floor(r1) : -floor(-r1); */ *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3800,3813 **** ffecom_call_gfrt (FFECOM_gfrtL_FLOOR, build_tree_list (NULL_TREE, convert (double_type_node, ! saved_expr1))), ffecom_1 (NEGATE_EXPR, double_type_node, ffecom_call_gfrt (FFECOM_gfrtL_FLOOR, build_tree_list (NULL_TREE, convert (double_type_node, ffecom_1 (NEGATE_EXPR, arg1_type, ! saved_expr1)))) )) ); #endif --- 4102,4117 ---- ffecom_call_gfrt (FFECOM_gfrtL_FLOOR, build_tree_list (NULL_TREE, convert (double_type_node, ! saved_expr1)), ! NULL_TREE), ffecom_1 (NEGATE_EXPR, double_type_node, ffecom_call_gfrt (FFECOM_gfrtL_FLOOR, build_tree_list (NULL_TREE, convert (double_type_node, ffecom_1 (NEGATE_EXPR, arg1_type, ! saved_expr1))), ! NULL_TREE) )) ); #endif *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3852,3858 **** arg1_type, saved_expr1, convert (arg1_type, ! ffecom_float_half_))))), ffecom_1 (NEGATE_EXPR, double_type_node, ffecom_call_gfrt (FFECOM_gfrtL_FLOOR, build_tree_list (NULL_TREE, --- 4156,4163 ---- arg1_type, saved_expr1, convert (arg1_type, ! ffecom_float_half_)))), ! NULL_TREE), ffecom_1 (NEGATE_EXPR, double_type_node, ffecom_call_gfrt (FFECOM_gfrtL_FLOOR, build_tree_list (NULL_TREE, *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3861,3867 **** arg1_type, convert (arg1_type, ffecom_float_half_), ! saved_expr1))))) ) ); #endif --- 4166,4173 ---- arg1_type, convert (arg1_type, ffecom_float_half_), ! saved_expr1))), ! NULL_TREE)) ) ); #endif *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3876,3884 **** case FFEINTRIN_impCHAR: case FFEINTRIN_impACHAR: ! assert (ffecom_pending_calls_ != 0); ! tempvar = ffecom_push_tempvar (char_type_node, ! 1, -1, TRUE); { tree tmv = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (tempvar))); --- 4182,4193 ---- 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))); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4128,4135 **** case FFEINTRIN_impNINT: case FFEINTRIN_impIDNINT: ! #if 0 /* ~~ ideally FIX_ROUND_EXPR would be ! implemented, but it ain't yet */ return ffecom_1 (FIX_ROUND_EXPR, tree_type, ffecom_expr (arg1)); #else /* i__1 = r1 >= 0 ? floor(r1 + .5) : -floor(.5 - r1); */ --- 4437,4444 ---- case FFEINTRIN_impNINT: case FFEINTRIN_impIDNINT: ! #if 0 ! /* ~~Ideally FIX_ROUND_EXPR would be implemented, but it ain't yet. */ return ffecom_1 (FIX_ROUND_EXPR, tree_type, ffecom_expr (arg1)); #else /* i__1 = r1 >= 0 ? floor(r1 + .5) : -floor(.5 - r1); */ *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4542,4554 **** tree prep_arg4; tree arg5_plus_arg3; - ffecom_push_calltemps (); - arg2_tree = convert (integer_type_node, ffecom_expr (arg2)); arg3_tree = ffecom_save_tree (convert (integer_type_node, ffecom_expr (arg3))); ! arg4_tree = ffecom_expr_rw (arg4); arg4_type = TREE_TYPE (arg4_tree); arg1_tree = ffecom_save_tree (convert (arg4_type, --- 4851,4861 ---- tree prep_arg4; tree arg5_plus_arg3; arg2_tree = convert (integer_type_node, ffecom_expr (arg2)); arg3_tree = ffecom_save_tree (convert (integer_type_node, ffecom_expr (arg3))); ! arg4_tree = ffecom_expr_rw (NULL_TREE, arg4); arg4_type = TREE_TYPE (arg4_tree); arg1_tree = ffecom_save_tree (convert (arg4_type, *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4557,4564 **** arg5_tree = ffecom_save_tree (convert (integer_type_node, ffecom_expr (arg5))); - ffecom_pop_calltemps (); - prep_arg1 = ffecom_2 (LSHIFT_EXPR, arg4_type, ffecom_2 (BIT_AND_EXPR, arg4_type, --- 4864,4869 ---- *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4676,4683 **** tree arg2_tree; tree arg3_tree; - ffecom_push_calltemps (); - arg1_tree = convert (ffecom_f2c_integer_type_node, ffecom_expr (arg1)); arg1_tree = ffecom_1 (ADDR_EXPR, --- 4981,4986 ---- *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4693,4704 **** arg2_tree); if (arg3 != NULL) ! arg3_tree = ffecom_expr_rw (arg3); else arg3_tree = NULL_TREE; - ffecom_pop_calltemps (); - arg1_tree = build_tree_list (NULL_TREE, arg1_tree); arg2_tree = build_tree_list (NULL_TREE, arg2_tree); TREE_CHAIN (arg1_tree) = arg2_tree; --- 4996,5005 ---- arg2_tree); if (arg3 != NULL) ! arg3_tree = ffecom_expr_w (NULL_TREE, arg3); else arg3_tree = NULL_TREE; arg1_tree = build_tree_list (NULL_TREE, arg1_tree); arg2_tree = build_tree_list (NULL_TREE, arg2_tree); TREE_CHAIN (arg1_tree) = arg2_tree; *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4711,4717 **** NULL_TREE : tree_type), arg1_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE); if (arg3_tree != NULL_TREE) expr_tree --- 5012,5019 ---- NULL_TREE : tree_type), arg1_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE, ! ffebld_nonter_hook (expr)); if (arg3_tree != NULL_TREE) expr_tree *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4727,4734 **** tree arg2_tree; tree arg3_tree; - ffecom_push_calltemps (); - arg1_tree = convert (ffecom_f2c_integer_type_node, ffecom_expr (arg1)); arg1_tree = ffecom_1 (ADDR_EXPR, --- 5029,5034 ---- *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4744,4755 **** arg2_tree); if (arg3 != NULL) ! arg3_tree = ffecom_expr_rw (arg3); else arg3_tree = NULL_TREE; - ffecom_pop_calltemps (); - arg1_tree = build_tree_list (NULL_TREE, arg1_tree); arg2_tree = build_tree_list (NULL_TREE, arg2_tree); TREE_CHAIN (arg1_tree) = arg2_tree; --- 5044,5053 ---- arg2_tree); if (arg3 != NULL) ! arg3_tree = ffecom_expr_w (NULL_TREE, arg3); else arg3_tree = NULL_TREE; arg1_tree = build_tree_list (NULL_TREE, arg1_tree); arg2_tree = build_tree_list (NULL_TREE, arg2_tree); TREE_CHAIN (arg1_tree) = arg2_tree; *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4760,4766 **** FALSE, NULL_TREE, arg1_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE); if (arg3_tree != NULL_TREE) expr_tree --- 5058,5065 ---- FALSE, NULL_TREE, arg1_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE, ! ffebld_nonter_hook (expr)); if (arg3_tree != NULL_TREE) expr_tree *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4783,4799 **** tree arg1_tree; tree arg2_tree; - ffecom_push_calltemps (); - arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len); if (arg2 != NULL) ! arg2_tree = ffecom_expr_rw (arg2); else arg2_tree = NULL_TREE; - ffecom_pop_calltemps (); - arg1_tree = build_tree_list (NULL_TREE, arg1_tree); arg1_len = build_tree_list (NULL_TREE, arg1_len); TREE_CHAIN (arg1_tree) = arg1_len; --- 5082,5094 ---- tree arg1_tree; tree arg2_tree; arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len); if (arg2 != NULL) ! arg2_tree = ffecom_expr_w (NULL_TREE, arg2); else arg2_tree = NULL_TREE; arg1_tree = build_tree_list (NULL_TREE, arg1_tree); arg1_len = build_tree_list (NULL_TREE, arg1_len); TREE_CHAIN (arg1_tree) = arg1_len; *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4804,4810 **** FALSE, NULL_TREE, arg1_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE); if (arg2_tree != NULL_TREE) expr_tree --- 5099,5106 ---- FALSE, NULL_TREE, arg1_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE, ! ffebld_nonter_hook (expr)); if (arg2_tree != NULL_TREE) expr_tree *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4830,4836 **** FALSE, void_type_node, expr_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE); case FFEINTRIN_impFLUSH: if (arg1 == NULL) --- 5126,5133 ---- FALSE, void_type_node, expr_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE, ! ffebld_nonter_hook (expr)); case FFEINTRIN_impFLUSH: if (arg1 == NULL) *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4850,4866 **** tree arg2_tree; tree arg3_tree; - ffecom_push_calltemps (); - arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len); arg2_tree = ffecom_arg_ptr_to_expr (arg2, &arg2_len); if (arg3 != NULL) ! arg3_tree = ffecom_expr_rw (arg3); else arg3_tree = NULL_TREE; - ffecom_pop_calltemps (); - arg1_tree = build_tree_list (NULL_TREE, arg1_tree); arg1_len = build_tree_list (NULL_TREE, arg1_len); arg2_tree = build_tree_list (NULL_TREE, arg2_tree); --- 5147,5159 ---- tree arg2_tree; tree arg3_tree; arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len); arg2_tree = ffecom_arg_ptr_to_expr (arg2, &arg2_len); if (arg3 != NULL) ! arg3_tree = ffecom_expr_w (NULL_TREE, arg3); else arg3_tree = NULL_TREE; arg1_tree = build_tree_list (NULL_TREE, arg1_tree); arg1_len = build_tree_list (NULL_TREE, arg1_len); arg2_tree = build_tree_list (NULL_TREE, arg2_tree); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4873,4879 **** FALSE, NULL_TREE, arg1_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE); if (arg3_tree != NULL_TREE) expr_tree = ffecom_modify (NULL_TREE, arg3_tree, convert (TREE_TYPE (arg3_tree), --- 5166,5173 ---- FALSE, NULL_TREE, arg1_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE, ! ffebld_nonter_hook (expr)); if (arg3_tree != NULL_TREE) expr_tree = ffecom_modify (NULL_TREE, arg3_tree, convert (TREE_TYPE (arg3_tree), *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4889,4907 **** tree arg2_tree; tree arg3_tree; - ffecom_push_calltemps (); - arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len); arg2_tree = ffecom_ptr_to_expr (arg2); if (arg3 != NULL) ! arg3_tree = ffecom_expr_rw (arg3); else arg3_tree = NULL_TREE; - ffecom_pop_calltemps (); - arg1_tree = build_tree_list (NULL_TREE, arg1_tree); arg1_len = build_tree_list (NULL_TREE, arg1_len); arg2_tree = build_tree_list (NULL_TREE, arg2_tree); --- 5183,5197 ---- tree arg2_tree; tree arg3_tree; arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len); arg2_tree = ffecom_ptr_to_expr (arg2); if (arg3 != NULL) ! arg3_tree = ffecom_expr_w (NULL_TREE, arg3); else arg3_tree = NULL_TREE; arg1_tree = build_tree_list (NULL_TREE, arg1_tree); arg1_len = build_tree_list (NULL_TREE, arg1_len); arg2_tree = build_tree_list (NULL_TREE, arg2_tree); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4912,4918 **** FALSE, NULL_TREE, arg1_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE); if (arg3_tree != NULL_TREE) expr_tree = ffecom_modify (NULL_TREE, arg3_tree, convert (TREE_TYPE (arg3_tree), --- 5202,5209 ---- FALSE, NULL_TREE, arg1_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE, ! ffebld_nonter_hook (expr)); if (arg3_tree != NULL_TREE) expr_tree = ffecom_modify (NULL_TREE, arg3_tree, convert (TREE_TYPE (arg3_tree), *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4928,4935 **** tree arg2_len = integer_zero_node; tree arg3_tree; - ffecom_push_calltemps (); - arg1_tree = convert (ffecom_f2c_integer_type_node, ffecom_expr (arg1)); arg1_tree = ffecom_1 (ADDR_EXPR, --- 5219,5224 ---- *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4937,4945 **** arg1_tree); arg2_tree = ffecom_arg_ptr_to_expr (arg2, &arg2_len); ! arg3_tree = ffecom_expr_rw (arg3); ! ! ffecom_pop_calltemps (); arg1_tree = build_tree_list (NULL_TREE, arg1_tree); arg2_tree = build_tree_list (NULL_TREE, arg2_tree); --- 5226,5232 ---- arg1_tree); arg2_tree = ffecom_arg_ptr_to_expr (arg2, &arg2_len); ! arg3_tree = ffecom_expr_w (NULL_TREE, arg3); arg1_tree = build_tree_list (NULL_TREE, arg1_tree); arg2_tree = build_tree_list (NULL_TREE, arg2_tree); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4952,4958 **** FALSE, NULL_TREE, arg1_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE); expr_tree = ffecom_modify (NULL_TREE, arg3_tree, convert (TREE_TYPE (arg3_tree), expr_tree)); --- 5239,5246 ---- FALSE, NULL_TREE, arg1_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE, ! ffebld_nonter_hook (expr)); expr_tree = ffecom_modify (NULL_TREE, arg3_tree, convert (TREE_TYPE (arg3_tree), expr_tree)); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4965,4972 **** tree arg2_tree; tree arg3_tree; - ffecom_push_calltemps (); - arg1_tree = convert (ffecom_f2c_integer_type_node, ffecom_expr (arg1)); arg1_tree = ffecom_1 (ADDR_EXPR, --- 5253,5258 ---- *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4979,4987 **** if (arg3 == NULL) arg3_tree = NULL_TREE; else ! arg3_tree = ffecom_expr_rw (arg3); ! ! ffecom_pop_calltemps (); arg1_tree = build_tree_list (NULL_TREE, arg1_tree); arg2_tree = build_tree_list (NULL_TREE, arg2_tree); --- 5265,5271 ---- if (arg3 == NULL) arg3_tree = NULL_TREE; else ! arg3_tree = ffecom_expr_w (NULL_TREE, arg3); arg1_tree = build_tree_list (NULL_TREE, arg1_tree); arg2_tree = build_tree_list (NULL_TREE, arg2_tree); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4991,4997 **** FALSE, NULL_TREE, arg1_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE); if (arg3_tree != NULL_TREE) { expr_tree = ffecom_modify (NULL_TREE, arg3_tree, convert (TREE_TYPE (arg3_tree), --- 5275,5282 ---- FALSE, NULL_TREE, arg1_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE, ! ffebld_nonter_hook (expr)); if (arg3_tree != NULL_TREE) { expr_tree = ffecom_modify (NULL_TREE, arg3_tree, convert (TREE_TYPE (arg3_tree), *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 5006,5013 **** tree arg2_tree; tree arg3_tree; - ffecom_push_calltemps (); - arg1_tree = convert (ffecom_f2c_integer_type_node, ffecom_expr (arg1)); arg1_tree = ffecom_1 (ADDR_EXPR, --- 5291,5296 ---- *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 5023,5031 **** if (arg3 == NULL) arg3_tree = NULL_TREE; else ! arg3_tree = ffecom_expr_rw (arg3); ! ! ffecom_pop_calltemps (); arg1_tree = build_tree_list (NULL_TREE, arg1_tree); arg2_tree = build_tree_list (NULL_TREE, arg2_tree); --- 5306,5312 ---- if (arg3 == NULL) arg3_tree = NULL_TREE; else ! arg3_tree = ffecom_expr_w (NULL_TREE, arg3); arg1_tree = build_tree_list (NULL_TREE, arg1_tree); arg2_tree = build_tree_list (NULL_TREE, arg2_tree); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 5035,5041 **** FALSE, NULL_TREE, arg1_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE); if (arg3_tree != NULL_TREE) { expr_tree = ffecom_modify (NULL_TREE, arg3_tree, convert (TREE_TYPE (arg3_tree), --- 5316,5323 ---- FALSE, NULL_TREE, arg1_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE, ! ffebld_nonter_hook (expr)); if (arg3_tree != NULL_TREE) { expr_tree = ffecom_modify (NULL_TREE, arg3_tree, convert (TREE_TYPE (arg3_tree), *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 5051,5070 **** tree arg1_tree; tree arg2_tree; ! ffecom_push_calltemps (); ! ! arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len); ! arg2_tree = convert (((gfrt == FFEINTRIN_impCTIME_subr) ? ffecom_f2c_longint_type_node : ffecom_f2c_integer_type_node), ! ffecom_expr (arg2)); arg2_tree = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (arg2_tree)), arg2_tree); - ffecom_pop_calltemps (); - arg1_tree = build_tree_list (NULL_TREE, arg1_tree); arg1_len = build_tree_list (NULL_TREE, arg1_len); arg2_tree = build_tree_list (NULL_TREE, arg2_tree); --- 5333,5348 ---- tree arg1_tree; tree arg2_tree; ! arg1_tree = ffecom_arg_ptr_to_expr (arg2, &arg1_len); ! arg2_tree = convert (((codegen_imp == FFEINTRIN_impCTIME_subr) ? ffecom_f2c_longint_type_node : ffecom_f2c_integer_type_node), ! ffecom_expr (arg1)); arg2_tree = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (arg2_tree)), arg2_tree); arg1_tree = build_tree_list (NULL_TREE, arg1_tree); arg1_len = build_tree_list (NULL_TREE, arg1_len); arg2_tree = build_tree_list (NULL_TREE, arg2_tree); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 5077,5083 **** FALSE, NULL_TREE, arg1_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE); } return expr_tree; --- 5355,5363 ---- FALSE, NULL_TREE, arg1_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE, ! ffebld_nonter_hook (expr)); ! TREE_SIDE_EFFECTS (expr_tree) = 1; } return expr_tree; *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 5106,5112 **** ffecom_f2c_real_type_node), arg1_tree, dest_tree, dest, dest_used, ! NULL_TREE, TRUE); } return expr_tree; --- 5386,5393 ---- ffecom_f2c_real_type_node), arg1_tree, dest_tree, dest, dest_used, ! NULL_TREE, TRUE, ! ffebld_nonter_hook (expr)); } return expr_tree; *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 5116,5123 **** tree arg1_tree; tree arg2_tree; - ffecom_push_calltemps (); - arg1_tree = convert (ffecom_f2c_integer_type_node, ffecom_expr (arg1)); arg1_tree = ffecom_1 (ADDR_EXPR, --- 5397,5402 ---- *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 5127,5135 **** if (arg2 == NULL) arg2_tree = NULL_TREE; else ! arg2_tree = ffecom_expr_rw (arg2); ! ! ffecom_pop_calltemps (); expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ffecom_gfrt_kindtype (gfrt), --- 5406,5412 ---- if (arg2 == NULL) arg2_tree = NULL_TREE; else ! arg2_tree = ffecom_expr_w (NULL_TREE, arg2); expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ffecom_gfrt_kindtype (gfrt), *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 5137,5143 **** NULL_TREE, build_tree_list (NULL_TREE, arg1_tree), NULL_TREE, NULL, NULL, NULL_TREE, ! TRUE); if (arg2_tree != NULL_TREE) { expr_tree = ffecom_modify (NULL_TREE, arg2_tree, convert (TREE_TYPE (arg2_tree), --- 5414,5421 ---- NULL_TREE, build_tree_list (NULL_TREE, arg1_tree), NULL_TREE, NULL, NULL, NULL_TREE, ! TRUE, ! ffebld_nonter_hook (expr)); if (arg2_tree != NULL_TREE) { expr_tree = ffecom_modify (NULL_TREE, arg2_tree, convert (TREE_TYPE (arg2_tree), *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 5151,5161 **** { tree arg1_tree; ! ffecom_push_calltemps (); ! ! arg1_tree = ffecom_expr_rw (arg1); ! ! ffecom_pop_calltemps (); expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), --- 5429,5435 ---- { tree arg1_tree; ! arg1_tree = ffecom_expr_w (NULL_TREE, arg1); expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 5163,5169 **** FALSE, NULL_TREE, NULL_TREE, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE); expr_tree = ffecom_modify (NULL_TREE, arg1_tree, --- 5437,5444 ---- FALSE, NULL_TREE, NULL_TREE, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE, ! ffebld_nonter_hook (expr)); expr_tree = ffecom_modify (NULL_TREE, arg1_tree, *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 5176,5205 **** case FFEINTRIN_impETIME_subr: { tree arg1_tree; ! tree arg2_tree; ! ffecom_push_calltemps (); ! arg1_tree = ffecom_expr_rw (arg1); ! ! arg2_tree = ffecom_ptr_to_expr (arg2); ! ! ffecom_pop_calltemps (); expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ffecom_gfrt_kindtype (gfrt), FALSE, NULL_TREE, ! build_tree_list (NULL_TREE, arg2_tree), NULL_TREE, NULL, NULL, NULL_TREE, ! TRUE); ! expr_tree = ffecom_modify (NULL_TREE, arg1_tree, ! convert (TREE_TYPE (arg1_tree), expr_tree)); } return expr_tree; ! /* Straightforward calls of libf2c routines: */ case FFEINTRIN_impABORT: case FFEINTRIN_impACCESS: case FFEINTRIN_impBESJ0: --- 5451,5477 ---- case FFEINTRIN_impETIME_subr: { tree arg1_tree; ! tree result_tree; ! result_tree = ffecom_expr_w (NULL_TREE, arg2); ! arg1_tree = ffecom_ptr_to_expr (arg1); expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ffecom_gfrt_kindtype (gfrt), FALSE, NULL_TREE, ! build_tree_list (NULL_TREE, arg1_tree), NULL_TREE, NULL, NULL, NULL_TREE, ! TRUE, ! ffebld_nonter_hook (expr)); ! expr_tree = ffecom_modify (NULL_TREE, result_tree, ! convert (TREE_TYPE (result_tree), expr_tree)); } return expr_tree; ! /* Straightforward calls of libf2c routines: */ case FFEINTRIN_impABORT: case FFEINTRIN_impACCESS: case FFEINTRIN_impBESJ0: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 5280,16510 **** assert (gfrt != FFECOM_gfrt); /* Must have an implementation! */ - ffecom_push_calltemps (); expr_tree = ffecom_arglist_expr_ (ffecom_gfrt_args_ (gfrt), ffebld_right (expr)); - ffecom_pop_calltemps (); return ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ffecom_gfrt_kindtype (gfrt), (ffe_is_f2c_library () && ffecom_gfrt_complex_[gfrt]), tree_type, expr_tree, dest_tree, dest, dest_used, ! NULL_TREE, TRUE); ! /**INDENT* (Do not reformat this comment even with -fca option.) ! Data-gathering files: Given the source file listed below, compiled with ! f2c I obtained the output file listed after that, and from the output ! file I derived the above code. ! -------- (begin input file to f2c) ! implicit none ! character*10 A1,A2 ! complex C1,C2 ! integer I1,I2 ! real R1,R2 ! double precision D1,D2 ! C ! call getem(A1,A2,C1,C2,I1,I2,R1,R2,D1,D2) ! c / ! call fooI(I1/I2) ! call fooR(R1/I1) ! call fooD(D1/I1) ! call fooC(C1/I1) ! call fooR(R1/R2) ! call fooD(R1/D1) ! call fooD(D1/D2) ! call fooD(D1/R1) ! call fooC(C1/C2) ! call fooC(C1/R1) ! call fooZ(C1/D1) ! c ** ! call fooI(I1**I2) ! call fooR(R1**I1) ! call fooD(D1**I1) ! call fooC(C1**I1) ! call fooR(R1**R2) ! call fooD(R1**D1) ! call fooD(D1**D2) ! call fooD(D1**R1) ! call fooC(C1**C2) ! call fooC(C1**R1) ! call fooZ(C1**D1) ! c FFEINTRIN_impABS ! call fooR(ABS(R1)) ! c FFEINTRIN_impACOS ! call fooR(ACOS(R1)) ! c FFEINTRIN_impAIMAG ! call fooR(AIMAG(C1)) ! c FFEINTRIN_impAINT ! call fooR(AINT(R1)) ! c FFEINTRIN_impALOG ! call fooR(ALOG(R1)) ! c FFEINTRIN_impALOG10 ! call fooR(ALOG10(R1)) ! c FFEINTRIN_impAMAX0 ! call fooR(AMAX0(I1,I2)) ! c FFEINTRIN_impAMAX1 ! call fooR(AMAX1(R1,R2)) ! c FFEINTRIN_impAMIN0 ! call fooR(AMIN0(I1,I2)) ! c FFEINTRIN_impAMIN1 ! call fooR(AMIN1(R1,R2)) ! c FFEINTRIN_impAMOD ! call fooR(AMOD(R1,R2)) ! c FFEINTRIN_impANINT ! call fooR(ANINT(R1)) ! c FFEINTRIN_impASIN ! call fooR(ASIN(R1)) ! c FFEINTRIN_impATAN ! call fooR(ATAN(R1)) ! c FFEINTRIN_impATAN2 ! call fooR(ATAN2(R1,R2)) ! c FFEINTRIN_impCABS ! call fooR(CABS(C1)) ! c FFEINTRIN_impCCOS ! call fooC(CCOS(C1)) ! c FFEINTRIN_impCEXP ! call fooC(CEXP(C1)) ! c FFEINTRIN_impCHAR ! call fooA(CHAR(I1)) ! c FFEINTRIN_impCLOG ! call fooC(CLOG(C1)) ! c FFEINTRIN_impCONJG ! call fooC(CONJG(C1)) ! c FFEINTRIN_impCOS ! call fooR(COS(R1)) ! c FFEINTRIN_impCOSH ! call fooR(COSH(R1)) ! c FFEINTRIN_impCSIN ! call fooC(CSIN(C1)) ! c FFEINTRIN_impCSQRT ! call fooC(CSQRT(C1)) ! c FFEINTRIN_impDABS ! call fooD(DABS(D1)) ! c FFEINTRIN_impDACOS ! call fooD(DACOS(D1)) ! c FFEINTRIN_impDASIN ! call fooD(DASIN(D1)) ! c FFEINTRIN_impDATAN ! call fooD(DATAN(D1)) ! c FFEINTRIN_impDATAN2 ! call fooD(DATAN2(D1,D2)) ! c FFEINTRIN_impDCOS ! call fooD(DCOS(D1)) ! c FFEINTRIN_impDCOSH ! call fooD(DCOSH(D1)) ! c FFEINTRIN_impDDIM ! call fooD(DDIM(D1,D2)) ! c FFEINTRIN_impDEXP ! call fooD(DEXP(D1)) ! c FFEINTRIN_impDIM ! call fooR(DIM(R1,R2)) ! c FFEINTRIN_impDINT ! call fooD(DINT(D1)) ! c FFEINTRIN_impDLOG ! call fooD(DLOG(D1)) ! c FFEINTRIN_impDLOG10 ! call fooD(DLOG10(D1)) ! c FFEINTRIN_impDMAX1 ! call fooD(DMAX1(D1,D2)) ! c FFEINTRIN_impDMIN1 ! call fooD(DMIN1(D1,D2)) ! c FFEINTRIN_impDMOD ! call fooD(DMOD(D1,D2)) ! c FFEINTRIN_impDNINT ! call fooD(DNINT(D1)) ! c FFEINTRIN_impDPROD ! call fooD(DPROD(R1,R2)) ! c FFEINTRIN_impDSIGN ! call fooD(DSIGN(D1,D2)) ! c FFEINTRIN_impDSIN ! call fooD(DSIN(D1)) ! c FFEINTRIN_impDSINH ! call fooD(DSINH(D1)) ! c FFEINTRIN_impDSQRT ! call fooD(DSQRT(D1)) ! c FFEINTRIN_impDTAN ! call fooD(DTAN(D1)) ! c FFEINTRIN_impDTANH ! call fooD(DTANH(D1)) ! c FFEINTRIN_impEXP ! call fooR(EXP(R1)) ! c FFEINTRIN_impIABS ! call fooI(IABS(I1)) ! c FFEINTRIN_impICHAR ! call fooI(ICHAR(A1)) ! c FFEINTRIN_impIDIM ! call fooI(IDIM(I1,I2)) ! c FFEINTRIN_impIDNINT ! call fooI(IDNINT(D1)) ! c FFEINTRIN_impINDEX ! call fooI(INDEX(A1,A2)) ! c FFEINTRIN_impISIGN ! call fooI(ISIGN(I1,I2)) ! c FFEINTRIN_impLEN ! call fooI(LEN(A1)) ! c FFEINTRIN_impLGE ! call fooL(LGE(A1,A2)) ! c FFEINTRIN_impLGT ! call fooL(LGT(A1,A2)) ! c FFEINTRIN_impLLE ! call fooL(LLE(A1,A2)) ! c FFEINTRIN_impLLT ! call fooL(LLT(A1,A2)) ! c FFEINTRIN_impMAX0 ! call fooI(MAX0(I1,I2)) ! c FFEINTRIN_impMAX1 ! call fooI(MAX1(R1,R2)) ! c FFEINTRIN_impMIN0 ! call fooI(MIN0(I1,I2)) ! c FFEINTRIN_impMIN1 ! call fooI(MIN1(R1,R2)) ! c FFEINTRIN_impMOD ! call fooI(MOD(I1,I2)) ! c FFEINTRIN_impNINT ! call fooI(NINT(R1)) ! c FFEINTRIN_impSIGN ! call fooR(SIGN(R1,R2)) ! c FFEINTRIN_impSIN ! call fooR(SIN(R1)) ! c FFEINTRIN_impSINH ! call fooR(SINH(R1)) ! c FFEINTRIN_impSQRT ! call fooR(SQRT(R1)) ! c FFEINTRIN_impTAN ! call fooR(TAN(R1)) ! c FFEINTRIN_impTANH ! call fooR(TANH(R1)) ! c FFEINTRIN_imp_CMPLX_C ! call fooC(cmplx(C1,C2)) ! c FFEINTRIN_imp_CMPLX_D ! call fooZ(cmplx(D1,D2)) ! c FFEINTRIN_imp_CMPLX_I ! call fooC(cmplx(I1,I2)) ! c FFEINTRIN_imp_CMPLX_R ! call fooC(cmplx(R1,R2)) ! c FFEINTRIN_imp_DBLE_C ! call fooD(dble(C1)) ! c FFEINTRIN_imp_DBLE_D ! call fooD(dble(D1)) ! c FFEINTRIN_imp_DBLE_I ! call fooD(dble(I1)) ! c FFEINTRIN_imp_DBLE_R ! call fooD(dble(R1)) ! c FFEINTRIN_imp_INT_C ! call fooI(int(C1)) ! c FFEINTRIN_imp_INT_D ! call fooI(int(D1)) ! c FFEINTRIN_imp_INT_I ! call fooI(int(I1)) ! c FFEINTRIN_imp_INT_R ! call fooI(int(R1)) ! c FFEINTRIN_imp_REAL_C ! call fooR(real(C1)) ! c FFEINTRIN_imp_REAL_D ! call fooR(real(D1)) ! c FFEINTRIN_imp_REAL_I ! call fooR(real(I1)) ! c FFEINTRIN_imp_REAL_R ! call fooR(real(R1)) ! c ! c FFEINTRIN_imp_INT_D: ! c ! c FFEINTRIN_specIDINT ! call fooI(IDINT(D1)) ! c ! c FFEINTRIN_imp_INT_R: ! c ! c FFEINTRIN_specIFIX ! call fooI(IFIX(R1)) ! c FFEINTRIN_specINT ! call fooI(INT(R1)) ! c ! c FFEINTRIN_imp_REAL_D: ! c ! c FFEINTRIN_specSNGL ! call fooR(SNGL(D1)) ! c ! c FFEINTRIN_imp_REAL_I: ! c ! c FFEINTRIN_specFLOAT ! call fooR(FLOAT(I1)) ! c FFEINTRIN_specREAL ! call fooR(REAL(I1)) ! c ! end ! -------- (end input file to f2c) ! ! -------- (begin output from providing above input file as input to: ! -------- `f2c | gcc -E -C - | sed -e "s:/[*]*://:g" -e "s:[*]*[/]://:g" \ ! -------- -e "s:^#.*$::g"') ! ! // -- translated by f2c (version 19950223). ! You must link the resulting object file with the libraries: ! -lf2c -lm (in that order) ! // ! ! ! // f2c.h -- Standard Fortran to C header file // ! ! /// barf [ba:rf] 2. "He suggested using FORTRAN, and everybody barfed." ! - From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) // ! // F2C_INTEGER will normally be `int' but would be `long' on 16-bit systems // ! // we assume short, float are OK // ! typedef long int // long int // integer; ! typedef char *address; ! typedef short int shortint; ! typedef float real; ! typedef double doublereal; ! typedef struct { real r, i; } complex; ! typedef struct { doublereal r, i; } doublecomplex; ! typedef long int // long int // logical; ! typedef short int shortlogical; ! typedef char logical1; ! typedef char integer1; ! // typedef long long longint; // // system-dependent // ! // Extern is for use with -E // ! // I/O stuff // ! ! ! ! ! ! ! ! ! typedef long int // int or long int // flag; ! typedef long int // int or long int // ftnlen; ! typedef long int // int or long int // ftnint; ! ! ! //external read, write// ! typedef struct ! { flag cierr; ! ftnint ciunit; ! flag ciend; ! char *cifmt; ! ftnint cirec; ! } cilist; ! ! //internal read, write// ! typedef struct ! { flag icierr; ! char *iciunit; ! flag iciend; ! char *icifmt; ! ftnint icirlen; ! ftnint icirnum; ! } icilist; ! ! //open// ! typedef struct ! { flag oerr; ! ftnint ounit; ! char *ofnm; ! ftnlen ofnmlen; ! char *osta; ! char *oacc; ! char *ofm; ! ftnint orl; ! char *oblnk; ! } olist; ! ! //close// ! typedef struct ! { flag cerr; ! ftnint cunit; ! char *csta; ! } cllist; ! ! //rewind, backspace, endfile// ! typedef struct ! { flag aerr; ! ftnint aunit; ! } alist; ! ! // inquire // ! typedef struct ! { flag inerr; ! ftnint inunit; ! char *infile; ! ftnlen infilen; ! ftnint *inex; //parameters in standard's order// ! ftnint *inopen; ! ftnint *innum; ! ftnint *innamed; ! char *inname; ! ftnlen innamlen; ! char *inacc; ! ftnlen inacclen; ! char *inseq; ! ftnlen inseqlen; ! char *indir; ! ftnlen indirlen; ! char *infmt; ! ftnlen infmtlen; ! char *inform; ! ftnint informlen; ! char *inunf; ! ftnlen inunflen; ! ftnint *inrecl; ! ftnint *innrec; ! char *inblank; ! ftnlen inblanklen; ! } inlist; ! ! ! ! union Multitype { // for multiple entry points // ! integer1 g; ! shortint h; ! integer i; ! // longint j; // ! real r; ! doublereal d; ! complex c; ! doublecomplex z; ! }; ! ! typedef union Multitype Multitype; ! ! typedef long Long; // No longer used; formerly in Namelist // ! ! struct Vardesc { // for Namelist // ! char *name; ! char *addr; ! ftnlen *dims; ! int type; ! }; ! typedef struct Vardesc Vardesc; ! ! struct Namelist { ! char *name; ! Vardesc **vars; ! int nvars; ! }; ! typedef struct Namelist Namelist; ! ! // procedure parameter types for -A and -C++ // ! typedef int // Unknown procedure type // (*U_fp)(); ! typedef shortint (*J_fp)(); ! typedef integer (*I_fp)(); ! typedef real (*R_fp)(); ! typedef doublereal (*D_fp)(), (*E_fp)(); ! typedef // Complex // void (*C_fp)(); ! typedef // Double Complex // void (*Z_fp)(); ! typedef logical (*L_fp)(); ! typedef shortlogical (*K_fp)(); ! typedef // Character // void (*H_fp)(); ! typedef // Subroutine // int (*S_fp)(); ! // E_fp is for real functions when -R is not specified // ! typedef void C_f; // complex function // ! typedef void H_f; // character function // ! typedef void Z_f; // double complex function // ! typedef doublereal E_f; // real function with -R not specified // ! // undef any lower-case symbols that your C compiler predefines, e.g.: // ! // (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].) // ! // Main program // MAIN__() ! { ! // System generated locals // ! integer i__1; ! real r__1, r__2; ! doublereal d__1, d__2; ! complex q__1; ! doublecomplex z__1, z__2, z__3; ! logical L__1; ! char ch__1[1]; ! // Builtin functions // ! void c_div(); ! integer pow_ii(); ! double pow_ri(), pow_di(); ! void pow_ci(); ! double pow_dd(); ! void pow_zz(); ! double acos(), r_imag(), r_int(), log(), r_lg10(), r_mod(), r_nint(), ! asin(), atan(), atan2(), c_abs(); ! void c_cos(), c_exp(), c_log(), r_cnjg(); ! double cos(), cosh(); ! void c_sin(), c_sqrt(); ! double d_dim(), exp(), r_dim(), d_int(), d_lg10(), d_mod(), d_nint(), ! d_sign(), sin(), sinh(), sqrt(), tan(), tanh(); ! integer i_dim(), i_dnnt(), i_indx(), i_sign(), i_len(); ! logical l_ge(), l_gt(), l_le(), l_lt(); ! integer i_nint(); ! double r_sign(); ! // Local variables // ! extern // Subroutine // int fooa_(), fooc_(), food_(), fooi_(), foor_(), ! fool_(), fooz_(), getem_(); ! static char a1[10], a2[10]; ! static complex c1, c2; ! static doublereal d1, d2; ! static integer i1, i2; ! static real r1, r2; ! getem_(a1, a2, &c1, &c2, &i1, &i2, &r1, &r2, &d1, &d2, 10L, 10L); ! // / // ! i__1 = i1 / i2; ! fooi_(&i__1); ! r__1 = r1 / i1; ! foor_(&r__1); ! d__1 = d1 / i1; ! food_(&d__1); ! d__1 = (doublereal) i1; ! q__1.r = c1.r / d__1, q__1.i = c1.i / d__1; ! fooc_(&q__1); ! r__1 = r1 / r2; ! foor_(&r__1); ! d__1 = r1 / d1; ! food_(&d__1); ! d__1 = d1 / d2; ! food_(&d__1); ! d__1 = d1 / r1; ! food_(&d__1); ! c_div(&q__1, &c1, &c2); ! fooc_(&q__1); ! q__1.r = c1.r / r1, q__1.i = c1.i / r1; ! fooc_(&q__1); ! z__1.r = c1.r / d1, z__1.i = c1.i / d1; ! fooz_(&z__1); ! // ** // ! i__1 = pow_ii(&i1, &i2); ! fooi_(&i__1); ! r__1 = pow_ri(&r1, &i1); ! foor_(&r__1); ! d__1 = pow_di(&d1, &i1); ! food_(&d__1); ! pow_ci(&q__1, &c1, &i1); ! fooc_(&q__1); ! d__1 = (doublereal) r1; ! d__2 = (doublereal) r2; ! r__1 = pow_dd(&d__1, &d__2); ! foor_(&r__1); ! d__2 = (doublereal) r1; ! d__1 = pow_dd(&d__2, &d1); ! food_(&d__1); ! d__1 = pow_dd(&d1, &d2); ! food_(&d__1); ! d__2 = (doublereal) r1; ! d__1 = pow_dd(&d1, &d__2); ! food_(&d__1); ! z__2.r = c1.r, z__2.i = c1.i; ! z__3.r = c2.r, z__3.i = c2.i; ! pow_zz(&z__1, &z__2, &z__3); ! q__1.r = z__1.r, q__1.i = z__1.i; ! fooc_(&q__1); ! z__2.r = c1.r, z__2.i = c1.i; ! z__3.r = r1, z__3.i = 0.; ! pow_zz(&z__1, &z__2, &z__3); ! q__1.r = z__1.r, q__1.i = z__1.i; ! fooc_(&q__1); ! z__2.r = c1.r, z__2.i = c1.i; ! z__3.r = d1, z__3.i = 0.; ! pow_zz(&z__1, &z__2, &z__3); ! fooz_(&z__1); ! // FFEINTRIN_impABS // ! r__1 = (doublereal)(( r1 ) >= 0 ? ( r1 ) : -( r1 )) ; ! foor_(&r__1); ! // FFEINTRIN_impACOS // ! r__1 = acos(r1); ! foor_(&r__1); ! // FFEINTRIN_impAIMAG // ! r__1 = r_imag(&c1); ! foor_(&r__1); ! // FFEINTRIN_impAINT // ! r__1 = r_int(&r1); ! foor_(&r__1); ! // FFEINTRIN_impALOG // ! r__1 = log(r1); ! foor_(&r__1); ! // FFEINTRIN_impALOG10 // ! r__1 = r_lg10(&r1); ! foor_(&r__1); ! // FFEINTRIN_impAMAX0 // ! r__1 = (real) (( i1 ) >= ( i2 ) ? ( i1 ) : ( i2 )) ; ! foor_(&r__1); ! // FFEINTRIN_impAMAX1 // ! r__1 = (doublereal)(( r1 ) >= ( r2 ) ? ( r1 ) : ( r2 )) ; ! foor_(&r__1); ! // FFEINTRIN_impAMIN0 // ! r__1 = (real) (( i1 ) <= ( i2 ) ? ( i1 ) : ( i2 )) ; ! foor_(&r__1); ! // FFEINTRIN_impAMIN1 // ! r__1 = (doublereal)(( r1 ) <= ( r2 ) ? ( r1 ) : ( r2 )) ; ! foor_(&r__1); ! // FFEINTRIN_impAMOD // ! r__1 = r_mod(&r1, &r2); ! foor_(&r__1); ! // FFEINTRIN_impANINT // ! r__1 = r_nint(&r1); ! foor_(&r__1); ! // FFEINTRIN_impASIN // ! r__1 = asin(r1); ! foor_(&r__1); ! // FFEINTRIN_impATAN // ! r__1 = atan(r1); ! foor_(&r__1); ! // FFEINTRIN_impATAN2 // ! r__1 = atan2(r1, r2); ! foor_(&r__1); ! // FFEINTRIN_impCABS // ! r__1 = c_abs(&c1); ! foor_(&r__1); ! // FFEINTRIN_impCCOS // ! c_cos(&q__1, &c1); ! fooc_(&q__1); ! // FFEINTRIN_impCEXP // ! c_exp(&q__1, &c1); ! fooc_(&q__1); ! // FFEINTRIN_impCHAR // ! *(unsigned char *)&ch__1[0] = i1; ! fooa_(ch__1, 1L); ! // FFEINTRIN_impCLOG // ! c_log(&q__1, &c1); ! fooc_(&q__1); ! // FFEINTRIN_impCONJG // ! r_cnjg(&q__1, &c1); ! fooc_(&q__1); ! // FFEINTRIN_impCOS // ! r__1 = cos(r1); ! foor_(&r__1); ! // FFEINTRIN_impCOSH // ! r__1 = cosh(r1); ! foor_(&r__1); ! // FFEINTRIN_impCSIN // ! c_sin(&q__1, &c1); ! fooc_(&q__1); ! // FFEINTRIN_impCSQRT // ! c_sqrt(&q__1, &c1); ! fooc_(&q__1); ! // FFEINTRIN_impDABS // ! d__1 = (( d1 ) >= 0 ? ( d1 ) : -( d1 )) ; ! food_(&d__1); ! // FFEINTRIN_impDACOS // ! d__1 = acos(d1); ! food_(&d__1); ! // FFEINTRIN_impDASIN // ! d__1 = asin(d1); ! food_(&d__1); ! // FFEINTRIN_impDATAN // ! d__1 = atan(d1); ! food_(&d__1); ! // FFEINTRIN_impDATAN2 // ! d__1 = atan2(d1, d2); ! food_(&d__1); ! // FFEINTRIN_impDCOS // ! d__1 = cos(d1); ! food_(&d__1); ! // FFEINTRIN_impDCOSH // ! d__1 = cosh(d1); ! food_(&d__1); ! // FFEINTRIN_impDDIM // ! d__1 = d_dim(&d1, &d2); ! food_(&d__1); ! // FFEINTRIN_impDEXP // ! d__1 = exp(d1); ! food_(&d__1); ! // FFEINTRIN_impDIM // ! r__1 = r_dim(&r1, &r2); ! foor_(&r__1); ! // FFEINTRIN_impDINT // ! d__1 = d_int(&d1); ! food_(&d__1); ! // FFEINTRIN_impDLOG // ! d__1 = log(d1); ! food_(&d__1); ! // FFEINTRIN_impDLOG10 // ! d__1 = d_lg10(&d1); ! food_(&d__1); ! // FFEINTRIN_impDMAX1 // ! d__1 = (( d1 ) >= ( d2 ) ? ( d1 ) : ( d2 )) ; ! food_(&d__1); ! // FFEINTRIN_impDMIN1 // ! d__1 = (( d1 ) <= ( d2 ) ? ( d1 ) : ( d2 )) ; ! food_(&d__1); ! // FFEINTRIN_impDMOD // ! d__1 = d_mod(&d1, &d2); ! food_(&d__1); ! // FFEINTRIN_impDNINT // ! d__1 = d_nint(&d1); ! food_(&d__1); ! // FFEINTRIN_impDPROD // ! d__1 = (doublereal) r1 * r2; ! food_(&d__1); ! // FFEINTRIN_impDSIGN // ! d__1 = d_sign(&d1, &d2); ! food_(&d__1); ! // FFEINTRIN_impDSIN // ! d__1 = sin(d1); ! food_(&d__1); ! // FFEINTRIN_impDSINH // ! d__1 = sinh(d1); ! food_(&d__1); ! // FFEINTRIN_impDSQRT // ! d__1 = sqrt(d1); ! food_(&d__1); ! // FFEINTRIN_impDTAN // ! d__1 = tan(d1); ! food_(&d__1); ! // FFEINTRIN_impDTANH // ! d__1 = tanh(d1); ! food_(&d__1); ! // FFEINTRIN_impEXP // ! r__1 = exp(r1); ! foor_(&r__1); ! // FFEINTRIN_impIABS // ! i__1 = (( i1 ) >= 0 ? ( i1 ) : -( i1 )) ; ! fooi_(&i__1); ! // FFEINTRIN_impICHAR // ! i__1 = *(unsigned char *)a1; ! fooi_(&i__1); ! // FFEINTRIN_impIDIM // ! i__1 = i_dim(&i1, &i2); ! fooi_(&i__1); ! // FFEINTRIN_impIDNINT // ! i__1 = i_dnnt(&d1); ! fooi_(&i__1); ! // FFEINTRIN_impINDEX // ! i__1 = i_indx(a1, a2, 10L, 10L); ! fooi_(&i__1); ! // FFEINTRIN_impISIGN // ! i__1 = i_sign(&i1, &i2); ! fooi_(&i__1); ! // FFEINTRIN_impLEN // ! i__1 = i_len(a1, 10L); ! fooi_(&i__1); ! // FFEINTRIN_impLGE // ! L__1 = l_ge(a1, a2, 10L, 10L); ! fool_(&L__1); ! // FFEINTRIN_impLGT // ! L__1 = l_gt(a1, a2, 10L, 10L); ! fool_(&L__1); ! // FFEINTRIN_impLLE // ! L__1 = l_le(a1, a2, 10L, 10L); ! fool_(&L__1); ! // FFEINTRIN_impLLT // ! L__1 = l_lt(a1, a2, 10L, 10L); ! fool_(&L__1); ! // FFEINTRIN_impMAX0 // ! i__1 = (( i1 ) >= ( i2 ) ? ( i1 ) : ( i2 )) ; ! fooi_(&i__1); ! // FFEINTRIN_impMAX1 // ! i__1 = (integer) (doublereal)(( r1 ) >= ( r2 ) ? ( r1 ) : ( r2 )) ; ! fooi_(&i__1); ! // FFEINTRIN_impMIN0 // ! i__1 = (( i1 ) <= ( i2 ) ? ( i1 ) : ( i2 )) ; ! fooi_(&i__1); ! // FFEINTRIN_impMIN1 // ! i__1 = (integer) (doublereal)(( r1 ) <= ( r2 ) ? ( r1 ) : ( r2 )) ; ! fooi_(&i__1); ! // FFEINTRIN_impMOD // ! i__1 = i1 % i2; ! fooi_(&i__1); ! // FFEINTRIN_impNINT // ! i__1 = i_nint(&r1); ! fooi_(&i__1); ! // FFEINTRIN_impSIGN // ! r__1 = r_sign(&r1, &r2); ! foor_(&r__1); ! // FFEINTRIN_impSIN // ! r__1 = sin(r1); ! foor_(&r__1); ! // FFEINTRIN_impSINH // ! r__1 = sinh(r1); ! foor_(&r__1); ! // FFEINTRIN_impSQRT // ! r__1 = sqrt(r1); ! foor_(&r__1); ! // FFEINTRIN_impTAN // ! r__1 = tan(r1); ! foor_(&r__1); ! // FFEINTRIN_impTANH // ! r__1 = tanh(r1); ! foor_(&r__1); ! // FFEINTRIN_imp_CMPLX_C // ! r__1 = c1.r; ! r__2 = c2.r; ! q__1.r = r__1, q__1.i = r__2; ! fooc_(&q__1); ! // FFEINTRIN_imp_CMPLX_D // ! z__1.r = d1, z__1.i = d2; ! fooz_(&z__1); ! // FFEINTRIN_imp_CMPLX_I // ! r__1 = (real) i1; ! r__2 = (real) i2; ! q__1.r = r__1, q__1.i = r__2; ! fooc_(&q__1); ! // FFEINTRIN_imp_CMPLX_R // ! q__1.r = r1, q__1.i = r2; ! fooc_(&q__1); ! // FFEINTRIN_imp_DBLE_C // ! d__1 = (doublereal) c1.r; ! food_(&d__1); ! // FFEINTRIN_imp_DBLE_D // ! d__1 = d1; ! food_(&d__1); ! // FFEINTRIN_imp_DBLE_I // ! d__1 = (doublereal) i1; ! food_(&d__1); ! // FFEINTRIN_imp_DBLE_R // ! d__1 = (doublereal) r1; ! food_(&d__1); ! // FFEINTRIN_imp_INT_C // ! i__1 = (integer) c1.r; ! fooi_(&i__1); ! // FFEINTRIN_imp_INT_D // ! i__1 = (integer) d1; ! fooi_(&i__1); ! // FFEINTRIN_imp_INT_I // ! i__1 = i1; ! fooi_(&i__1); ! // FFEINTRIN_imp_INT_R // ! i__1 = (integer) r1; ! fooi_(&i__1); ! // FFEINTRIN_imp_REAL_C // ! r__1 = c1.r; ! foor_(&r__1); ! // FFEINTRIN_imp_REAL_D // ! r__1 = (real) d1; ! foor_(&r__1); ! // FFEINTRIN_imp_REAL_I // ! r__1 = (real) i1; ! foor_(&r__1); ! // FFEINTRIN_imp_REAL_R // ! r__1 = r1; ! foor_(&r__1); ! // FFEINTRIN_imp_INT_D: // ! // FFEINTRIN_specIDINT // ! i__1 = (integer) d1; ! fooi_(&i__1); ! // FFEINTRIN_imp_INT_R: // ! // FFEINTRIN_specIFIX // ! i__1 = (integer) r1; ! fooi_(&i__1); ! // FFEINTRIN_specINT // ! i__1 = (integer) r1; ! fooi_(&i__1); ! // FFEINTRIN_imp_REAL_D: // ! // FFEINTRIN_specSNGL // ! r__1 = (real) d1; ! foor_(&r__1); ! // FFEINTRIN_imp_REAL_I: // ! // FFEINTRIN_specFLOAT // ! r__1 = (real) i1; ! foor_(&r__1); ! // FFEINTRIN_specREAL // ! r__1 = (real) i1; ! foor_(&r__1); ! } // MAIN__ // ! -------- (end output file from f2c) ! */ } #endif - /* For power (exponentiation) where right-hand operand is type INTEGER, - generate in-line code to do it the fast way (which, if the operand - is a constant, might just mean a series of multiplies). */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_expr_power_integer_ (ffebld left, ffebld right) { ! tree l = ffecom_expr (left); ! tree r = ffecom_expr (right); ! tree ltype = TREE_TYPE (l); ! tree rtype = TREE_TYPE (r); ! tree result = NULL_TREE; ! ! if (l == error_mark_node ! || r == error_mark_node) ! return error_mark_node; ! if (TREE_CODE (r) == INTEGER_CST) ! { ! int sgn = tree_int_cst_sgn (r); ! if (sgn == 0) ! return convert (ltype, integer_one_node); ! if ((TREE_CODE (ltype) == INTEGER_TYPE) ! && (sgn < 0)) ! { ! /* Reciprocal of integer is either 0, -1, or 1, so after ! calculating that (which we leave to the back end to do ! or not do optimally), don't bother with any multiplying. */ ! result = ffecom_tree_divide_ (ltype, ! convert (ltype, integer_one_node), ! l, ! NULL_TREE, NULL, NULL); ! r = ffecom_1 (NEGATE_EXPR, ! rtype, ! r); ! if ((TREE_INT_CST_LOW (r) & 1) == 0) ! result = ffecom_1 (ABS_EXPR, rtype, ! result); ! } ! /* Generate appropriate series of multiplies, preceded ! by divide if the exponent is negative. */ ! l = save_expr (l); ! if (sgn < 0) ! { ! l = ffecom_tree_divide_ (ltype, ! convert (ltype, integer_one_node), ! l, ! NULL_TREE, NULL, NULL); ! r = ffecom_1 (NEGATE_EXPR, rtype, r); ! assert (TREE_CODE (r) == INTEGER_CST); ! if (tree_int_cst_sgn (r) < 0) ! { /* The "most negative" number. */ ! r = ffecom_1 (NEGATE_EXPR, rtype, ! ffecom_2 (RSHIFT_EXPR, rtype, ! r, ! integer_one_node)); ! l = save_expr (l); ! l = ffecom_2 (MULT_EXPR, ltype, ! l, ! l); ! } ! } ! for (;;) ! { ! if (TREE_INT_CST_LOW (r) & 1) ! { ! if (result == NULL_TREE) ! result = l; ! else ! result = ffecom_2 (MULT_EXPR, ltype, ! result, ! l); ! } ! r = ffecom_2 (RSHIFT_EXPR, rtype, ! r, ! integer_one_node); ! if (integer_zerop (r)) ! break; ! assert (TREE_CODE (r) == INTEGER_CST); ! l = save_expr (l); ! l = ffecom_2 (MULT_EXPR, ltype, ! l, ! l); ! } ! return result; } ! /* Though rhs isn't a constant, in-line code cannot be expanded ! while transforming dummies ! because the back end cannot be easily convinced to generate ! stores (MODIFY_EXPR), handle temporaries, and so on before ! all the appropriate rtx's have been generated for things like ! dummy args referenced in rhs -- which doesn't happen until ! store_parm_decls() is called (expand_function_start, I believe, ! does the actual rtx-stuffing of PARM_DECLs). ! ! So, in this case, let the caller generate the call to the ! run-time-library function to evaluate the power for us. */ ! if (ffecom_transform_only_dummies_) ! return NULL_TREE; ! /* Right-hand operand not a constant, expand in-line code to figure ! out how to do the multiplies, &c. ! The returned expression is expressed this way in GNU C, where l and ! r are the "inputs": ! ({ typeof (r) rtmp = r; ! typeof (l) ltmp = l; ! typeof (l) result; ! if (rtmp == 0) ! result = 1; ! else ! { ! if ((basetypeof (l) == basetypeof (int)) ! && (rtmp < 0)) ! { ! result = ((typeof (l)) 1) / ltmp; ! if ((ltmp < 0) && (((-rtmp) & 1) == 0)) ! result = -result; ! } ! else ! { ! result = 1; ! if ((basetypeof (l) != basetypeof (int)) ! && (rtmp < 0)) ! { ! ltmp = ((typeof (l)) 1) / ltmp; ! rtmp = -rtmp; ! if (rtmp < 0) ! { ! rtmp = -(rtmp >> 1); ! ltmp *= ltmp; ! } ! } ! for (;;) ! { ! if (rtmp & 1) ! result *= ltmp; ! if ((rtmp >>= 1) == 0) ! break; ! ltmp *= ltmp; ! } ! } ! } ! result; ! }) ! Note that some of the above is compile-time collapsable, such as ! the first part of the if statements that checks the base type of ! l against int. The if statements are phrased that way to suggest ! an easy way to generate the if/else constructs here, knowing that ! the back end should (and probably does) eliminate the resulting ! dead code (either the int case or the non-int case), something ! it couldn't do without the redundant phrasing, requiring explicit ! dead-code elimination here, which would be kind of difficult to ! read. */ ! { ! tree rtmp; ! tree ltmp; ! tree basetypeof_l_is_int; ! tree se; ! basetypeof_l_is_int ! = build_int_2 ((TREE_CODE (ltype) == INTEGER_TYPE), 0); ! se = expand_start_stmt_expr (); ! ffecom_push_calltemps (); ! rtmp = ffecom_push_tempvar (rtype, FFETARGET_charactersizeNONE, -1, ! TRUE); ! ltmp = ffecom_push_tempvar (ltype, FFETARGET_charactersizeNONE, -1, ! TRUE); ! result = ffecom_push_tempvar (ltype, FFETARGET_charactersizeNONE, -1, ! TRUE); ! expand_expr_stmt (ffecom_modify (void_type_node, ! rtmp, ! r)); ! expand_expr_stmt (ffecom_modify (void_type_node, ! ltmp, ! l)); ! expand_start_cond (ffecom_truth_value ! (ffecom_2 (EQ_EXPR, integer_type_node, ! rtmp, ! convert (rtype, integer_zero_node))), ! 0); ! expand_expr_stmt (ffecom_modify (void_type_node, ! result, ! convert (ltype, integer_one_node))); ! expand_start_else (); ! if (!integer_zerop (basetypeof_l_is_int)) { ! expand_start_cond (ffecom_2 (LT_EXPR, integer_type_node, ! rtmp, ! convert (rtype, ! integer_zero_node)), ! 0); ! expand_expr_stmt (ffecom_modify (void_type_node, ! result, ! ffecom_tree_divide_ ! (ltype, ! convert (ltype, integer_one_node), ! ltmp, ! NULL_TREE, NULL, NULL))); ! expand_start_cond (ffecom_truth_value ! (ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node, ! ffecom_2 (LT_EXPR, integer_type_node, ! ltmp, ! convert (ltype, ! integer_zero_node)), ! ffecom_2 (EQ_EXPR, integer_type_node, ! ffecom_2 (BIT_AND_EXPR, ! rtype, ! ffecom_1 (NEGATE_EXPR, ! rtype, ! rtmp), ! convert (rtype, ! integer_one_node)), ! convert (rtype, ! integer_zero_node)))), ! 0); ! expand_expr_stmt (ffecom_modify (void_type_node, ! result, ! ffecom_1 (NEGATE_EXPR, ! ltype, ! result))); ! expand_end_cond (); ! expand_start_else (); ! } ! expand_expr_stmt (ffecom_modify (void_type_node, ! result, ! convert (ltype, integer_one_node))); ! expand_start_cond (ffecom_truth_value ! (ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node, ! ffecom_truth_value_invert ! (basetypeof_l_is_int), ! ffecom_2 (LT_EXPR, integer_type_node, ! rtmp, ! convert (rtype, ! integer_zero_node)))), ! 0); ! expand_expr_stmt (ffecom_modify (void_type_node, ! ltmp, ! ffecom_tree_divide_ ! (ltype, ! convert (ltype, integer_one_node), ! ltmp, ! NULL_TREE, NULL, NULL))); ! expand_expr_stmt (ffecom_modify (void_type_node, ! rtmp, ! ffecom_1 (NEGATE_EXPR, rtype, ! rtmp))); ! expand_start_cond (ffecom_truth_value ! (ffecom_2 (LT_EXPR, integer_type_node, ! rtmp, ! convert (rtype, integer_zero_node))), ! 0); ! expand_expr_stmt (ffecom_modify (void_type_node, ! rtmp, ! ffecom_1 (NEGATE_EXPR, rtype, ! ffecom_2 (RSHIFT_EXPR, ! rtype, ! rtmp, ! integer_one_node)))); ! expand_expr_stmt (ffecom_modify (void_type_node, ! ltmp, ! ffecom_2 (MULT_EXPR, ltype, ! ltmp, ! ltmp))); ! expand_end_cond (); ! expand_end_cond (); ! expand_start_loop (1); ! expand_start_cond (ffecom_truth_value ! (ffecom_2 (BIT_AND_EXPR, rtype, ! rtmp, ! convert (rtype, integer_one_node))), ! 0); ! expand_expr_stmt (ffecom_modify (void_type_node, ! result, ! ffecom_2 (MULT_EXPR, ltype, ! result, ! ltmp))); ! expand_end_cond (); ! expand_exit_loop_if_false (NULL, ! ffecom_truth_value ! (ffecom_modify (rtype, ! rtmp, ! ffecom_2 (RSHIFT_EXPR, ! rtype, ! rtmp, ! integer_one_node)))); ! expand_expr_stmt (ffecom_modify (void_type_node, ! ltmp, ! ffecom_2 (MULT_EXPR, ltype, ! ltmp, ! ltmp))); ! expand_end_loop (); ! expand_end_cond (); ! if (!integer_zerop (basetypeof_l_is_int)) ! expand_end_cond (); ! expand_expr_stmt (result); ! ffecom_pop_calltemps (); ! result = expand_end_stmt_expr (se); ! TREE_SIDE_EFFECTS (result) = 1; ! } ! return result; } #endif ! /* ffecom_expr_transform_ -- Transform symbols in expr ! ffebld expr; // FFE expression. ! ffecom_expr_transform_ (expr); ! Recursive descent on expr while transforming any untransformed SYMTERs. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void ! ffecom_expr_transform_ (ffebld expr) { ! tree t; ! ffesymbol s; ! tail_recurse: /* :::::::::::::::::::: */ ! if (expr == NULL) ! return; ! switch (ffebld_op (expr)) ! { ! case FFEBLD_opSYMTER: ! s = ffebld_symter (expr); ! t = ffesymbol_hook (s).decl_tree; ! if ((t == NULL_TREE) ! && ((ffesymbol_kind (s) != FFEINFO_kindNONE) ! || ((ffesymbol_where (s) != FFEINFO_whereNONE) ! && (ffesymbol_where (s) != FFEINFO_whereINTRINSIC)))) ! { ! s = ffecom_sym_transform_ (s); ! t = ffesymbol_hook (s).decl_tree; /* Sfunc expr non-dummy, ! DIMENSION expr? */ ! } ! break; /* Ok if (t == NULL) here. */ ! case FFEBLD_opITEM: ! ffecom_expr_transform_ (ffebld_head (expr)); ! expr = ffebld_trail (expr); ! goto tail_recurse; /* :::::::::::::::::::: */ ! default: break; - } ! switch (ffebld_arity (expr)) ! { ! case 2: ! ffecom_expr_transform_ (ffebld_left (expr)); ! expr = ffebld_right (expr); ! goto tail_recurse; /* :::::::::::::::::::: */ ! case 1: ! expr = ffebld_left (expr); ! goto tail_recurse; /* :::::::::::::::::::: */ default: break; } ! return; } #endif ! /* Make a type based on info in live f2c.h file. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC static void ! ffecom_f2c_make_type_ (tree *type, int tcode, char *name) { ! switch (tcode) ! { ! case FFECOM_f2ccodeCHAR: ! *type = make_signed_type (CHAR_TYPE_SIZE); ! break; ! case FFECOM_f2ccodeSHORT: ! *type = make_signed_type (SHORT_TYPE_SIZE); ! break; ! case FFECOM_f2ccodeINT: ! *type = make_signed_type (INT_TYPE_SIZE); ! break; ! case FFECOM_f2ccodeLONG: ! *type = make_signed_type (LONG_TYPE_SIZE); ! break; ! case FFECOM_f2ccodeLONGLONG: ! *type = make_signed_type (LONG_LONG_TYPE_SIZE); ! break; ! case FFECOM_f2ccodeCHARPTR: ! *type = build_pointer_type (DEFAULT_SIGNED_CHAR ! ? signed_char_type_node ! : unsigned_char_type_node); ! break; ! case FFECOM_f2ccodeFLOAT: ! *type = make_node (REAL_TYPE); ! TYPE_PRECISION (*type) = FLOAT_TYPE_SIZE; ! layout_type (*type); ! break; ! case FFECOM_f2ccodeDOUBLE: ! *type = make_node (REAL_TYPE); ! TYPE_PRECISION (*type) = DOUBLE_TYPE_SIZE; ! layout_type (*type); ! break; ! case FFECOM_f2ccodeLONGDOUBLE: ! *type = make_node (REAL_TYPE); ! TYPE_PRECISION (*type) = LONG_DOUBLE_TYPE_SIZE; ! layout_type (*type); ! break; ! case FFECOM_f2ccodeTWOREALS: ! *type = ffecom_make_complex_type_ (ffecom_f2c_real_type_node); ! break; ! case FFECOM_f2ccodeTWODOUBLEREALS: ! *type = ffecom_make_complex_type_ (ffecom_f2c_doublereal_type_node); ! break; ! default: ! assert ("unexpected FFECOM_f2ccodeXYZZY!" == NULL); ! *type = error_mark_node; ! return; ! } ! pushdecl (build_decl (TYPE_DECL, ! ffecom_get_invented_identifier ("__g77_f2c_%s", ! name, 0), ! *type)); ! } ! #endif ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! /* Set the f2c list-directed-I/O code for whatever (integral) type has the ! given size. */ ! static void ! ffecom_f2c_set_lio_code_ (ffeinfoBasictype bt, int size, ! int code) ! { ! int j; ! tree t; ! for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j) ! if (((t = ffecom_tree_type[bt][j]) != NULL_TREE) ! && (TREE_INT_CST_LOW (TYPE_SIZE (t)) == size)) ! { ! assert (code != -1); ! ffecom_f2c_typecode_[bt][j] = code; ! code = -1; ! } ! } ! #endif ! /* Finish up globals after doing all program units in file ! Need to handle only uninitialized COMMON areas. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static ffeglobal ! ffecom_finish_global_ (ffeglobal global) ! { ! tree cbtype; ! tree cbt; ! tree size; ! if (ffeglobal_type (global) != FFEGLOBAL_typeCOMMON) ! return global; ! if (ffeglobal_common_init (global)) ! return global; ! cbt = ffeglobal_hook (global); ! if ((cbt == NULL_TREE) ! || !ffeglobal_common_have_size (global)) ! return global; /* No need to make common, never ref'd. */ ! suspend_momentary (); ! DECL_EXTERNAL (cbt) = 0; ! /* Give the array a size now. */ ! size = build_int_2 ((ffeglobal_common_size (global) ! + ffeglobal_common_pad (global)) - 1, ! 0); ! cbtype = TREE_TYPE (cbt); ! TYPE_DOMAIN (cbtype) = build_range_type (integer_type_node, ! integer_zero_node, ! size); ! if (!TREE_TYPE (size)) ! TREE_TYPE (size) = TYPE_DOMAIN (cbtype); ! layout_type (cbtype); ! cbt = start_decl (cbt, FALSE); ! assert (cbt == ffeglobal_hook (global)); ! finish_decl (cbt, NULL_TREE, FALSE); ! return global; } #endif ! /* Finish up any untransformed symbols. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static ffesymbol ! ffecom_finish_symbol_transform_ (ffesymbol s) { ! if ((s == NULL) || (TREE_CODE (current_function_decl) == ERROR_MARK)) ! return s; ! /* It's easy to know to transform an untransformed symbol, to make sure ! we put out debugging info for it. But COMMON variables, unlike ! EQUIVALENCE ones, aren't given declarations in addition to the ! tree expressions that specify offsets, because COMMON variables ! can be referenced in the outer scope where only dummy arguments ! (PARM_DECLs) should really be seen. To be safe, just don't do any ! VAR_DECLs for COMMON variables when we transform them for real ! use, and therefore we do all the VAR_DECL creating here. */ ! if (ffesymbol_hook (s).decl_tree == NULL_TREE) { ! if (ffesymbol_kind (s) != FFEINFO_kindNONE ! || (ffesymbol_where (s) != FFEINFO_whereNONE ! && ffesymbol_where (s) != FFEINFO_whereINTRINSIC ! && ffesymbol_where (s) != FFEINFO_whereDUMMY)) ! /* Not transformed, and not CHARACTER*(*), and not a dummy ! argument, which can happen only if the entry point names ! it "rides in on" are all invalidated for other reasons. */ ! s = ffecom_sym_transform_ (s); ! } ! if ((ffesymbol_where (s) == FFEINFO_whereCOMMON) ! && (ffesymbol_hook (s).decl_tree != error_mark_node)) ! { ! #ifdef SOMEONE_GETS_DEBUG_SUPPORT_WORKING ! int yes = suspend_momentary (); ! /* This isn't working, at least for dbxout. The .s file looks ! okay to me (burley), but in gdb 4.9 at least, the variables ! appear to reside somewhere outside of the common area, so ! it doesn't make sense to mislead anyone by generating the info ! on those variables until this is fixed. NOTE: Same problem ! with EQUIVALENCE, sadly...see similar #if later. */ ! ffecom_member_phase2_ (ffesymbol_storage (ffesymbol_common (s)), ! ffesymbol_storage (s)); ! resume_momentary (yes); ! #endif ! } ! return s; ! } ! #endif ! /* Append underscore(s) to name before calling get_identifier. "us" ! is nonzero if the name already contains an underscore and thus ! needs two underscores appended. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_get_appended_identifier_ (char us, char *name) ! { ! int i; ! char *newname; ! tree id; ! newname = xmalloc ((i = strlen (name)) + 1 ! + ffe_is_underscoring () ! + us); ! memcpy (newname, name, i); ! newname[i] = '_'; ! newname[i + us] = '_'; ! newname[i + 1 + us] = '\0'; ! id = get_identifier (newname); ! free (newname); ! return id; ! } ! #endif ! /* Decide whether to append underscore to name before calling ! get_identifier. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_get_external_identifier_ (ffesymbol s) ! { ! char us; ! char *name = ffesymbol_text (s); ! /* If name is a built-in name, just return it as is. */ ! if (!ffe_is_underscoring () ! || (strcmp (name, FFETARGET_nameBLANK_COMMON) == 0) ! #if FFETARGET_isENFORCED_MAIN_NAME ! || (strcmp (name, FFETARGET_nameENFORCED_NAME) == 0) ! #else ! || (strcmp (name, FFETARGET_nameUNNAMED_MAIN) == 0) ! #endif ! || (strcmp (name, FFETARGET_nameUNNAMED_BLOCK_DATA) == 0)) ! return get_identifier (name); ! us = ffe_is_second_underscore () ! ? (strchr (name, '_') != NULL) ! : 0; ! return ffecom_get_appended_identifier_ (us, name); ! } ! #endif ! /* Decide whether to append underscore to internal name before calling ! get_identifier. ! This is for non-external, top-function-context names only. Transform ! identifier so it doesn't conflict with the transformed result ! of using a _different_ external name. E.g. if "CALL FOO" is ! transformed into "FOO_();", then the variable in "FOO_ = 3" ! must be transformed into something that does not conflict, since ! these two things should be independent. ! The transformation is as follows. If the name does not contain ! an underscore, there is no possible conflict, so just return. ! If the name does contain an underscore, then transform it just ! like we transform an external identifier. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_get_identifier_ (char *name) { ! /* If name does not contain an underscore, just return it as is. */ ! ! if (!ffe_is_underscoring () ! || (strchr (name, '_') == NULL)) ! return get_identifier (name); ! return ffecom_get_appended_identifier_ (ffe_is_second_underscore (), ! name); } #endif ! /* ffecom_gen_sfuncdef_ -- Generate definition of statement function ! ! tree t; ! ffesymbol s; // kindFUNCTION, whereIMMEDIATE. ! t = ffecom_gen_sfuncdef_(s,ffesymbol_basictype(s), ! ffesymbol_kindtype(s)); ! ! Call after setting up containing function and getting trees for all ! other symbols. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_gen_sfuncdef_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt) { ! ffebld expr = ffesymbol_sfexpr (s); tree type; - tree func; - tree result; - bool charfunc = (bt == FFEINFO_basictypeCHARACTER); - static bool recurse = FALSE; - int yes; - int old_lineno = lineno; - char *old_input_filename = input_filename; ! ffecom_nested_entry_ = s; ! /* For now, we don't have a handy pointer to where the sfunc is actually ! defined, though that should be easy to add to an ffesymbol. (The ! token/where info available might well point to the place where the type ! of the sfunc is declared, especially if that precedes the place where ! the sfunc itself is defined, which is typically the case.) We should ! put out a null pointer rather than point somewhere wrong, but I want to ! see how it works at this point. */ ! input_filename = ffesymbol_where_filename (s); ! lineno = ffesymbol_where_filelinenum (s); ! /* Pretransform the expression so any newly discovered things belong to the ! outer program unit, not to the statement function. */ ! ffecom_expr_transform_ (expr); ! /* Make sure no recursive invocation of this fn (a specific case of failing ! to pretransform an sfunc's expression, i.e. where its expression ! references another untransformed sfunc) happens. */ ! assert (!recurse); ! recurse = TRUE; ! yes = suspend_momentary (); ! push_f_function_context (); ! ffecom_push_calltemps (); ! if (charfunc) ! type = void_type_node; ! else { ! type = ffecom_tree_type[bt][kt]; ! if (type == NULL_TREE) ! type = integer_type_node; /* _sym_exec_transition reports ! error. */ ! } ! start_function (ffecom_get_identifier_ (ffesymbol_text (s)), ! build_function_type (type, NULL_TREE), ! 1, /* nested/inline */ ! 0); /* TREE_PUBLIC */ ! /* We don't worry about COMPLEX return values here, because this is ! entirely internal to our code, and gcc has the ability to return COMPLEX ! directly as a value. */ ! yes = suspend_momentary (); ! if (charfunc) ! { /* Prepend arg for where result goes. */ ! tree type; ! type = ffecom_tree_type[FFEINFO_basictypeCHARACTER][kt]; ! result = ffecom_get_invented_identifier ("__g77_%s", ! "result", 0); ! ffecom_char_enhance_arg_ (&type, s); /* Ignore returned length. */ ! type = build_pointer_type (type); ! result = build_decl (PARM_DECL, result, type); ! push_parm_decl (result); ! } ! else ! result = NULL_TREE; /* Not ref'd if !charfunc. */ ! ffecom_push_dummy_decls_ (ffesymbol_dummyargs (s), TRUE); ! resume_momentary (yes); ! store_parm_decls (0); ! ffecom_start_compstmt_ (); ! if (expr != NULL) { ! if (charfunc) { ! ffetargetCharacterSize sz = ffesymbol_size (s); ! tree result_length; ! ! result_length = build_int_2 (sz, 0); ! TREE_TYPE (result_length) = ffecom_f2c_ftnlen_type_node; ! ffecom_let_char_ (result, result_length, sz, expr); ! expand_null_return (); } ! else ! expand_return (ffecom_modify (NULL_TREE, ! DECL_RESULT (current_function_decl), ! ffecom_expr (expr))); ! clear_momentary (); ! } ! ffecom_end_compstmt_ (); ! func = current_function_decl; ! finish_function (1); ! ffecom_pop_calltemps (); ! pop_f_function_context (); ! resume_momentary (yes); ! recurse = FALSE; ! lineno = old_lineno; ! input_filename = old_input_filename; ! ffecom_nested_entry_ = NULL; ! return func; ! } ! #endif ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static char * ! ffecom_gfrt_args_ (ffecomGfrt ix) ! { ! return ffecom_gfrt_argstring_[ix]; ! } #endif ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_gfrt_tree_ (ffecomGfrt ix) ! { ! if (ffecom_gfrt_[ix] == NULL_TREE) ! ffecom_make_gfrt_ (ix); ! ! return ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (ffecom_gfrt_[ix])), ! ffecom_gfrt_[ix]); ! } ! #endif ! /* Return initialize-to-zero expression for this VAR_DECL. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_init_zero_ (tree decl) ! { ! tree init; ! int incremental = TREE_STATIC (decl); ! tree type = TREE_TYPE (decl); ! if (incremental) { ! int momentary = suspend_momentary (); ! push_obstacks_nochange (); ! if (TREE_PERMANENT (decl)) ! end_temporary_allocation (); ! make_decl_rtl (decl, NULL, TREE_PUBLIC (decl) ? 1 : 0); ! assemble_variable (decl, TREE_PUBLIC (decl) ? 1 : 0, 0, 1); ! pop_obstacks (); ! resume_momentary (momentary); } ! push_momentary (); ! ! if ((TREE_CODE (type) != ARRAY_TYPE) ! && (TREE_CODE (type) != RECORD_TYPE) ! && (TREE_CODE (type) != UNION_TYPE) ! && !incremental) ! init = convert (type, integer_zero_node); ! else if (!incremental) ! { ! int momentary = suspend_momentary (); ! init = build (CONSTRUCTOR, type, NULL_TREE, NULL_TREE); ! TREE_CONSTANT (init) = 1; ! TREE_STATIC (init) = 1; ! resume_momentary (momentary); } - else - { - int momentary = suspend_momentary (); - - assemble_zeros (int_size_in_bytes (type)); - init = error_mark_node; ! resume_momentary (momentary); ! } ! pop_momentary_nofree (); ! return init; ! } ! #endif ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg, ! tree *maybe_tree) ! { ! tree expr_tree; ! tree length_tree; ! switch (ffebld_op (arg)) ! { ! case FFEBLD_opCONTER: /* For F90, check 0-length. */ ! if (ffetarget_length_character1 ! (ffebld_constant_character1 ! (ffebld_conter (arg))) == 0) ! { ! *maybe_tree = integer_zero_node; ! return convert (tree_type, integer_zero_node); ! } ! *maybe_tree = integer_one_node; ! expr_tree = build_int_2 (*ffetarget_text_character1 ! (ffebld_constant_character1 ! (ffebld_conter (arg))), ! 0); ! TREE_TYPE (expr_tree) = tree_type; ! return expr_tree; ! case FFEBLD_opSYMTER: ! case FFEBLD_opARRAYREF: ! case FFEBLD_opFUNCREF: ! case FFEBLD_opSUBSTR: ! ffecom_push_calltemps (); ! ffecom_char_args_ (&expr_tree, &length_tree, arg); ! ffecom_pop_calltemps (); ! if ((expr_tree == error_mark_node) ! || (length_tree == error_mark_node)) { ! *maybe_tree = error_mark_node; ! return error_mark_node; } ! if (integer_zerop (length_tree)) ! { ! *maybe_tree = integer_zero_node; ! return convert (tree_type, integer_zero_node); ! } ! expr_tree ! = ffecom_1 (INDIRECT_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (expr_tree))), ! expr_tree); ! expr_tree ! = ffecom_2 (ARRAY_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (expr_tree))), ! expr_tree, ! integer_one_node); ! expr_tree = convert (tree_type, expr_tree); ! if (TREE_CODE (length_tree) == INTEGER_CST) ! *maybe_tree = integer_one_node; ! else /* Must check length at run time. */ ! *maybe_tree ! = ffecom_truth_value ! (ffecom_2 (GT_EXPR, integer_type_node, ! length_tree, ! ffecom_f2c_ftnlen_zero_node)); ! return expr_tree; ! case FFEBLD_opPAREN: ! case FFEBLD_opCONVERT: ! if (ffeinfo_size (ffebld_info (arg)) == 0) ! { ! *maybe_tree = integer_zero_node; ! return convert (tree_type, integer_zero_node); ! } ! return ffecom_intrinsic_ichar_ (tree_type, ffebld_left (arg), ! maybe_tree); ! case FFEBLD_opCONCATENATE: ! { ! tree maybe_left; ! tree maybe_right; ! tree expr_left; ! tree expr_right; ! expr_left = ffecom_intrinsic_ichar_ (tree_type, ffebld_left (arg), ! &maybe_left); ! expr_right = ffecom_intrinsic_ichar_ (tree_type, ffebld_right (arg), ! &maybe_right); ! *maybe_tree = ffecom_2 (TRUTH_ORIF_EXPR, integer_type_node, ! maybe_left, ! maybe_right); ! expr_tree = ffecom_3 (COND_EXPR, tree_type, ! maybe_left, ! expr_left, ! expr_right); ! return expr_tree; ! } ! default: ! assert ("bad op in ICHAR" == NULL); ! return error_mark_node; ! } } #endif ! /* ffecom_intrinsic_len_ -- Return length info for char arg (LEN()) ! tree length_arg; ! ffebld expr; ! length_arg = ffecom_intrinsic_len_ (expr); ! Handles CHARACTER-type CONTER, SYMTER, SUBSTR, ARRAYREF, and FUNCREF ! subexpressions by constructing the appropriate tree for the ! length-of-character-text argument in a calling sequence. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_intrinsic_len_ (ffebld expr) { ! ffetargetCharacter1 val; ! tree length; ! switch (ffebld_op (expr)) ! { ! case FFEBLD_opCONTER: ! val = ffebld_constant_character1 (ffebld_conter (expr)); ! length = build_int_2 (ffetarget_length_character1 (val), 0); ! TREE_TYPE (length) = ffecom_f2c_ftnlen_type_node; ! break; ! case FFEBLD_opSYMTER: ! { ! ffesymbol s = ffebld_symter (expr); ! tree item; ! item = ffesymbol_hook (s).decl_tree; ! if (item == NULL_TREE) ! { ! s = ffecom_sym_transform_ (s); ! item = ffesymbol_hook (s).decl_tree; ! } ! if (ffesymbol_kind (s) == FFEINFO_kindENTITY) ! { ! if (ffesymbol_size (s) == FFETARGET_charactersizeNONE) ! length = ffesymbol_hook (s).length_tree; ! else ! { ! length = build_int_2 (ffesymbol_size (s), 0); ! TREE_TYPE (length) = ffecom_f2c_ftnlen_type_node; ! } ! } ! else if (item == error_mark_node) ! length = error_mark_node; ! else /* FFEINFO_kindFUNCTION: */ ! length = NULL_TREE; ! } ! break; ! case FFEBLD_opARRAYREF: ! length = ffecom_intrinsic_len_ (ffebld_left (expr)); ! break; ! case FFEBLD_opSUBSTR: ! { ! ffebld start; ! ffebld end; ! ffebld thing = ffebld_right (expr); ! tree start_tree; ! tree end_tree; ! assert (ffebld_op (thing) == FFEBLD_opITEM); ! start = ffebld_head (thing); ! thing = ffebld_trail (thing); ! assert (ffebld_trail (thing) == NULL); ! end = ffebld_head (thing); ! length = ffecom_intrinsic_len_ (ffebld_left (expr)); ! if (length == error_mark_node) break; ! if (start == NULL) ! { ! if (end == NULL) ! ; ! else ! { ! length = convert (ffecom_f2c_ftnlen_type_node, ! ffecom_expr (end)); ! } ! } ! else ! { ! start_tree = convert (ffecom_f2c_ftnlen_type_node, ! ffecom_expr (start)); ! if (start_tree == error_mark_node) ! { ! length = error_mark_node; ! break; ! } ! if (end == NULL) ! { ! length = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node, ! ffecom_f2c_ftnlen_one_node, ! ffecom_2 (MINUS_EXPR, ! ffecom_f2c_ftnlen_type_node, ! length, ! start_tree)); ! } ! else ! { ! end_tree = convert (ffecom_f2c_ftnlen_type_node, ! ffecom_expr (end)); ! if (end_tree == error_mark_node) ! { ! length = error_mark_node; ! break; ! } ! length = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node, ! ffecom_f2c_ftnlen_one_node, ! ffecom_2 (MINUS_EXPR, ! ffecom_f2c_ftnlen_type_node, ! end_tree, start_tree)); ! } ! } ! } ! break; ! case FFEBLD_opCONCATENATE: ! length ! = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node, ! ffecom_intrinsic_len_ (ffebld_left (expr)), ! ffecom_intrinsic_len_ (ffebld_right (expr))); ! break; ! case FFEBLD_opFUNCREF: ! case FFEBLD_opCONVERT: ! length = build_int_2 (ffebld_size (expr), 0); ! TREE_TYPE (length) = ffecom_f2c_ftnlen_type_node; ! break; ! default: ! assert ("bad op for single char arg expr" == NULL); ! length = ffecom_f2c_ftnlen_zero_node; break; - } ! assert (length != NULL_TREE); ! return length; ! } ! #endif ! /* ffecom_let_char_ -- Do assignment stuff for character type ! tree dest_tree; // destination (ADDR_EXPR) ! tree dest_length; // length (INT_CST/INDIRECT_REF(PARM_DECL)) ! ffetargetCharacterSize dest_size; // length ! ffebld source; // source expression ! ffecom_let_char_(dest_tree,dest_length,dest_size,source); ! Generates code to do the assignment. Used by ordinary assignment ! statement handler ffecom_let_stmt and by statement-function ! handler to generate code for a statement function. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void ! ffecom_let_char_ (tree dest_tree, tree dest_length, ! ffetargetCharacterSize dest_size, ffebld source) ! { ! ffecomConcatList_ catlist; ! tree source_length; ! tree source_tree; ! tree expr_tree; ! if ((dest_tree == error_mark_node) ! || (dest_length == error_mark_node)) ! return; ! assert (dest_tree != NULL_TREE); ! assert (dest_length != NULL_TREE); ! /* Source might be an opCONVERT, which just means it is a different size ! than the destination. Since the underlying implementation here handles ! that (directly or via the s_copy or s_cat run-time-library functions), ! we don't need the "convenience" of an opCONVERT that tells us to ! truncate or blank-pad, particularly since the resulting implementation ! would probably be slower than otherwise. */ ! while (ffebld_op (source) == FFEBLD_opCONVERT) ! source = ffebld_left (source); ! catlist = ffecom_concat_list_new_ (source, dest_size); ! switch (ffecom_concat_list_count_ (catlist)) ! { ! case 0: /* Shouldn't happen, but in case it does... */ ! ffecom_concat_list_kill_ (catlist); ! source_tree = null_pointer_node; ! source_length = ffecom_f2c_ftnlen_zero_node; ! expr_tree = build_tree_list (NULL_TREE, dest_tree); ! TREE_CHAIN (expr_tree) = build_tree_list (NULL_TREE, source_tree); ! TREE_CHAIN (TREE_CHAIN (expr_tree)) ! = build_tree_list (NULL_TREE, dest_length); ! TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (expr_tree))) ! = build_tree_list (NULL_TREE, source_length); ! expr_tree = ffecom_call_gfrt (FFECOM_gfrtCOPY, expr_tree); ! TREE_SIDE_EFFECTS (expr_tree) = 1; ! expand_expr_stmt (expr_tree); ! return; ! case 1: /* The (fairly) easy case. */ ! ffecom_char_args_ (&source_tree, &source_length, ! ffecom_concat_list_expr_ (catlist, 0)); ! ffecom_concat_list_kill_ (catlist); ! assert (source_tree != NULL_TREE); ! assert (source_length != NULL_TREE); ! if ((source_tree == error_mark_node) ! || (source_length == error_mark_node)) ! return; ! if (dest_size == 1) ! { ! dest_tree ! = ffecom_1 (INDIRECT_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE ! (dest_tree))), ! dest_tree); ! dest_tree ! = ffecom_2 (ARRAY_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE ! (dest_tree))), ! dest_tree, ! integer_one_node); ! source_tree ! = ffecom_1 (INDIRECT_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE ! (source_tree))), ! source_tree); ! source_tree ! = ffecom_2 (ARRAY_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE ! (source_tree))), ! source_tree, ! integer_one_node); ! expr_tree = ffecom_modify (void_type_node, dest_tree, source_tree); ! expand_expr_stmt (expr_tree); ! return; ! } ! expr_tree = build_tree_list (NULL_TREE, dest_tree); ! TREE_CHAIN (expr_tree) = build_tree_list (NULL_TREE, source_tree); ! TREE_CHAIN (TREE_CHAIN (expr_tree)) ! = build_tree_list (NULL_TREE, dest_length); ! TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (expr_tree))) ! = build_tree_list (NULL_TREE, source_length); ! expr_tree = ffecom_call_gfrt (FFECOM_gfrtCOPY, expr_tree); ! TREE_SIDE_EFFECTS (expr_tree) = 1; ! expand_expr_stmt (expr_tree); ! return; ! default: /* Must actually concatenate things. */ ! break; ! } ! /* Heavy-duty concatenation. */ ! { ! int count = ffecom_concat_list_count_ (catlist); ! int i; ! tree lengths; ! tree items; ! tree length_array; ! tree item_array; ! tree citem; ! tree clength; ! 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); ! for (i = 0; i < count; ++i) ! { ! ffecom_char_args_ (&citem, &clength, ! ffecom_concat_list_expr_ (catlist, i)); ! if ((citem == error_mark_node) ! || (clength == error_mark_node)) ! { ! ffecom_concat_list_kill_ (catlist); ! return; } ! items ! = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (items), ! ffecom_modify (void_type_node, ! ffecom_2 (ARRAY_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item_array))), ! item_array, ! build_int_2 (i, 0)), ! citem), ! items); ! lengths ! = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (lengths), ! ffecom_modify (void_type_node, ! ffecom_2 (ARRAY_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (length_array))), ! length_array, ! build_int_2 (i, 0)), ! clength), ! lengths); ! } ! expr_tree = build_tree_list (NULL_TREE, dest_tree); ! TREE_CHAIN (expr_tree) ! = build_tree_list (NULL_TREE, ! ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (items)), ! items)); ! TREE_CHAIN (TREE_CHAIN (expr_tree)) ! = build_tree_list (NULL_TREE, ! ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (lengths)), ! lengths)); ! TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (expr_tree))) ! = build_tree_list ! (NULL_TREE, ! ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnlen_type_node, ! convert (ffecom_f2c_ftnlen_type_node, ! build_int_2 (count, 0)))); ! TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (expr_tree)))) ! = build_tree_list (NULL_TREE, dest_length); ! expr_tree = ffecom_call_gfrt (FFECOM_gfrtCAT, expr_tree); ! TREE_SIDE_EFFECTS (expr_tree) = 1; ! expand_expr_stmt (expr_tree); ! } ! ffecom_concat_list_kill_ (catlist); ! } ! #endif ! /* ffecom_make_gfrt_ -- Make initial info for run-time routine ! ffecomGfrt ix; ! ffecom_make_gfrt_(ix); ! Assumes gfrt_[ix] is NULL_TREE, and replaces it with the FUNCTION_DECL ! for the indicated run-time routine (ix). */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void ! ffecom_make_gfrt_ (ffecomGfrt ix) ! { ! tree t; ! tree ttype; ! push_obstacks_nochange (); ! end_temporary_allocation (); ! switch (ffecom_gfrt_type_[ix]) ! { ! case FFECOM_rttypeVOID_: ! ttype = void_type_node; ! break; ! case FFECOM_rttypeVOIDSTAR_: ! ttype = TREE_TYPE (null_pointer_node); /* `void *'. */ ! break; ! case FFECOM_rttypeFTNINT_: ! ttype = ffecom_f2c_ftnint_type_node; ! break; ! case FFECOM_rttypeINTEGER_: ! ttype = ffecom_f2c_integer_type_node; ! break; ! case FFECOM_rttypeLONGINT_: ! ttype = ffecom_f2c_longint_type_node; ! break; ! case FFECOM_rttypeLOGICAL_: ! ttype = ffecom_f2c_logical_type_node; ! break; ! case FFECOM_rttypeREAL_F2C_: ! ttype = double_type_node; ! break; ! case FFECOM_rttypeREAL_GNU_: ! ttype = float_type_node; ! break; ! case FFECOM_rttypeCOMPLEX_F2C_: ! ttype = void_type_node; ! break; ! case FFECOM_rttypeCOMPLEX_GNU_: ! ttype = ffecom_f2c_complex_type_node; ! break; ! case FFECOM_rttypeDOUBLE_: ! ttype = double_type_node; ! break; ! case FFECOM_rttypeDOUBLEREAL_: ! ttype = ffecom_f2c_doublereal_type_node; ! break; ! case FFECOM_rttypeDBLCMPLX_F2C_: ! ttype = void_type_node; ! break; ! case FFECOM_rttypeDBLCMPLX_GNU_: ! ttype = ffecom_f2c_doublecomplex_type_node; ! break; ! case FFECOM_rttypeCHARACTER_: ! ttype = void_type_node; ! break; ! default: ! ttype = NULL; ! assert ("bad rttype" == NULL); ! break; ! } ! ttype = build_function_type (ttype, NULL_TREE); ! t = build_decl (FUNCTION_DECL, ! get_identifier (ffecom_gfrt_name_[ix]), ! ttype); ! DECL_EXTERNAL (t) = 1; ! TREE_PUBLIC (t) = 1; ! TREE_THIS_VOLATILE (t) = ffecom_gfrt_volatile_[ix] ? 1 : 0; ! t = start_decl (t, TRUE); ! finish_decl (t, NULL_TREE, TRUE); ! resume_temporary_allocation (); ! pop_obstacks (); ! ffecom_gfrt_[ix] = t; ! } ! #endif ! /* Phase 1 pass over each member of a COMMON/EQUIVALENCE group. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void ! ffecom_member_phase1_ (ffestorag mst UNUSED, ffestorag st) ! { ! ffesymbol s = ffestorag_symbol (st); ! if (ffesymbol_namelisted (s)) ! ffecom_member_namelisted_ = TRUE; ! } ! #endif ! /* Phase 2 pass over each member of a COMMON/EQUIVALENCE group. Declare ! the member so debugger will see it. Otherwise nobody should be ! referencing the member. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #ifdef SOMEONE_GETS_DEBUG_SUPPORT_WORKING ! static void ! ffecom_member_phase2_ (ffestorag mst, ffestorag st) ! { ! ffesymbol s; ! tree t; ! tree mt; ! tree type; ! if ((mst == NULL) ! || ((mt = ffestorag_hook (mst)) == NULL) ! || (mt == error_mark_node)) ! return; ! if ((st == NULL) ! || ((s = ffestorag_symbol (st)) == NULL)) ! return; ! type = ffecom_type_localvar_ (s, ! ffesymbol_basictype (s), ! ffesymbol_kindtype (s)); ! if (type == error_mark_node) ! return; ! t = build_decl (VAR_DECL, ! ffecom_get_identifier_ (ffesymbol_text (s)), ! type); ! TREE_STATIC (t) = TREE_STATIC (mt); ! DECL_INITIAL (t) = NULL_TREE; ! TREE_ASM_WRITTEN (t) = 1; ! DECL_RTL (t) ! = gen_rtx (MEM, TYPE_MODE (type), ! plus_constant (XEXP (DECL_RTL (mt), 0), ! ffestorag_modulo (mst) ! + ffestorag_offset (st) ! - ffestorag_offset (mst))); ! t = start_decl (t, FALSE); ! finish_decl (t, NULL_TREE, FALSE); ! } ! #endif ! #endif ! /* ffecom_push_dummy_decls_ -- Transform dummy args, push parm decls in order ! Ignores STAR (alternate-return) dummies. All other get exec-transitioned ! (which generates their trees) and then their trees get push_parm_decl'd. ! The second arg is TRUE if the dummies are for a statement function, in ! which case lengths are not pushed for character arguments (since they are ! always known by both the caller and the callee, though the code allows ! for someday permitting CHAR*(*) stmtfunc dummies). */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void ! ffecom_push_dummy_decls_ (ffebld dummy_list, bool stmtfunc) ! { ! ffebld dummy; ! ffebld dumlist; ! ffesymbol s; ! tree parm; ! ffecom_transform_only_dummies_ = TRUE; ! /* First push the parms corresponding to actual dummy "contents". */ ! for (dumlist = dummy_list; dumlist != NULL; dumlist = ffebld_trail (dumlist)) ! { ! dummy = ffebld_head (dumlist); ! switch (ffebld_op (dummy)) ! { ! case FFEBLD_opSTAR: ! case FFEBLD_opANY: ! continue; /* Forget alternate returns. */ ! default: ! break; ! } ! assert (ffebld_op (dummy) == FFEBLD_opSYMTER); ! s = ffebld_symter (dummy); ! parm = ffesymbol_hook (s).decl_tree; ! if (parm == NULL_TREE) ! { ! s = ffecom_sym_transform_ (s); ! parm = ffesymbol_hook (s).decl_tree; ! assert (parm != NULL_TREE); ! } ! if (parm != error_mark_node) ! push_parm_decl (parm); ! } ! /* Then, for CHARACTER dummies, push the parms giving their lengths. */ ! for (dumlist = dummy_list; dumlist != NULL; dumlist = ffebld_trail (dumlist)) ! { ! dummy = ffebld_head (dumlist); ! switch (ffebld_op (dummy)) ! { ! case FFEBLD_opSTAR: ! case FFEBLD_opANY: ! continue; /* Forget alternate returns, they mean ! NOTHING! */ ! default: ! break; ! } ! s = ffebld_symter (dummy); ! if (ffesymbol_basictype (s) != FFEINFO_basictypeCHARACTER) ! continue; /* Only looking for CHARACTER arguments. */ ! if (stmtfunc && (ffesymbol_size (s) != FFETARGET_charactersizeNONE)) ! continue; /* Stmtfunc arg with known size needs no ! length param. */ ! if (ffesymbol_kind (s) != FFEINFO_kindENTITY) ! continue; /* Only looking for variables and arrays. */ ! parm = ffesymbol_hook (s).length_tree; ! assert (parm != NULL_TREE); ! if (parm != error_mark_node) ! push_parm_decl (parm); ! } ! ffecom_transform_only_dummies_ = FALSE; ! } ! #endif ! /* ffecom_start_progunit_ -- Beginning of program unit ! Does GNU back end stuff necessary to teach it about the start of its ! equivalent of a Fortran program unit. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void ! ffecom_start_progunit_ () ! { ! ffesymbol fn = ffecom_primary_entry_; ! ffebld arglist; ! tree id; /* Identifier (name) of function. */ ! tree type; /* Type of function. */ ! tree result; /* Result of function. */ ! ffeinfoBasictype bt; ! ffeinfoKindtype kt; ! ffeglobal g; ! ffeglobalType gt; ! ffeglobalType egt = FFEGLOBAL_type; ! bool charfunc; ! bool cmplxfunc; ! bool altentries = (ffecom_num_entrypoints_ != 0); ! bool multi ! = altentries ! && (ffecom_primary_entry_kind_ == FFEINFO_kindFUNCTION) ! && (ffecom_master_bt_ == FFEINFO_basictypeNONE); ! bool main_program = FALSE; ! int old_lineno = lineno; ! char *old_input_filename = input_filename; ! int yes; ! assert (fn != NULL); ! assert (ffesymbol_hook (fn).decl_tree == NULL_TREE); ! input_filename = ffesymbol_where_filename (fn); ! lineno = ffesymbol_where_filelinenum (fn); ! /* c-parse.y indeed does call suspend_momentary and not only ignores the ! return value, but also never calls resume_momentary, when starting an ! outer function (see "fndef:", "setspecs:", and so on). So g77 does the ! same thing. It shouldn't be a problem since start_function calls ! temporary_allocation, but it might be necessary. If it causes a problem ! here, then maybe there's a bug lurking in gcc. NOTE: This identical ! comment appears twice in thist file. */ ! suspend_momentary (); ! switch (ffecom_primary_entry_kind_) ! { ! case FFEINFO_kindPROGRAM: ! main_program = TRUE; ! gt = FFEGLOBAL_typeMAIN; ! bt = FFEINFO_basictypeNONE; ! kt = FFEINFO_kindtypeNONE; ! type = ffecom_tree_fun_type_void; ! charfunc = FALSE; ! cmplxfunc = FALSE; ! break; ! case FFEINFO_kindBLOCKDATA: ! gt = FFEGLOBAL_typeBDATA; ! bt = FFEINFO_basictypeNONE; ! kt = FFEINFO_kindtypeNONE; ! type = ffecom_tree_fun_type_void; ! charfunc = FALSE; ! cmplxfunc = FALSE; ! break; ! case FFEINFO_kindFUNCTION: ! gt = FFEGLOBAL_typeFUNC; ! egt = FFEGLOBAL_typeEXT; ! bt = ffesymbol_basictype (fn); ! kt = ffesymbol_kindtype (fn); ! if (bt == FFEINFO_basictypeNONE) ! { ! ffeimplic_establish_symbol (fn); ! if (ffesymbol_funcresult (fn) != NULL) ! ffeimplic_establish_symbol (ffesymbol_funcresult (fn)); ! bt = ffesymbol_basictype (fn); ! kt = ffesymbol_kindtype (fn); ! } ! if (multi) ! charfunc = cmplxfunc = FALSE; ! else if (bt == FFEINFO_basictypeCHARACTER) ! charfunc = TRUE, cmplxfunc = FALSE; ! else if ((bt == FFEINFO_basictypeCOMPLEX) ! && ffesymbol_is_f2c (fn) ! && !altentries) ! charfunc = FALSE, cmplxfunc = TRUE; ! else ! charfunc = cmplxfunc = FALSE; ! if (multi || charfunc) ! type = ffecom_tree_fun_type_void; ! else if (ffesymbol_is_f2c (fn) && !altentries) ! type = ffecom_tree_fun_type[bt][kt]; ! else ! type = build_function_type (ffecom_tree_type[bt][kt], NULL_TREE); ! if ((type == NULL_TREE) ! || (TREE_TYPE (type) == NULL_TREE)) ! type = ffecom_tree_fun_type_void; /* _sym_exec_transition. */ ! break; ! case FFEINFO_kindSUBROUTINE: ! gt = FFEGLOBAL_typeSUBR; ! egt = FFEGLOBAL_typeEXT; ! bt = FFEINFO_basictypeNONE; ! kt = FFEINFO_kindtypeNONE; ! if (ffecom_is_altreturning_) ! type = ffecom_tree_subr_type; ! else ! type = ffecom_tree_fun_type_void; ! charfunc = FALSE; ! cmplxfunc = FALSE; ! break; ! default: ! assert ("say what??" == NULL); ! /* Fall through. */ ! case FFEINFO_kindANY: ! gt = FFEGLOBAL_typeANY; ! bt = FFEINFO_basictypeNONE; ! kt = FFEINFO_kindtypeNONE; ! type = error_mark_node; ! charfunc = FALSE; ! cmplxfunc = FALSE; ! break; ! } ! if (altentries) ! { ! id = ffecom_get_invented_identifier ("__g77_masterfun_%s", ! ffesymbol_text (fn), ! 0); ! } ! #if FFETARGET_isENFORCED_MAIN ! else if (main_program) ! id = get_identifier (FFETARGET_nameENFORCED_MAIN_NAME); ! #endif ! else ! id = ffecom_get_external_identifier_ (fn); ! start_function (id, ! type, ! 0, /* nested/inline */ ! !altentries); /* TREE_PUBLIC */ ! TREE_USED (current_function_decl) = 1; /* Avoid spurious warning if altentries. */ ! if (!altentries ! && ((g = ffesymbol_global (fn)) != NULL) ! && ((ffeglobal_type (g) == gt) ! || (ffeglobal_type (g) == egt))) ! { ! ffeglobal_set_hook (g, current_function_decl); ! } ! yes = suspend_momentary (); ! /* Arg handling needs exec-transitioned ffesymbols to work with. But ! exec-transitioning needs current_function_decl to be filled in. So we ! do these things in two phases. */ ! if (altentries) ! { /* 1st arg identifies which entrypoint. */ ! ffecom_which_entrypoint_decl_ ! = build_decl (PARM_DECL, ! ffecom_get_invented_identifier ("__g77_%s", ! "which_entrypoint", ! 0), ! integer_type_node); ! push_parm_decl (ffecom_which_entrypoint_decl_); ! } ! if (charfunc ! || cmplxfunc ! || multi) ! { /* Arg for result (return value). */ ! tree type; ! tree length; ! if (charfunc) ! type = ffecom_tree_type[FFEINFO_basictypeCHARACTER][kt]; ! else if (cmplxfunc) ! type = ffecom_tree_type[FFEINFO_basictypeCOMPLEX][kt]; ! else ! type = ffecom_multi_type_node_; ! result = ffecom_get_invented_identifier ("__g77_%s", ! "result", 0); ! /* Make length arg _and_ enhance type info for CHAR arg itself. */ ! if (charfunc) ! length = ffecom_char_enhance_arg_ (&type, fn); ! else ! length = NULL_TREE; /* Not ref'd if !charfunc. */ ! type = build_pointer_type (type); ! result = build_decl (PARM_DECL, result, type); ! push_parm_decl (result); ! if (multi) ! ffecom_multi_retval_ = result; ! else ! ffecom_func_result_ = result; ! if (charfunc) ! { ! push_parm_decl (length); ! ffecom_func_length_ = length; ! } ! } ! if (ffecom_primary_entry_is_proc_) ! { ! if (altentries) ! arglist = ffecom_master_arglist_; ! else ! arglist = ffesymbol_dummyargs (fn); ! ffecom_push_dummy_decls_ (arglist, FALSE); ! } ! resume_momentary (yes); ! if (TREE_CODE (current_function_decl) != ERROR_MARK) ! store_parm_decls (main_program ? 1 : 0); ! ffecom_start_compstmt_ (); ! lineno = old_lineno; ! input_filename = old_input_filename; ! /* This handles any symbols still untransformed, in case -g specified. ! This used to be done in ffecom_finish_progunit, but it turns out to ! be necessary to do it here so that statement functions are ! expanded before code. But don't bother for BLOCK DATA. */ ! if (ffecom_primary_entry_kind_ != FFEINFO_kindBLOCKDATA) ! ffesymbol_drive (ffecom_finish_symbol_transform_); ! } ! #endif ! /* ffecom_sym_transform_ -- Transform FFE sym into backend sym ! ffesymbol s; ! ffecom_sym_transform_(s); ! The ffesymbol_hook info for s is updated with appropriate backend info ! on the symbol. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static ffesymbol ! ffecom_sym_transform_ (ffesymbol s) ! { ! tree t; /* Transformed thingy. */ ! tree tlen; /* Length if CHAR*(*). */ ! bool addr; /* Is t the address of the thingy? */ ! ffeinfoBasictype bt; ! ffeinfoKindtype kt; ! ffeglobal g; ! int yes; ! int old_lineno = lineno; ! char *old_input_filename = input_filename; ! if (ffesymbol_sfdummyparent (s) == NULL) ! { ! input_filename = ffesymbol_where_filename (s); ! lineno = ffesymbol_where_filelinenum (s); ! } ! else ! { ! ffesymbol sf = ffesymbol_sfdummyparent (s); ! input_filename = ffesymbol_where_filename (sf); ! lineno = ffesymbol_where_filelinenum (sf); ! } ! bt = ffeinfo_basictype (ffebld_info (s)); ! kt = ffeinfo_kindtype (ffebld_info (s)); ! t = NULL_TREE; ! tlen = NULL_TREE; ! addr = FALSE; ! switch (ffesymbol_kind (s)) ! { ! case FFEINFO_kindNONE: ! switch (ffesymbol_where (s)) ! { ! case FFEINFO_whereDUMMY: /* Subroutine or function. */ ! assert (ffecom_transform_only_dummies_); ! /* Before 0.4, this could be ENTITY/DUMMY, but see ! ffestu_sym_end_transition -- no longer true (in particular, if ! it could be an ENTITY, it _will_ be made one, so that ! possibility won't come through here). So we never make length ! arg for CHARACTER type. */ ! t = build_decl (PARM_DECL, ! ffecom_get_identifier_ (ffesymbol_text (s)), ! ffecom_tree_ptr_to_subr_type); ! #if BUILT_FOR_270 ! DECL_ARTIFICIAL (t) = 1; ! #endif ! addr = TRUE; break; ! case FFEINFO_whereGLOBAL: /* Subroutine or function. */ assert (!ffecom_transform_only_dummies_); ! if (((g = ffesymbol_global (s)) != NULL) ! && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR) ! || (ffeglobal_type (g) == FFEGLOBAL_typeFUNC) ! || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)) ! && (ffeglobal_hook (g) != NULL_TREE) ! && ffe_is_globals ()) ! { ! t = ffeglobal_hook (g); ! break; ! } push_obstacks_nochange (); end_temporary_allocation (); t = build_decl (FUNCTION_DECL, ffecom_get_external_identifier_ (s), ! ffecom_tree_subr_type); /* Assume subr. */ DECL_EXTERNAL (t) = 1; TREE_PUBLIC (t) = 1; t = start_decl (t, FALSE); finish_decl (t, NULL_TREE, FALSE); - if ((g != NULL) - && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR) - || (ffeglobal_type (g) == FFEGLOBAL_typeFUNC) - || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))) - ffeglobal_set_hook (g, t); - resume_temporary_allocation (); pop_obstacks (); break; default: ! assert ("NONE where unexpected" == NULL); /* Fall through. */ case FFEINFO_whereANY: break; } break; ! case FFEINFO_kindENTITY: switch (ffeinfo_where (ffesymbol_info (s))) { ! ! case FFEINFO_whereCONSTANT: /* ~~debugging info needed? */ assert (!ffecom_transform_only_dummies_); ! t = error_mark_node; /* Shouldn't ever see this in expr. */ break; case FFEINFO_whereLOCAL: assert (!ffecom_transform_only_dummies_); ! { ! ffestorag st = ffesymbol_storage (s); ! tree type; ! ! if ((st != NULL) ! && (ffestorag_size (st) == 0)) ! { ! t = error_mark_node; ! break; ! } ! ! yes = suspend_momentary (); ! type = ffecom_type_localvar_ (s, bt, kt); ! resume_momentary (yes); ! ! if (type == error_mark_node) ! { ! t = error_mark_node; ! break; ! } ! ! if ((st != NULL) ! && (ffestorag_parent (st) != NULL)) ! { /* Child of EQUIVALENCE parent. */ ! ffestorag est; ! tree et; ! int yes; ! ffetargetOffset offset; ! ! est = ffestorag_parent (st); ! ffecom_transform_equiv_ (est); ! ! et = ffestorag_hook (est); ! assert (et != NULL_TREE); ! ! if (! TREE_STATIC (et)) ! put_var_into_stack (et); ! ! yes = suspend_momentary (); ! ! offset = ffestorag_modulo (est) ! + ffestorag_offset (ffesymbol_storage (s)) ! - ffestorag_offset (est); ! ! ffecom_debug_kludge_ (et, "EQUIVALENCE", s, type, offset); ! ! /* (t_type *) (((char *) &et) + offset) */ ! ! t = convert (string_type_node, /* (char *) */ ! ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (et)), ! et)); ! t = ffecom_2 (PLUS_EXPR, TREE_TYPE (t), ! t, ! build_int_2 (offset, 0)); ! t = convert (build_pointer_type (type), ! t); ! ! addr = TRUE; ! ! resume_momentary (yes); ! } ! else ! { ! tree initexpr; ! bool init = ffesymbol_is_init (s); ! ! yes = suspend_momentary (); ! ! t = build_decl (VAR_DECL, ! ffecom_get_identifier_ (ffesymbol_text (s)), ! type); ! ! if (init ! || ffesymbol_namelisted (s) ! #ifdef FFECOM_sizeMAXSTACKITEM ! || ((st != NULL) ! && (ffestorag_size (st) > FFECOM_sizeMAXSTACKITEM)) ! #endif ! || ((ffecom_primary_entry_kind_ != FFEINFO_kindPROGRAM) ! && (ffecom_primary_entry_kind_ ! != FFEINFO_kindBLOCKDATA) ! && (ffesymbol_is_save (s) || ffe_is_saveall ()))) ! TREE_STATIC (t) = !ffesymbol_attr (s, FFESYMBOL_attrADJUSTABLE); ! else ! TREE_STATIC (t) = 0; /* No need to make static. */ ! ! if (init || ffe_is_init_local_zero ()) ! DECL_INITIAL (t) = error_mark_node; ! ! /* Keep -Wunused from complaining about var if it ! is used as sfunc arg or DATA implied-DO. */ ! if (ffesymbol_attrs (s) & FFESYMBOL_attrsSFARG) ! DECL_IN_SYSTEM_HEADER (t) = 1; ! t = start_decl (t, FALSE); ! if (init) ! { ! if (ffesymbol_init (s) != NULL) ! initexpr = ffecom_expr (ffesymbol_init (s)); ! else ! initexpr = ffecom_init_zero_ (t); ! } ! else if (ffe_is_init_local_zero ()) ! initexpr = ffecom_init_zero_ (t); ! else ! initexpr = NULL_TREE; /* Not ref'd if !init. */ ! finish_decl (t, initexpr, FALSE); ! if ((st != NULL) && (DECL_SIZE (t) != error_mark_node)) ! { ! tree size_tree; ! size_tree = size_binop (CEIL_DIV_EXPR, ! DECL_SIZE (t), ! size_int (BITS_PER_UNIT)); ! assert (TREE_INT_CST_HIGH (size_tree) == 0); ! assert (TREE_INT_CST_LOW (size_tree) == ffestorag_size (st)); ! } ! resume_momentary (yes); ! } ! } ! break; ! case FFEINFO_whereRESULT: ! assert (!ffecom_transform_only_dummies_); ! if (bt == FFEINFO_basictypeCHARACTER) ! { /* Result is already in list of dummies, use ! it (& length). */ ! t = ffecom_func_result_; ! tlen = ffecom_func_length_; ! addr = TRUE; ! break; ! } ! if ((ffecom_num_entrypoints_ == 0) ! && (bt == FFEINFO_basictypeCOMPLEX) ! && (ffesymbol_is_f2c (ffecom_primary_entry_))) ! { /* Result is already in list of dummies, use ! it. */ ! t = ffecom_func_result_; ! addr = TRUE; ! break; ! } ! if (ffecom_func_result_ != NULL_TREE) ! { ! t = ffecom_func_result_; ! break; ! } ! if ((ffecom_num_entrypoints_ != 0) ! && (ffecom_master_bt_ == FFEINFO_basictypeNONE)) ! { ! yes = suspend_momentary (); ! assert (ffecom_multi_retval_ != NULL_TREE); ! t = ffecom_1 (INDIRECT_REF, ffecom_multi_type_node_, ! ffecom_multi_retval_); ! t = ffecom_2 (COMPONENT_REF, ffecom_tree_type[bt][kt], ! t, ffecom_multi_fields_[bt][kt]); ! resume_momentary (yes); ! break; ! } ! yes = suspend_momentary (); ! t = build_decl (VAR_DECL, ! ffecom_get_identifier_ (ffesymbol_text (s)), ! ffecom_tree_type[bt][kt]); ! TREE_STATIC (t) = 0; /* Put result on stack. */ ! t = start_decl (t, FALSE); ! finish_decl (t, NULL_TREE, FALSE); ! ffecom_func_result_ = t; ! resume_momentary (yes); ! break; ! case FFEINFO_whereDUMMY: ! { ! tree type; ! ffebld dl; ! ffebld dim; ! tree low; ! tree high; ! tree old_sizes; ! bool adjustable = FALSE; /* Conditionally adjustable? */ ! type = ffecom_tree_type[bt][kt]; ! if (ffesymbol_sfdummyparent (s) != NULL) ! { ! if (current_function_decl == ffecom_outer_function_decl_) ! { /* Exec transition before sfunc ! context; get it later. */ ! break; ! } ! t = ffecom_get_identifier_ (ffesymbol_text ! (ffesymbol_sfdummyparent (s))); ! } ! else ! t = ffecom_get_identifier_ (ffesymbol_text (s)); ! assert (ffecom_transform_only_dummies_); ! old_sizes = get_pending_sizes (); ! put_pending_sizes (old_sizes); ! if (bt == FFEINFO_basictypeCHARACTER) ! tlen = ffecom_char_enhance_arg_ (&type, s); ! type = ffecom_check_size_overflow_ (s, type, TRUE); ! for (dl = ffesymbol_dims (s); dl != NULL; dl = ffebld_trail (dl)) ! { ! if (type == error_mark_node) ! break; ! dim = ffebld_head (dl); ! assert (ffebld_op (dim) == FFEBLD_opBOUNDS); ! if ((ffebld_left (dim) == NULL) || ffecom_doing_entry_) ! low = ffecom_integer_one_node; ! else ! low = ffecom_expr (ffebld_left (dim)); ! assert (ffebld_right (dim) != NULL); ! if ((ffebld_op (ffebld_right (dim)) == FFEBLD_opSTAR) ! || ffecom_doing_entry_) ! { ! /* Used to just do high=low. But for ffecom_tree_ ! canonize_ref_, it probably is important to correctly ! assess the size. E.g. given COMPLEX C(*),CFUNC and ! C(2)=CFUNC(C), overlap can happen, while it can't ! for, say, C(1)=CFUNC(C(2)). */ ! /* Even more recently used to set to INT_MAX, but that ! broke when some overflow checking went into the back ! end. Now we just leave the upper bound unspecified. */ ! high = NULL; ! } ! else ! high = ffecom_expr (ffebld_right (dim)); ! /* Determine whether array is conditionally adjustable, ! to decide whether back-end magic is needed. ! Normally the front end uses the back-end function ! variable_size to wrap SAVE_EXPR's around expressions ! affecting the size/shape of an array so that the ! size/shape info doesn't change during execution ! of the compiled code even though variables and ! functions referenced in those expressions might. ! variable_size also makes sure those saved expressions ! get evaluated immediately upon entry to the ! compiled procedure -- the front end normally doesn't ! have to worry about that. ! However, there is a problem with this that affects ! g77's implementation of entry points, and that is ! that it is _not_ true that each invocation of the ! compiled procedure is permitted to evaluate ! array size/shape info -- because it is possible ! that, for some invocations, that info is invalid (in ! which case it is "promised" -- i.e. a violation of ! the Fortran standard -- that the compiled code ! won't reference the array or its size/shape ! during that particular invocation). ! To phrase this in C terms, consider this gcc function: ! void foo (int *n, float (*a)[*n]) ! { ! // a is "pointer to array ...", fyi. ! } ! Suppose that, for some invocations, it is permitted ! for a caller of foo to do this: ! foo (NULL, NULL); ! Now the _written_ code for foo can take such a call ! into account by either testing explicitly for whether ! (a == NULL) || (n == NULL) -- presumably it is ! not permitted to reference *a in various fashions ! if (n == NULL) I suppose -- or it can avoid it by ! looking at other info (other arguments, static/global ! data, etc.). ! However, this won't work in gcc 2.5.8 because it'll ! automatically emit the code to save the "*n" ! expression, which'll yield a NULL dereference for ! the "foo (NULL, NULL)" call, something the code ! for foo cannot prevent. ! g77 definitely needs to avoid executing such ! code anytime the pointer to the adjustable array ! is NULL, because even if its bounds expressions ! don't have any references to possible "absent" ! variables like "*n" -- say all variable references ! are to COMMON variables, i.e. global (though in C, ! local static could actually make sense) -- the ! expressions could yield other run-time problems ! for allowably "dead" values in those variables. ! For example, let's consider a more complicated ! version of foo: ! extern int i; ! extern int j; ! void foo (float (*a)[i/j]) ! { ! ... ! } ! The above is (essentially) quite valid for Fortran ! but, again, for a call like "foo (NULL);", it is ! permitted for i and j to be undefined when the ! call is made. If j happened to be zero, for ! example, emitting the code to evaluate "i/j" ! could result in a run-time error. ! Offhand, though I don't have my F77 or F90 ! standards handy, it might even be valid for a ! bounds expression to contain a function reference, ! in which case I doubt it is permitted for an ! implementation to invoke that function in the ! Fortran case involved here (invocation of an ! alternate ENTRY point that doesn't have the adjustable ! array as one of its arguments). ! So, the code that the compiler would normally emit ! to preevaluate the size/shape info for an ! adjustable array _must not_ be executed at run time ! in certain cases. Specifically, for Fortran, ! the case is when the pointer to the adjustable ! array == NULL. (For gnu-ish C, it might be nice ! for the source code itself to specify an expression ! that, if TRUE, inhibits execution of the code. Or ! reverse the sense for elegance.) ! (Note that g77 could use a different test than NULL, ! actually, since it happens to always pass an ! integer to the called function that specifies which ! entry point is being invoked. Hmm, this might ! solve the next problem.) ! One way a user could, I suppose, write "foo" so ! it works is to insert COND_EXPR's for the ! size/shape info so the dangerous stuff isn't ! actually done, as in: ! void foo (int *n, float (*a)[(a == NULL) ? 0 : *n]) ! { ! ... ! } ! The next problem is that the front end needs to ! be able to tell the back end about the array's ! decl _before_ it tells it about the conditional ! expression to inhibit evaluation of size/shape info, ! as shown above. ! To solve this, the front end needs to be able ! to give the back end the expression to inhibit ! generation of the preevaluation code _after_ ! it makes the decl for the adjustable array. ! Until then, the above example using the COND_EXPR ! doesn't pass muster with gcc because the "(a == NULL)" ! part has a reference to "a", which is still ! undefined at that point. ! g77 will therefore use a different mechanism in the ! meantime. */ ! if (!adjustable ! && ((TREE_CODE (low) != INTEGER_CST) ! || (high && TREE_CODE (high) != INTEGER_CST))) ! adjustable = TRUE; ! #if 0 /* Old approach -- see below. */ ! if (TREE_CODE (low) != INTEGER_CST) ! low = ffecom_3 (COND_EXPR, integer_type_node, ! ffecom_adjarray_passed_ (s), ! low, ! ffecom_integer_zero_node); ! if (high && TREE_CODE (high) != INTEGER_CST) ! high = ffecom_3 (COND_EXPR, integer_type_node, ! ffecom_adjarray_passed_ (s), ! high, ! ffecom_integer_zero_node); ! #endif ! /* ~~~gcc/stor-layout.c/layout_type should do this, ! probably. Fixes 950302-1.f. */ ! if (TREE_CODE (low) != INTEGER_CST) ! low = variable_size (low); ! /* ~~~similarly, this fixes dumb0.f. The C front end ! does this, which is why dumb0.c would work. */ ! if (high && TREE_CODE (high) != INTEGER_CST) ! high = variable_size (high); ! type ! = build_array_type ! (type, ! build_range_type (ffecom_integer_type_node, ! low, high)); ! type = ffecom_check_size_overflow_ (s, type, TRUE); ! } ! if (type == error_mark_node) ! { ! t = error_mark_node; ! break; ! } ! if ((ffesymbol_sfdummyparent (s) == NULL) ! || (ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER)) ! { ! type = build_pointer_type (type); ! addr = TRUE; ! } ! t = build_decl (PARM_DECL, t, type); ! #if BUILT_FOR_270 ! DECL_ARTIFICIAL (t) = 1; ! #endif ! /* If this arg is present in every entry point's list of ! dummy args, then we're done. */ ! if (ffesymbol_numentries (s) ! == (ffecom_num_entrypoints_ + 1)) ! break; ! #if 1 ! /* If variable_size in stor-layout has been called during ! the above, then get_pending_sizes should have the ! yet-to-be-evaluated saved expressions pending. ! Make the whole lot of them get emitted, conditionally ! on whether the array decl ("t" above) is not NULL. */ ! { ! tree sizes = get_pending_sizes (); ! tree tem; ! for (tem = sizes; ! tem != old_sizes; ! tem = TREE_CHAIN (tem)) ! { ! tree temv = TREE_VALUE (tem); ! if (sizes == tem) ! sizes = temv; ! else ! sizes ! = ffecom_2 (COMPOUND_EXPR, ! TREE_TYPE (sizes), ! temv, ! sizes); ! } ! if (sizes != tem) ! { ! sizes ! = ffecom_3 (COND_EXPR, ! TREE_TYPE (sizes), ! ffecom_2 (NE_EXPR, ! integer_type_node, ! t, ! null_pointer_node), ! sizes, ! convert (TREE_TYPE (sizes), ! integer_zero_node)); ! sizes = ffecom_save_tree (sizes); ! sizes ! = tree_cons (NULL_TREE, sizes, tem); ! } ! if (sizes) ! put_pending_sizes (sizes); ! } ! #else ! #if 0 ! if (adjustable ! && (ffesymbol_numentries (s) ! != ffecom_num_entrypoints_ + 1)) ! DECL_SOMETHING (t) ! = ffecom_2 (NE_EXPR, integer_type_node, ! t, ! null_pointer_node); ! #else ! #if 0 ! if (adjustable ! && (ffesymbol_numentries (s) ! != ffecom_num_entrypoints_ + 1)) ! { ! ffebad_start (FFEBAD_MISSING_ADJARRAY_UNSUPPORTED); ! ffebad_here (0, ffesymbol_where_line (s), ! ffesymbol_where_column (s)); ! ffebad_string (ffesymbol_text (s)); ! ffebad_finish (); ! } ! #endif ! #endif ! #endif ! } ! break; ! case FFEINFO_whereCOMMON: ! { ! ffesymbol cs; ! ffeglobal cg; ! tree ct; ! ffestorag st = ffesymbol_storage (s); ! tree type; ! int yes; ! cs = ffesymbol_common (s); /* The COMMON area itself. */ ! if (st != NULL) /* Else not laid out. */ ! { ! ffecom_transform_common_ (cs); ! st = ffesymbol_storage (s); ! } ! yes = suspend_momentary (); ! type = ffecom_type_localvar_ (s, bt, kt); ! cg = ffesymbol_global (cs); /* The global COMMON info. */ ! if ((cg == NULL) ! || (ffeglobal_type (cg) != FFEGLOBAL_typeCOMMON)) ! ct = NULL_TREE; ! else ! ct = ffeglobal_hook (cg); /* The common area's tree. */ ! if ((ct == NULL_TREE) ! || (st == NULL) ! || (type == error_mark_node)) ! t = error_mark_node; ! else ! { ! ffetargetOffset offset; ! ffestorag cst; ! cst = ffestorag_parent (st); ! assert (cst == ffesymbol_storage (cs)); ! offset = ffestorag_modulo (cst) ! + ffestorag_offset (st) ! - ffestorag_offset (cst); ! ffecom_debug_kludge_ (ct, "COMMON", s, type, offset); ! /* (t_type *) (((char *) &ct) + offset) */ ! t = convert (string_type_node, /* (char *) */ ! ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (ct)), ! ct)); ! t = ffecom_2 (PLUS_EXPR, TREE_TYPE (t), ! t, ! build_int_2 (offset, 0)); ! t = convert (build_pointer_type (type), ! t); ! addr = TRUE; ! } ! resume_momentary (yes); ! } ! break; ! case FFEINFO_whereIMMEDIATE: ! case FFEINFO_whereGLOBAL: ! case FFEINFO_whereFLEETING: ! case FFEINFO_whereFLEETING_CADDR: ! case FFEINFO_whereFLEETING_IADDR: ! case FFEINFO_whereINTRINSIC: ! case FFEINFO_whereCONSTANT_SUBOBJECT: ! default: ! assert ("ENTITY where unheard of" == NULL); ! /* Fall through. */ ! case FFEINFO_whereANY: ! t = error_mark_node; ! break; ! } ! break; ! case FFEINFO_kindFUNCTION: ! switch (ffeinfo_where (ffesymbol_info (s))) ! { ! case FFEINFO_whereLOCAL: /* Me. */ ! assert (!ffecom_transform_only_dummies_); ! t = current_function_decl; ! break; ! case FFEINFO_whereGLOBAL: ! assert (!ffecom_transform_only_dummies_); ! if (((g = ffesymbol_global (s)) != NULL) ! && ((ffeglobal_type (g) == FFEGLOBAL_typeFUNC) ! || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)) ! && (ffeglobal_hook (g) != NULL_TREE) ! && ffe_is_globals ()) ! { ! t = ffeglobal_hook (g); ! break; ! } ! push_obstacks_nochange (); ! end_temporary_allocation (); ! if (ffesymbol_is_f2c (s) ! && (ffesymbol_where (s) != FFEINFO_whereCONSTANT)) ! t = ffecom_tree_fun_type[bt][kt]; ! else ! t = build_function_type (ffecom_tree_type[bt][kt], NULL_TREE); ! t = build_decl (FUNCTION_DECL, ! ffecom_get_external_identifier_ (s), ! t); ! DECL_EXTERNAL (t) = 1; ! TREE_PUBLIC (t) = 1; ! t = start_decl (t, FALSE); ! finish_decl (t, NULL_TREE, FALSE); ! if ((g != NULL) ! && ((ffeglobal_type (g) == FFEGLOBAL_typeFUNC) ! || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))) ! ffeglobal_set_hook (g, t); ! resume_temporary_allocation (); ! pop_obstacks (); ! break; ! case FFEINFO_whereDUMMY: ! assert (ffecom_transform_only_dummies_); ! if (ffesymbol_is_f2c (s) ! && (ffesymbol_where (s) != FFEINFO_whereCONSTANT)) ! t = ffecom_tree_ptr_to_fun_type[bt][kt]; ! else ! t = build_pointer_type ! (build_function_type (ffecom_tree_type[bt][kt], NULL_TREE)); ! t = build_decl (PARM_DECL, ! ffecom_get_identifier_ (ffesymbol_text (s)), ! t); ! #if BUILT_FOR_270 ! DECL_ARTIFICIAL (t) = 1; ! #endif ! addr = TRUE; ! break; ! case FFEINFO_whereCONSTANT: /* Statement function. */ ! assert (!ffecom_transform_only_dummies_); ! t = ffecom_gen_sfuncdef_ (s, bt, kt); ! break; ! case FFEINFO_whereINTRINSIC: ! assert (!ffecom_transform_only_dummies_); ! break; /* Let actual references generate their ! decls. */ ! default: ! assert ("FUNCTION where unheard of" == NULL); ! /* Fall through. */ ! case FFEINFO_whereANY: ! t = error_mark_node; ! break; ! } ! break; ! case FFEINFO_kindSUBROUTINE: ! switch (ffeinfo_where (ffesymbol_info (s))) ! { ! case FFEINFO_whereLOCAL: /* Me. */ ! assert (!ffecom_transform_only_dummies_); ! t = current_function_decl; ! break; ! case FFEINFO_whereGLOBAL: ! assert (!ffecom_transform_only_dummies_); ! if (((g = ffesymbol_global (s)) != NULL) ! && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR) ! || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)) ! && (ffeglobal_hook (g) != NULL_TREE) ! && ffe_is_globals ()) ! { ! t = ffeglobal_hook (g); ! break; ! } ! push_obstacks_nochange (); ! end_temporary_allocation (); ! t = build_decl (FUNCTION_DECL, ! ffecom_get_external_identifier_ (s), ! ffecom_tree_subr_type); ! DECL_EXTERNAL (t) = 1; ! TREE_PUBLIC (t) = 1; ! t = start_decl (t, FALSE); ! finish_decl (t, NULL_TREE, FALSE); ! if ((g != NULL) ! && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR) ! || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))) ! ffeglobal_set_hook (g, t); ! resume_temporary_allocation (); ! pop_obstacks (); ! break; ! case FFEINFO_whereDUMMY: ! assert (ffecom_transform_only_dummies_); ! t = build_decl (PARM_DECL, ! ffecom_get_identifier_ (ffesymbol_text (s)), ! ffecom_tree_ptr_to_subr_type); ! #if BUILT_FOR_270 ! DECL_ARTIFICIAL (t) = 1; ! #endif ! addr = TRUE; ! break; ! case FFEINFO_whereINTRINSIC: ! assert (!ffecom_transform_only_dummies_); ! break; /* Let actual references generate their ! decls. */ ! default: ! assert ("SUBROUTINE where unheard of" == NULL); ! /* Fall through. */ ! case FFEINFO_whereANY: ! t = error_mark_node; break; } break; ! case FFEINFO_kindPROGRAM: ! switch (ffeinfo_where (ffesymbol_info (s))) ! { ! case FFEINFO_whereLOCAL: /* Me. */ ! assert (!ffecom_transform_only_dummies_); ! t = current_function_decl; ! break; ! case FFEINFO_whereCOMMON: ! case FFEINFO_whereDUMMY: ! case FFEINFO_whereGLOBAL: ! case FFEINFO_whereRESULT: ! case FFEINFO_whereFLEETING: ! case FFEINFO_whereFLEETING_CADDR: ! case FFEINFO_whereFLEETING_IADDR: ! case FFEINFO_whereIMMEDIATE: ! case FFEINFO_whereINTRINSIC: ! case FFEINFO_whereCONSTANT: ! case FFEINFO_whereCONSTANT_SUBOBJECT: ! default: ! assert ("PROGRAM where unheard of" == NULL); ! /* Fall through. */ ! case FFEINFO_whereANY: ! t = error_mark_node; break; } break; ! case FFEINFO_kindBLOCKDATA: ! switch (ffeinfo_where (ffesymbol_info (s))) ! { ! case FFEINFO_whereLOCAL: /* Me. */ ! assert (!ffecom_transform_only_dummies_); ! t = current_function_decl; ! break; ! case FFEINFO_whereGLOBAL: ! assert (!ffecom_transform_only_dummies_); ! push_obstacks_nochange (); ! end_temporary_allocation (); ! t = build_decl (FUNCTION_DECL, ! ffecom_get_external_identifier_ (s), ! ffecom_tree_blockdata_type); ! DECL_EXTERNAL (t) = 1; ! TREE_PUBLIC (t) = 1; ! t = start_decl (t, FALSE); ! finish_decl (t, NULL_TREE, FALSE); ! resume_temporary_allocation (); ! pop_obstacks (); ! break; ! case FFEINFO_whereCOMMON: ! case FFEINFO_whereDUMMY: ! case FFEINFO_whereRESULT: ! case FFEINFO_whereFLEETING: ! case FFEINFO_whereFLEETING_CADDR: ! case FFEINFO_whereFLEETING_IADDR: ! case FFEINFO_whereIMMEDIATE: ! case FFEINFO_whereINTRINSIC: ! case FFEINFO_whereCONSTANT: ! case FFEINFO_whereCONSTANT_SUBOBJECT: ! default: ! assert ("BLOCKDATA where unheard of" == NULL); ! /* Fall through. */ ! case FFEINFO_whereANY: ! t = error_mark_node; ! break; ! } ! break; ! case FFEINFO_kindCOMMON: ! switch (ffeinfo_where (ffesymbol_info (s))) ! { ! case FFEINFO_whereLOCAL: ! assert (!ffecom_transform_only_dummies_); ! ffecom_transform_common_ (s); ! break; ! case FFEINFO_whereNONE: ! case FFEINFO_whereCOMMON: ! case FFEINFO_whereDUMMY: ! case FFEINFO_whereGLOBAL: ! case FFEINFO_whereRESULT: ! case FFEINFO_whereFLEETING: ! case FFEINFO_whereFLEETING_CADDR: ! case FFEINFO_whereFLEETING_IADDR: ! case FFEINFO_whereIMMEDIATE: ! case FFEINFO_whereINTRINSIC: ! case FFEINFO_whereCONSTANT: ! case FFEINFO_whereCONSTANT_SUBOBJECT: ! default: ! assert ("COMMON where unheard of" == NULL); ! /* Fall through. */ ! case FFEINFO_whereANY: ! t = error_mark_node; ! break; ! } ! break; ! case FFEINFO_kindCONSTRUCT: ! switch (ffeinfo_where (ffesymbol_info (s))) ! { ! case FFEINFO_whereLOCAL: ! assert (!ffecom_transform_only_dummies_); ! break; ! case FFEINFO_whereNONE: ! case FFEINFO_whereCOMMON: ! case FFEINFO_whereDUMMY: ! case FFEINFO_whereGLOBAL: ! case FFEINFO_whereRESULT: ! case FFEINFO_whereFLEETING: ! case FFEINFO_whereFLEETING_CADDR: ! case FFEINFO_whereFLEETING_IADDR: ! case FFEINFO_whereIMMEDIATE: ! case FFEINFO_whereINTRINSIC: ! case FFEINFO_whereCONSTANT: ! case FFEINFO_whereCONSTANT_SUBOBJECT: ! default: ! assert ("CONSTRUCT where unheard of" == NULL); ! /* Fall through. */ ! case FFEINFO_whereANY: ! t = error_mark_node; ! break; ! } ! break; ! case FFEINFO_kindNAMELIST: ! switch (ffeinfo_where (ffesymbol_info (s))) ! { ! case FFEINFO_whereLOCAL: ! assert (!ffecom_transform_only_dummies_); ! t = ffecom_transform_namelist_ (s); ! break; ! case FFEINFO_whereNONE: ! case FFEINFO_whereCOMMON: ! case FFEINFO_whereDUMMY: ! case FFEINFO_whereGLOBAL: ! case FFEINFO_whereRESULT: ! case FFEINFO_whereFLEETING: ! case FFEINFO_whereFLEETING_CADDR: ! case FFEINFO_whereFLEETING_IADDR: ! case FFEINFO_whereIMMEDIATE: ! case FFEINFO_whereINTRINSIC: ! case FFEINFO_whereCONSTANT: ! case FFEINFO_whereCONSTANT_SUBOBJECT: ! default: ! assert ("NAMELIST where unheard of" == NULL); ! /* Fall through. */ ! case FFEINFO_whereANY: ! t = error_mark_node; ! break; ! } ! break; ! default: ! assert ("kind unheard of" == NULL); ! /* Fall through. */ ! case FFEINFO_kindANY: ! t = error_mark_node; ! break; ! } ! ffesymbol_hook (s).decl_tree = t; ! ffesymbol_hook (s).length_tree = tlen; ! ffesymbol_hook (s).addr = addr; ! lineno = old_lineno; ! input_filename = old_input_filename; ! return s; ! } #endif - /* Transform into ASSIGNable symbol. ! Symbol has already been transformed, but for whatever reason, the ! resulting decl_tree has been deemed not usable for an ASSIGN target. ! (E.g. it isn't wide enough to hold a pointer.) So, here we invent ! another local symbol of type void * and stuff that in the assign_tree ! argument. The F77/F90 standards allow this implementation. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static ffesymbol ! ffecom_sym_transform_assign_ (ffesymbol s) { ! tree t; /* Transformed thingy. */ ! int yes; ! int old_lineno = lineno; ! char *old_input_filename = input_filename; ! if (ffesymbol_sfdummyparent (s) == NULL) ! { ! input_filename = ffesymbol_where_filename (s); ! lineno = ffesymbol_where_filelinenum (s); ! } ! else { ! ffesymbol sf = ffesymbol_sfdummyparent (s); ! ! input_filename = ffesymbol_where_filename (sf); ! lineno = ffesymbol_where_filelinenum (sf); ! } ! assert (!ffecom_transform_only_dummies_); ! yes = suspend_momentary (); ! t = build_decl (VAR_DECL, ! ffecom_get_invented_identifier ("__g77_ASSIGN_%s", ! ffesymbol_text (s), ! 0), ! TREE_TYPE (null_pointer_node)); ! switch (ffesymbol_where (s)) ! { ! case FFEINFO_whereLOCAL: ! /* Unlike for regular vars, SAVE status is easy to determine for ! ASSIGNed vars, since there's no initialization, there's no ! effective storage association (so "SAVE J" does not apply to ! K even given "EQUIVALENCE (J,K)"), there's no size issue ! to worry about, etc. */ ! if ((ffesymbol_is_save (s) || ffe_is_saveall ()) ! && (ffecom_primary_entry_kind_ != FFEINFO_kindPROGRAM) ! && (ffecom_primary_entry_kind_ != FFEINFO_kindBLOCKDATA)) ! TREE_STATIC (t) = 1; /* SAVEd in proc, make static. */ ! else ! TREE_STATIC (t) = 0; /* No need to make static. */ break; ! case FFEINFO_whereCOMMON: ! TREE_STATIC (t) = 1; /* Assume COMMONs always SAVEd. */ ! break; ! case FFEINFO_whereDUMMY: ! /* Note that twinning a DUMMY means the caller won't see ! the ASSIGNed value. But both F77 and F90 allow implementations ! to do this, i.e. disallow Fortran code that would try and ! take advantage of actually putting a label into a variable ! via a dummy argument (or any other storage association, for ! that matter). */ ! TREE_STATIC (t) = 0; break; default: ! TREE_STATIC (t) = 0; ! break; } - - t = start_decl (t, FALSE); - finish_decl (t, NULL_TREE, FALSE); - - resume_momentary (yes); - - ffesymbol_hook (s).assign_tree = t; - - lineno = old_lineno; - input_filename = old_input_filename; - - return s; } #endif ! /* Implement COMMON area in back end. ! Because COMMON-based variables can be referenced in the dimension ! expressions of dummy (adjustable) arrays, and because dummies ! (in the gcc back end) need to be put in the outer binding level ! of a function (which has two binding levels, the outer holding ! the dummies and the inner holding the other vars), special care ! must be taken to handle COMMON areas. ! The current strategy is basically to always tell the back end about ! the COMMON area as a top-level external reference to just a block ! of storage of the master type of that area (e.g. integer, real, ! character, whatever -- not a structure). As a distinct action, ! if initial values are provided, tell the back end about the area ! as a top-level non-external (initialized) area and remember not to ! allow further initialization or expansion of the area. Meanwhile, ! if no initialization happens at all, tell the back end about ! the largest size we've seen declared so the space does get reserved. ! (This function doesn't handle all that stuff, but it does some ! of the important things.) ! Meanwhile, for COMMON variables themselves, just keep creating ! references like *((float *) (&common_area + offset)) each time ! we reference the variable. In other words, don't make a VAR_DECL ! or any kind of component reference (like we used to do before 0.4), ! though we might do that as well just for debugging purposes (and ! stuff the rtl with the appropriate offset expression). */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void ! ffecom_transform_common_ (ffesymbol s) ! { ! ffestorag st = ffesymbol_storage (s); ! ffeglobal g = ffesymbol_global (s); ! tree cbt; ! tree cbtype; ! tree init; ! tree high; ! bool is_init = ffestorag_is_init (st); ! assert (st != NULL); ! if ((g == NULL) ! || (ffeglobal_type (g) != FFEGLOBAL_typeCOMMON)) ! return; ! /* First update the size of the area in global terms. */ ! ffeglobal_size_common (s, ffestorag_size (st)); ! if (!ffeglobal_common_init (g)) ! is_init = FALSE; /* No explicit init, don't let erroneous joins init. */ ! cbt = ffeglobal_hook (g); ! /* If we already have declared this common block for a previous program ! unit, and either we already initialized it or we don't have new ! initialization for it, just return what we have without changing it. */ ! if ((cbt != NULL_TREE) ! && (!is_init ! || !DECL_EXTERNAL (cbt))) ! return; ! /* Process inits. */ ! if (is_init) { ! if (ffestorag_init (st) != NULL) ! { ! ffebld sexp; ! /* Set the padding for the expression, so ffecom_expr ! knows to insert that many zeros. */ ! switch (ffebld_op (sexp = ffestorag_init (st))) ! { ! case FFEBLD_opCONTER: ! ffebld_conter_set_pad (sexp, ffestorag_modulo (st)); ! break; ! case FFEBLD_opARRTER: ! ffebld_arrter_set_pad (sexp, ffestorag_modulo (st)); ! break; ! case FFEBLD_opACCTER: ! ffebld_accter_set_pad (sexp, ffestorag_modulo (st)); ! break; ! default: ! assert ("bad op for cmn init (pad)" == NULL); ! break; ! } ! init = ffecom_expr (sexp); ! if (init == error_mark_node) ! { /* Hopefully the back end complained! */ ! init = NULL_TREE; ! if (cbt != NULL_TREE) ! return; ! } ! } ! else ! init = error_mark_node; } - else - init = NULL_TREE; ! push_obstacks_nochange (); ! end_temporary_allocation (); ! /* cbtype must be permanently allocated! */ ! /* Allocate the MAX of the areas so far, seen filewide. */ ! high = build_int_2 ((ffeglobal_common_size (g) ! + ffeglobal_common_pad (g)) - 1, 0); ! TREE_TYPE (high) = ffecom_integer_type_node; ! if (init) ! cbtype = build_array_type (char_type_node, ! build_range_type (integer_type_node, ! integer_zero_node, ! high)); ! else ! cbtype = build_array_type (char_type_node, NULL_TREE); ! if (cbt == NULL_TREE) ! { ! cbt ! = build_decl (VAR_DECL, ! ffecom_get_external_identifier_ (s), ! cbtype); ! TREE_STATIC (cbt) = 1; ! TREE_PUBLIC (cbt) = 1; ! } ! else ! { ! assert (is_init); ! TREE_TYPE (cbt) = cbtype; ! } ! DECL_EXTERNAL (cbt) = init ? 0 : 1; ! DECL_INITIAL (cbt) = init ? error_mark_node : NULL_TREE; ! cbt = start_decl (cbt, TRUE); ! if (ffeglobal_hook (g) != NULL) ! assert (cbt == ffeglobal_hook (g)); ! assert (!init || !DECL_EXTERNAL (cbt)); ! /* Make sure that any type can live in COMMON and be referenced ! without getting a bus error. We could pick the most restrictive ! alignment of all entities actually placed in the COMMON, but ! this seems easy enough. */ ! DECL_ALIGN (cbt) = BIGGEST_ALIGNMENT; ! if (is_init && (ffestorag_init (st) == NULL)) ! init = ffecom_init_zero_ (cbt); ! finish_decl (cbt, init, TRUE); ! if (is_init) ! ffestorag_set_init (st, ffebld_new_any ()); ! if (init) { ! tree size_tree; ! assert (DECL_SIZE (cbt) != NULL_TREE); ! assert (TREE_CODE (DECL_SIZE (cbt)) == INTEGER_CST); ! size_tree = size_binop (CEIL_DIV_EXPR, ! DECL_SIZE (cbt), ! size_int (BITS_PER_UNIT)); ! assert (TREE_INT_CST_HIGH (size_tree) == 0); ! assert (TREE_INT_CST_LOW (size_tree) ! == ffeglobal_common_size (g) + ffeglobal_common_pad (g)); ! } ! ffeglobal_set_hook (g, cbt); ! ffestorag_set_hook (st, cbt); ! resume_temporary_allocation (); ! pop_obstacks (); } #endif - /* Make master area for local EQUIVALENCE. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void ! ffecom_transform_equiv_ (ffestorag eqst) { ! tree eqt; ! tree eqtype; ! tree init; ! tree high; ! bool is_init = ffestorag_is_init (eqst); ! int yes; ! assert (eqst != NULL); ! eqt = ffestorag_hook (eqst); ! if (eqt != NULL_TREE) ! return; ! /* Process inits. */ ! if (is_init) ! { ! if (ffestorag_init (eqst) != NULL) ! { ! ffebld sexp; ! /* Set the padding for the expression, so ffecom_expr ! knows to insert that many zeros. */ ! switch (ffebld_op (sexp = ffestorag_init (eqst))) ! { ! case FFEBLD_opCONTER: ! ffebld_conter_set_pad (sexp, ffestorag_modulo (eqst)); ! break; ! case FFEBLD_opARRTER: ! ffebld_arrter_set_pad (sexp, ffestorag_modulo (eqst)); ! break; ! case FFEBLD_opACCTER: ! ffebld_accter_set_pad (sexp, ffestorag_modulo (eqst)); ! break; ! default: ! assert ("bad op for eqv init (pad)" == NULL); ! break; ! } ! init = ffecom_expr (sexp); ! if (init == error_mark_node) ! init = NULL_TREE; /* Hopefully the back end complained! */ } else ! init = error_mark_node; ! } ! else if (ffe_is_init_local_zero ()) ! init = error_mark_node; ! else ! init = NULL_TREE; ! ! ffecom_member_namelisted_ = FALSE; ! ffestorag_drive (ffestorag_list_equivs (eqst), ! &ffecom_member_phase1_, ! eqst); ! yes = suspend_momentary (); ! high = build_int_2 ((ffestorag_size (eqst) ! + ffestorag_modulo (eqst)) - 1, 0); ! TREE_TYPE (high) = ffecom_integer_type_node; ! eqtype = build_array_type (char_type_node, ! build_range_type (ffecom_integer_type_node, ! ffecom_integer_zero_node, ! high)); ! eqt = build_decl (VAR_DECL, ! ffecom_get_invented_identifier ("__g77_equiv_%s", ! ffesymbol_text ! (ffestorag_symbol ! (eqst)), ! 0), ! eqtype); ! DECL_EXTERNAL (eqt) = 0; ! if (is_init ! || ffecom_member_namelisted_ ! #ifdef FFECOM_sizeMAXSTACKITEM ! || (ffestorag_size (eqst) > FFECOM_sizeMAXSTACKITEM) ! #endif ! || ((ffecom_primary_entry_kind_ != FFEINFO_kindPROGRAM) ! && (ffecom_primary_entry_kind_ != FFEINFO_kindBLOCKDATA) ! && (ffestorag_is_save (eqst) || ffe_is_saveall ()))) ! TREE_STATIC (eqt) = 1; ! else ! TREE_STATIC (eqt) = 0; ! TREE_PUBLIC (eqt) = 0; ! DECL_CONTEXT (eqt) = current_function_decl; ! if (init) ! DECL_INITIAL (eqt) = error_mark_node; ! else ! DECL_INITIAL (eqt) = NULL_TREE; ! eqt = start_decl (eqt, FALSE); ! /* Make sure that any type can live in EQUIVALENCE and be referenced ! without getting a bus error. We could pick the most restrictive ! alignment of all entities actually placed in the EQUIVALENCE, but ! this seems easy enough. */ ! DECL_ALIGN (eqt) = BIGGEST_ALIGNMENT; ! if ((!is_init && ffe_is_init_local_zero ()) ! || (is_init && (ffestorag_init (eqst) == NULL))) ! init = ffecom_init_zero_ (eqt); ! finish_decl (eqt, init, FALSE); ! if (is_init) ! ffestorag_set_init (eqst, ffebld_new_any ()); ! { ! tree size_tree; ! size_tree = size_binop (CEIL_DIV_EXPR, ! DECL_SIZE (eqt), ! size_int (BITS_PER_UNIT)); ! assert (TREE_INT_CST_HIGH (size_tree) == 0); ! assert (TREE_INT_CST_LOW (size_tree) ! == ffestorag_size (eqst) + ffestorag_modulo (eqst)); ! } ! ffestorag_set_hook (eqst, eqt); ! #ifdef SOMEONE_GETS_DEBUG_SUPPORT_WORKING ! ffestorag_drive (ffestorag_list_equivs (eqst), ! &ffecom_member_phase2_, ! eqst); ! #endif resume_momentary (yes); } #endif - /* Implement NAMELIST in back end. See f2c/format.c for more info. */ - #if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ! ffecom_transform_namelist_ (ffesymbol s) { ! tree nmlt; ! tree nmltype = ffecom_type_namelist_ (); ! tree nmlinits; ! tree nameinit; ! tree varsinit; ! tree nvarsinit; ! tree field; ! tree high; ! int yes; ! int i; ! static int mynumber = 0; ! yes = suspend_momentary (); ! nmlt = build_decl (VAR_DECL, ! ffecom_get_invented_identifier ("__g77_namelist_%d", ! NULL, mynumber++), ! nmltype); ! TREE_STATIC (nmlt) = 1; ! DECL_INITIAL (nmlt) = error_mark_node; ! nmlt = start_decl (nmlt, FALSE); ! /* Process inits. */ ! i = strlen (ffesymbol_text (s)); ! high = build_int_2 (i, 0); ! TREE_TYPE (high) = ffecom_f2c_ftnlen_type_node; ! nameinit = ffecom_build_f2c_string_ (i + 1, ! ffesymbol_text (s)); ! TREE_TYPE (nameinit) ! = build_type_variant ! (build_array_type ! (char_type_node, ! build_range_type (ffecom_f2c_ftnlen_type_node, ! ffecom_f2c_ftnlen_one_node, ! high)), ! 1, 0); ! TREE_CONSTANT (nameinit) = 1; ! TREE_STATIC (nameinit) = 1; ! nameinit = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (nameinit)), ! nameinit); ! varsinit = ffecom_vardesc_array_ (s); ! varsinit = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (varsinit)), ! varsinit); ! TREE_CONSTANT (varsinit) = 1; ! TREE_STATIC (varsinit) = 1; ! { ! ffebld b; ! for (i = 0, b = ffesymbol_namelist (s); b != NULL; b = ffebld_trail (b)) ! ++i; ! } ! nvarsinit = build_int_2 (i, 0); ! TREE_TYPE (nvarsinit) = integer_type_node; ! TREE_CONSTANT (nvarsinit) = 1; ! TREE_STATIC (nvarsinit) = 1; ! nmlinits = build_tree_list ((field = TYPE_FIELDS (nmltype)), nameinit); ! TREE_CHAIN (nmlinits) = build_tree_list ((field = TREE_CHAIN (field)), ! varsinit); ! TREE_CHAIN (TREE_CHAIN (nmlinits)) ! = build_tree_list ((field = TREE_CHAIN (field)), nvarsinit); ! nmlinits = build (CONSTRUCTOR, nmltype, NULL_TREE, nmlinits); ! TREE_CONSTANT (nmlinits) = 1; ! TREE_STATIC (nmlinits) = 1; ! finish_decl (nmlt, nmlinits, FALSE); ! nmlt = ffecom_1 (ADDR_EXPR, build_pointer_type (nmltype), nmlt); ! resume_momentary (yes); ! return nmlt; } #endif ! /* A subroutine of ffecom_tree_canonize_ref_. The incoming tree is ! analyzed on the assumption it is calculating a pointer to be ! indirected through. It must return the proper decl and offset, ! taking into account different units of measurements for offsets. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void ! ffecom_tree_canonize_ptr_ (tree *decl, tree *offset, ! tree t) { ! switch (TREE_CODE (t)) { ! case NOP_EXPR: ! case CONVERT_EXPR: ! case NON_LVALUE_EXPR: ! ffecom_tree_canonize_ptr_ (decl, offset, TREE_OPERAND (t, 0)); ! break; ! case PLUS_EXPR: ! ffecom_tree_canonize_ptr_ (decl, offset, TREE_OPERAND (t, 0)); ! if ((*decl == NULL_TREE) ! || (*decl == error_mark_node)) ! break; ! if (TREE_CODE (TREE_OPERAND (t, 1)) == INTEGER_CST) ! { ! /* An offset into COMMON. */ ! *offset = size_binop (PLUS_EXPR, ! *offset, ! TREE_OPERAND (t, 1)); ! /* Convert offset (presumably in bytes) into canonical units ! (presumably bits). */ ! *offset = size_binop (MULT_EXPR, ! TYPE_SIZE (TREE_TYPE (TREE_TYPE (t))), ! *offset); ! break; ! } ! /* Not a COMMON reference, so an unrecognized pattern. */ ! *decl = error_mark_node; break; ! case PARM_DECL: ! *decl = t; ! *offset = bitsize_int (0L, 0L); break; ! case ADDR_EXPR: ! if (TREE_CODE (TREE_OPERAND (t, 0)) == VAR_DECL) { ! /* A reference to COMMON. */ ! *decl = TREE_OPERAND (t, 0); ! *offset = bitsize_int (0L, 0L); break; } ! /* Fall through. */ ! default: ! /* Not a COMMON reference, so an unrecognized pattern. */ ! *decl = error_mark_node; ! break; ! } ! } ! #endif ! ! /* Given a tree that is possibly intended for use as an lvalue, return ! information representing a canonical view of that tree as a decl, an ! offset into that decl, and a size for the lvalue. ! ! If there's no applicable decl, NULL_TREE is returned for the decl, ! and the other fields are left undefined. ! ! If the tree doesn't fit the recognizable forms, an ERROR_MARK node ! is returned for the decl, and the other fields are left undefined. ! ! Otherwise, the decl returned currently is either a VAR_DECL or a ! PARM_DECL. ! ! The offset returned is always valid, but of course not necessarily ! a constant, and not necessarily converted into the appropriate ! type, leaving that up to the caller (so as to avoid that overhead ! if the decls being looked at are different anyway). ! ! If the size cannot be determined (e.g. an adjustable array), ! an ERROR_MARK node is returned for the size. Otherwise, the ! size returned is valid, not necessarily a constant, and not ! necessarily converted into the appropriate type as with the ! offset. ! ! Note that the offset and size expressions are expressed in the ! base storage units (usually bits) rather than in the units of ! the type of the decl, because two decls with different types ! might overlap but with apparently non-overlapping array offsets, ! whereas converting the array offsets to consistant offsets will ! reveal the overlap. */ ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void ! ffecom_tree_canonize_ref_ (tree *decl, tree *offset, ! tree *size, tree t) ! { ! /* The default path is to report a nonexistant decl. */ ! *decl = NULL_TREE; ! ! if (t == NULL_TREE) ! return; ! ! switch (TREE_CODE (t)) ! { ! case ERROR_MARK: ! case IDENTIFIER_NODE: ! case INTEGER_CST: ! case REAL_CST: ! case COMPLEX_CST: ! case STRING_CST: ! case CONST_DECL: ! case PLUS_EXPR: ! case MINUS_EXPR: ! case MULT_EXPR: ! case TRUNC_DIV_EXPR: ! case CEIL_DIV_EXPR: ! case FLOOR_DIV_EXPR: ! case ROUND_DIV_EXPR: ! case TRUNC_MOD_EXPR: ! case CEIL_MOD_EXPR: ! case FLOOR_MOD_EXPR: ! case ROUND_MOD_EXPR: ! case RDIV_EXPR: ! case EXACT_DIV_EXPR: ! case FIX_TRUNC_EXPR: ! case FIX_CEIL_EXPR: ! case FIX_FLOOR_EXPR: ! case FIX_ROUND_EXPR: ! case FLOAT_EXPR: ! case EXPON_EXPR: ! case NEGATE_EXPR: ! case MIN_EXPR: ! case MAX_EXPR: ! case ABS_EXPR: ! case FFS_EXPR: ! case LSHIFT_EXPR: ! case RSHIFT_EXPR: ! case LROTATE_EXPR: ! case RROTATE_EXPR: ! case BIT_IOR_EXPR: ! case BIT_XOR_EXPR: ! case BIT_AND_EXPR: ! case BIT_ANDTC_EXPR: ! case BIT_NOT_EXPR: ! case TRUTH_ANDIF_EXPR: ! case TRUTH_ORIF_EXPR: ! case TRUTH_AND_EXPR: ! case TRUTH_OR_EXPR: ! case TRUTH_XOR_EXPR: ! case TRUTH_NOT_EXPR: ! case LT_EXPR: ! case LE_EXPR: ! case GT_EXPR: ! case GE_EXPR: ! case EQ_EXPR: ! case NE_EXPR: ! case COMPLEX_EXPR: ! case CONJ_EXPR: ! case REALPART_EXPR: ! case IMAGPART_EXPR: ! case LABEL_EXPR: ! case COMPONENT_REF: ! case COMPOUND_EXPR: ! case ADDR_EXPR: ! return; ! case VAR_DECL: ! case PARM_DECL: ! *decl = t; ! *offset = bitsize_int (0L, 0L); ! *size = TYPE_SIZE (TREE_TYPE (t)); ! return; ! case ARRAY_REF: ! { ! tree array = TREE_OPERAND (t, 0); ! tree element = TREE_OPERAND (t, 1); ! tree init_offset; ! if ((array == NULL_TREE) ! || (element == NULL_TREE)) ! { ! *decl = error_mark_node; ! return; ! } ! ffecom_tree_canonize_ref_ (decl, &init_offset, size, ! array); ! if ((*decl == NULL_TREE) ! || (*decl == error_mark_node)) ! return; ! *offset = size_binop (MULT_EXPR, ! TYPE_SIZE (TREE_TYPE (TREE_TYPE (array))), ! size_binop (MINUS_EXPR, ! element, ! TYPE_MIN_VALUE ! (TYPE_DOMAIN ! (TREE_TYPE (array))))); ! *offset = size_binop (PLUS_EXPR, ! init_offset, ! *offset); ! *size = TYPE_SIZE (TREE_TYPE (t)); ! return; ! } ! case INDIRECT_REF: ! /* Most of this code is to handle references to COMMON. And so ! far that is useful only for calling library functions, since ! external (user) functions might reference common areas. But ! even calling an external function, it's worthwhile to decode ! COMMON references because if not storing into COMMON, we don't ! want COMMON-based arguments to gratuitously force use of a ! temporary. */ ! *size = TYPE_SIZE (TREE_TYPE (t)); ! ffecom_tree_canonize_ptr_ (decl, offset, ! TREE_OPERAND (t, 0)); ! return; - case CONVERT_EXPR: - case NOP_EXPR: - case MODIFY_EXPR: - case NON_LVALUE_EXPR: - case RESULT_DECL: - case FIELD_DECL: - case COND_EXPR: /* More cases than we can handle. */ - case SAVE_EXPR: - case REFERENCE_EXPR: - case PREDECREMENT_EXPR: - case PREINCREMENT_EXPR: - case POSTDECREMENT_EXPR: - case POSTINCREMENT_EXPR: - case CALL_EXPR: default: ! *decl = error_mark_node; ! return; } - } - #endif - - /* Do divide operation appropriate to type of operands. */ - - #if FFECOM_targetCURRENT == FFECOM_targetGCC - static tree - ffecom_tree_divide_ (tree tree_type, tree left, tree right, - tree dest_tree, ffebld dest, bool *dest_used) - { - if ((left == error_mark_node) - || (right == error_mark_node)) - return error_mark_node; ! switch (TREE_CODE (tree_type)) ! { ! case INTEGER_TYPE: ! return ffecom_2 (TRUNC_DIV_EXPR, tree_type, ! left, ! right); ! case COMPLEX_TYPE: ! { ! ffecomGfrt ix; ! if (TREE_TYPE (tree_type) ! == ffecom_tree_type [FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1]) ! ix = FFECOM_gfrtDIV_CC; /* Overlapping result okay. */ ! else ! ix = FFECOM_gfrtDIV_ZZ; /* Overlapping result okay. */ ! left = ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (left)), ! left); ! left = build_tree_list (NULL_TREE, left); ! right = ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (right)), ! right); ! right = build_tree_list (NULL_TREE, right); ! TREE_CHAIN (left) = right; ! return ffecom_call_ (ffecom_gfrt_tree_ (ix), ! ffecom_gfrt_kindtype (ix), ! ffe_is_f2c_library (), ! tree_type, ! left, ! dest_tree, dest, dest_used, ! NULL_TREE, TRUE); ! } ! break; ! case RECORD_TYPE: ! { ! ffecomGfrt ix; ! if (TREE_TYPE (TYPE_FIELDS (tree_type)) ! == ffecom_tree_type [FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1]) ! ix = FFECOM_gfrtDIV_CC; /* Overlapping result okay. */ ! else ! ix = FFECOM_gfrtDIV_ZZ; /* Overlapping result okay. */ ! left = ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (left)), ! left); ! left = build_tree_list (NULL_TREE, left); ! right = ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (right)), ! right); ! right = build_tree_list (NULL_TREE, right); ! TREE_CHAIN (left) = right; ! return ffecom_call_ (ffecom_gfrt_tree_ (ix), ! ffecom_gfrt_kindtype (ix), ! ffe_is_f2c_library (), ! tree_type, ! left, ! dest_tree, dest, dest_used, ! NULL_TREE, TRUE); ! } ! break; ! default: ! return ffecom_2 (RDIV_EXPR, tree_type, ! left, ! right); } - } ! #endif ! /* ffecom_type_localvar_ -- Build type info for non-dummy variable ! tree type; ! ffesymbol s; // the variable's symbol ! ffeinfoBasictype bt; // it's basictype ! ffeinfoKindtype kt; // it's kindtype ! type = ffecom_type_localvar_(s,bt,kt); ! Handles static arrays, CHARACTER type, etc. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_type_localvar_ (ffesymbol s, ffeinfoBasictype bt, ! ffeinfoKindtype kt) ! { ! tree type; ! ffebld dl; ! ffebld dim; ! tree lowt; ! tree hight; ! type = ffecom_tree_type[bt][kt]; ! if (bt == FFEINFO_basictypeCHARACTER) ! { ! hight = build_int_2 (ffesymbol_size (s), 0); ! TREE_TYPE (hight) = ffecom_f2c_ftnlen_type_node; ! type ! = build_array_type ! (type, ! build_range_type (ffecom_f2c_ftnlen_type_node, ! ffecom_f2c_ftnlen_one_node, ! hight)); ! type = ffecom_check_size_overflow_ (s, type, FALSE); } ! for (dl = ffesymbol_dims (s); dl != NULL; dl = ffebld_trail (dl)) { ! if (type == error_mark_node) ! break; ! dim = ffebld_head (dl); ! assert (ffebld_op (dim) == FFEBLD_opBOUNDS); ! if (ffebld_left (dim) == NULL) ! lowt = integer_one_node; ! else ! lowt = ffecom_expr (ffebld_left (dim)); ! if (TREE_CODE (lowt) != INTEGER_CST) ! lowt = variable_size (lowt); ! assert (ffebld_right (dim) != NULL); ! hight = ffecom_expr (ffebld_right (dim)); ! if (TREE_CODE (hight) != INTEGER_CST) ! hight = variable_size (hight); ! type = build_array_type (type, ! build_range_type (ffecom_integer_type_node, ! lowt, hight)); ! type = ffecom_check_size_overflow_ (s, type, FALSE); } ! return type; } #endif ! /* Build Namelist type. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_type_namelist_ () { ! static tree type = NULL_TREE; ! ! if (type == NULL_TREE) ! { ! static tree namefield, varsfield, nvarsfield; ! tree vardesctype; ! vardesctype = ffecom_type_vardesc_ (); ! push_obstacks_nochange (); ! end_temporary_allocation (); ! type = make_node (RECORD_TYPE); ! vardesctype = build_pointer_type (build_pointer_type (vardesctype)); ! namefield = ffecom_decl_field (type, NULL_TREE, "name", ! string_type_node); ! varsfield = ffecom_decl_field (type, namefield, "vars", vardesctype); ! nvarsfield = ffecom_decl_field (type, varsfield, "nvars", ! integer_type_node); ! TYPE_FIELDS (type) = namefield; ! layout_type (type); ! resume_temporary_allocation (); ! pop_obstacks (); ! } ! return type; } #endif ! /* Make a copy of a type, assuming caller has switched to the permanent ! obstacks and that the type is for an aggregate (array) initializer. */ ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC && 0 /* Not used now. */ ! static tree ! ffecom_type_permanent_copy_ (tree t) { ! tree domain; ! tree max; ! assert (TREE_TYPE (t) != NULL_TREE); ! domain = TYPE_DOMAIN (t); ! assert (TREE_CODE (t) == ARRAY_TYPE); ! assert (TREE_PERMANENT (TREE_TYPE (t))); ! assert (TREE_PERMANENT (TREE_TYPE (domain))); ! assert (TREE_PERMANENT (TYPE_MIN_VALUE (domain))); ! max = TYPE_MAX_VALUE (domain); ! if (!TREE_PERMANENT (max)) ! { ! assert (TREE_CODE (max) == INTEGER_CST); ! max = build_int_2 (TREE_INT_CST_LOW (max), TREE_INT_CST_HIGH (max)); ! TREE_TYPE (max) = TREE_TYPE (TYPE_MIN_VALUE (domain)); ! } ! return build_array_type (TREE_TYPE (t), ! build_range_type (TREE_TYPE (domain), ! TYPE_MIN_VALUE (domain), ! max)); } #endif ! /* Build Vardesc type. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_type_vardesc_ () ! { ! static tree type = NULL_TREE; ! static tree namefield, addrfield, dimsfield, typefield; ! if (type == NULL_TREE) ! { ! push_obstacks_nochange (); ! end_temporary_allocation (); ! type = make_node (RECORD_TYPE); ! namefield = ffecom_decl_field (type, NULL_TREE, "name", ! string_type_node); ! addrfield = ffecom_decl_field (type, namefield, "addr", ! string_type_node); ! dimsfield = ffecom_decl_field (type, addrfield, "dims", ! ffecom_f2c_ptr_to_ftnlen_type_node); ! typefield = ffecom_decl_field (type, dimsfield, "type", ! integer_type_node); ! TYPE_FIELDS (type) = namefield; ! layout_type (type); ! resume_temporary_allocation (); ! pop_obstacks (); ! } ! return type; } #endif ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_vardesc_ (ffebld expr) { ! ffesymbol s; ! assert (ffebld_op (expr) == FFEBLD_opSYMTER); ! s = ffebld_symter (expr); ! if (ffesymbol_hook (s).vardesc_tree == NULL_TREE) { ! int i; ! tree vardesctype = ffecom_type_vardesc_ (); ! tree var; ! tree nameinit; ! tree dimsinit; ! tree addrinit; ! tree typeinit; ! tree field; ! tree varinits; ! int yes; ! static int mynumber = 0; ! yes = suspend_momentary (); ! var = build_decl (VAR_DECL, ! ffecom_get_invented_identifier ("__g77_vardesc_%d", ! NULL, mynumber++), ! vardesctype); ! TREE_STATIC (var) = 1; ! DECL_INITIAL (var) = error_mark_node; ! var = start_decl (var, FALSE); ! /* Process inits. */ ! nameinit = ffecom_build_f2c_string_ ((i = strlen (ffesymbol_text (s))) ! + 1, ! ffesymbol_text (s)); ! TREE_TYPE (nameinit) ! = build_type_variant ! (build_array_type ! (char_type_node, ! build_range_type (integer_type_node, ! integer_one_node, ! build_int_2 (i, 0))), ! 1, 0); ! TREE_CONSTANT (nameinit) = 1; ! TREE_STATIC (nameinit) = 1; ! nameinit = ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (nameinit)), ! nameinit); ! addrinit = ffecom_arg_ptr_to_expr (expr, &typeinit); ! dimsinit = ffecom_vardesc_dims_ (s); ! if (typeinit == NULL_TREE) ! { ! ffeinfoBasictype bt = ffesymbol_basictype (s); ! ffeinfoKindtype kt = ffesymbol_kindtype (s); ! int tc = ffecom_f2c_typecode (bt, kt); ! assert (tc != -1); ! typeinit = build_int_2 (tc, (tc < 0) ? -1 : 0); ! } ! else ! typeinit = ffecom_1 (NEGATE_EXPR, TREE_TYPE (typeinit), typeinit); ! varinits = build_tree_list ((field = TYPE_FIELDS (vardesctype)), ! nameinit); ! TREE_CHAIN (varinits) = build_tree_list ((field = TREE_CHAIN (field)), ! addrinit); ! TREE_CHAIN (TREE_CHAIN (varinits)) ! = build_tree_list ((field = TREE_CHAIN (field)), dimsinit); ! TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (varinits))) ! = build_tree_list ((field = TREE_CHAIN (field)), typeinit); ! varinits = build (CONSTRUCTOR, vardesctype, NULL_TREE, varinits); ! TREE_CONSTANT (varinits) = 1; ! TREE_STATIC (varinits) = 1; ! finish_decl (var, varinits, FALSE); ! var = ffecom_1 (ADDR_EXPR, build_pointer_type (vardesctype), var); ! resume_momentary (yes); ! ffesymbol_hook (s).vardesc_tree = var; } ! return ffesymbol_hook (s).vardesc_tree; ! } #endif - #if FFECOM_targetCURRENT == FFECOM_targetGCC - static tree - ffecom_vardesc_array_ (ffesymbol s) - { - ffebld b; - tree list; - tree item = NULL_TREE; - tree var; - int i; - int yes; - static int mynumber = 0; ! for (i = 0, list = NULL_TREE, b = ffesymbol_namelist (s); ! b != NULL; ! b = ffebld_trail (b), ++i) ! { ! tree t; ! t = ffecom_vardesc_ (ffebld_head (b)); ! if (list == NULL_TREE) ! list = item = build_tree_list (NULL_TREE, t); ! else { ! TREE_CHAIN (item) = build_tree_list (NULL_TREE, t); ! item = TREE_CHAIN (item); } ! } ! yes = suspend_momentary (); ! item = build_array_type (build_pointer_type (ffecom_type_vardesc_ ()), ! build_range_type (integer_type_node, ! integer_one_node, ! build_int_2 (i, 0))); ! list = build (CONSTRUCTOR, item, NULL_TREE, list); ! TREE_CONSTANT (list) = 1; ! TREE_STATIC (list) = 1; ! var = ffecom_get_invented_identifier ("__g77_vardesc_array_%d", NULL, ! mynumber++); ! var = build_decl (VAR_DECL, var, item); ! TREE_STATIC (var) = 1; ! DECL_INITIAL (var) = error_mark_node; ! var = start_decl (var, FALSE); ! finish_decl (var, list, FALSE); ! resume_momentary (yes); ! return var; ! } #endif - #if FFECOM_targetCURRENT == FFECOM_targetGCC - static tree - ffecom_vardesc_dims_ (ffesymbol s) - { - if (ffesymbol_dims (s) == NULL) - return convert (ffecom_f2c_ptr_to_ftnlen_type_node, - integer_zero_node); - - { - ffebld b; - ffebld e; - tree list; - tree backlist; - tree item = NULL_TREE; - tree var; - int yes; - tree numdim; - tree numelem; - tree baseoff = NULL_TREE; - static int mynumber = 0; - - numdim = build_int_2 ((int) ffesymbol_rank (s), 0); - TREE_TYPE (numdim) = ffecom_f2c_ftnlen_type_node; ! numelem = ffecom_expr (ffesymbol_arraysize (s)); ! TREE_TYPE (numelem) = ffecom_f2c_ftnlen_type_node; ! list = NULL_TREE; ! backlist = NULL_TREE; ! for (b = ffesymbol_dims (s), e = ffesymbol_extents (s); ! b != NULL; ! b = ffebld_trail (b), e = ffebld_trail (e)) { ! tree t; ! tree low; ! tree back; ! ! if (ffebld_trail (b) == NULL) ! t = NULL_TREE; else { ! t = convert (ffecom_f2c_ftnlen_type_node, ! ffecom_expr (ffebld_head (e))); ! ! if (list == NULL_TREE) ! list = item = build_tree_list (NULL_TREE, t); ! else ! { ! TREE_CHAIN (item) = build_tree_list (NULL_TREE, t); ! item = TREE_CHAIN (item); ! } } ! if (ffebld_left (ffebld_head (b)) == NULL) ! low = ffecom_integer_one_node; ! else ! low = ffecom_expr (ffebld_left (ffebld_head (b))); ! low = convert (ffecom_f2c_ftnlen_type_node, low); ! ! back = build_tree_list (low, t); ! TREE_CHAIN (back) = backlist; ! backlist = back; ! } ! ! for (item = backlist; item != NULL_TREE; item = TREE_CHAIN (item)) ! { ! if (TREE_VALUE (item) == NULL_TREE) ! baseoff = TREE_PURPOSE (item); ! else ! baseoff = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node, ! TREE_PURPOSE (item), ! ffecom_2 (MULT_EXPR, ! ffecom_f2c_ftnlen_type_node, ! TREE_VALUE (item), ! baseoff)); } ! /* backlist now dead, along with all TREE_PURPOSEs on it. */ ! ! baseoff = build_tree_list (NULL_TREE, baseoff); ! TREE_CHAIN (baseoff) = list; ! ! numelem = build_tree_list (NULL_TREE, numelem); ! TREE_CHAIN (numelem) = baseoff; ! numdim = build_tree_list (NULL_TREE, numdim); ! TREE_CHAIN (numdim) = numelem; ! yes = suspend_momentary (); ! item = build_array_type (ffecom_f2c_ftnlen_type_node, ! build_range_type (integer_type_node, ! integer_zero_node, ! build_int_2 ! ((int) ffesymbol_rank (s) ! + 2, 0))); ! list = build (CONSTRUCTOR, item, NULL_TREE, numdim); ! TREE_CONSTANT (list) = 1; ! TREE_STATIC (list) = 1; ! var = ffecom_get_invented_identifier ("__g77_dims_%d", NULL, ! mynumber++); ! var = build_decl (VAR_DECL, var, item); ! TREE_STATIC (var) = 1; ! DECL_INITIAL (var) = error_mark_node; ! var = start_decl (var, FALSE); ! finish_decl (var, list, FALSE); ! var = ffecom_1 (ADDR_EXPR, build_pointer_type (item), var); ! resume_momentary (yes); ! return var; ! } } - #endif - /* Essentially does a "fold (build1 (code, type, node))" while checking - for certain housekeeping things. ! NOTE: for building an ADDR_EXPR around a FUNCTION_DECL, use ! ffecom_1_fn instead. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC tree ! ffecom_1 (enum tree_code code, tree type, tree node) { tree item; ! if ((node == error_mark_node) ! || (type == error_mark_node)) ! return error_mark_node; ! ! if (code == ADDR_EXPR) { ! if (!mark_addressable (node)) ! assert ("can't mark_addressable this node!" == NULL); ! } ! switch (ffe_is_emulate_complex () ? code : NOP_EXPR) ! { ! tree realtype; ! case REALPART_EXPR: ! item = build (COMPONENT_REF, type, node, TYPE_FIELDS (TREE_TYPE (node))); ! break; ! case IMAGPART_EXPR: ! item = build (COMPONENT_REF, type, node, TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (node)))); ! break; ! case NEGATE_EXPR: ! if (TREE_CODE (type) != RECORD_TYPE) ! { ! item = build1 (code, type, node); ! break; ! } ! node = ffecom_stabilize_aggregate_ (node); ! realtype = TREE_TYPE (TYPE_FIELDS (type)); ! item = ! ffecom_2 (COMPLEX_EXPR, type, ! ffecom_1 (NEGATE_EXPR, realtype, ! ffecom_1 (REALPART_EXPR, realtype, ! node)), ! ffecom_1 (NEGATE_EXPR, realtype, ! ffecom_1 (IMAGPART_EXPR, realtype, ! node))); break; ! default: ! item = build1 (code, type, node); break; - } ! if (TREE_SIDE_EFFECTS (node)) ! TREE_SIDE_EFFECTS (item) = 1; ! if ((code == ADDR_EXPR) && staticp (node)) ! TREE_CONSTANT (item) = 1; ! return fold (item); ! } #endif ! /* Like ffecom_1 (ADDR_EXPR, TREE_TYPE (node), node), except ! handles TREE_CODE (node) == FUNCTION_DECL. In particular, ! does not set TREE_ADDRESSABLE (because calling an inline ! function does not mean the function needs to be separately ! compiled). */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_1_fn (tree node) ! { ! tree item; ! tree type; ! if (node == error_mark_node) ! return error_mark_node; ! type = build_type_variant (TREE_TYPE (node), ! TREE_READONLY (node), ! TREE_THIS_VOLATILE (node)); ! item = build1 (ADDR_EXPR, ! build_pointer_type (type), node); ! if (TREE_SIDE_EFFECTS (node)) ! TREE_SIDE_EFFECTS (item) = 1; ! if (staticp (node)) ! TREE_CONSTANT (item) = 1; ! return fold (item); ! } #endif ! /* Essentially does a "fold (build (code, type, node1, node2))" while ! checking for certain housekeeping things. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_2 (enum tree_code code, tree type, tree node1, ! tree node2) ! { ! tree item; ! if ((node1 == error_mark_node) ! || (node2 == error_mark_node) ! || (type == error_mark_node)) ! return error_mark_node; ! switch (ffe_is_emulate_complex () ? code : NOP_EXPR) ! { ! tree a, b, c, d, realtype; ! case CONJ_EXPR: ! assert ("no CONJ_EXPR support yet" == NULL); ! return error_mark_node; ! case COMPLEX_EXPR: ! item = build_tree_list (TYPE_FIELDS (type), node1); ! TREE_CHAIN (item) = build_tree_list (TREE_CHAIN (TYPE_FIELDS (type)), node2); ! item = build (CONSTRUCTOR, type, NULL_TREE, item); ! break; ! case PLUS_EXPR: ! if (TREE_CODE (type) != RECORD_TYPE) ! { ! item = build (code, type, node1, node2); ! break; ! } ! node1 = ffecom_stabilize_aggregate_ (node1); ! node2 = ffecom_stabilize_aggregate_ (node2); ! realtype = TREE_TYPE (TYPE_FIELDS (type)); ! item = ! ffecom_2 (COMPLEX_EXPR, type, ! ffecom_2 (PLUS_EXPR, realtype, ! ffecom_1 (REALPART_EXPR, realtype, ! node1), ! ffecom_1 (REALPART_EXPR, realtype, ! node2)), ! ffecom_2 (PLUS_EXPR, realtype, ! ffecom_1 (IMAGPART_EXPR, realtype, ! node1), ! ffecom_1 (IMAGPART_EXPR, realtype, ! node2))); break; ! case MINUS_EXPR: ! if (TREE_CODE (type) != RECORD_TYPE) ! { ! item = build (code, type, node1, node2); ! break; ! } ! node1 = ffecom_stabilize_aggregate_ (node1); ! node2 = ffecom_stabilize_aggregate_ (node2); ! realtype = TREE_TYPE (TYPE_FIELDS (type)); ! item = ! ffecom_2 (COMPLEX_EXPR, type, ! ffecom_2 (MINUS_EXPR, realtype, ! ffecom_1 (REALPART_EXPR, realtype, ! node1), ! ffecom_1 (REALPART_EXPR, realtype, ! node2)), ! ffecom_2 (MINUS_EXPR, realtype, ! ffecom_1 (IMAGPART_EXPR, realtype, ! node1), ! ffecom_1 (IMAGPART_EXPR, realtype, ! node2))); ! break; ! case MULT_EXPR: ! if (TREE_CODE (type) != RECORD_TYPE) ! { ! item = build (code, type, node1, node2); ! break; ! } ! node1 = ffecom_stabilize_aggregate_ (node1); ! node2 = ffecom_stabilize_aggregate_ (node2); ! realtype = TREE_TYPE (TYPE_FIELDS (type)); ! a = save_expr (ffecom_1 (REALPART_EXPR, realtype, ! node1)); ! b = save_expr (ffecom_1 (IMAGPART_EXPR, realtype, ! node1)); ! c = save_expr (ffecom_1 (REALPART_EXPR, realtype, ! node2)); ! d = save_expr (ffecom_1 (IMAGPART_EXPR, realtype, ! node2)); ! item = ! ffecom_2 (COMPLEX_EXPR, type, ! ffecom_2 (MINUS_EXPR, realtype, ! ffecom_2 (MULT_EXPR, realtype, ! a, ! c), ! ffecom_2 (MULT_EXPR, realtype, ! b, ! d)), ! ffecom_2 (PLUS_EXPR, realtype, ! ffecom_2 (MULT_EXPR, realtype, ! a, ! d), ! ffecom_2 (MULT_EXPR, realtype, ! c, ! b))); ! break; ! case EQ_EXPR: ! if ((TREE_CODE (node1) != RECORD_TYPE) ! && (TREE_CODE (node2) != RECORD_TYPE)) ! { ! item = build (code, type, node1, node2); ! break; ! } ! assert (TREE_CODE (node1) == RECORD_TYPE); ! assert (TREE_CODE (node2) == RECORD_TYPE); ! node1 = ffecom_stabilize_aggregate_ (node1); ! node2 = ffecom_stabilize_aggregate_ (node2); ! realtype = TREE_TYPE (TYPE_FIELDS (type)); ! item = ! ffecom_2 (TRUTH_ANDIF_EXPR, type, ! ffecom_2 (code, type, ! ffecom_1 (REALPART_EXPR, realtype, ! node1), ! ffecom_1 (REALPART_EXPR, realtype, ! node2)), ! ffecom_2 (code, type, ! ffecom_1 (IMAGPART_EXPR, realtype, ! node1), ! ffecom_1 (IMAGPART_EXPR, realtype, ! node2))); break; ! case NE_EXPR: ! if ((TREE_CODE (node1) != RECORD_TYPE) ! && (TREE_CODE (node2) != RECORD_TYPE)) ! { ! item = build (code, type, node1, node2); ! break; ! } ! assert (TREE_CODE (node1) == RECORD_TYPE); ! assert (TREE_CODE (node2) == RECORD_TYPE); ! node1 = ffecom_stabilize_aggregate_ (node1); ! node2 = ffecom_stabilize_aggregate_ (node2); ! realtype = TREE_TYPE (TYPE_FIELDS (type)); ! item = ! ffecom_2 (TRUTH_ORIF_EXPR, type, ! ffecom_2 (code, type, ! ffecom_1 (REALPART_EXPR, realtype, ! node1), ! ffecom_1 (REALPART_EXPR, realtype, ! node2)), ! ffecom_2 (code, type, ! ffecom_1 (IMAGPART_EXPR, realtype, ! node1), ! ffecom_1 (IMAGPART_EXPR, realtype, ! node2))); break; default: ! item = build (code, type, node1, node2); ! break; } ! if (TREE_SIDE_EFFECTS (node1) || TREE_SIDE_EFFECTS (node2)) ! TREE_SIDE_EFFECTS (item) = 1; ! return fold (item); } #endif - /* ffecom_2pass_advise_entrypoint -- Advise that there's this entrypoint ! ffesymbol s; // the ENTRY point itself ! if (ffecom_2pass_advise_entrypoint(s)) ! // the ENTRY point has been accepted ! Does whatever compiler needs to do when it learns about the entrypoint, ! like determine the return type of the master function, count the ! number of entrypoints, etc. Returns FALSE if the return type is ! not compatible with the return type(s) of other entrypoint(s). ! NOTE: for every call to this fn that returns TRUE, _do_entrypoint must ! later (after _finish_progunit) be called with the same entrypoint(s) ! as passed to this fn for which TRUE was returned. ! 03-Jan-92 JCB 2.0 ! Return FALSE if the return type conflicts with previous entrypoints. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! bool ! ffecom_2pass_advise_entrypoint (ffesymbol entry) { ! ffebld list; /* opITEM. */ ! ffebld mlist; /* opITEM. */ ! ffebld plist; /* opITEM. */ ! ffebld arg; /* ffebld_head(opITEM). */ ! ffebld item; /* opITEM. */ ! ffesymbol s; /* ffebld_symter(arg). */ ! ffeinfoBasictype bt = ffesymbol_basictype (entry); ! ffeinfoKindtype kt = ffesymbol_kindtype (entry); ! ffetargetCharacterSize size = ffesymbol_size (entry); ! bool ok; ! if (ffecom_num_entrypoints_ == 0) ! { /* First entrypoint, make list of main ! arglist's dummies. */ ! assert (ffecom_primary_entry_ != NULL); ! ffecom_master_bt_ = ffesymbol_basictype (ffecom_primary_entry_); ! ffecom_master_kt_ = ffesymbol_kindtype (ffecom_primary_entry_); ! ffecom_master_size_ = ffesymbol_size (ffecom_primary_entry_); ! for (plist = NULL, list = ffesymbol_dummyargs (ffecom_primary_entry_); ! list != NULL; ! list = ffebld_trail (list)) { ! arg = ffebld_head (list); ! if (ffebld_op (arg) != FFEBLD_opSYMTER) ! continue; /* Alternate return or some such thing. */ ! item = ffebld_new_item (arg, NULL); ! if (plist == NULL) ! ffecom_master_arglist_ = item; ! else ! ffebld_set_trail (plist, item); ! plist = item; } } ! /* If necessary, scan entry arglist for alternate returns. Do this scan ! apparently redundantly (it's done below to UNIONize the arglists) so ! that we don't complain about RETURN 1 if an offending ENTRY is the only ! one with an alternate return. */ ! if (!ffecom_is_altreturning_) { ! for (list = ffesymbol_dummyargs (entry); ! list != NULL; ! list = ffebld_trail (list)) ! { ! arg = ffebld_head (list); ! if (ffebld_op (arg) == FFEBLD_opSTAR) ! { ! ffecom_is_altreturning_ = TRUE; ! break; ! } ! } } ! /* Now check type compatibility. */ ! switch (ffecom_master_bt_) ! { ! case FFEINFO_basictypeNONE: ! ok = (bt != FFEINFO_basictypeCHARACTER); ! break; ! case FFEINFO_basictypeCHARACTER: ! ok ! = (bt == FFEINFO_basictypeCHARACTER) ! && (kt == ffecom_master_kt_) ! && (size == ffecom_master_size_); ! break; ! case FFEINFO_basictypeANY: ! return FALSE; /* Just don't bother. */ ! default: ! if (bt == FFEINFO_basictypeCHARACTER) { ! ok = FALSE; ! break; } ! ok = TRUE; ! if ((bt != ffecom_master_bt_) || (kt != ffecom_master_kt_)) { ! ffecom_master_bt_ = FFEINFO_basictypeNONE; ! ffecom_master_kt_ = FFEINFO_kindtypeNONE; } - break; - } ! if (!ok) ! { ! ffebad_start (FFEBAD_ENTRY_CONFLICTS); ! ffest_ffebad_here_current_stmt (0); ! ffebad_finish (); ! return FALSE; /* Can't handle entrypoint. */ ! } ! /* Entrypoint type compatible with previous types. */ ! ++ffecom_num_entrypoints_; ! /* Master-arg-list = UNION(Master-arg-list,entry-arg-list). */ ! for (list = ffesymbol_dummyargs (entry); ! list != NULL; ! list = ffebld_trail (list)) ! { ! arg = ffebld_head (list); ! if (ffebld_op (arg) != FFEBLD_opSYMTER) ! continue; /* Alternate return or some such thing. */ ! s = ffebld_symter (arg); ! for (plist = NULL, mlist = ffecom_master_arglist_; ! mlist != NULL; ! plist = mlist, mlist = ffebld_trail (mlist)) ! { /* plist points to previous item for easy ! appending of arg. */ ! if (ffebld_symter (ffebld_head (mlist)) == s) ! break; /* Already have this arg in the master list. */ } ! if (mlist != NULL) ! continue; /* Already have this arg in the master list. */ ! ! /* Append this arg to the master list. */ ! item = ffebld_new_item (arg, NULL); ! if (plist == NULL) ! ffecom_master_arglist_ = item; else ! ffebld_set_trail (plist, item); } ! return TRUE; } #endif ! /* ffecom_2pass_do_entrypoint -- Do compilation of entrypoint ! ffesymbol s; // the ENTRY point itself ! ffecom_2pass_do_entrypoint(s); ! Does whatever compiler needs to do to make the entrypoint actually ! happen. Must be called for each entrypoint after ! ffecom_finish_progunit is called. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! void ! ffecom_2pass_do_entrypoint (ffesymbol entry) { ! static int mfn_num = 0; ! static int ent_num; ! ! if (mfn_num != ffecom_num_fns_) ! { /* First entrypoint for this program unit. */ ! ent_num = 1; ! mfn_num = ffecom_num_fns_; ! ffecom_do_entry_ (ffecom_primary_entry_, 0); ! } ! else ! ++ent_num; ! ! --ffecom_num_entrypoints_; ! ! ffecom_do_entry_ (entry, ent_num); } #endif ! ! /* Essentially does a "fold (build (code, type, node1, node2))" while ! checking for certain housekeeping things. Always sets ! TREE_SIDE_EFFECTS. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC tree ! ffecom_2s (enum tree_code code, tree type, tree node1, ! tree node2) { ! tree item; ! ! if ((node1 == error_mark_node) ! || (node2 == error_mark_node) ! || (type == error_mark_node)) ! return error_mark_node; ! ! item = build (code, type, node1, node2); ! TREE_SIDE_EFFECTS (item) = 1; ! return fold (item); } #endif ! /* Essentially does a "fold (build (code, type, node1, node2, node3))" while ! checking for certain housekeeping things. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC tree ! ffecom_3 (enum tree_code code, tree type, tree node1, ! tree node2, tree node3) { ! tree item; ! ! if ((node1 == error_mark_node) ! || (node2 == error_mark_node) ! || (node3 == error_mark_node) ! || (type == error_mark_node)) ! return error_mark_node; ! ! item = build (code, type, node1, node2, node3); ! if (TREE_SIDE_EFFECTS (node1) || TREE_SIDE_EFFECTS (node2) ! || (node3 != NULL_TREE && TREE_SIDE_EFFECTS (node3))) ! TREE_SIDE_EFFECTS (item) = 1; ! return fold (item); } #endif ! /* Essentially does a "fold (build (code, type, node1, node2, node3))" while ! checking for certain housekeeping things. Always sets ! TREE_SIDE_EFFECTS. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC tree ! ffecom_3s (enum tree_code code, tree type, tree node1, ! tree node2, tree node3) { ! tree item; ! ! if ((node1 == error_mark_node) ! || (node2 == error_mark_node) ! || (node3 == error_mark_node) ! || (type == error_mark_node)) ! return error_mark_node; ! item = build (code, type, node1, node2, node3); ! TREE_SIDE_EFFECTS (item) = 1; ! return fold (item); } #endif ! /* ffecom_arg_expr -- Transform argument expr into gcc tree ! ! See use by ffecom_list_expr. ! ! If expression is NULL, returns an integer zero tree. If it is not ! a CHARACTER expression, returns whatever ffecom_expr ! returns and sets the length return value to NULL_TREE. Otherwise ! generates code to evaluate the character expression, returns the proper ! pointer to the result, but does NOT set the length return value to a tree ! that specifies the length of the result. (In other words, the length ! variable is always set to NULL_TREE, because a length is never passed.) ! 21-Dec-91 JCB 1.1 ! Don't set returned length, since nobody needs it (yet; someday if ! we allow CHARACTER*(*) dummies to statement functions, we'll need ! it). */ #if FFECOM_targetCURRENT == FFECOM_targetGCC tree ! ffecom_arg_expr (ffebld expr, tree *length) { ! tree ign; ! *length = NULL_TREE; ! if (expr == NULL) ! return integer_zero_node; ! if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER) ! return ffecom_expr (expr); ! return ffecom_arg_ptr_to_expr (expr, &ign); } #endif ! /* ffecom_arg_ptr_to_expr -- Transform argument expr into gcc tree ! See use by ffecom_list_ptr_to_expr. ! If expression is NULL, returns an integer zero tree. If it is not ! a CHARACTER expression, returns whatever ffecom_ptr_to_expr ! returns and sets the length return value to NULL_TREE. Otherwise ! generates code to evaluate the character expression, returns the proper ! pointer to the result, AND sets the length return value to a tree that ! specifies the length of the result. ! If the length argument is NULL, this is a slightly special ! case of building a FORMAT expression, that is, an expression that ! will be used at run time without regard to length. For the current ! implementation, which uses the libf2c library, this means it is nice ! to append a null byte to the end of the expression, where feasible, ! to make sure any diagnostic about the FORMAT string terminates at ! some useful point. ! For now, treat %REF(char-expr) as the same as char-expr with a NULL ! length argument. This might even be seen as a feature, if a null ! byte can always be appended. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC tree ! ffecom_arg_ptr_to_expr (ffebld expr, tree *length) { ! tree item; ! tree ign_length; ! ffecomConcatList_ catlist; ! ! if (length != NULL) ! *length = NULL_TREE; ! ! if (expr == NULL) ! return integer_zero_node; ! switch (ffebld_op (expr)) { ! case FFEBLD_opPERCENT_VAL: ! if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER) ! return ffecom_expr (ffebld_left (expr)); ! { ! tree temp_exp; ! tree temp_length; ! temp_exp = ffecom_arg_ptr_to_expr (ffebld_left (expr), &temp_length); ! return ffecom_1 (INDIRECT_REF, TREE_TYPE (TREE_TYPE (temp_exp)), ! temp_exp); ! } ! case FFEBLD_opPERCENT_REF: ! if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER) ! return ffecom_ptr_to_expr (ffebld_left (expr)); ! if (length != NULL) ! { ! ign_length = NULL_TREE; ! length = &ign_length; ! } ! expr = ffebld_left (expr); ! break; ! case FFEBLD_opPERCENT_DESCR: ! switch (ffeinfo_basictype (ffebld_info (expr))) ! { ! #ifdef PASS_HOLLERITH_BY_DESCRIPTOR ! case FFEINFO_basictypeHOLLERITH: ! #endif ! case FFEINFO_basictypeCHARACTER: ! break; /* Passed by descriptor anyway. */ ! default: ! item = ffecom_ptr_to_expr (expr); ! if (item != error_mark_node) ! *length = TYPE_SIZE (TREE_TYPE (TREE_TYPE (item))); ! break; ! } ! break; ! default: ! break; ! } ! #ifdef PASS_HOLLERITH_BY_DESCRIPTOR ! if ((ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeHOLLERITH) ! && (length != NULL)) ! { /* Pass Hollerith by descriptor. */ ! ffetargetHollerith h; ! assert (ffebld_op (expr) == FFEBLD_opCONTER); ! h = ffebld_cu_val_hollerith (ffebld_constant_union ! (ffebld_conter (expr))); ! *length ! = build_int_2 (h.length, 0); ! TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node; ! } ! #endif ! if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER) ! return ffecom_ptr_to_expr (expr); ! assert (ffeinfo_kindtype (ffebld_info (expr)) ! == FFEINFO_kindtypeCHARACTER1); ! catlist = ffecom_concat_list_new_ (expr, FFETARGET_charactersizeNONE); ! switch (ffecom_concat_list_count_ (catlist)) ! { ! case 0: /* Shouldn't happen, but in case it does... */ ! if (length != NULL) ! { ! *length = ffecom_f2c_ftnlen_zero_node; ! TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node; ! } ! ffecom_concat_list_kill_ (catlist); ! return null_pointer_node; ! case 1: /* The (fairly) easy case. */ ! if (length == NULL) ! ffecom_char_args_with_null_ (&item, &ign_length, ! ffecom_concat_list_expr_ (catlist, 0)); ! else ! ffecom_char_args_ (&item, length, ! ffecom_concat_list_expr_ (catlist, 0)); ! ffecom_concat_list_kill_ (catlist); ! assert (item != NULL_TREE); ! return item; ! default: /* Must actually concatenate things. */ ! break; ! } ! { ! int count = ffecom_concat_list_count_ (catlist); ! int i; ! tree lengths; ! tree items; ! tree length_array; ! tree item_array; ! tree citem; ! tree clength; ! tree temporary; ! tree num; ! tree known_length; ! ffetargetCharacterSize sz; ! 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); ! known_length = ffecom_f2c_ftnlen_zero_node; ! for (i = 0; i < count; ++i) ! { ! if ((i == count) ! && (length == NULL)) ! ffecom_char_args_with_null_ (&citem, &clength, ! ffecom_concat_list_expr_ (catlist, i)); ! else ! ffecom_char_args_ (&citem, &clength, ! ffecom_concat_list_expr_ (catlist, i)); ! if ((citem == error_mark_node) ! || (clength == error_mark_node)) ! { ! ffecom_concat_list_kill_ (catlist); ! *length = error_mark_node; ! return error_mark_node; ! } ! items ! = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (items), ! ffecom_modify (void_type_node, ! ffecom_2 (ARRAY_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item_array))), ! item_array, ! build_int_2 (i, 0)), ! citem), ! items); ! clength = ffecom_save_tree (clength); ! if (length != NULL) ! known_length ! = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node, ! known_length, ! clength); ! lengths ! = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (lengths), ! ffecom_modify (void_type_node, ! ffecom_2 (ARRAY_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (length_array))), ! length_array, ! build_int_2 (i, 0)), ! clength), ! lengths); ! } ! sz = ffecom_concat_list_maxlen_ (catlist); ! assert (sz != FFETARGET_charactersizeNONE); ! temporary = ffecom_push_tempvar (char_type_node, ! sz, -1, TRUE); ! temporary = ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (temporary)), ! temporary); ! item = build_tree_list (NULL_TREE, temporary); ! TREE_CHAIN (item) ! = build_tree_list (NULL_TREE, ! ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (items)), ! items)); ! TREE_CHAIN (TREE_CHAIN (item)) ! = build_tree_list (NULL_TREE, ! ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (lengths)), ! lengths)); ! TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (item))) ! = build_tree_list ! (NULL_TREE, ! ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnlen_type_node, ! convert (ffecom_f2c_ftnlen_type_node, ! build_int_2 (count, 0)))); ! num = build_int_2 (sz, 0); ! TREE_TYPE (num) = ffecom_f2c_ftnlen_type_node; ! TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (item)))) ! = build_tree_list (NULL_TREE, num); ! item = ffecom_call_gfrt (FFECOM_gfrtCAT, item); ! TREE_SIDE_EFFECTS (item) = 1; ! item = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (temporary), ! item, ! temporary); ! if (length != NULL) ! *length = known_length; ! } ! ffecom_concat_list_kill_ (catlist); ! assert (item != NULL_TREE); ! return item; ! } ! #endif ! /* ffecom_call_gfrt -- Generate call to run-time function ! tree expr; ! expr = ffecom_call_gfrt(FFECOM_gfrtSTOPNIL,NULL_TREE); ! The first arg is the GNU Fortran Run-Time function index, the second ! arg is the list of arguments to pass to it. Returned is the expression ! (WITHOUT TREE_SIDE_EFFECTS set!) that makes the call and returns the ! result (which may be void). */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_call_gfrt (ffecomGfrt ix, tree args) ! { ! return ffecom_call_ (ffecom_gfrt_tree_ (ix), ! ffecom_gfrt_kindtype (ix), ! ffe_is_f2c_library () && ffecom_gfrt_complex_[ix], ! NULL_TREE, args, NULL_TREE, NULL, ! NULL, NULL_TREE, TRUE); ! } ! #endif ! /* ffecom_constantunion -- Transform constant-union to tree ! ffebldConstantUnion cu; // the constant to transform ! ffeinfoBasictype bt; // its basic type ! ffeinfoKindtype kt; // its kind type ! tree tree_type; // ffecom_tree_type[bt][kt] ! ffecom_constantunion(&cu,bt,kt,tree_type); */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt, ! ffeinfoKindtype kt, tree tree_type) { ! tree item; ! switch (bt) { ! case FFEINFO_basictypeINTEGER: ! { ! int val; ! switch (kt) ! { ! #if FFETARGET_okINTEGER1 ! case FFEINFO_kindtypeINTEGER1: ! val = ffebld_cu_val_integer1 (*cu); ! break; ! #endif ! #if FFETARGET_okINTEGER2 ! case FFEINFO_kindtypeINTEGER2: ! val = ffebld_cu_val_integer2 (*cu); ! break; ! #endif ! #if FFETARGET_okINTEGER3 ! case FFEINFO_kindtypeINTEGER3: ! val = ffebld_cu_val_integer3 (*cu); ! break; ! #endif ! #if FFETARGET_okINTEGER4 ! case FFEINFO_kindtypeINTEGER4: ! val = ffebld_cu_val_integer4 (*cu); ! break; #endif ! default: ! assert ("bad INTEGER constant kind type" == NULL); ! /* Fall through. */ ! case FFEINFO_kindtypeANY: ! return error_mark_node; ! } ! item = build_int_2 (val, (val < 0) ? -1 : 0); ! TREE_TYPE (item) = tree_type; ! } ! break; ! case FFEINFO_basictypeLOGICAL: ! { ! int val; ! switch (kt) ! { ! #if FFETARGET_okLOGICAL1 ! case FFEINFO_kindtypeLOGICAL1: ! val = ffebld_cu_val_logical1 (*cu); ! break; ! #endif ! #if FFETARGET_okLOGICAL2 ! case FFEINFO_kindtypeLOGICAL2: ! val = ffebld_cu_val_logical2 (*cu); ! break; ! #endif ! #if FFETARGET_okLOGICAL3 ! case FFEINFO_kindtypeLOGICAL3: ! val = ffebld_cu_val_logical3 (*cu); ! break; ! #endif ! #if FFETARGET_okLOGICAL4 ! case FFEINFO_kindtypeLOGICAL4: ! val = ffebld_cu_val_logical4 (*cu); ! break; ! #endif ! default: ! assert ("bad LOGICAL constant kind type" == NULL); ! /* Fall through. */ ! case FFEINFO_kindtypeANY: ! return error_mark_node; ! } ! item = build_int_2 (val, (val < 0) ? -1 : 0); ! TREE_TYPE (item) = tree_type; ! } ! break; ! case FFEINFO_basictypeREAL: ! { ! REAL_VALUE_TYPE val; ! switch (kt) ! { ! #if FFETARGET_okREAL1 ! case FFEINFO_kindtypeREAL1: ! val = ffetarget_value_real1 (ffebld_cu_val_real1 (*cu)); ! break; ! #endif ! #if FFETARGET_okREAL2 ! case FFEINFO_kindtypeREAL2: ! val = ffetarget_value_real2 (ffebld_cu_val_real2 (*cu)); ! break; ! #endif ! #if FFETARGET_okREAL3 ! case FFEINFO_kindtypeREAL3: ! val = ffetarget_value_real3 (ffebld_cu_val_real3 (*cu)); ! break; ! #endif ! #if FFETARGET_okREAL4 ! case FFEINFO_kindtypeREAL4: ! val = ffetarget_value_real4 (ffebld_cu_val_real4 (*cu)); ! break; ! #endif ! default: ! assert ("bad REAL constant kind type" == NULL); ! /* Fall through. */ ! case FFEINFO_kindtypeANY: ! return error_mark_node; ! } ! item = build_real (tree_type, val); ! } ! break; ! case FFEINFO_basictypeCOMPLEX: ! { ! REAL_VALUE_TYPE real; ! REAL_VALUE_TYPE imag; ! tree el_type = ffecom_tree_type[FFEINFO_basictypeREAL][kt]; ! switch (kt) ! { ! #if FFETARGET_okCOMPLEX1 ! case FFEINFO_kindtypeREAL1: ! real = ffetarget_value_real1 (ffebld_cu_val_complex1 (*cu).real); ! imag = ffetarget_value_real1 (ffebld_cu_val_complex1 (*cu).imaginary); ! break; ! #endif ! #if FFETARGET_okCOMPLEX2 ! case FFEINFO_kindtypeREAL2: ! real = ffetarget_value_real2 (ffebld_cu_val_complex2 (*cu).real); ! imag = ffetarget_value_real2 (ffebld_cu_val_complex2 (*cu).imaginary); ! break; ! #endif ! #if FFETARGET_okCOMPLEX3 ! case FFEINFO_kindtypeREAL3: ! real = ffetarget_value_real3 (ffebld_cu_val_complex3 (*cu).real); ! imag = ffetarget_value_real3 (ffebld_cu_val_complex3 (*cu).imaginary); ! break; ! #endif ! #if FFETARGET_okCOMPLEX4 ! case FFEINFO_kindtypeREAL4: ! real = ffetarget_value_real4 (ffebld_cu_val_complex4 (*cu).real); ! imag = ffetarget_value_real4 (ffebld_cu_val_complex4 (*cu).imaginary); ! break; ! #endif ! default: ! assert ("bad REAL constant kind type" == NULL); ! /* Fall through. */ ! case FFEINFO_kindtypeANY: ! return error_mark_node; ! } ! item = ffecom_build_complex_constant_ (tree_type, ! build_real (el_type, real), ! build_real (el_type, imag)); ! } ! break; ! case FFEINFO_basictypeCHARACTER: ! { /* Happens only in DATA and similar contexts. */ ! ffetargetCharacter1 val; ! switch (kt) ! { ! #if FFETARGET_okCHARACTER1 ! case FFEINFO_kindtypeLOGICAL1: ! val = ffebld_cu_val_character1 (*cu); ! break; ! #endif ! default: ! assert ("bad CHARACTER constant kind type" == NULL); ! /* Fall through. */ ! case FFEINFO_kindtypeANY: ! return error_mark_node; ! } ! item = build_string (ffetarget_length_character1 (val), ! ffetarget_text_character1 (val)); ! TREE_TYPE (item) ! = build_type_variant (build_array_type (char_type_node, ! build_range_type ! (integer_type_node, ! integer_one_node, ! build_int_2 ! (ffetarget_length_character1 ! (val), 0))), ! 1, 0); ! } ! break; ! case FFEINFO_basictypeHOLLERITH: ! { ! ffetargetHollerith h; ! h = ffebld_cu_val_hollerith (*cu); ! /* If not at least as wide as default INTEGER, widen it. */ ! if (h.length >= FLOAT_TYPE_SIZE / CHAR_TYPE_SIZE) ! item = build_string (h.length, h.text); ! else ! { ! char str[FLOAT_TYPE_SIZE / CHAR_TYPE_SIZE]; ! memcpy (str, h.text, h.length); ! memset (&str[h.length], ' ', ! FLOAT_TYPE_SIZE / CHAR_TYPE_SIZE ! - h.length); ! item = build_string (FLOAT_TYPE_SIZE / CHAR_TYPE_SIZE, ! str); ! } ! TREE_TYPE (item) ! = build_type_variant (build_array_type (char_type_node, ! build_range_type ! (integer_type_node, ! integer_one_node, ! build_int_2 ! (h.length, 0))), ! 1, 0); } - break; ! case FFEINFO_basictypeTYPELESS: ! { ! ffetargetInteger1 ival; ! ffetargetTypeless tless; ! ffebad error; ! tless = ffebld_cu_val_typeless (*cu); ! error = ffetarget_convert_integer1_typeless (&ival, tless); ! assert (error == FFEBAD); ! item = build_int_2 ((int) ival, 0); ! } ! break; ! default: ! assert ("not yet on constant type" == NULL); ! /* Fall through. */ ! case FFEINFO_basictypeANY: ! return error_mark_node; ! } ! TREE_CONSTANT (item) = 1; ! return item; ! } ! #endif ! /* Handy way to make a field in a struct/union. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_decl_field (tree context, tree prevfield, ! char *name, tree type) ! { ! tree field; ! field = build_decl (FIELD_DECL, get_identifier (name), type); ! DECL_CONTEXT (field) = context; ! DECL_FRAME_SIZE (field) = 0; ! if (prevfield != NULL_TREE) ! TREE_CHAIN (prevfield) = field; ! return field; ! } ! #endif ! void ! ffecom_close_include (FILE *f) ! { ! #if FFECOM_GCC_INCLUDE ! ffecom_close_include_ (f); ! #endif ! } ! int ! ffecom_decode_include_option (char *spec) ! { ! #if FFECOM_GCC_INCLUDE ! return ffecom_decode_include_option_ (spec); ! #else ! return 1; ! #endif ! } ! /* ffecom_end_transition -- Perform end transition on all symbols ! ffecom_end_transition(); ! Calls ffecom_sym_end_transition for each global and local symbol. */ ! void ! ffecom_end_transition () ! { ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! ffebld item; ! #endif ! if (ffe_is_ffedebug ()) ! fprintf (dmpout, "; end_stmt_transition\n"); ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! ffecom_list_blockdata_ = NULL; ! ffecom_list_common_ = NULL; ! #endif ! ffesymbol_drive (ffecom_sym_end_transition); ! if (ffe_is_ffedebug ()) ! { ! ffestorag_report (); ! #if FFECOM_targetCURRENT == FFECOM_targetFFE ! ffesymbol_report_all (); ! #endif ! } ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! ffecom_start_progunit_ (); ! for (item = ffecom_list_blockdata_; ! item != NULL; ! item = ffebld_trail (item)) ! { ! ffebld callee; ! ffesymbol s; ! tree dt; ! tree t; ! tree var; ! int yes; ! static int number = 0; ! callee = ffebld_head (item); ! s = ffebld_symter (callee); ! t = ffesymbol_hook (s).decl_tree; ! if (t == NULL_TREE) ! { ! s = ffecom_sym_transform_ (s); ! t = ffesymbol_hook (s).decl_tree; ! } ! yes = suspend_momentary (); ! dt = build_pointer_type (TREE_TYPE (t)); ! var = build_decl (VAR_DECL, ! ffecom_get_invented_identifier ("__g77_forceload_%d", ! NULL, number++), ! dt); ! DECL_EXTERNAL (var) = 0; ! TREE_STATIC (var) = 1; ! TREE_PUBLIC (var) = 0; ! DECL_INITIAL (var) = error_mark_node; ! TREE_USED (var) = 1; ! var = start_decl (var, FALSE); ! t = ffecom_1 (ADDR_EXPR, dt, t); ! finish_decl (var, t, FALSE); ! resume_momentary (yes); ! } ! /* This handles any COMMON areas that weren't referenced but have, for ! example, important initial data. */ ! for (item = ffecom_list_common_; ! item != NULL; ! item = ffebld_trail (item)) ! ffecom_transform_common_ (ffebld_symter (ffebld_head (item))); ! ffecom_list_common_ = NULL; ! #endif ! } ! /* ffecom_exec_transition -- Perform exec transition on all symbols ! ffecom_exec_transition(); ! Calls ffecom_sym_exec_transition for each global and local symbol. ! Make sure error updating not inhibited. */ ! void ! ffecom_exec_transition () ! { ! bool inhibited; ! if (ffe_is_ffedebug ()) ! fprintf (dmpout, "; exec_stmt_transition\n"); ! inhibited = ffebad_inhibit (); ! ffebad_set_inhibit (FALSE); ! ffesymbol_drive (ffecom_sym_exec_transition); /* Don't retract! */ ! ffeequiv_exec_transition (); /* Handle all pending EQUIVALENCEs. */ ! if (ffe_is_ffedebug ()) ! { ! ffestorag_report (); ! #if FFECOM_targetCURRENT == FFECOM_targetFFE ! ffesymbol_report_all (); #endif - } - - if (inhibited) - ffebad_set_inhibit (TRUE); - } ! /* ffecom_expand_let_stmt -- Compile let (assignment) statement ! ! ffebld dest; ! ffebld source; ! ffecom_expand_let_stmt(dest,source); ! Convert dest and source using ffecom_expr, then join them ! with an ASSIGN op and pass the whole thing to expand_expr_stmt. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! void ! ffecom_expand_let_stmt (ffebld dest, ffebld source) ! { ! tree dest_tree; ! tree dest_length; ! tree source_tree; ! tree expr_tree; ! if (ffeinfo_basictype (ffebld_info (dest)) != FFEINFO_basictypeCHARACTER) ! { ! bool dest_used; ! dest_tree = ffecom_expr_rw (dest); ! if (dest_tree == error_mark_node) ! return; ! if ((TREE_CODE (dest_tree) != VAR_DECL) ! || TREE_ADDRESSABLE (dest_tree)) ! source_tree = ffecom_expr_ (source, dest_tree, dest, &dest_used, ! FALSE, FALSE); ! else ! { ! source_tree = ffecom_expr (source); ! dest_used = FALSE; ! } ! if (source_tree == error_mark_node) ! return; ! if (dest_used) ! expr_tree = source_tree; ! else ! expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node, ! dest_tree, ! source_tree); ! expand_expr_stmt (expr_tree); ! return; ! } ! ffecom_push_calltemps (); ! ffecom_char_args_ (&dest_tree, &dest_length, dest); ! ffecom_let_char_ (dest_tree, dest_length, ffebld_size_known (dest), ! source); ! ffecom_pop_calltemps (); ! } #endif ! /* ffecom_expr -- Transform expr into gcc tree ! ! tree t; ! ffebld expr; // FFE expression. ! tree = ffecom_expr(expr); ! Recursive descent on expr while making corresponding tree nodes and ! attaching type info and such. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_expr (ffebld expr) ! { ! return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, FALSE, FALSE); ! } #endif - /* Like ffecom_expr, but return tree usable for assigned GOTO or FORMAT. */ - - #if FFECOM_targetCURRENT == FFECOM_targetGCC - tree - ffecom_expr_assign (ffebld expr) - { - return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, TRUE, FALSE); - } #endif - /* Like ffecom_expr_rw, but return tree usable for ASSIGN. */ - - #if FFECOM_targetCURRENT == FFECOM_targetGCC - tree - ffecom_expr_assign_w (ffebld expr) - { - return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, TRUE, FALSE); - } #endif - /* Transform expr for use as into read/write tree and stabilize the - reference. Not for use on CHARACTER expressions. - - Recursive descent on expr while making corresponding tree nodes and - attaching type info and such. */ - - #if FFECOM_targetCURRENT == FFECOM_targetGCC - tree - ffecom_expr_rw (ffebld expr) - { - assert (expr != NULL); - - return stabilize_reference (ffecom_expr (expr)); } #endif ! /* Do global stuff. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC void ! ffecom_finish_compile () { assert (ffecom_outer_function_decl_ == NULL_TREE); assert (current_function_decl == NULL_TREE); ! ffeglobal_drive (ffecom_finish_global_); ! } ! ! #endif ! /* Public entry point for front end to access finish_decl. */ ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! void ! ffecom_finish_decl (tree decl, tree init, bool is_top_level) ! { ! assert (!is_top_level); ! finish_decl (decl, init, FALSE); } #endif ! /* Finish a program unit. */ ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! void ! ffecom_finish_progunit () ! { ! ffecom_end_compstmt_ (); ! ! ffecom_previous_function_decl_ = current_function_decl; ! ffecom_which_entrypoint_decl_ = NULL_TREE; ! finish_function (0); ! } ! #endif ! /* Wrapper for get_identifier. pattern is like "...%s...", text is ! inserted into final name in place of "%s", or if text is NULL, ! pattern is like "...%d..." and text form of number is inserted ! in place of "%d". */ #if FFECOM_targetCURRENT == FFECOM_targetGCC tree ! ffecom_get_invented_identifier (char *pattern, char *text, int number) ! { ! tree decl; ! char *nam; ! mallocSize lenlen; ! char space[66]; ! ! if (text == NULL) ! lenlen = strlen (pattern) + 20; ! else ! lenlen = strlen (pattern) + strlen (text) - 1; ! if (lenlen > ARRAY_SIZE (space)) ! nam = malloc_new_ks (malloc_pool_image (), pattern, lenlen); ! else ! nam = &space[0]; ! if (text == NULL) ! sprintf (&nam[0], pattern, number); ! else ! sprintf (&nam[0], pattern, text); ! decl = get_identifier (nam); ! if (lenlen > ARRAY_SIZE (space)) ! malloc_kill_ks (malloc_pool_image (), nam, lenlen); ! ! IDENTIFIER_INVENTED (decl) = 1; ! ! return decl; ! } ! ! ffeinfoBasictype ! ffecom_gfrt_basictype (ffecomGfrt gfrt) ! { ! assert (gfrt < FFECOM_gfrt); ! ! switch (ffecom_gfrt_type_[gfrt]) ! { ! case FFECOM_rttypeVOID_: ! case FFECOM_rttypeVOIDSTAR_: ! return FFEINFO_basictypeNONE; ! ! case FFECOM_rttypeFTNINT_: ! return FFEINFO_basictypeINTEGER; ! ! case FFECOM_rttypeINTEGER_: ! return FFEINFO_basictypeINTEGER; ! ! case FFECOM_rttypeLONGINT_: ! return FFEINFO_basictypeINTEGER; ! ! case FFECOM_rttypeLOGICAL_: ! return FFEINFO_basictypeLOGICAL; ! ! case FFECOM_rttypeREAL_F2C_: ! case FFECOM_rttypeREAL_GNU_: ! return FFEINFO_basictypeREAL; ! ! case FFECOM_rttypeCOMPLEX_F2C_: ! case FFECOM_rttypeCOMPLEX_GNU_: ! return FFEINFO_basictypeCOMPLEX; ! ! case FFECOM_rttypeDOUBLE_: ! case FFECOM_rttypeDOUBLEREAL_: ! return FFEINFO_basictypeREAL; ! ! case FFECOM_rttypeDBLCMPLX_F2C_: ! case FFECOM_rttypeDBLCMPLX_GNU_: ! return FFEINFO_basictypeCOMPLEX; ! ! case FFECOM_rttypeCHARACTER_: ! return FFEINFO_basictypeCHARACTER; ! ! default: ! return FFEINFO_basictypeANY; ! } ! } ! ! ffeinfoKindtype ! ffecom_gfrt_kindtype (ffecomGfrt gfrt) { ! assert (gfrt < FFECOM_gfrt); ! switch (ffecom_gfrt_type_[gfrt]) { ! case FFECOM_rttypeVOID_: ! case FFECOM_rttypeVOIDSTAR_: ! return FFEINFO_kindtypeNONE; ! ! case FFECOM_rttypeFTNINT_: ! return FFEINFO_kindtypeINTEGER1; ! case FFECOM_rttypeINTEGER_: ! return FFEINFO_kindtypeINTEGER1; ! ! case FFECOM_rttypeLONGINT_: ! return FFEINFO_kindtypeINTEGER4; ! ! case FFECOM_rttypeLOGICAL_: ! return FFEINFO_kindtypeLOGICAL1; ! case FFECOM_rttypeREAL_F2C_: ! case FFECOM_rttypeREAL_GNU_: ! return FFEINFO_kindtypeREAL1; ! case FFECOM_rttypeCOMPLEX_F2C_: ! case FFECOM_rttypeCOMPLEX_GNU_: ! return FFEINFO_kindtypeREAL1; ! case FFECOM_rttypeDOUBLE_: ! case FFECOM_rttypeDOUBLEREAL_: ! return FFEINFO_kindtypeREAL2; ! case FFECOM_rttypeDBLCMPLX_F2C_: ! case FFECOM_rttypeDBLCMPLX_GNU_: ! return FFEINFO_kindtypeREAL2; ! case FFECOM_rttypeCHARACTER_: ! return FFEINFO_kindtypeCHARACTER1; ! default: ! return FFEINFO_kindtypeANY; ! } ! } ! void ! ffecom_init_0 () { ! tree endlink; ! int i; ! int j; ! tree t; ! tree field; ! ffetype type; ! ffetype base_type; ! ! /* This block of code comes from the now-obsolete cktyps.c. It checks ! whether the compiler environment is buggy in known ways, some of which ! would, if not explicitly checked here, result in subtle bugs in g77. */ ! if (ffe_is_do_internal_checks ()) { ! static char names[][12] ! = ! {"bar", "bletch", "foo", "foobar"}; ! char *name; ! unsigned long ul; ! double fl; ! ! name = bsearch ("foo", &names[0], ARRAY_SIZE (names), sizeof (names[0]), ! (int (*)()) strcmp); ! if (name != (char *) &names[2]) ! { ! assert ("bsearch doesn't work, #define FFEPROJ_BSEARCH 0 in proj.h" ! == NULL); ! abort (); ! } ! ul = strtoul ("123456789", NULL, 10); ! if (ul != 123456789L) ! { ! assert ("strtoul doesn't have enough range, #define FFEPROJ_STRTOUL 0\ ! in proj.h" == NULL); ! abort (); ! } ! fl = atof ("56.789"); ! if ((fl < 56.788) || (fl > 56.79)) { ! assert ("atof not type double, fix your #include " ! == NULL); ! abort (); } } ! /* Set the sizetype before we do anything else. This _should_ be the ! first type we create. */ ! t = make_unsigned_type (POINTER_SIZE); ! assert (t == sizetype); - #if FFECOM_GCC_INCLUDE - ffecom_initialize_char_syntax_ (); #endif ! ffecom_outer_function_decl_ = NULL_TREE; ! current_function_decl = NULL_TREE; ! named_labels = NULL_TREE; ! current_binding_level = NULL_BINDING_LEVEL; ! free_binding_level = NULL_BINDING_LEVEL; ! pushlevel (0); /* make the binding_level structure for ! global names */ ! global_binding_level = current_binding_level; ! /* Define `int' and `char' first so that dbx will output them first. */ ! integer_type_node = make_signed_type (INT_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("int"), ! integer_type_node)); ! char_type_node = make_unsigned_type (CHAR_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("char"), ! char_type_node)); ! long_integer_type_node = make_signed_type (LONG_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("long int"), ! long_integer_type_node)); ! unsigned_type_node = make_unsigned_type (INT_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned int"), ! unsigned_type_node)); ! long_unsigned_type_node = make_unsigned_type (LONG_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("long unsigned int"), ! long_unsigned_type_node)); ! long_long_integer_type_node = make_signed_type (LONG_LONG_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("long long int"), ! long_long_integer_type_node)); ! long_long_unsigned_type_node = make_unsigned_type (LONG_LONG_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("long long unsigned int"), ! long_long_unsigned_type_node)); ! error_mark_node = make_node (ERROR_MARK); ! TREE_TYPE (error_mark_node) = error_mark_node; ! short_integer_type_node = make_signed_type (SHORT_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("short int"), ! short_integer_type_node)); ! short_unsigned_type_node = make_unsigned_type (SHORT_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("short unsigned int"), ! short_unsigned_type_node)); ! /* Define both `signed char' and `unsigned char'. */ ! signed_char_type_node = make_signed_type (CHAR_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("signed char"), ! signed_char_type_node)); ! unsigned_char_type_node = make_unsigned_type (CHAR_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned char"), ! unsigned_char_type_node)); ! float_type_node = make_node (REAL_TYPE); ! TYPE_PRECISION (float_type_node) = FLOAT_TYPE_SIZE; ! layout_type (float_type_node); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("float"), ! float_type_node)); ! double_type_node = make_node (REAL_TYPE); ! TYPE_PRECISION (double_type_node) = DOUBLE_TYPE_SIZE; ! layout_type (double_type_node); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("double"), ! double_type_node)); ! long_double_type_node = make_node (REAL_TYPE); ! TYPE_PRECISION (long_double_type_node) = LONG_DOUBLE_TYPE_SIZE; ! layout_type (long_double_type_node); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("long double"), ! long_double_type_node)); ! complex_integer_type_node = ffecom_make_complex_type_ (integer_type_node); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("complex int"), ! complex_integer_type_node)); ! complex_float_type_node = ffecom_make_complex_type_ (float_type_node); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("complex float"), ! complex_float_type_node)); ! complex_double_type_node = ffecom_make_complex_type_ (double_type_node); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("complex double"), ! complex_double_type_node)); ! complex_long_double_type_node = ffecom_make_complex_type_ (long_double_type_node); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("complex long double"), ! complex_long_double_type_node)); ! integer_zero_node = build_int_2 (0, 0); ! TREE_TYPE (integer_zero_node) = integer_type_node; ! integer_one_node = build_int_2 (1, 0); ! TREE_TYPE (integer_one_node) = integer_type_node; ! size_zero_node = build_int_2 (0, 0); ! TREE_TYPE (size_zero_node) = sizetype; ! size_one_node = build_int_2 (1, 0); ! TREE_TYPE (size_one_node) = sizetype; ! void_type_node = make_node (VOID_TYPE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("void"), ! void_type_node)); ! layout_type (void_type_node); /* Uses integer_zero_node */ ! /* We are not going to have real types in C with less than byte alignment, ! so we might as well not have any types that claim to have it. */ ! TYPE_ALIGN (void_type_node) = BITS_PER_UNIT; ! null_pointer_node = build_int_2 (0, 0); ! TREE_TYPE (null_pointer_node) = build_pointer_type (void_type_node); ! layout_type (TREE_TYPE (null_pointer_node)); ! string_type_node = build_pointer_type (char_type_node); ! ffecom_tree_fun_type_void ! = build_function_type (void_type_node, NULL_TREE); ! ffecom_tree_ptr_to_fun_type_void ! = build_pointer_type (ffecom_tree_fun_type_void); ! endlink = tree_cons (NULL_TREE, void_type_node, NULL_TREE); ! float_ftype_float ! = build_function_type (float_type_node, ! tree_cons (NULL_TREE, float_type_node, endlink)); ! double_ftype_double ! = build_function_type (double_type_node, ! tree_cons (NULL_TREE, double_type_node, endlink)); ! ldouble_ftype_ldouble ! = build_function_type (long_double_type_node, ! tree_cons (NULL_TREE, long_double_type_node, ! endlink)); ! for (i = 0; ((size_t) i) < ARRAY_SIZE (ffecom_tree_type); ++i) ! for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j) ! { ! ffecom_tree_type[i][j] = NULL_TREE; ! ffecom_tree_fun_type[i][j] = NULL_TREE; ! ffecom_tree_ptr_to_fun_type[i][j] = NULL_TREE; ! ffecom_f2c_typecode_[i][j] = -1; ! } ! /* Set up standard g77 types. Note that INTEGER and LOGICAL are set ! to size FLOAT_TYPE_SIZE because they have to be the same size as ! REAL, which also is FLOAT_TYPE_SIZE, according to the standard. ! Compiler options and other such stuff that change the ways these ! types are set should not affect this particular setup. */ ! ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER1] ! = t = make_signed_type (FLOAT_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("integer"), ! t)); ! type = ffetype_new (); ! base_type = type; ! ffeinfo_set_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER1, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 1, type); ! assert (ffetype_size (type) == sizeof (ffetargetInteger1)); ! ffecom_tree_type[FFEINFO_basictypeHOLLERITH][FFEINFO_kindtypeINTEGER1] ! = t = make_unsigned_type (FLOAT_TYPE_SIZE); /* HOLLERITH means unsigned. */ ! pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned"), ! t)); ! ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER2] ! = t = make_signed_type (CHAR_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("byte"), ! t)); ! type = ffetype_new (); ! ffeinfo_set_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER2, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 3, type); ! assert (ffetype_size (type) == sizeof (ffetargetInteger2)); ! ffecom_tree_type[FFEINFO_basictypeHOLLERITH][FFEINFO_kindtypeINTEGER2] ! = t = make_unsigned_type (CHAR_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned byte"), ! t)); ! ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER3] ! = t = make_signed_type (CHAR_TYPE_SIZE * 2); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("word"), ! t)); ! type = ffetype_new (); ! ffeinfo_set_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER3, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 6, type); ! assert (ffetype_size (type) == sizeof (ffetargetInteger3)); ! ffecom_tree_type[FFEINFO_basictypeHOLLERITH][FFEINFO_kindtypeINTEGER3] ! = t = make_unsigned_type (CHAR_TYPE_SIZE * 2); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned word"), ! t)); ! ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER4] ! = t = make_signed_type (FLOAT_TYPE_SIZE * 2); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("integer4"), ! t)); ! type = ffetype_new (); ! ffeinfo_set_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER4, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 2, type); ! assert (ffetype_size (type) == sizeof (ffetargetInteger4)); ! ffecom_tree_type[FFEINFO_basictypeHOLLERITH][FFEINFO_kindtypeINTEGER4] ! = t = make_unsigned_type (FLOAT_TYPE_SIZE * 2); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned4"), ! t)); ! #if 0 ! if (ffe_is_do_internal_checks () ! && LONG_TYPE_SIZE != FLOAT_TYPE_SIZE ! && LONG_TYPE_SIZE != CHAR_TYPE_SIZE ! && LONG_TYPE_SIZE != SHORT_TYPE_SIZE ! && LONG_TYPE_SIZE != LONG_LONG_TYPE_SIZE) ! { ! fprintf (stderr, "Sorry, no g77 support for LONG_TYPE_SIZE (%d bits) yet.\n", ! LONG_TYPE_SIZE); } #endif ! ffecom_tree_type[FFEINFO_basictypeLOGICAL][FFEINFO_kindtypeLOGICAL1] ! = t = make_signed_type (FLOAT_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("logical"), ! t)); ! type = ffetype_new (); ! base_type = type; ! ffeinfo_set_type (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL1, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 1, type); ! assert (ffetype_size (type) == sizeof (ffetargetLogical1)); ! ffecom_tree_type[FFEINFO_basictypeLOGICAL][FFEINFO_kindtypeLOGICAL2] ! = t = make_signed_type (CHAR_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("logical2"), ! t)); ! type = ffetype_new (); ! ffeinfo_set_type (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL2, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 3, type); ! assert (ffetype_size (type) == sizeof (ffetargetLogical2)); ! ffecom_tree_type[FFEINFO_basictypeLOGICAL][FFEINFO_kindtypeLOGICAL3] ! = t = make_signed_type (CHAR_TYPE_SIZE * 2); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("logical3"), ! t)); ! type = ffetype_new (); ! ffeinfo_set_type (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL3, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 6, type); ! assert (ffetype_size (type) == sizeof (ffetargetLogical3)); ! ffecom_tree_type[FFEINFO_basictypeLOGICAL][FFEINFO_kindtypeLOGICAL4] ! = t = make_signed_type (FLOAT_TYPE_SIZE * 2); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("logical4"), ! t)); ! type = ffetype_new (); ! ffeinfo_set_type (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL4, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 2, type); ! assert (ffetype_size (type) == sizeof (ffetargetLogical4)); ! ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1] ! = t = make_node (REAL_TYPE); ! TYPE_PRECISION (t) = FLOAT_TYPE_SIZE; ! pushdecl (build_decl (TYPE_DECL, get_identifier ("real"), ! t)); ! layout_type (t); ! type = ffetype_new (); ! base_type = type; ! ffeinfo_set_type (FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL1, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 1, type); ! ffecom_f2c_typecode_[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1] ! = FFETARGET_f2cTYREAL; ! assert (ffetype_size (type) == sizeof (ffetargetReal1)); ! ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREALDOUBLE] ! = t = make_node (REAL_TYPE); ! TYPE_PRECISION (t) = FLOAT_TYPE_SIZE * 2; /* Always twice REAL. */ ! pushdecl (build_decl (TYPE_DECL, get_identifier ("double precision"), ! t)); ! layout_type (t); ! type = ffetype_new (); ! ffeinfo_set_type (FFEINFO_basictypeREAL, FFEINFO_kindtypeREALDOUBLE, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 2, type); ! ffecom_f2c_typecode_[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL2] ! = FFETARGET_f2cTYDREAL; ! assert (ffetype_size (type) == sizeof (ffetargetReal2)); ! ffecom_tree_type[FFEINFO_basictypeCOMPLEX][FFEINFO_kindtypeREAL1] ! = t = ffecom_make_complex_type_ (ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1]); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("complex"), ! t)); ! type = ffetype_new (); ! base_type = type; ! ffeinfo_set_type (FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL1, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 1, type); ! ffecom_f2c_typecode_[FFEINFO_basictypeCOMPLEX][FFEINFO_kindtypeREAL1] ! = FFETARGET_f2cTYCOMPLEX; ! assert (ffetype_size (type) == sizeof (ffetargetComplex1)); ! ffecom_tree_type[FFEINFO_basictypeCOMPLEX][FFEINFO_kindtypeREALDOUBLE] ! = t = ffecom_make_complex_type_ (ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL2]); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("double complex"), ! t)); ! type = ffetype_new (); ! ffeinfo_set_type (FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREALDOUBLE, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 2, ! type); ! ffecom_f2c_typecode_[FFEINFO_basictypeCOMPLEX][FFEINFO_kindtypeREAL2] ! = FFETARGET_f2cTYDCOMPLEX; ! assert (ffetype_size (type) == sizeof (ffetargetComplex2)); ! /* Make function and ptr-to-function types for non-CHARACTER types. */ ! for (i = 0; ((size_t) i) < ARRAY_SIZE (ffecom_tree_type); ++i) ! for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j) ! { ! if ((t = ffecom_tree_type[i][j]) != NULL_TREE) ! { ! if (i == FFEINFO_basictypeINTEGER) ! { ! /* Figure out the smallest INTEGER type that can hold ! a pointer on this machine. */ ! if (GET_MODE_SIZE (TYPE_MODE (t)) ! >= GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node)))) ! { ! if ((ffecom_pointer_kind_ == FFEINFO_kindtypeNONE) ! || (GET_MODE_SIZE (TYPE_MODE (ffecom_tree_type[i][ffecom_pointer_kind_])) ! > GET_MODE_SIZE (TYPE_MODE (t)))) ! ffecom_pointer_kind_ = j; ! } ! } ! else if (i == FFEINFO_basictypeCOMPLEX) ! t = void_type_node; ! /* For f2c compatibility, REAL functions are really ! implemented as DOUBLE PRECISION. */ ! else if ((i == FFEINFO_basictypeREAL) ! && (j == FFEINFO_kindtypeREAL1)) ! t = ffecom_tree_type ! [FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL2]; ! t = ffecom_tree_fun_type[i][j] = build_function_type (t, ! NULL_TREE); ! ffecom_tree_ptr_to_fun_type[i][j] = build_pointer_type (t); ! } ! } ! /* Set up pointer types. */ ! if (ffecom_pointer_kind_ == FFEINFO_basictypeNONE) ! fatal ("no INTEGER type can hold a pointer on this configuration"); ! else if (0 && ffe_is_do_internal_checks ()) ! fprintf (stderr, "Pointer type kt=%d\n", ffecom_pointer_kind_); ! ffetype_set_kind (ffeinfo_type (FFEINFO_basictypeINTEGER, ! FFEINFO_kindtypeINTEGERDEFAULT), ! 7, ! ffeinfo_type (FFEINFO_basictypeINTEGER, ! ffecom_pointer_kind_)); ! if (ffe_is_ugly_assign ()) ! ffecom_label_kind_ = ffecom_pointer_kind_; /* Require ASSIGN etc to this. */ ! else ! ffecom_label_kind_ = FFEINFO_kindtypeINTEGERDEFAULT; ! if (0 && ffe_is_do_internal_checks ()) ! fprintf (stderr, "Label type kt=%d\n", ffecom_label_kind_); ! ffecom_integer_type_node ! = ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER1]; ! ffecom_integer_zero_node = convert (ffecom_integer_type_node, ! integer_zero_node); ! ffecom_integer_one_node = convert (ffecom_integer_type_node, ! integer_one_node); ! /* Yes, the "FLOAT_TYPE_SIZE" references below are intentional. ! Turns out that by TYLONG, runtime/libI77/lio.h really means ! "whatever size an ftnint is". For consistency and sanity, ! com.h and runtime/f2c.h.in agree that flag, ftnint, and ftlen ! all are INTEGER, which we also make out of whatever back-end ! integer type is FLOAT_TYPE_SIZE bits wide. This change, from ! LONG_TYPE_SIZE, for TYLONG and TYLOGICAL, was necessary to ! accommodate machines like the Alpha. Note that this suggests ! f2c and libf2c are missing a distinction perhaps needed on ! some machines between "int" and "long int". -- burley 0.5.5 950215 */ ! ffecom_f2c_set_lio_code_ (FFEINFO_basictypeINTEGER, FLOAT_TYPE_SIZE, ! FFETARGET_f2cTYLONG); ! ffecom_f2c_set_lio_code_ (FFEINFO_basictypeINTEGER, SHORT_TYPE_SIZE, ! FFETARGET_f2cTYSHORT); ! ffecom_f2c_set_lio_code_ (FFEINFO_basictypeINTEGER, CHAR_TYPE_SIZE, ! FFETARGET_f2cTYINT1); ! ffecom_f2c_set_lio_code_ (FFEINFO_basictypeINTEGER, LONG_LONG_TYPE_SIZE, ! FFETARGET_f2cTYQUAD); ! ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, FLOAT_TYPE_SIZE, ! FFETARGET_f2cTYLOGICAL); ! ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, SHORT_TYPE_SIZE, ! FFETARGET_f2cTYLOGICAL2); ! ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, CHAR_TYPE_SIZE, ! FFETARGET_f2cTYLOGICAL1); ! ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, LONG_LONG_TYPE_SIZE, ! FFETARGET_f2cTYQUAD /* ~~~ */); ! /* CHARACTER stuff is all special-cased, so it is not handled in the above ! loop. CHARACTER items are built as arrays of unsigned char. */ ! ffecom_tree_type[FFEINFO_basictypeCHARACTER] ! [FFEINFO_kindtypeCHARACTER1] = t = char_type_node; ! type = ffetype_new (); ! base_type = type; ! ffeinfo_set_type (FFEINFO_basictypeCHARACTER, ! FFEINFO_kindtypeCHARACTER1, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_kind (base_type, 1, type); ! assert (ffetype_size (type) ! == sizeof (((ffetargetCharacter1) { 0, NULL }).text[0])); ! ffecom_tree_fun_type[FFEINFO_basictypeCHARACTER] ! [FFEINFO_kindtypeCHARACTER1] = ffecom_tree_fun_type_void; ! ffecom_tree_ptr_to_fun_type[FFEINFO_basictypeCHARACTER] ! [FFEINFO_kindtypeCHARACTER1] ! = ffecom_tree_ptr_to_fun_type_void; ! ffecom_f2c_typecode_[FFEINFO_basictypeCHARACTER][FFEINFO_kindtypeCHARACTER1] ! = FFETARGET_f2cTYCHAR; ! ffecom_f2c_typecode_[FFEINFO_basictypeANY][FFEINFO_kindtypeANY] ! = 0; ! /* Make multi-return-value type and fields. */ ! ffecom_multi_type_node_ = make_node (UNION_TYPE); ! field = NULL_TREE; ! for (i = 0; ((size_t) i) < ARRAY_SIZE (ffecom_tree_type); ++i) ! for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j) ! { ! char name[30]; ! if (ffecom_tree_type[i][j] == NULL_TREE) ! continue; /* Not supported. */ ! sprintf (&name[0], "bt_%s_kt_%s", ! ffeinfo_basictype_string ((ffeinfoBasictype) i), ! ffeinfo_kindtype_string ((ffeinfoKindtype) j)); ! ffecom_multi_fields_[i][j] = build_decl (FIELD_DECL, ! get_identifier (name), ! ffecom_tree_type[i][j]); ! DECL_CONTEXT (ffecom_multi_fields_[i][j]) ! = ffecom_multi_type_node_; ! DECL_FRAME_SIZE (ffecom_multi_fields_[i][j]) = 0; ! TREE_CHAIN (ffecom_multi_fields_[i][j]) = field; ! field = ffecom_multi_fields_[i][j]; ! } ! TYPE_FIELDS (ffecom_multi_type_node_) = field; ! layout_type (ffecom_multi_type_node_); ! /* Subroutines usually return integer because they might have alternate ! returns. */ ! ffecom_tree_subr_type ! = build_function_type (integer_type_node, NULL_TREE); ! ffecom_tree_ptr_to_subr_type ! = build_pointer_type (ffecom_tree_subr_type); ! ffecom_tree_blockdata_type ! = build_function_type (void_type_node, NULL_TREE); ! builtin_function ("__builtin_sqrtf", float_ftype_float, ! BUILT_IN_FSQRT, "sqrtf"); ! builtin_function ("__builtin_fsqrt", double_ftype_double, ! BUILT_IN_FSQRT, "sqrt"); ! builtin_function ("__builtin_sqrtl", ldouble_ftype_ldouble, ! BUILT_IN_FSQRT, "sqrtl"); ! builtin_function ("__builtin_sinf", float_ftype_float, ! BUILT_IN_SIN, "sinf"); ! builtin_function ("__builtin_sin", double_ftype_double, ! BUILT_IN_SIN, "sin"); ! builtin_function ("__builtin_sinl", ldouble_ftype_ldouble, ! BUILT_IN_SIN, "sinl"); ! builtin_function ("__builtin_cosf", float_ftype_float, ! BUILT_IN_COS, "cosf"); ! builtin_function ("__builtin_cos", double_ftype_double, ! BUILT_IN_COS, "cos"); ! builtin_function ("__builtin_cosl", ldouble_ftype_ldouble, ! BUILT_IN_COS, "cosl"); ! #if BUILT_FOR_270 ! pedantic_lvalues = FALSE; ! #endif ! ffecom_f2c_make_type_ (&ffecom_f2c_integer_type_node, ! FFECOM_f2cINTEGER, ! "integer"); ! ffecom_f2c_make_type_ (&ffecom_f2c_address_type_node, ! FFECOM_f2cADDRESS, ! "address"); ! ffecom_f2c_make_type_ (&ffecom_f2c_real_type_node, ! FFECOM_f2cREAL, ! "real"); ! ffecom_f2c_make_type_ (&ffecom_f2c_doublereal_type_node, ! FFECOM_f2cDOUBLEREAL, ! "doublereal"); ! ffecom_f2c_make_type_ (&ffecom_f2c_complex_type_node, ! FFECOM_f2cCOMPLEX, ! "complex"); ! ffecom_f2c_make_type_ (&ffecom_f2c_doublecomplex_type_node, ! FFECOM_f2cDOUBLECOMPLEX, ! "doublecomplex"); ! ffecom_f2c_make_type_ (&ffecom_f2c_longint_type_node, ! FFECOM_f2cLONGINT, ! "longint"); ! ffecom_f2c_make_type_ (&ffecom_f2c_logical_type_node, ! FFECOM_f2cLOGICAL, ! "logical"); ! ffecom_f2c_make_type_ (&ffecom_f2c_flag_type_node, ! FFECOM_f2cFLAG, ! "flag"); ! ffecom_f2c_make_type_ (&ffecom_f2c_ftnlen_type_node, ! FFECOM_f2cFTNLEN, ! "ftnlen"); ! ffecom_f2c_make_type_ (&ffecom_f2c_ftnint_type_node, ! FFECOM_f2cFTNINT, ! "ftnint"); ! ffecom_f2c_ftnlen_zero_node ! = convert (ffecom_f2c_ftnlen_type_node, integer_zero_node); ! ffecom_f2c_ftnlen_one_node ! = convert (ffecom_f2c_ftnlen_type_node, integer_one_node); ! ffecom_f2c_ftnlen_two_node = build_int_2 (2, 0); ! TREE_TYPE (ffecom_f2c_ftnlen_two_node) = ffecom_integer_type_node; ! ffecom_f2c_ptr_to_ftnlen_type_node ! = build_pointer_type (ffecom_f2c_ftnlen_type_node); ! ffecom_f2c_ptr_to_ftnint_type_node ! = build_pointer_type (ffecom_f2c_ftnint_type_node); ! ffecom_f2c_ptr_to_integer_type_node ! = build_pointer_type (ffecom_f2c_integer_type_node); ! ffecom_f2c_ptr_to_real_type_node ! = build_pointer_type (ffecom_f2c_real_type_node); ! ffecom_float_zero_ = build_real (float_type_node, dconst0); ! ffecom_double_zero_ = build_real (double_type_node, dconst0); ! { ! 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); - } ! /* Do "extern int xargc;". */ ! ffecom_tree_xargc_ = build_decl (VAR_DECL, ! get_identifier ("f__xargc"), ! integer_type_node); ! DECL_EXTERNAL (ffecom_tree_xargc_) = 1; ! TREE_STATIC (ffecom_tree_xargc_) = 1; ! TREE_PUBLIC (ffecom_tree_xargc_) = 1; ! ffecom_tree_xargc_ = start_decl (ffecom_tree_xargc_, FALSE); ! finish_decl (ffecom_tree_xargc_, NULL_TREE, FALSE); ! #if 0 /* This is being fixed, and seems to be working now. */ ! if ((FLOAT_TYPE_SIZE != 32) ! || (TREE_INT_CST_LOW (TYPE_SIZE (TREE_TYPE (null_pointer_node))) != 32)) ! { ! warning ("configuration: REAL, INTEGER, and LOGICAL are %d bits wide,", ! (int) FLOAT_TYPE_SIZE); ! warning ("and pointers are %d bits wide, but g77 doesn't yet work", ! (int) TREE_INT_CST_LOW (TYPE_SIZE (TREE_TYPE (null_pointer_node)))); ! warning ("properly unless they all are 32 bits wide."); ! warning ("Please keep this in mind before you report bugs. g77 should"); ! warning ("support non-32-bit machines better as of version 0.6."); ! } ! #endif ! #if 0 /* Code in ste.c that would crash has been commented out. */ ! if (TYPE_PRECISION (ffecom_f2c_ftnlen_type_node) ! < TYPE_PRECISION (string_type_node)) ! /* I/O will probably crash. */ ! warning ("configuration: char * holds %d bits, but ftnlen only %d", ! TYPE_PRECISION (string_type_node), ! TYPE_PRECISION (ffecom_f2c_ftnlen_type_node)); ! #endif ! #if 0 /* ASSIGN-related stuff has been changed to accommodate this. */ ! if (TYPE_PRECISION (ffecom_integer_type_node) ! < TYPE_PRECISION (string_type_node)) ! /* ASSIGN 10 TO I will crash. */ ! warning ("configuration: char * holds %d bits, but INTEGER only %d --\n\ ! ASSIGN statement might fail", ! TYPE_PRECISION (string_type_node), ! TYPE_PRECISION (ffecom_integer_type_node)); ! #endif } ! #endif ! /* ffecom_init_2 -- Initialize ! ffecom_init_2(); */ - #if FFECOM_targetCURRENT == FFECOM_targetGCC void ! ffecom_init_2 () { ! assert (ffecom_outer_function_decl_ == NULL_TREE); ! assert (current_function_decl == NULL_TREE); ! assert (ffecom_which_entrypoint_decl_ == NULL_TREE); ! ffecom_master_arglist_ = NULL; ! ++ffecom_num_fns_; ! ffecom_latest_temp_ = NULL; ! ffecom_primary_entry_ = NULL; ! ffecom_is_altreturning_ = FALSE; ! ffecom_func_result_ = NULL_TREE; ! ffecom_multi_retval_ = NULL_TREE; ! } ! #endif ! /* ffecom_list_expr -- Transform list of exprs into gcc tree ! tree t; ! ffebld expr; // FFE opITEM list. ! tree = ffecom_list_expr(expr); ! List of actual args is transformed into corresponding gcc backend list. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_list_expr (ffebld expr) ! { ! tree list; ! tree *plist = &list; ! tree trail = NULL_TREE; /* Append char length args here. */ ! tree *ptrail = &trail; ! tree length; ! while (expr != NULL) { ! *plist ! = build_tree_list (NULL_TREE, ffecom_arg_expr (ffebld_head (expr), ! &length)); ! plist = &TREE_CHAIN (*plist); ! expr = ffebld_trail (expr); ! if (length != NULL_TREE) { ! *ptrail = build_tree_list (NULL_TREE, length); ! ptrail = &TREE_CHAIN (*ptrail); ! } ! } ! *plist = trail; ! return list; ! } ! #endif ! /* ffecom_list_ptr_to_expr -- Transform list of exprs into gcc tree ! tree t; ! ffebld expr; // FFE opITEM list. ! tree = ffecom_list_ptr_to_expr(expr); ! List of actual args is transformed into corresponding gcc backend list for ! use in calling an external procedure (vs. a statement function). */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_list_ptr_to_expr (ffebld expr) ! { ! tree list; ! tree *plist = &list; ! tree trail = NULL_TREE; /* Append char length args here. */ ! tree *ptrail = &trail; ! tree length; ! while (expr != NULL) ! { ! *plist ! = build_tree_list (NULL_TREE, ! ffecom_arg_ptr_to_expr (ffebld_head (expr), ! &length)); ! plist = &TREE_CHAIN (*plist); ! expr = ffebld_trail (expr); ! if (length != NULL_TREE) ! { ! *ptrail = build_tree_list (NULL_TREE, length); ! ptrail = &TREE_CHAIN (*ptrail); } ! } ! *plist = trail; ! return list; ! } ! #endif ! /* Obtain gcc's LABEL_DECL tree for label. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_lookup_label (ffelab label) ! { ! tree glabel; ! if (ffelab_hook (label) == NULL_TREE) { ! char labelname[16]; ! switch (ffelab_type (label)) ! { ! case FFELAB_typeLOOPEND: ! case FFELAB_typeNOTLOOP: ! case FFELAB_typeENDIF: ! sprintf (labelname, "%" ffelabValue_f "u", ffelab_value (label)); ! glabel = build_decl (LABEL_DECL, get_identifier (labelname), ! void_type_node); ! DECL_CONTEXT (glabel) = current_function_decl; ! DECL_MODE (glabel) = VOIDmode; ! break; ! case FFELAB_typeFORMAT: ! push_obstacks_nochange (); ! end_temporary_allocation (); ! glabel = build_decl (VAR_DECL, ! ffecom_get_invented_identifier ! ("__g77_format_%d", NULL, ! (int) ffelab_value (label)), ! build_type_variant (build_array_type ! (char_type_node, ! NULL_TREE), ! 1, 0)); ! TREE_CONSTANT (glabel) = 1; ! TREE_STATIC (glabel) = 1; ! DECL_CONTEXT (glabel) = 0; ! DECL_INITIAL (glabel) = NULL; ! make_decl_rtl (glabel, NULL, 0); ! expand_decl (glabel); ! resume_temporary_allocation (); ! pop_obstacks (); break; ! case FFELAB_typeANY: ! glabel = error_mark_node; break; default: - assert ("bad label type" == NULL); - glabel = NULL; break; } - ffelab_set_hook (label, glabel); - } - else - { - glabel = ffelab_hook (label); } ! return glabel; } ! #endif ! /* Stabilizes the arguments. Don't use this if the lhs and rhs come from ! a single source specification (as in the fourth argument of MVBITS). ! If the type is NULL_TREE, the type of lhs is used to make the type of ! the MODIFY_EXPR. */ ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_modify (tree newtype, tree lhs, ! tree rhs) ! { ! if (lhs == error_mark_node || rhs == error_mark_node) ! return error_mark_node; ! if (newtype == NULL_TREE) ! newtype = TREE_TYPE (lhs); ! if (TREE_SIDE_EFFECTS (lhs)) ! lhs = stabilize_reference (lhs); ! return ffecom_2s (MODIFY_EXPR, newtype, lhs, rhs); } ! #endif ! /* Register source file name. */ void ! ffecom_file (char *name) { ! #if FFECOM_GCC_INCLUDE ! ffecom_file_ (name); ! #endif ! } ! ! /* ffecom_notify_init_storage -- An aggregate storage is now fully init'ed ! ! ffestorag st; ! ffecom_notify_init_storage(st); ! ! Gets called when all possible units in an aggregate storage area (a LOCAL ! with equivalences or a COMMON) have been initialized. The initialization ! info either is in ffestorag_init or, if that is NULL, ! ffestorag_accretion: ! ! ffestorag_init may contain an opCONTER or opARRTER. opCONTER may occur ! even for an array if the array is one element in length! ! ffestorag_accretion will contain an opACCTER. It is much like an ! opARRTER except it has an ffebit object in it instead of just a size. ! The back end can use the info in the ffebit object, if it wants, to ! reduce the amount of actual initialization, but in any case it should ! kill the ffebit object when done. Also, set accretion to NULL but ! init to a non-NULL value. ! After performing initialization, DO NOT set init to NULL, because that'll ! tell the front end it is ok for more initialization to happen. Instead, ! set init to an opANY expression or some such thing that you can use to ! tell that you've already initialized the object. ! 27-Oct-91 JCB 1.1 ! Support two-pass FFE. */ void ! ffecom_notify_init_storage (ffestorag st) { ! ffebld init; /* The initialization expression. */ ! #if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC ! ffetargetOffset size; /* The size of the entity. */ ! ffetargetAlign pad; /* Its initial padding. */ ! #endif ! ! if (ffestorag_init (st) == NULL) ! { ! init = ffestorag_accretion (st); ! assert (init != NULL); ! ffestorag_set_accretion (st, NULL); ! ffestorag_set_accretes (st, 0); ! ! #if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC ! /* For GNU backend, just turn ACCTER into ARRTER and proceed. */ ! size = ffebld_accter_size (init); ! pad = ffebld_accter_pad (init); ! ffebit_kill (ffebld_accter_bits (init)); ! ffebld_set_op (init, FFEBLD_opARRTER); ! ffebld_set_arrter (init, ffebld_accter (init)); ! ffebld_arrter_set_size (init, size); ! ffebld_arrter_set_pad (init, size); ! #endif ! ! #if FFECOM_TWOPASS ! ffestorag_set_init (st, init); ! #endif ! } ! #if FFECOM_ONEPASS ! else ! init = ffestorag_init (st); ! #endif ! ! #if FFECOM_ONEPASS /* Process the inits, wipe 'em out. */ ! ffestorag_set_init (st, ffebld_new_any ()); ! ! if (ffebld_op (init) == FFEBLD_opANY) ! return; /* Oh, we already did this! */ ! ! #if FFECOM_targetCURRENT == FFECOM_targetFFE ! { ! ffesymbol s; ! ! if (ffestorag_symbol (st) != NULL) ! s = ffestorag_symbol (st); ! else ! s = ffestorag_typesymbol (st); ! fprintf (dmpout, "= initialize_storage \"%s\" ", ! (s != NULL) ? ffesymbol_text (s) : "(unnamed)"); ! ffebld_dump (init); ! fputc ('\n', dmpout); ! } ! #endif ! ! #endif /* if FFECOM_ONEPASS */ } ! /* ffecom_notify_init_symbol -- A symbol is now fully init'ed ! ! ffesymbol s; ! ffecom_notify_init_symbol(s); ! ! Gets called when all possible units in a symbol (not placed in COMMON ! or involved in EQUIVALENCE, unless it as yet has no ffestorag object) ! have been initialized. The initialization info either is in ! ffesymbol_init or, if that is NULL, ffesymbol_accretion: ! ffesymbol_init may contain an opCONTER or opARRTER. opCONTER may occur ! even for an array if the array is one element in length! ! ffesymbol_accretion will contain an opACCTER. It is much like an ! opARRTER except it has an ffebit object in it instead of just a size. ! The back end can use the info in the ffebit object, if it wants, to ! reduce the amount of actual initialization, but in any case it should ! kill the ffebit object when done. Also, set accretion to NULL but ! init to a non-NULL value. ! After performing initialization, DO NOT set init to NULL, because that'll ! tell the front end it is ok for more initialization to happen. Instead, ! set init to an opANY expression or some such thing that you can use to ! tell that you've already initialized the object. ! 27-Oct-91 JCB 1.1 ! Support two-pass FFE. */ ! void ! ffecom_notify_init_symbol (ffesymbol s) { ! ffebld init; /* The initialization expression. */ ! #if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC ! ffetargetOffset size; /* The size of the entity. */ ! ffetargetAlign pad; /* Its initial padding. */ ! #endif ! if (ffesymbol_storage (s) == NULL) ! return; /* Do nothing until COMMON/EQUIVALENCE ! possibilities checked. */ ! if ((ffesymbol_init (s) == NULL) ! && ((init = ffesymbol_accretion (s)) != NULL)) { ! ffesymbol_set_accretion (s, NULL); ! ffesymbol_set_accretes (s, 0); ! ! #if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC ! /* For GNU backend, just turn ACCTER into ARRTER and proceed. */ ! size = ffebld_accter_size (init); ! pad = ffebld_accter_pad (init); ! ffebit_kill (ffebld_accter_bits (init)); ! ffebld_set_op (init, FFEBLD_opARRTER); ! ffebld_set_arrter (init, ffebld_accter (init)); ! ffebld_arrter_set_size (init, size); ! ffebld_arrter_set_pad (init, size); ! #endif ! #if FFECOM_TWOPASS ! ffesymbol_set_init (s, init); ! #endif } - #if FFECOM_ONEPASS - else - init = ffesymbol_init (s); - #endif - - #if FFECOM_ONEPASS - ffesymbol_set_init (s, ffebld_new_any ()); - - if (ffebld_op (init) == FFEBLD_opANY) - return; /* Oh, we already did this! */ - - #if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "= initialize_symbol \"%s\" ", ffesymbol_text (s)); - ffebld_dump (init); - fputc ('\n', dmpout); - #endif ! #endif /* if FFECOM_ONEPASS */ } ! /* ffecom_notify_primary_entry -- Learn which is the primary entry point ! ffesymbol s; ! ffecom_notify_primary_entry(s); ! Gets called when implicit or explicit PROGRAM statement seen or when ! FUNCTION, SUBROUTINE, or BLOCK DATA statement seen, with the primary ! global symbol that serves as the entry point. */ ! void ! ffecom_notify_primary_entry (ffesymbol s) { ! ffecom_primary_entry_ = s; ! ffecom_primary_entry_kind_ = ffesymbol_kind (s); ! ! if ((ffecom_primary_entry_kind_ == FFEINFO_kindFUNCTION) ! || (ffecom_primary_entry_kind_ == FFEINFO_kindSUBROUTINE)) ! ffecom_primary_entry_is_proc_ = TRUE; ! else ! ffecom_primary_entry_is_proc_ = FALSE; ! if (!ffe_is_silent ()) { ! if (ffecom_primary_entry_kind_ == FFEINFO_kindPROGRAM) ! fprintf (stderr, "%s:\n", ffesymbol_text (s)); else ! fprintf (stderr, " %s:\n", ffesymbol_text (s)); ! } ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! if (ffecom_primary_entry_kind_ == FFEINFO_kindSUBROUTINE) ! { ! ffebld list; ! ffebld arg; ! for (list = ffesymbol_dummyargs (s); ! list != NULL; ! list = ffebld_trail (list)) { ! arg = ffebld_head (list); ! if (ffebld_op (arg) == FFEBLD_opSTAR) ! { ! ffecom_is_altreturning_ = TRUE; ! break; ! } } - } #endif ! } ! FILE * ! ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c) ! { ! #if FFECOM_GCC_INCLUDE ! return ffecom_open_include_ (name, l, c); ! #else ! return fopen (name, "r"); ! #endif ! } ! /* Clean up after making automatically popped call-arg temps. ! Call this in pairs with push_calltemps around calls to ! ffecom_arg_ptr_to_expr if the latter might use temporaries. ! Any temporaries made within the outermost sequence of ! push_calltemps and pop_calltemps, that are marked as "auto-pop" ! meaning they won't be explicitly popped (freed), are popped ! at this point so they can be reused later. ! ! NOTE: when called by ffecom_gen_sfuncdef_, ffecom_pending_calls_ ! should come in == 1, and all of the in-use auto-pop temps ! should have DECL_CONTEXT (temp->t) == current_function_decl. ! Moreover, these temps should _never_ be re-used in future ! calls to ffecom_push_tempvar -- since current_function_decl will ! never be the same again. ! ! SO, it could be a minor win in terms of compile time to just ! strip these temps off the list. That is, if the above assumptions ! are correct, just remove from the list of temps any temp ! that is both in-use and has DECL_CONTEXT (temp->t) ! == current_function_decl, when called from ffecom_gen_sfuncdef_. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! void ! ffecom_pop_calltemps () { ! ffecomTemp_ temp; ! ! assert (ffecom_pending_calls_ > 0); ! ! if (--ffecom_pending_calls_ == 0) ! for (temp = ffecom_latest_temp_; temp != NULL; temp = temp->next) ! if (temp->auto_pop) ! temp->in_use = FALSE; } - #endif ! /* Mark latest temp with given tree as no longer in use. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC void ! ffecom_pop_tempvar (tree t) { ! ffecomTemp_ temp; ! for (temp = ffecom_latest_temp_; temp != NULL; temp = temp->next) ! if (temp->in_use && (temp->t == t)) ! { ! assert (!temp->auto_pop); ! temp->in_use = FALSE; ! return; ! } ! else ! assert (temp->t != t); ! assert ("couldn't ffecom_pop_tempvar!" != NULL); } #endif ! /* ffecom_ptr_to_expr -- Transform expr into gcc tree with & in front ! tree t; ! ffebld expr; // FFE expression. ! tree = ffecom_ptr_to_expr(expr); ! Like ffecom_expr, but sticks address-of in front of most things. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_ptr_to_expr (ffebld expr) { ! tree item; ! ffeinfoBasictype bt; ! ffeinfoKindtype kt; ! ffesymbol s; ! assert (expr != NULL); ! switch (ffebld_op (expr)) ! { ! case FFEBLD_opSYMTER: ! s = ffebld_symter (expr); ! if (ffesymbol_where (s) == FFEINFO_whereINTRINSIC) ! { ! ffecomGfrt ix; ! ix = ffeintrin_gfrt_indirect (ffebld_symter_implementation (expr)); ! assert (ix != FFECOM_gfrt); ! if ((item = ffecom_gfrt_[ix]) == NULL_TREE) ! { ! ffecom_make_gfrt_ (ix); ! item = ffecom_gfrt_[ix]; ! } ! } ! else ! { ! item = ffesymbol_hook (s).decl_tree; ! if (item == NULL_TREE) ! { ! s = ffecom_sym_transform_ (s); ! item = ffesymbol_hook (s).decl_tree; ! } ! } ! assert (item != NULL); ! if (item == error_mark_node) ! return item; ! if (!ffesymbol_hook (s).addr) ! item = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (item)), ! item); ! return item; ! case FFEBLD_opARRAYREF: ! { ! ffebld dims[FFECOM_dimensionsMAX]; ! tree array; ! int i; ! item = ffecom_ptr_to_expr (ffebld_left (expr)); ! if (item == error_mark_node) ! return item; ! if ((ffeinfo_where (ffebld_info (expr)) == FFEINFO_whereFLEETING) ! && !mark_addressable (item)) ! return error_mark_node; /* Make sure non-const ref is to ! non-reg. */ ! ! /* Build up ARRAY_REFs in reverse order (since we're column major ! here in Fortran land). */ ! ! for (i = 0, expr = ffebld_right (expr); ! expr != NULL; ! expr = ffebld_trail (expr)) ! dims[i++] = ffebld_head (expr); ! ! for (--i, array = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item))); ! i >= 0; ! --i, array = TYPE_MAIN_VARIANT (TREE_TYPE (array))) ! { ! /* The initial subtraction should happen in the original type so ! that (possible) negative values are handled appropriately. */ ! item ! = ffecom_2 (PLUS_EXPR, ! build_pointer_type (TREE_TYPE (array)), ! item, ! size_binop (MULT_EXPR, ! size_in_bytes (TREE_TYPE (array)), ! convert (sizetype, ! fold (build (MINUS_EXPR, ! TREE_TYPE (TYPE_MIN_VALUE (TYPE_DOMAIN (array))), ! ffecom_expr (dims[i]), ! TYPE_MIN_VALUE (TYPE_DOMAIN (array))))))); ! } ! } ! return item; ! case FFEBLD_opCONTER: ! bt = ffeinfo_basictype (ffebld_info (expr)); ! kt = ffeinfo_kindtype (ffebld_info (expr)); ! item = ffecom_constantunion (&ffebld_constant_union ! (ffebld_conter (expr)), bt, kt, ! ffecom_tree_type[bt][kt]); ! if (item == error_mark_node) ! return error_mark_node; ! item = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (item)), ! item); ! return item; ! case FFEBLD_opANY: ! return error_mark_node; ! default: ! assert (ffecom_pending_calls_ > 0); ! bt = ffeinfo_basictype (ffebld_info (expr)); ! kt = ffeinfo_kindtype (ffebld_info (expr)); ! item = ffecom_expr (expr); ! if (item == error_mark_node) ! return error_mark_node; ! /* The back end currently optimizes a bit too zealously for us, in that ! we fail JCB001 if the following block of code is omitted. It checks ! to see if the transformed expression is a symbol or array reference, ! and encloses it in a SAVE_EXPR if that is the case. */ ! STRIP_NOPS (item); ! if ((TREE_CODE (item) == VAR_DECL) ! || (TREE_CODE (item) == PARM_DECL) ! || (TREE_CODE (item) == RESULT_DECL) ! || (TREE_CODE (item) == INDIRECT_REF) ! || (TREE_CODE (item) == ARRAY_REF) ! || (TREE_CODE (item) == COMPONENT_REF) ! #ifdef OFFSET_REF ! || (TREE_CODE (item) == OFFSET_REF) ! #endif ! || (TREE_CODE (item) == BUFFER_REF) ! || (TREE_CODE (item) == REALPART_EXPR) ! || (TREE_CODE (item) == IMAGPART_EXPR)) ! { ! item = ffecom_save_tree (item); ! } ! item = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (item)), ! item); ! return item; ! } ! assert ("fall-through error" == NULL); ! return error_mark_node; } ! #endif ! /* Prepare to make call-arg temps. ! Call this in pairs with pop_calltemps around calls to ! ffecom_arg_ptr_to_expr if the latter might use temporaries. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! void ! ffecom_push_calltemps () { ! ffecom_pending_calls_++; } ! #endif ! /* Obtain a temp var with given data type. ! Returns a VAR_DECL tree of a currently (that is, at the current ! statement being compiled) not in use and having the given data type, ! making a new one if necessary. size is FFETARGET_charactersizeNONE ! for a non-CHARACTER type or >= 0 for a CHARACTER type. elements is ! -1 for a scalar or > 0 for an array of type. auto_pop is TRUE if ! ffecom_pop_tempvar won't be called, meaning temp will be freed ! when #pending calls goes to zero. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_push_tempvar (tree type, ffetargetCharacterSize size, int elements, ! bool auto_pop) { ! ffecomTemp_ temp; ! int yes; ! tree t; ! static int mynumber; ! ! assert (!auto_pop || (ffecom_pending_calls_ > 0)); ! ! if (type == error_mark_node) ! return error_mark_node; ! for (temp = ffecom_latest_temp_; temp != NULL; temp = temp->next) { ! if (temp->in_use ! || (temp->type != type) ! || (temp->size != size) ! || (temp->elements != elements) ! || (DECL_CONTEXT (temp->t) != current_function_decl)) ! continue; ! temp->in_use = TRUE; ! temp->auto_pop = auto_pop; ! return temp->t; ! } ! /* Create a new temp. */ ! yes = suspend_momentary (); ! if (size != FFETARGET_charactersizeNONE) ! type = build_array_type (type, ! build_range_type (ffecom_f2c_ftnlen_type_node, ! ffecom_f2c_ftnlen_one_node, ! build_int_2 (size, 0))); ! if (elements != -1) ! type = build_array_type (type, ! build_range_type (integer_type_node, ! integer_zero_node, ! build_int_2 (elements - 1, ! 0))); ! t = build_decl (VAR_DECL, ! ffecom_get_invented_identifier ("__g77_expr_%d", NULL, ! mynumber++), ! type); ! /* This temp must be put in the same scope as the containing BLOCK ! (aka function), but for reasons that should be explained elsewhere, ! the GBE normally decides it should be in a "phantom BLOCK" associated ! with the expand_start_stmt_expr() call. So push the topmost ! sequence back onto the GBE's internal stack before telling it ! about the decl, then restore it afterwards. */ ! push_topmost_sequence (); ! t = start_decl (t, FALSE); ! finish_decl (t, NULL_TREE, FALSE); ! pop_topmost_sequence (); ! resume_momentary (yes); ! temp = malloc_new_kp (ffe_pool_program_unit (), "ffecomTemp_", ! sizeof (*temp)); ! temp->next = ffecom_latest_temp_; ! temp->type = type; ! temp->t = t; ! temp->size = size; ! temp->elements = elements; ! temp->in_use = TRUE; ! temp->auto_pop = auto_pop; ! ffecom_latest_temp_ = temp; ! return t; } #endif ! /* ffecom_return_expr -- Returns return-value expr given alt return expr ! ! tree rtn; // NULL_TREE means use expand_null_return() ! ffebld expr; // NULL if no alt return expr to RETURN stmt ! rtn = ffecom_return_expr(expr); ! Based on the program unit type and other info (like return function ! type, return master function type when alternate ENTRY points, ! whether subroutine has any alternate RETURN points, etc), returns the ! appropriate expression to be returned to the caller, or NULL_TREE ! meaning no return value or the caller expects it to be returned somewhere ! else (which is handled by other parts of this module). */ #if FFECOM_targetCURRENT == FFECOM_targetGCC tree ! ffecom_return_expr (ffebld expr) { ! tree rtn; ! switch (ffecom_primary_entry_kind_) ! { ! case FFEINFO_kindPROGRAM: ! case FFEINFO_kindBLOCKDATA: ! rtn = NULL_TREE; ! break; ! case FFEINFO_kindSUBROUTINE: ! if (!ffecom_is_altreturning_) ! rtn = NULL_TREE; /* No alt returns, never an expr. */ ! else if (expr == NULL) ! rtn = integer_zero_node; ! else ! rtn = ffecom_expr (expr); ! break; ! case FFEINFO_kindFUNCTION: ! if ((ffecom_multi_retval_ != NULL_TREE) ! || (ffesymbol_basictype (ffecom_primary_entry_) ! == FFEINFO_basictypeCHARACTER) ! || ((ffesymbol_basictype (ffecom_primary_entry_) ! == FFEINFO_basictypeCOMPLEX) ! && (ffecom_num_entrypoints_ == 0) ! && ffesymbol_is_f2c (ffecom_primary_entry_))) ! { /* Value is returned by direct assignment ! into (implicit) dummy. */ ! rtn = NULL_TREE; ! break; ! } ! rtn = ffecom_func_result_; ! #if 0 ! /* Spurious error if RETURN happens before first reference! So elide ! this code. In particular, for debugging registry, rtn should always ! be non-null after all, but TREE_USED won't be set until we encounter ! a reference in the code. Perfectly okay (but weird) code that, ! e.g., has "GOTO 20;10 RETURN;20 RTN=0;GOTO 10", would result in ! this diagnostic for no reason. Have people use -O -Wuninitialized ! and leave it to the back end to find obviously weird cases. */ ! /* Used to "assert(rtn != NULL_TREE);" here, but it's kind of a valid ! situation; if the return value has never been referenced, it won't ! have a tree under 2pass mode. */ ! if ((rtn == NULL_TREE) ! || !TREE_USED (rtn)) ! { ! ffebad_start (FFEBAD_RETURN_VALUE_UNSET); ! ffebad_here (0, ffesymbol_where_line (ffecom_primary_entry_), ! ffesymbol_where_column (ffecom_primary_entry_)); ! ffebad_string (ffesymbol_text (ffesymbol_funcresult ! (ffecom_primary_entry_))); ! ffebad_finish (); ! } ! #endif ! break; default: ! assert ("bad unit kind" == NULL); ! case FFEINFO_kindANY: ! rtn = error_mark_node; ! break; } - - return rtn; } ! #endif ! /* Do save_expr only if tree is not error_mark_node. */ ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_save_tree (tree t) ! { ! return save_expr (t); ! } ! #endif ! /* Public entry point for front end to access start_decl. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC tree ! ffecom_start_decl (tree decl, bool is_initialized) { ! DECL_INITIAL (decl) = is_initialized ? error_mark_node : NULL_TREE; ! return start_decl (decl, FALSE); } #endif ! /* ffecom_sym_commit -- Symbol's state being committed to reality ! ! ffesymbol s; ! ffecom_sym_commit(s); ! Does whatever the backend needs when a symbol is committed after having ! been backtrackable for a period of time. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! void ! ffecom_sym_commit (ffesymbol s UNUSED) { ! assert (!ffesymbol_retractable ()); } ! #endif ! /* ffecom_sym_end_transition -- Perform end transition on all symbols ! ! ffecom_sym_end_transition(); ! ! Does backend-specific stuff and also calls ffest_sym_end_transition ! to do the necessary FFE stuff. ! ! Backtracking is never enabled when this fn is called, so don't worry ! about it. */ ! ! ffesymbol ! ffecom_sym_end_transition (ffesymbol s) { ! ffestorag st; ! assert (!ffesymbol_retractable ()); ! s = ffest_sym_end_transition (s); ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! if ((ffesymbol_kind (s) == FFEINFO_kindBLOCKDATA) ! && (ffesymbol_where (s) == FFEINFO_whereGLOBAL)) ! { ! ffecom_list_blockdata_ ! = ffebld_new_item (ffebld_new_symter (s, FFEINTRIN_genNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_impNONE), ! ffecom_list_blockdata_); ! } ! #endif ! /* This is where we finally notice that a symbol has partial initialization ! and finalize it. */ ! if (ffesymbol_accretion (s) != NULL) ! { ! assert (ffesymbol_init (s) == NULL); ! ffecom_notify_init_symbol (s); ! } ! else if (((st = ffesymbol_storage (s)) != NULL) ! && ((st = ffestorag_parent (st)) != NULL) ! && (ffestorag_accretion (st) != NULL)) ! { ! assert (ffestorag_init (st) == NULL); ! ffecom_notify_init_storage (st); ! } ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! if ((ffesymbol_kind (s) == FFEINFO_kindCOMMON) ! && (ffesymbol_where (s) == FFEINFO_whereLOCAL) ! && (ffesymbol_storage (s) != NULL)) { ! ffecom_list_common_ ! = ffebld_new_item (ffebld_new_symter (s, FFEINTRIN_genNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_impNONE), ! ffecom_list_common_); } - #endif ! return s; } ! /* ffecom_sym_exec_transition -- Perform exec transition on all symbols ! ! ffecom_sym_exec_transition(); ! ! Does backend-specific stuff and also calls ffest_sym_exec_transition ! to do the necessary FFE stuff. ! See the long-winded description in ffecom_sym_learned for info ! on handling the situation where backtracking is inhibited. */ ! ffesymbol ! ffecom_sym_exec_transition (ffesymbol s) { ! s = ffest_sym_exec_transition (s); ! ! return s; ! } ! ! /* ffecom_sym_learned -- Initial or more info gained on symbol after exec ! ! ffesymbol s; ! s = ffecom_sym_learned(s); ! ! Called when a new symbol is seen after the exec transition or when more ! info (perhaps) is gained for an UNCERTAIN symbol. The symbol state when ! it arrives here is that all its latest info is updated already, so its ! state may be UNCERTAIN or UNDERSTOOD, it might already have the hook ! field filled in if its gone through here or exec_transition first, and ! so on. ! The backend probably wants to check ffesymbol_retractable() to see if ! backtracking is in effect. If so, the FFE's changes to the symbol may ! be retracted (undone) or committed (ratified), at which time the ! appropriate ffecom_sym_retract or _commit function will be called ! for that function. ! If the backend has its own backtracking mechanism, great, use it so that ! committal is a simple operation. Though it doesn't make much difference, ! I suppose: the reason for tentative symbol evolution in the FFE is to ! enable error detection in weird incorrect statements early and to disable ! incorrect error detection on a correct statement. The backend is not ! likely to introduce any information that'll get involved in these ! considerations, so it is probably just fine that the implementation ! model for this fn and for _exec_transition is to not do anything ! (besides the required FFE stuff) if ffesymbol_retractable() returns TRUE ! and instead wait until ffecom_sym_commit is called (which it never ! will be as long as we're using ambiguity-detecting statement analysis in ! the FFE, which we are initially to shake out the code, but don't depend ! on this), otherwise go ahead and do whatever is needed. ! In essence, then, when this fn and _exec_transition get called while ! backtracking is enabled, a general mechanism would be to flag which (or ! both) of these were called (and in what order? neat question as to what ! might happen that I'm too lame to think through right now) and then when ! _commit is called reproduce the original calling sequence, if any, for ! the two fns (at which point backtracking will, of course, be disabled). */ ! ffesymbol ! ffecom_sym_learned (ffesymbol s) ! { ! ffestorag_exec_layout (s); ! return s; ! } ! /* ffecom_sym_retract -- Symbol's state being retracted from reality ! ffesymbol s; ! ffecom_sym_retract(s); ! Does whatever the backend needs when a symbol is retracted after having ! been backtrackable for a period of time. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! void ! ffecom_sym_retract (ffesymbol s UNUSED) ! { ! assert (!ffesymbol_retractable ()); ! #if 0 /* GCC doesn't commit any backtrackable sins, ! so nothing needed here. */ ! switch (ffesymbol_hook (s).state) { ! case 0: /* nothing happened yet. */ ! break; ! case 1: /* exec transition happened. */ ! break; ! case 2: /* learned happened. */ ! break; ! case 3: /* learned then exec. */ ! break; ! case 4: /* exec then learned. */ ! break; ! default: ! assert ("bad hook state" == NULL); ! break; ! } ! #endif ! } ! #endif ! /* Create temporary gcc label. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_temp_label () ! { ! tree glabel; ! static int mynumber = 0; ! glabel = build_decl (LABEL_DECL, ! ffecom_get_invented_identifier ("__g77_label_%d", ! NULL, ! mynumber++), ! void_type_node); ! DECL_CONTEXT (glabel) = current_function_decl; ! DECL_MODE (glabel) = VOIDmode; ! return glabel; ! } ! #endif ! /* Return an expression that is usable as an arg in a conditional context ! (IF, DO WHILE, .NOT., and so on). ! Use the one provided for the back end as of >2.6.0. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_truth_value (tree expr) ! { ! return truthvalue_conversion (expr); ! } #endif - /* Return the inversion of a truth value (the inversion of what - ffecom_truth_value builds). - - Apparently invert_truthvalue, which is properly in the back end, is - enough for now, so just use it. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_truth_value_invert (tree expr) ! { ! return invert_truthvalue (ffecom_truth_value (expr)); ! } ! #endif ! /* Return PARM_DECL for arg#1 of master fn containing alternate ENTRY points ! If the PARM_DECL already exists, return it, else create it. It's an ! integer_type_node argument for the master function that implements a ! subroutine or function with more than one entrypoint and is bound at ! run time with the entrypoint number (0 for SUBROUTINE/FUNCTION, 1 for ! first ENTRY statement, and so on). */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_which_entrypoint_decl () ! { ! assert (ffecom_which_entrypoint_decl_ != NULL_TREE); ! return ffecom_which_entrypoint_decl_; ! } ! #endif ! ! /* The following sections consists of private and public functions ! that have the same names and perform roughly the same functions ! as counterparts in the C front end. Changes in the C front end ! might affect how things should be done here. Only functions ! needed by the back end should be public here; the rest should ! be private (static in the C sense). Functions needed by other ! g77 front-end modules should be accessed by them via public ! ffecom_* names, which should themselves call private versions ! in this section so the private versions are easy to recognize ! when upgrading to a new gcc and finding interesting changes ! in the front end. ! Functions named after rule "foo:" in c-parse.y are named ! "bison_rule_foo_" so they are easy to find. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void ! bison_rule_compstmt_ () ! { ! emit_line_note (input_filename, lineno); ! expand_end_bindings (getdecls (), 1, 1); ! poplevel (1, 1, 0); ! pop_momentary (); } static void ! bison_rule_pushlevel_ () { ! emit_line_note (input_filename, lineno); ! pushlevel (0); ! clear_last_expr (); ! push_momentary (); ! expand_start_bindings (0); ! } ! /* Return a definition for a builtin function named NAME and whose data type ! is TYPE. TYPE should be a function type with argument types. ! FUNCTION_CODE tells later passes how to compile calls to this function. ! 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. */ ! static tree ! builtin_function (char *name, tree type, ! enum built_in_function function_code, char *library_name) ! { ! tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type); ! DECL_EXTERNAL (decl) = 1; ! TREE_PUBLIC (decl) = 1; ! if (library_name) ! DECL_ASSEMBLER_NAME (decl) = get_identifier (library_name); ! make_decl_rtl (decl, NULL_PTR, 1); ! pushdecl (decl); ! if (function_code != NOT_BUILT_IN) { ! DECL_BUILT_IN (decl) = 1; ! DECL_FUNCTION_CODE (decl) = function_code; } ! return decl; ! } ! ! /* Handle when a new declaration NEWDECL ! has the same name as an old one OLDDECL ! in the same binding contour. ! Prints an error message if appropriate. ! If safely possible, alter OLDDECL to look like NEWDECL, and return 1. ! Otherwise, return 0. */ ! static int ! duplicate_decls (tree newdecl, tree olddecl) ! { ! int types_match = 1; ! int new_is_definition = (TREE_CODE (newdecl) == FUNCTION_DECL ! && DECL_INITIAL (newdecl) != 0); ! tree oldtype = TREE_TYPE (olddecl); ! tree newtype = TREE_TYPE (newdecl); ! if (olddecl == newdecl) ! return 1; ! if (TREE_CODE (newtype) == ERROR_MARK ! || TREE_CODE (oldtype) == ERROR_MARK) ! types_match = 0; ! /* New decl is completely inconsistent with the old one => ! tell caller to replace the old one. ! This is always an error except in the case of shadowing a builtin. */ ! if (TREE_CODE (olddecl) != TREE_CODE (newdecl)) ! return 0; ! /* For real parm decl following a forward decl, ! return 1 so old decl will be reused. */ ! if (types_match && TREE_CODE (newdecl) == PARM_DECL ! && TREE_ASM_WRITTEN (olddecl) && ! TREE_ASM_WRITTEN (newdecl)) ! return 1; ! /* The new declaration is the same kind of object as the old one. ! The declarations may partially match. Print warnings if they don't ! match enough. Ultimately, copy most of the information from the new ! decl to the old one, and keep using the old one. */ ! if (TREE_CODE (olddecl) == FUNCTION_DECL ! && DECL_BUILT_IN (olddecl)) { ! /* A function declaration for a built-in function. */ ! if (!TREE_PUBLIC (newdecl)) ! return 0; ! else if (!types_match) ! { ! /* Accept the return type of the new declaration if same modes. */ ! tree oldreturntype = TREE_TYPE (TREE_TYPE (olddecl)); ! tree newreturntype = TREE_TYPE (TREE_TYPE (newdecl)); ! /* Make sure we put the new type in the same obstack as the old ones. ! If the old types are not both in the same obstack, use the ! permanent one. */ ! if (TYPE_OBSTACK (oldtype) == TYPE_OBSTACK (newtype)) ! push_obstacks (TYPE_OBSTACK (oldtype), TYPE_OBSTACK (oldtype)); ! else { ! push_obstacks_nochange (); ! end_temporary_allocation (); } ! if (TYPE_MODE (oldreturntype) == TYPE_MODE (newreturntype)) { ! /* Function types may be shared, so we can't just modify ! the return type of olddecl's function type. */ ! tree newtype ! = build_function_type (newreturntype, ! TYPE_ARG_TYPES (TREE_TYPE (olddecl))); ! types_match = 1; ! if (types_match) ! TREE_TYPE (olddecl) = newtype; } ! ! pop_obstacks (); } - if (!types_match) - return 0; } ! else if (TREE_CODE (olddecl) == FUNCTION_DECL ! && DECL_SOURCE_LINE (olddecl) == 0) { ! /* A function declaration for a predeclared function ! that isn't actually built in. */ ! if (!TREE_PUBLIC (newdecl)) ! return 0; ! else if (!types_match) { ! /* If the types don't match, preserve volatility indication. ! Later on, we will discard everything else about the ! default declaration. */ ! TREE_THIS_VOLATILE (newdecl) |= TREE_THIS_VOLATILE (olddecl); } } ! /* Copy all the DECL_... slots specified in the new decl ! except for any that we copy here from the old type. ! Past this point, we don't change OLDTYPE and NEWTYPE ! even if we change the types of NEWDECL and OLDDECL. */ ! if (types_match) ! { ! /* Make sure we put the new type in the same obstack as the old ones. ! If the old types are not both in the same obstack, use the permanent ! one. */ ! if (TYPE_OBSTACK (oldtype) == TYPE_OBSTACK (newtype)) ! push_obstacks (TYPE_OBSTACK (oldtype), TYPE_OBSTACK (oldtype)); ! else ! { ! push_obstacks_nochange (); ! end_temporary_allocation (); ! } ! /* Merge the data types specified in the two decls. */ ! if (TREE_CODE (newdecl) != FUNCTION_DECL || !DECL_BUILT_IN (olddecl)) ! TREE_TYPE (newdecl) ! = TREE_TYPE (olddecl) ! = TREE_TYPE (newdecl); ! /* Lay the type out, unless already done. */ ! if (oldtype != TREE_TYPE (newdecl)) ! { ! if (TREE_TYPE (newdecl) != error_mark_node) ! layout_type (TREE_TYPE (newdecl)); ! if (TREE_CODE (newdecl) != FUNCTION_DECL ! && TREE_CODE (newdecl) != TYPE_DECL ! && TREE_CODE (newdecl) != CONST_DECL) ! layout_decl (newdecl, 0); ! } else ! { ! /* Since the type is OLDDECL's, make OLDDECL's size go with. */ ! DECL_SIZE (newdecl) = DECL_SIZE (olddecl); ! if (TREE_CODE (olddecl) != FUNCTION_DECL) ! if (DECL_ALIGN (olddecl) > DECL_ALIGN (newdecl)) ! DECL_ALIGN (newdecl) = DECL_ALIGN (olddecl); ! } ! /* Keep the old rtl since we can safely use it. */ ! DECL_RTL (newdecl) = DECL_RTL (olddecl); ! /* Merge the type qualifiers. */ ! if (DECL_BUILT_IN_NONANSI (olddecl) && TREE_THIS_VOLATILE (olddecl) ! && !TREE_THIS_VOLATILE (newdecl)) ! TREE_THIS_VOLATILE (olddecl) = 0; ! if (TREE_READONLY (newdecl)) ! TREE_READONLY (olddecl) = 1; ! if (TREE_THIS_VOLATILE (newdecl)) ! { ! TREE_THIS_VOLATILE (olddecl) = 1; ! if (TREE_CODE (newdecl) == VAR_DECL) ! make_var_volatile (newdecl); ! } ! /* Keep source location of definition rather than declaration. ! Likewise, keep decl at outer scope. */ ! if ((DECL_INITIAL (newdecl) == 0 && DECL_INITIAL (olddecl) != 0) ! || (DECL_CONTEXT (newdecl) != 0 && DECL_CONTEXT (olddecl) == 0)) ! { ! DECL_SOURCE_LINE (newdecl) = DECL_SOURCE_LINE (olddecl); ! DECL_SOURCE_FILE (newdecl) = DECL_SOURCE_FILE (olddecl); ! if (DECL_CONTEXT (olddecl) == 0 ! && TREE_CODE (newdecl) != FUNCTION_DECL) ! DECL_CONTEXT (newdecl) = 0; ! } ! /* Merge the unused-warning information. */ ! if (DECL_IN_SYSTEM_HEADER (olddecl)) ! DECL_IN_SYSTEM_HEADER (newdecl) = 1; ! else if (DECL_IN_SYSTEM_HEADER (newdecl)) ! DECL_IN_SYSTEM_HEADER (olddecl) = 1; ! /* Merge the initialization information. */ ! if (DECL_INITIAL (newdecl) == 0) ! DECL_INITIAL (newdecl) = DECL_INITIAL (olddecl); ! /* Merge the section attribute. ! We want to issue an error if the sections conflict but that must be ! done later in decl_attributes since we are called before attributes ! are assigned. */ ! if (DECL_SECTION_NAME (newdecl) == NULL_TREE) ! DECL_SECTION_NAME (newdecl) = DECL_SECTION_NAME (olddecl); ! #if BUILT_FOR_270 ! if (TREE_CODE (newdecl) == FUNCTION_DECL) ! { ! DECL_STATIC_CONSTRUCTOR(newdecl) |= DECL_STATIC_CONSTRUCTOR(olddecl); ! DECL_STATIC_DESTRUCTOR (newdecl) |= DECL_STATIC_DESTRUCTOR (olddecl); ! } ! #endif ! pop_obstacks (); } ! /* If cannot merge, then use the new type and qualifiers, ! and don't preserve the old rtl. */ ! else { ! TREE_TYPE (olddecl) = TREE_TYPE (newdecl); ! TREE_READONLY (olddecl) = TREE_READONLY (newdecl); ! TREE_THIS_VOLATILE (olddecl) = TREE_THIS_VOLATILE (newdecl); ! TREE_SIDE_EFFECTS (olddecl) = TREE_SIDE_EFFECTS (newdecl); } ! /* Merge the storage class information. */ ! /* For functions, static overrides non-static. */ ! if (TREE_CODE (newdecl) == FUNCTION_DECL) { ! TREE_PUBLIC (newdecl) &= TREE_PUBLIC (olddecl); ! /* This is since we don't automatically ! copy the attributes of NEWDECL into OLDDECL. */ ! TREE_PUBLIC (olddecl) = TREE_PUBLIC (newdecl); ! /* If this clears `static', clear it in the identifier too. */ ! if (! TREE_PUBLIC (olddecl)) ! TREE_PUBLIC (DECL_NAME (olddecl)) = 0; } ! if (DECL_EXTERNAL (newdecl)) { ! TREE_STATIC (newdecl) = TREE_STATIC (olddecl); ! DECL_EXTERNAL (newdecl) = DECL_EXTERNAL (olddecl); ! /* An extern decl does not override previous storage class. */ ! TREE_PUBLIC (newdecl) = TREE_PUBLIC (olddecl); } else { ! TREE_STATIC (olddecl) = TREE_STATIC (newdecl); ! TREE_PUBLIC (olddecl) = TREE_PUBLIC (newdecl); ! } ! /* If either decl says `inline', this fn is inline, ! unless its definition was passed already. */ ! if (DECL_INLINE (newdecl) && DECL_INITIAL (olddecl) == 0) ! DECL_INLINE (olddecl) = 1; ! DECL_INLINE (newdecl) = DECL_INLINE (olddecl); ! /* Get rid of any built-in function if new arg types don't match it ! or if we have a function definition. */ ! if (TREE_CODE (newdecl) == FUNCTION_DECL ! && DECL_BUILT_IN (olddecl) ! && (!types_match || new_is_definition)) ! { ! TREE_TYPE (olddecl) = TREE_TYPE (newdecl); ! DECL_BUILT_IN (olddecl) = 0; } ! /* If redeclaring a builtin function, and not a definition, ! it stays built in. ! Also preserve various other info from the definition. */ ! if (TREE_CODE (newdecl) == FUNCTION_DECL && !new_is_definition) { ! if (DECL_BUILT_IN (olddecl)) { ! DECL_BUILT_IN (newdecl) = 1; ! DECL_FUNCTION_CODE (newdecl) = DECL_FUNCTION_CODE (olddecl); } - else - DECL_FRAME_SIZE (newdecl) = DECL_FRAME_SIZE (olddecl); ! DECL_RESULT (newdecl) = DECL_RESULT (olddecl); ! DECL_INITIAL (newdecl) = DECL_INITIAL (olddecl); ! DECL_SAVED_INSNS (newdecl) = DECL_SAVED_INSNS (olddecl); ! DECL_ARGUMENTS (newdecl) = DECL_ARGUMENTS (olddecl); } ! /* Copy most of the decl-specific fields of NEWDECL into OLDDECL. ! But preserve olddecl's DECL_UID. */ ! { ! register unsigned olddecl_uid = DECL_UID (olddecl); ! memcpy ((char *) olddecl + sizeof (struct tree_common), ! (char *) newdecl + sizeof (struct tree_common), ! sizeof (struct tree_decl) - sizeof (struct tree_common)); ! DECL_UID (olddecl) = olddecl_uid; ! } ! return 1; } ! /* Finish processing of a declaration; ! install its initial value. ! If the length of an array type is not known before, ! it must be determined now, from the initial value, or it is an error. */ ! static void ! finish_decl (tree decl, tree init, bool is_top_level) { ! register tree type = TREE_TYPE (decl); ! int was_incomplete = (DECL_SIZE (decl) == 0); ! int temporary = allocation_temporary_p (); ! bool at_top_level = (current_binding_level == global_binding_level); ! bool top_level = is_top_level || at_top_level; ! /* Caller should pass TRUE for is_top_level only if we wouldn't be at top ! level anyway. */ ! assert (!is_top_level || !at_top_level); ! if (TREE_CODE (decl) == PARM_DECL) ! assert (init == NULL_TREE); ! /* Remember that PARM_DECL doesn't have a DECL_INITIAL field per se -- it ! overlaps DECL_ARG_TYPE. */ ! else if (init == NULL_TREE) ! assert (DECL_INITIAL (decl) == NULL_TREE); ! else ! assert (DECL_INITIAL (decl) == error_mark_node); ! if (init != NULL_TREE) { ! if (TREE_CODE (decl) != TYPE_DECL) ! DECL_INITIAL (decl) = init; ! else ! { ! /* typedef foo = bar; store the type of bar as the type of foo. */ ! TREE_TYPE (decl) = TREE_TYPE (init); ! DECL_INITIAL (decl) = init = 0; ! } } ! /* Pop back to the obstack that is current for this binding level. This is ! because MAXINDEX, rtl, etc. to be made below must go in the permanent ! obstack. But don't discard the temporary data yet. */ ! pop_obstacks (); ! /* Deduce size of array from initialization, if not already known */ ! if (TREE_CODE (type) == ARRAY_TYPE ! && TYPE_DOMAIN (type) == 0 ! && TREE_CODE (decl) != TYPE_DECL) ! { ! assert (top_level); ! assert (was_incomplete); ! layout_decl (decl, 0); ! } ! if (TREE_CODE (decl) == VAR_DECL) ! { ! if (DECL_SIZE (decl) == NULL_TREE ! && TYPE_SIZE (TREE_TYPE (decl)) != NULL_TREE) ! layout_decl (decl, 0); ! if (DECL_SIZE (decl) == NULL_TREE ! && (TREE_STATIC (decl) ! ? ! /* A static variable with an incomplete type is an error if it is ! initialized. Also if it is not file scope. Otherwise, let it ! through, but if it is not `extern' then it may cause an error ! message later. */ ! (DECL_INITIAL (decl) != 0 || DECL_CONTEXT (decl) != 0) ! : ! /* An automatic variable with an incomplete type is an error. */ ! !DECL_EXTERNAL (decl))) ! { ! assert ("storage size not known" == NULL); ! abort (); ! } ! if ((DECL_EXTERNAL (decl) || TREE_STATIC (decl)) ! && (DECL_SIZE (decl) != 0) ! && (TREE_CODE (DECL_SIZE (decl)) != INTEGER_CST)) ! { ! assert ("storage size not constant" == NULL); ! abort (); ! } ! } ! /* Output the assembler code and/or RTL code for variables and functions, ! unless the type is an undefined structure or union. If not, it will get ! done when the type is completed. */ ! if (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == FUNCTION_DECL) ! { ! rest_of_decl_compilation (decl, NULL, ! DECL_CONTEXT (decl) == 0, ! 0); ! if (DECL_CONTEXT (decl) != 0) ! { ! /* Recompute the RTL of a local array now if it used to be an ! incomplete type. */ ! if (was_incomplete ! && !TREE_STATIC (decl) && !DECL_EXTERNAL (decl)) ! { ! /* If we used it already as memory, it must stay in memory. */ ! TREE_ADDRESSABLE (decl) = TREE_USED (decl); ! /* If it's still incomplete now, no init will save it. */ ! if (DECL_SIZE (decl) == 0) ! DECL_INITIAL (decl) = 0; ! expand_decl (decl); ! } ! /* Compute and store the initial value. */ ! if (TREE_CODE (decl) != FUNCTION_DECL) ! expand_decl_init (decl); ! } ! } ! else if (TREE_CODE (decl) == TYPE_DECL) ! { ! rest_of_decl_compilation (decl, NULL_PTR, ! DECL_CONTEXT (decl) == 0, ! 0); ! } ! /* This test used to include TREE_PERMANENT, however, we have the same ! problem with initializers at the function level. Such initializers get ! saved until the end of the function on the momentary_obstack. */ ! if (!(TREE_CODE (decl) == FUNCTION_DECL && DECL_INLINE (decl)) ! && temporary ! /* DECL_INITIAL is not defined in PARM_DECLs, since it shares space with ! DECL_ARG_TYPE. */ ! && TREE_CODE (decl) != PARM_DECL) ! { ! /* We need to remember that this array HAD an initialization, but ! discard the actual temporary nodes, since we can't have a permanent ! node keep pointing to them. */ ! /* We make an exception for inline functions, since it's normal for a ! local extern redeclaration of an inline function to have a copy of ! the top-level decl's DECL_INLINE. */ ! if ((DECL_INITIAL (decl) != 0) ! && (DECL_INITIAL (decl) != error_mark_node)) ! { ! /* If this is a const variable, then preserve the ! initializer instead of discarding it so that we can optimize ! references to it. */ ! /* This test used to include TREE_STATIC, but this won't be set ! for function level initializers. */ ! if (TREE_READONLY (decl)) ! { ! preserve_initializer (); ! /* Hack? Set the permanent bit for something that is ! permanent, but not on the permenent obstack, so as to ! convince output_constant_def to make its rtl on the ! permanent obstack. */ ! TREE_PERMANENT (DECL_INITIAL (decl)) = 1; ! /* The initializer and DECL must have the same (or equivalent ! types), but if the initializer is a STRING_CST, its type ! might not be on the right obstack, so copy the type ! of DECL. */ ! TREE_TYPE (DECL_INITIAL (decl)) = type; ! } ! else ! DECL_INITIAL (decl) = error_mark_node; ! } ! } ! /* If requested, warn about definitions of large data objects. */ ! if (warn_larger_than ! && (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == PARM_DECL) ! && !DECL_EXTERNAL (decl)) ! { ! register tree decl_size = DECL_SIZE (decl); ! if (decl_size && TREE_CODE (decl_size) == INTEGER_CST) ! { ! unsigned units = TREE_INT_CST_LOW (decl_size) / BITS_PER_UNIT; ! if (units > larger_than_size) ! warning_with_decl (decl, "size of `%s' is %u bytes", units); ! } ! } ! /* If we have gone back from temporary to permanent allocation, actually ! free the temporary space that we no longer need. */ ! if (temporary && !allocation_temporary_p ()) ! permanent_allocation (0); ! /* At the end of a declaration, throw away any variable type sizes of types ! defined inside that declaration. There is no use computing them in the ! following function definition. */ ! if (current_binding_level == global_binding_level) ! get_pending_sizes (); } ! /* Finish up a function declaration and compile that function ! all the way to assembler language output. The free the storage ! for the function definition. ! This is called after parsing the body of the function definition. ! NESTED is nonzero if the function being finished is nested in another. */ static void ! finish_function (int nested) { register tree fndecl = current_function_decl; ! assert (fndecl != NULL_TREE); ! if (TREE_CODE (fndecl) != ERROR_MARK) ! { ! if (nested) ! assert (DECL_CONTEXT (fndecl) != NULL_TREE); ! else ! assert (DECL_CONTEXT (fndecl) == NULL_TREE); ! } ! /* TREE_READONLY (fndecl) = 1; ! This caused &foo to be of type ptr-to-const-function ! which then got a warning when stored in a ptr-to-function variable. */ ! poplevel (1, 0, 1); ! if (TREE_CODE (fndecl) != ERROR_MARK) ! { ! BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl; ! /* Must mark the RESULT_DECL as being in this function. */ ! DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl; ! /* Obey `register' declarations if `setjmp' is called in this fn. */ ! /* Generate rtl for function exit. */ ! expand_function_end (input_filename, lineno, 0); ! /* So we can tell if jump_optimize sets it to 1. */ ! can_reach_end = 0; ! /* Run the optimizers and output the assembler code for this function. */ ! rest_of_compilation (fndecl); } ! /* Free all the tree nodes making up this function. */ ! /* Switch back to allocating nodes permanently until we start another ! function. */ ! if (!nested) ! permanent_allocation (1); ! if (DECL_SAVED_INSNS (fndecl) == 0 && !nested && (TREE_CODE (fndecl) != ERROR_MARK)) { ! /* Stop pointing to the local nodes about to be freed. */ ! /* But DECL_INITIAL must remain nonzero so we know this was an actual ! function definition. */ ! /* For a nested function, this is done in pop_f_function_context. */ ! /* If rest_of_compilation set this to 0, leave it 0. */ ! if (DECL_INITIAL (fndecl) != 0) ! DECL_INITIAL (fndecl) = error_mark_node; ! DECL_ARGUMENTS (fndecl) = 0; } ! if (!nested) { ! /* Let the error reporting routines know that we're outside a function. ! For a nested function, this value is used in pop_c_function_context ! and then reset via pop_function_context. */ ! ffecom_outer_function_decl_ = current_function_decl = NULL; } } ! /* Plug-in replacement for identifying the name of a decl and, for a ! function, what we call it in diagnostics. For now, "program unit" ! should suffice, since it's a bit of a hassle to figure out which ! of several kinds of things it is. Note that it could conceivably ! be a statement function, which probably isn't really a program unit ! per se, but if that comes up, it should be easy to check (being a ! nested function and all). */ ! static char * ! lang_printable_name (tree decl, int v) ! { ! /* Just to keep GCC quiet about the unused variable. ! In theory, differing values of V should produce different ! output. */ ! switch (v) ! { ! default: ! if (TREE_CODE (decl) == ERROR_MARK) ! return "erroneous code"; ! return IDENTIFIER_POINTER (DECL_NAME (decl)); ! } ! } ! /* g77's function to print out name of current function that caused ! an error. */ ! #if BUILT_FOR_270 ! void ! lang_print_error_function (file) ! char *file; { ! static ffeglobal last_g = NULL; ! static ffesymbol last_s = NULL; ! ffeglobal g; ! ffesymbol s; ! char *kind; ! if ((ffecom_primary_entry_ == NULL) ! || (ffesymbol_global (ffecom_primary_entry_) == NULL)) { ! g = NULL; ! s = NULL; ! kind = NULL; } else { ! g = ffesymbol_global (ffecom_primary_entry_); ! if (ffecom_nested_entry_ == NULL) ! { ! s = ffecom_primary_entry_; ! switch (ffesymbol_kind (s)) ! { ! case FFEINFO_kindFUNCTION: ! kind = "function"; ! break; ! case FFEINFO_kindSUBROUTINE: ! kind = "subroutine"; ! break; ! case FFEINFO_kindPROGRAM: ! kind = "program"; ! break; ! case FFEINFO_kindBLOCKDATA: ! kind = "block-data"; ! break; ! default: ! kind = ffeinfo_kind_message (ffesymbol_kind (s)); ! break; ! } ! } ! else ! { ! s = ffecom_nested_entry_; ! kind = "statement function"; ! } } ! if ((last_g != g) || (last_s != s)) ! { ! if (file) ! fprintf (stderr, "%s: ", file); ! if (s == NULL) ! fprintf (stderr, "Outside of any program unit:\n"); ! else ! { ! char *name = ffesymbol_text (s); ! fprintf (stderr, "In %s `%s':\n", kind, name); ! } ! last_g = g; ! last_s = s; } - } - #endif ! /* Similar to `lookup_name' but look only at current binding level. */ ! static tree ! lookup_name_current_level (tree name) { ! register tree t; ! if (current_binding_level == global_binding_level) ! return IDENTIFIER_GLOBAL_VALUE (name); ! if (IDENTIFIER_LOCAL_VALUE (name) == 0) ! return 0; ! for (t = current_binding_level->names; t; t = TREE_CHAIN (t)) ! if (DECL_NAME (t) == name) ! break; ! return t; } ! /* Create a new `struct binding_level'. */ ! static struct binding_level * ! make_binding_level () { ! /* NOSTRICT */ ! return (struct binding_level *) xmalloc (sizeof (struct binding_level)); } ! /* Save and restore the variables in this file and elsewhere ! that keep track of the progress of compilation of the current function. ! Used for nested functions. */ ! struct f_function { ! struct f_function *next; ! tree named_labels; ! tree shadowed_labels; ! struct binding_level *binding_level; ! }; ! struct f_function *f_function_chain; ! /* Restore the variables used during compilation of a C function. */ ! static void ! pop_f_function_context () { ! struct f_function *p = f_function_chain; ! tree link; ! /* Bring back all the labels that were shadowed. */ ! for (link = shadowed_labels; link; link = TREE_CHAIN (link)) ! if (DECL_NAME (TREE_VALUE (link)) != 0) ! IDENTIFIER_LABEL_VALUE (DECL_NAME (TREE_VALUE (link))) ! = TREE_VALUE (link); ! if (DECL_SAVED_INSNS (current_function_decl) == 0) { ! /* Stop pointing to the local nodes about to be freed. */ ! /* But DECL_INITIAL must remain nonzero so we know this was an actual ! function definition. */ ! DECL_INITIAL (current_function_decl) = error_mark_node; ! DECL_ARGUMENTS (current_function_decl) = 0; } ! pop_function_context (); ! f_function_chain = p->next; ! named_labels = p->named_labels; ! shadowed_labels = p->shadowed_labels; ! current_binding_level = p->binding_level; ! free (p); } ! /* Save and reinitialize the variables ! used during compilation of a C function. */ ! static void ! push_f_function_context () { ! struct f_function *p ! = (struct f_function *) xmalloc (sizeof (struct f_function)); ! push_function_context (); ! p->next = f_function_chain; ! f_function_chain = p; ! p->named_labels = named_labels; ! p->shadowed_labels = shadowed_labels; ! p->binding_level = current_binding_level; } ! static void ! push_parm_decl (tree parm) { ! int old_immediate_size_expand = immediate_size_expand; ! /* Don't try computing parm sizes now -- wait till fn is called. */ ! immediate_size_expand = 0; ! push_obstacks_nochange (); ! /* Fill in arg stuff. */ ! DECL_ARG_TYPE (parm) = TREE_TYPE (parm); ! DECL_ARG_TYPE_AS_WRITTEN (parm) = TREE_TYPE (parm); ! TREE_READONLY (parm) = 1; /* All implementation args are read-only. */ ! parm = pushdecl (parm); ! immediate_size_expand = old_immediate_size_expand; ! finish_decl (parm, NULL_TREE, FALSE); } ! /* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL, if appropriate. */ ! static tree ! pushdecl_top_level (x) ! tree x; ! { ! register tree t; ! register struct binding_level *b = current_binding_level; ! register tree f = current_function_decl; ! current_binding_level = global_binding_level; ! current_function_decl = NULL_TREE; ! t = pushdecl (x); ! current_binding_level = b; ! current_function_decl = f; ! return t; ! } ! /* Store the list of declarations of the current level. ! This is done for the parameter declarations of a function being defined, ! after they are modified in the light of any missing parameters. */ ! static tree ! storedecls (decls) ! tree decls; { ! return current_binding_level->names = decls; ! } ! /* Store the parameter declarations into the current function declaration. ! This is called after parsing the parameter declarations, before ! digesting the body of the function. ! For an old-style definition, modify the function's type ! to specify at least the number of arguments. */ ! static void ! store_parm_decls (int is_main_program UNUSED) ! { ! register tree fndecl = current_function_decl; ! /* This is a chain of PARM_DECLs from old-style parm declarations. */ ! DECL_ARGUMENTS (fndecl) = storedecls (nreverse (getdecls ())); ! /* Initialize the RTL code for the function. */ ! init_function_start (fndecl, input_filename, lineno); ! /* Set up parameters and prepare for return, for the function. */ ! expand_function_start (fndecl, 0); ! } ! static tree ! start_decl (tree decl, bool is_top_level) ! { ! register tree tem; ! bool at_top_level = (current_binding_level == global_binding_level); ! bool top_level = is_top_level || at_top_level; ! /* Caller should pass TRUE for is_top_level only if we wouldn't be at top ! level anyway. */ ! assert (!is_top_level || !at_top_level); ! /* The corresponding pop_obstacks is in finish_decl. */ ! push_obstacks_nochange (); ! if (DECL_INITIAL (decl) != NULL_TREE) { ! assert (DECL_INITIAL (decl) == error_mark_node); ! assert (!DECL_EXTERNAL (decl)); } - else if (top_level) - assert ((TREE_STATIC (decl) == 1) || DECL_EXTERNAL (decl) == 1); ! /* For Fortran, we by default put things in .common when possible. */ ! DECL_COMMON (decl) = 1; ! /* Add this decl to the current binding level. TEM may equal DECL or it may ! be a previous decl of the same name. */ ! if (is_top_level) ! tem = pushdecl_top_level (decl); ! else ! tem = pushdecl (decl); ! /* For a local variable, define the RTL now. */ ! if (!top_level ! /* But not if this is a duplicate decl and we preserved the rtl from the ! previous one (which may or may not happen). */ ! && DECL_RTL (tem) == 0) ! { ! if (TYPE_SIZE (TREE_TYPE (tem)) != 0) ! expand_decl (tem); ! else if (TREE_CODE (TREE_TYPE (tem)) == ARRAY_TYPE ! && DECL_INITIAL (tem) != 0) ! expand_decl (tem); ! } ! if (DECL_INITIAL (tem) != NULL_TREE) { ! /* When parsing and digesting the initializer, use temporary storage. ! Do this even if we will ignore the value. */ ! if (at_top_level) ! temporary_allocation (); } ! return tem; } ! /* Create the FUNCTION_DECL for a function definition. ! DECLSPECS and DECLARATOR are the parts of the declaration; ! they describe the function's name and the type it returns, ! but twisted together in a fashion that parallels the syntax of C. ! ! This function creates a binding context for the function body ! as well as setting up the FUNCTION_DECL in current_function_decl. ! 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. ! NESTED is nonzero for a function nested within another function. */ ! static void ! start_function (tree name, tree type, int nested, int public) { ! tree decl1; ! tree restype; ! int old_immediate_size_expand = immediate_size_expand; ! named_labels = 0; ! shadowed_labels = 0; ! /* Don't expand any sizes in the return type of the function. */ ! immediate_size_expand = 0; ! if (nested) ! { ! assert (!public); ! assert (current_function_decl != NULL_TREE); ! assert (DECL_CONTEXT (current_function_decl) == NULL_TREE); ! } ! else ! { ! assert (current_function_decl == NULL_TREE); ! } ! if (TREE_CODE (type) == ERROR_MARK) ! decl1 = current_function_decl = error_mark_node; else { ! decl1 = build_decl (FUNCTION_DECL, ! name, ! type); ! TREE_PUBLIC (decl1) = public ? 1 : 0; ! if (nested) ! DECL_INLINE (decl1) = 1; ! TREE_STATIC (decl1) = 1; ! DECL_EXTERNAL (decl1) = 0; ! announce_function (decl1); ! /* Make the init_value nonzero so pushdecl knows this is not tentative. ! error_mark_node is replaced below (in poplevel) with the BLOCK. */ ! DECL_INITIAL (decl1) = error_mark_node; ! /* Record the decl so that the function name is defined. If we already have ! a decl for this name, and it is a FUNCTION_DECL, use the old decl. */ ! current_function_decl = pushdecl (decl1); ! } ! if (!nested) ! ffecom_outer_function_decl_ = current_function_decl; ! pushlevel (0); ! if (TREE_CODE (current_function_decl) != ERROR_MARK) ! { ! make_function_rtl (current_function_decl); ! restype = TREE_TYPE (TREE_TYPE (current_function_decl)); ! DECL_RESULT (current_function_decl) ! = build_decl (RESULT_DECL, NULL_TREE, restype); ! } ! if (!nested) ! /* Allocate further tree nodes temporarily during compilation of this ! function only. */ ! temporary_allocation (); ! if (!nested && (TREE_CODE (current_function_decl) != ERROR_MARK)) ! TREE_ADDRESSABLE (current_function_decl) = 1; ! immediate_size_expand = old_immediate_size_expand; ! } ! ! /* Here are the public functions the GNU back end needs. */ ! tree ! convert (type, expr) ! tree type, expr; ! { ! register tree e = expr; ! register enum tree_code code = TREE_CODE (type); ! if (type == TREE_TYPE (e) ! || TREE_CODE (e) == ERROR_MARK) ! return e; ! if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (e))) ! return fold (build1 (NOP_EXPR, type, e)); ! if (TREE_CODE (TREE_TYPE (e)) == ERROR_MARK ! || code == ERROR_MARK) ! return error_mark_node; ! if (TREE_CODE (TREE_TYPE (e)) == VOID_TYPE) ! { ! assert ("void value not ignored as it ought to be" == NULL); ! return error_mark_node; ! } ! if (code == VOID_TYPE) ! return build1 (CONVERT_EXPR, type, e); ! if ((code != RECORD_TYPE) ! && (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE)) ! e = ffecom_1 (REALPART_EXPR, TREE_TYPE (TYPE_FIELDS (TREE_TYPE (e))), ! e); ! if (code == INTEGER_TYPE || code == ENUMERAL_TYPE) ! return fold (convert_to_integer (type, e)); ! if (code == POINTER_TYPE) ! return fold (convert_to_pointer (type, e)); ! if (code == REAL_TYPE) ! return fold (convert_to_real (type, e)); ! if (code == COMPLEX_TYPE) ! return fold (convert_to_complex (type, e)); ! if (code == RECORD_TYPE) ! return fold (ffecom_convert_to_complex_ (type, e)); ! assert ("conversion to non-scalar type requested" == NULL); ! 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 ! store the result back using `storedecls' or you will lose. */ ! tree ! getdecls () ! { ! return current_binding_level->names; } ! /* Nonzero if we are currently in the global binding level. */ ! int ! global_bindings_p () { ! return current_binding_level == global_binding_level; } ! /* Insert BLOCK at the end of the list of subblocks of the ! current binding level. This is used when a BIND_EXPR is expanded, ! to handle the BLOCK node inside the BIND_EXPR. */ void ! incomplete_type_error (value, type) ! tree value UNUSED; ! tree type; { ! if (TREE_CODE (type) == ERROR_MARK) ! return; ! assert ("incomplete type?!?" == NULL); ! } ! void ! init_decl_processing () ! { ! malloc_init (); ! ffe_init_0 (); ! } ! char * ! init_parse (filename) ! char *filename; ! { ! #if BUILT_FOR_270 ! extern void (*print_error_function) (char *); ! #endif ! /* Open input file. */ ! if (filename == 0 || !strcmp (filename, "-")) { ! finput = stdin; ! filename = "stdin"; } else ! finput = fopen (filename, "r"); ! if (finput == 0) ! pfatal_with_name (filename); ! ! #ifdef IO_BUFFER_SIZE ! setvbuf (finput, (char *) xmalloc (IO_BUFFER_SIZE), _IOFBF, IO_BUFFER_SIZE); ! #endif ! /* Make identifier nodes long enough for the language-specific slots. */ ! set_identifier_size (sizeof (struct lang_identifier)); ! decl_printable_name = lang_printable_name; ! #if BUILT_FOR_270 ! print_error_function = lang_print_error_function; ! #endif ! return filename; } ! void ! finish_parse () ! { ! fclose (finput); ! } void ! insert_block (block) ! tree block; { ! TREE_USED (block) = 1; ! current_binding_level->blocks ! = chainon (current_binding_level->blocks, block); } ! int ! lang_decode_option (argc, argv) ! int argc; ! char **argv; ! { ! return ffe_decode_option (argc, argv); ! } ! /* used by print-tree.c */ void ! lang_print_xnode (file, node, indent) ! FILE *file UNUSED; ! tree node UNUSED; ! int indent UNUSED; { } ! void ! lang_finish () { ! ffe_terminate_0 (); ! ! if (ffe_is_ffedebug ()) ! malloc_pool_display (malloc_pool_image ()); ! } ! char * ! lang_identify () ! { ! return "f77"; ! } ! void ! lang_init_options () ! { ! /* Set default options for Fortran. */ ! flag_move_all_movables = 1; ! flag_reduce_all_givs = 1; ! flag_argument_noalias = 2; ! } ! void ! lang_init () ! { ! /* If the file is output from cpp, it should contain a first line ! `# 1 "real-filename"', and the current design of gcc (toplev.c ! in particular and the way it sets up information relied on by ! INCLUDE) requires that we read this now, and store the ! "real-filename" info in master_input_filename. Ask the lexer ! to try doing this. */ ! ffelex_hash_kludge (finput); } ! int ! mark_addressable (exp) ! tree exp; { ! register tree x = exp; ! while (1) ! switch (TREE_CODE (x)) ! { ! case ADDR_EXPR: ! case COMPONENT_REF: ! case ARRAY_REF: ! x = TREE_OPERAND (x, 0); ! break; ! ! case CONSTRUCTOR: ! TREE_ADDRESSABLE (x) = 1; ! return 1; ! ! case VAR_DECL: ! case CONST_DECL: ! case PARM_DECL: ! case RESULT_DECL: ! if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x) ! && DECL_NONLOCAL (x)) ! { ! if (TREE_PUBLIC (x)) ! { ! assert ("address of global register var requested" == NULL); ! return 0; ! } ! assert ("address of register variable requested" == NULL); ! } ! else if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x)) ! { ! if (TREE_PUBLIC (x)) ! { ! assert ("address of global register var requested" == NULL); ! return 0; ! } ! assert ("address of register var requested" == NULL); ! } ! put_var_into_stack (x); ! /* drops in */ ! case FUNCTION_DECL: ! TREE_ADDRESSABLE (x) = 1; ! #if 0 /* poplevel deals with this now. */ ! if (DECL_CONTEXT (x) == 0) ! TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (x)) = 1; #endif ! default: ! return 1; ! } } ! /* 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. ! If KEEP is nonzero, this level had explicit declarations, so ! and create a "block" (a BLOCK node) for the level ! to record its declarations and subblocks for symbol table output. ! If FUNCTIONBODY is nonzero, this level is the body of a function, ! so create a block as if KEEP were set and also clear out all ! label names. ! If REVERSE is nonzero, reverse the order of decls before putting ! them into the BLOCK. */ ! tree ! poplevel (keep, reverse, functionbody) ! int keep; ! int reverse; ! int functionbody; ! { ! register tree link; ! /* The chain of decls was accumulated in reverse order. Put it into forward ! order, just for cleanliness. */ ! tree decls; ! tree subblocks = current_binding_level->blocks; ! tree block = 0; ! tree decl; ! int block_previously_created; ! /* Get the decls in the order they were written. Usually ! current_binding_level->names is in reverse order. But parameter decls ! were previously put in forward order. */ ! if (reverse) ! current_binding_level->names ! = decls = nreverse (current_binding_level->names); ! else ! decls = current_binding_level->names; ! /* Output any nested inline functions within this block if they weren't ! already output. */ ! for (decl = decls; decl; decl = TREE_CHAIN (decl)) ! if (TREE_CODE (decl) == FUNCTION_DECL ! && !TREE_ASM_WRITTEN (decl) ! && DECL_INITIAL (decl) != 0 ! && TREE_ADDRESSABLE (decl)) ! { ! /* If this decl was copied from a file-scope decl on account of a ! block-scope extern decl, propagate TREE_ADDRESSABLE to the ! file-scope decl. */ ! if (DECL_ABSTRACT_ORIGIN (decl) != 0) ! TREE_ADDRESSABLE (DECL_ABSTRACT_ORIGIN (decl)) = 1; ! else ! { ! push_function_context (); ! output_inline_function (decl); ! pop_function_context (); ! } ! } ! /* If there were any declarations or structure tags in that level, or if ! this level is a function body, create a BLOCK to record them for the ! life of this function. */ ! block = 0; ! block_previously_created = (current_binding_level->this_block != 0); ! if (block_previously_created) ! block = current_binding_level->this_block; ! else if (keep || functionbody) ! block = make_node (BLOCK); ! if (block != 0) ! { ! BLOCK_VARS (block) = decls; ! BLOCK_SUBBLOCKS (block) = subblocks; ! remember_end_note (block); ! } ! /* In each subblock, record that this is its superior. */ ! for (link = subblocks; link; link = TREE_CHAIN (link)) ! BLOCK_SUPERCONTEXT (link) = block; ! /* Clear out the meanings of the local variables of this level. */ ! for (link = decls; link; link = TREE_CHAIN (link)) ! { ! if (DECL_NAME (link) != 0) ! { ! /* If the ident. was used or addressed via a local extern decl, ! don't forget that fact. */ ! if (DECL_EXTERNAL (link)) ! { ! if (TREE_USED (link)) ! TREE_USED (DECL_NAME (link)) = 1; ! if (TREE_ADDRESSABLE (link)) ! TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (link)) = 1; ! } ! IDENTIFIER_LOCAL_VALUE (DECL_NAME (link)) = 0; ! } } ! /* If the level being exited is the top level of a function, check over all ! the labels, and clear out the current (function local) meanings of their ! names. */ ! if (functionbody) ! { ! /* If this is the top level block of a function, the vars are the ! function's parameters. Don't leave them in the BLOCK because they ! are found in the FUNCTION_DECL instead. */ ! BLOCK_VARS (block) = 0; ! } ! /* Pop the current level, and free the structure for reuse. */ ! { ! register struct binding_level *level = current_binding_level; ! current_binding_level = current_binding_level->level_chain; ! level->level_chain = free_binding_level; ! free_binding_level = level; ! } ! /* Dispose of the block that we just made inside some higher level. */ ! if (functionbody) ! DECL_INITIAL (current_function_decl) = block; ! else if (block) ! { ! if (!block_previously_created) ! current_binding_level->blocks ! = chainon (current_binding_level->blocks, block); ! } ! /* If we did not make a block for the level just exited, any blocks made ! for inner levels (since they cannot be recorded as subblocks in that ! level) must be carried forward so they will later become subblocks of ! something else. */ ! else if (subblocks) ! current_binding_level->blocks ! = chainon (current_binding_level->blocks, subblocks); ! /* Set the TYPE_CONTEXTs for all of the tagged types belonging to this ! binding contour so that they point to the appropriate construct, i.e. ! either to the current FUNCTION_DECL node, or else to the BLOCK node we ! just constructed. ! ! Note that for tagged types whose scope is just the formal parameter list ! for some function type specification, we can't properly set their ! TYPE_CONTEXTs here, because we don't have a pointer to the appropriate ! FUNCTION_TYPE node readily available to us. For those cases, the ! TYPE_CONTEXTs of the relevant tagged type nodes get set in ! `grokdeclarator' as soon as we have created the FUNCTION_TYPE node which ! will represent the "scope" for these "parameter list local" tagged ! types. */ ! if (block) ! TREE_USED (block) = 1; ! return block; ! } ! void ! print_lang_decl (file, node, indent) ! FILE *file UNUSED; ! tree node UNUSED; ! int indent UNUSED; ! { ! } ! void ! print_lang_identifier (file, node, indent) ! FILE *file; ! tree node; ! int indent; ! { ! print_node (file, "global", IDENTIFIER_GLOBAL_VALUE (node), indent + 4); ! print_node (file, "local", IDENTIFIER_LOCAL_VALUE (node), indent + 4); ! } ! void ! print_lang_statistics () ! { } ! void ! print_lang_type (file, node, indent) ! FILE *file UNUSED; ! tree node UNUSED; ! int indent UNUSED; { ! } ! /* Record a decl-node X as belonging to the current lexical scope. ! Check for errors (such as an incompatible declaration for the same ! name already seen in the same scope). ! Returns either X or an old decl for the same name. ! If an old decl is returned, it may have been smashed ! to agree with what X says. */ ! tree ! pushdecl (x) ! tree x; ! { ! register tree t; ! register tree name = DECL_NAME (x); ! register struct binding_level *b = current_binding_level; ! if ((TREE_CODE (x) == FUNCTION_DECL) ! && (DECL_INITIAL (x) == 0) ! && DECL_EXTERNAL (x)) ! DECL_CONTEXT (x) = NULL_TREE; ! else ! DECL_CONTEXT (x) = current_function_decl; ! if (name) ! { ! if (IDENTIFIER_INVENTED (name)) ! { ! #if BUILT_FOR_270 ! DECL_ARTIFICIAL (x) = 1; ! #endif ! DECL_IN_SYSTEM_HEADER (x) = 1; ! } ! t = lookup_name_current_level (name); ! assert ((t == NULL_TREE) || (DECL_CONTEXT (x) == NULL_TREE)); ! /* Don't push non-parms onto list for parms until we understand ! why we're doing this and whether it works. */ ! assert ((b == global_binding_level) ! || !ffecom_transform_only_dummies_ ! || TREE_CODE (x) == PARM_DECL); ! if ((t != NULL_TREE) && duplicate_decls (x, t)) ! return t; ! /* If we are processing a typedef statement, generate a whole new ! ..._TYPE node (which will be just an variant of the existing ! ..._TYPE node with identical properties) and then install the ! TYPE_DECL node generated to represent the typedef name as the ! TYPE_NAME of this brand new (duplicate) ..._TYPE node. ! The whole point here is to end up with a situation where each and every ! ..._TYPE node the compiler creates will be uniquely associated with ! AT MOST one node representing a typedef name. This way, even though ! the compiler substitutes corresponding ..._TYPE nodes for TYPE_DECL ! (i.e. "typedef name") nodes very early on, later parts of the ! compiler can always do the reverse translation and get back the ! corresponding typedef name. For example, given: ! typedef struct S MY_TYPE; MY_TYPE object; ! Later parts of the compiler might only know that `object' was of type ! `struct S' if it were not for code just below. With this code ! however, later parts of the compiler see something like: ! struct S' == struct S typedef struct S' MY_TYPE; struct S' object; ! And they can then deduce (from the node for type struct S') that the ! original object declaration was: ! MY_TYPE object; ! Being able to do this is important for proper support of protoize, and ! also for generating precise symbolic debugging information which ! takes full account of the programmer's (typedef) vocabulary. ! Obviously, we don't want to generate a duplicate ..._TYPE node if the ! TYPE_DECL node that we are now processing really represents a ! standard built-in type. ! Since all standard types are effectively declared at line zero in the ! source file, we can easily check to see if we are working on a ! standard type by checking the current value of lineno. */ ! if (TREE_CODE (x) == TYPE_DECL) ! { ! if (DECL_SOURCE_LINE (x) == 0) ! { ! if (TYPE_NAME (TREE_TYPE (x)) == 0) ! TYPE_NAME (TREE_TYPE (x)) = x; ! } ! else if (TREE_TYPE (x) != error_mark_node) ! { ! tree tt = TREE_TYPE (x); ! tt = build_type_copy (tt); ! TYPE_NAME (tt) = x; ! TREE_TYPE (x) = tt; ! } ! } ! /* This name is new in its binding level. Install the new declaration ! and return it. */ ! if (b == global_binding_level) ! IDENTIFIER_GLOBAL_VALUE (name) = x; ! else ! IDENTIFIER_LOCAL_VALUE (name) = x; ! } ! /* Put decls on list in reverse order. We will reverse them later if ! necessary. */ ! TREE_CHAIN (x) = b->names; ! b->names = x; ! return x; ! } ! /* Enter a new binding level. ! If TAG_TRANSPARENT is nonzero, do so only for the name space of variables, ! not for that of tags. */ ! void ! pushlevel (tag_transparent) ! int tag_transparent; ! { ! register struct binding_level *newlevel = NULL_BINDING_LEVEL; ! assert (!tag_transparent); ! /* Reuse or create a struct for this binding level. */ ! if (free_binding_level) ! { ! newlevel = free_binding_level; ! free_binding_level = free_binding_level->level_chain; ! } ! else ! { ! newlevel = make_binding_level (); ! } ! /* Add this level to the front of the chain (stack) of levels that are ! active. */ ! *newlevel = clear_binding_level; ! newlevel->level_chain = current_binding_level; ! current_binding_level = newlevel; ! } ! /* Set the BLOCK node for the innermost scope ! (the one we are currently in). */ ! void ! set_block (block) ! register tree block; ! { ! current_binding_level->this_block = block; ! } ! /* ~~tree.h SHOULD declare this, because toplev.c references it. */ ! /* Can't 'yydebug' a front end not generated by yacc/bison! */ ! void ! set_yydebug (value) ! int value; { ! if (value) ! fprintf (stderr, "warning: no yacc/bison-generated output to debug!\n"); ! } ! tree ! signed_or_unsigned_type (unsignedp, type) ! int unsignedp; ! tree type; ! { ! tree type2; ! if (! INTEGRAL_TYPE_P (type)) ! return type; ! if (TYPE_PRECISION (type) == TYPE_PRECISION (signed_char_type_node)) ! return unsignedp ? unsigned_char_type_node : signed_char_type_node; ! if (TYPE_PRECISION (type) == TYPE_PRECISION (integer_type_node)) ! return unsignedp ? unsigned_type_node : integer_type_node; ! if (TYPE_PRECISION (type) == TYPE_PRECISION (short_integer_type_node)) ! return unsignedp ? short_unsigned_type_node : short_integer_type_node; ! if (TYPE_PRECISION (type) == TYPE_PRECISION (long_integer_type_node)) ! return unsignedp ? long_unsigned_type_node : long_integer_type_node; ! if (TYPE_PRECISION (type) == TYPE_PRECISION (long_long_integer_type_node)) ! return (unsignedp ? long_long_unsigned_type_node ! : long_long_integer_type_node); ! type2 = type_for_size (TYPE_PRECISION (type), unsignedp); ! if (type2 == NULL_TREE) ! return type; ! return type2; } ! tree ! signed_type (type) ! tree type; { ! tree type1 = TYPE_MAIN_VARIANT (type); ! ffeinfoKindtype kt; ! tree type2; ! if (type1 == unsigned_char_type_node || type1 == char_type_node) ! return signed_char_type_node; ! if (type1 == unsigned_type_node) ! return integer_type_node; ! if (type1 == short_unsigned_type_node) ! return short_integer_type_node; ! if (type1 == long_unsigned_type_node) ! return long_integer_type_node; ! if (type1 == long_long_unsigned_type_node) ! return long_long_integer_type_node; ! #if 0 /* gcc/c-* files only */ ! if (type1 == unsigned_intDI_type_node) ! return intDI_type_node; ! if (type1 == unsigned_intSI_type_node) ! return intSI_type_node; ! if (type1 == unsigned_intHI_type_node) ! return intHI_type_node; ! if (type1 == unsigned_intQI_type_node) ! return intQI_type_node; ! #endif ! type2 = type_for_size (TYPE_PRECISION (type1), 0); ! if (type2 != NULL_TREE) ! return type2; ! for (kt = 0; kt < ARRAY_SIZE (ffecom_tree_type[0]); ++kt) { ! type2 = ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt]; ! if (type1 == type2) ! return ffecom_tree_type[FFEINFO_basictypeINTEGER][kt]; } ! return type; } ! /* Prepare expr to be an argument of a TRUTH_NOT_EXPR, ! or validate its data type for an `if' or `while' statement or ?..: exp. ! This preparation consists of taking the ordinary ! representation of an expression expr and producing a valid tree ! boolean expression describing whether expr is nonzero. We could ! simply always do build_binary_op (NE_EXPR, expr, integer_zero_node, 1), ! but we optimize comparisons, &&, ||, and !. ! The resulting type should always be `integer_type_node'. */ ! tree ! truthvalue_conversion (expr) ! tree expr; ! { ! if (TREE_CODE (expr) == ERROR_MARK) ! return expr; ! #if 0 /* This appears to be wrong for C++. */ ! /* These really should return error_mark_node after 2.4 is stable. ! But not all callers handle ERROR_MARK properly. */ ! switch (TREE_CODE (TREE_TYPE (expr))) ! { ! case RECORD_TYPE: ! error ("struct type value used where scalar is required"); ! return integer_zero_node; ! case UNION_TYPE: ! error ("union type value used where scalar is required"); ! return integer_zero_node; ! case ARRAY_TYPE: ! error ("array type value used where scalar is required"); ! return integer_zero_node; ! default: ! break; ! } ! #endif /* 0 */ ! switch (TREE_CODE (expr)) ! { ! /* It is simpler and generates better code to have only TRUTH_*_EXPR ! or comparison expressions as truth values at this level. */ ! #if 0 ! case COMPONENT_REF: ! /* A one-bit unsigned bit-field is already acceptable. */ ! if (1 == TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (expr, 1))) ! && TREE_UNSIGNED (TREE_OPERAND (expr, 1))) ! return expr; ! break; ! #endif ! case EQ_EXPR: ! /* It is simpler and generates better code to have only TRUTH_*_EXPR ! or comparison expressions as truth values at this level. */ ! #if 0 ! if (integer_zerop (TREE_OPERAND (expr, 1))) ! return build_unary_op (TRUTH_NOT_EXPR, TREE_OPERAND (expr, 0), 0); ! #endif ! case NE_EXPR: case LE_EXPR: case GE_EXPR: case LT_EXPR: case GT_EXPR: ! case TRUTH_ANDIF_EXPR: ! case TRUTH_ORIF_EXPR: ! case TRUTH_AND_EXPR: ! case TRUTH_OR_EXPR: ! case TRUTH_XOR_EXPR: ! TREE_TYPE (expr) = integer_type_node; ! return expr; ! case ERROR_MARK: ! return expr; ! case INTEGER_CST: ! return integer_zerop (expr) ? integer_zero_node : integer_one_node; ! case REAL_CST: ! return real_zerop (expr) ? integer_zero_node : integer_one_node; ! case ADDR_EXPR: ! if (TREE_SIDE_EFFECTS (TREE_OPERAND (expr, 0))) ! return build (COMPOUND_EXPR, integer_type_node, ! TREE_OPERAND (expr, 0), integer_one_node); ! else ! return integer_one_node; ! case COMPLEX_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))); ! 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)); ! case LROTATE_EXPR: ! case RROTATE_EXPR: ! /* These don't change whether an object is zero or non-zero, 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))); ! else ! return 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)))); ! case CONVERT_EXPR: ! /* Don't cancel the effect of a CONVERT_EXPR from a REFERENCE_TYPE, ! since that affects how `default_conversion' will behave. */ ! if (TREE_CODE (TREE_TYPE (expr)) == REFERENCE_TYPE ! || TREE_CODE (TREE_TYPE (TREE_OPERAND (expr, 0))) == REFERENCE_TYPE) ! break; ! /* fall through... */ ! case NOP_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)); ! break; ! case MINUS_EXPR: ! /* With IEEE arithmetic, x - x may not equal 0, so we can't optimize ! this case. */ ! if (TARGET_FLOAT_FORMAT == IEEE_FLOAT_FORMAT ! && TREE_CODE (TREE_TYPE (expr)) == REAL_TYPE) ! break; ! /* fall through... */ ! case BIT_XOR_EXPR: ! /* This and MINUS_EXPR can be changed into a comparison of the ! two objects. */ ! if (TREE_TYPE (TREE_OPERAND (expr, 0)) ! == TREE_TYPE (TREE_OPERAND (expr, 1))) ! return ffecom_2 (NE_EXPR, integer_type_node, ! TREE_OPERAND (expr, 0), ! TREE_OPERAND (expr, 1)); ! return ffecom_2 (NE_EXPR, integer_type_node, ! TREE_OPERAND (expr, 0), ! fold (build1 (NOP_EXPR, ! TREE_TYPE (TREE_OPERAND (expr, 0)), ! TREE_OPERAND (expr, 1)))); ! case BIT_AND_EXPR: ! if (integer_onep (TREE_OPERAND (expr, 1))) ! return expr; ! break; ! case MODIFY_EXPR: ! #if 0 /* No such thing in Fortran. */ ! if (warn_parentheses && C_EXP_ORIGINAL_CODE (expr) == MODIFY_EXPR) ! warning ("suggest parentheses around assignment used as truth value"); ! #endif ! break; ! default: ! break; } ! if (TREE_CODE (TREE_TYPE (expr)) == COMPLEX_TYPE) ! return (ffecom_2 ! ((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)))); ! return ffecom_2 (NE_EXPR, integer_type_node, ! expr, ! convert (TREE_TYPE (expr), integer_zero_node)); } ! tree ! type_for_mode (mode, unsignedp) ! enum machine_mode mode; ! int unsignedp; { ! int i; ! int j; ! tree t; ! if (mode == TYPE_MODE (integer_type_node)) ! return unsignedp ? unsigned_type_node : integer_type_node; ! if (mode == TYPE_MODE (signed_char_type_node)) ! return unsignedp ? unsigned_char_type_node : signed_char_type_node; ! if (mode == TYPE_MODE (short_integer_type_node)) ! return unsignedp ? short_unsigned_type_node : short_integer_type_node; ! if (mode == TYPE_MODE (long_integer_type_node)) ! return unsignedp ? long_unsigned_type_node : long_integer_type_node; ! if (mode == TYPE_MODE (long_long_integer_type_node)) ! return unsignedp ? long_long_unsigned_type_node : long_long_integer_type_node; ! if (mode == TYPE_MODE (float_type_node)) ! return float_type_node; ! if (mode == TYPE_MODE (double_type_node)) ! return double_type_node; ! if (mode == TYPE_MODE (build_pointer_type (char_type_node))) ! return build_pointer_type (char_type_node); ! if (mode == TYPE_MODE (build_pointer_type (integer_type_node))) ! return build_pointer_type (integer_type_node); ! for (i = 0; ((size_t) i) < ARRAY_SIZE (ffecom_tree_type); ++i) ! for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j) ! { ! if (((t = ffecom_tree_type[i][j]) != NULL_TREE) ! && (mode == TYPE_MODE (t))) ! { ! if ((i == FFEINFO_basictypeINTEGER) && unsignedp) ! return ffecom_tree_type[FFEINFO_basictypeHOLLERITH][j]; ! else ! return t; ! } ! } ! return 0; } ! tree ! type_for_size (bits, unsignedp) ! unsigned bits; ! int unsignedp; { ! ffeinfoKindtype kt; ! tree type_node; ! if (bits == TYPE_PRECISION (integer_type_node)) ! return unsignedp ? unsigned_type_node : integer_type_node; ! if (bits == TYPE_PRECISION (signed_char_type_node)) ! return unsignedp ? unsigned_char_type_node : signed_char_type_node; ! if (bits == TYPE_PRECISION (short_integer_type_node)) ! return unsignedp ? short_unsigned_type_node : short_integer_type_node; ! if (bits == TYPE_PRECISION (long_integer_type_node)) ! return unsignedp ? long_unsigned_type_node : long_integer_type_node; ! if (bits == TYPE_PRECISION (long_long_integer_type_node)) ! return (unsignedp ? long_long_unsigned_type_node ! : long_long_integer_type_node); ! for (kt = 0; kt < ARRAY_SIZE (ffecom_tree_type[0]); ++kt) { ! type_node = ffecom_tree_type[FFEINFO_basictypeINTEGER][kt]; ! ! if ((type_node != NULL_TREE) && (bits == TYPE_PRECISION (type_node))) ! return unsignedp ? ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt] ! : type_node; } ! return 0; ! } ! tree ! unsigned_type (type) ! tree type; ! { ! tree type1 = TYPE_MAIN_VARIANT (type); ! ffeinfoKindtype kt; ! tree type2; ! if (type1 == signed_char_type_node || type1 == char_type_node) ! return unsigned_char_type_node; ! if (type1 == integer_type_node) ! return unsigned_type_node; ! if (type1 == short_integer_type_node) ! return short_unsigned_type_node; ! if (type1 == long_integer_type_node) ! return long_unsigned_type_node; ! if (type1 == long_long_integer_type_node) ! return long_long_unsigned_type_node; ! #if 0 /* gcc/c-* files only */ ! if (type1 == intDI_type_node) ! return unsigned_intDI_type_node; ! if (type1 == intSI_type_node) ! return unsigned_intSI_type_node; ! if (type1 == intHI_type_node) ! return unsigned_intHI_type_node; ! if (type1 == intQI_type_node) ! return unsigned_intQI_type_node; #endif ! type2 = type_for_size (TYPE_PRECISION (type1), 1); ! if (type2 != NULL_TREE) ! return type2; ! ! for (kt = 0; kt < ARRAY_SIZE (ffecom_tree_type[0]); ++kt) { ! type2 = ffecom_tree_type[FFEINFO_basictypeINTEGER][kt]; ! if (type1 == type2) ! return ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt]; } ! return type; ! } ! ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ ! ! #if FFECOM_GCC_INCLUDE ! ! /* From gcc/cccp.c, the code to handle -I. */ ! ! /* Skip leading "./" from a directory name. ! This may yield the empty string, which represents the current directory. */ ! static char * ! skip_redundant_dir_prefix (char *dir) ! { ! while (dir[0] == '.' && dir[1] == '/') ! for (dir += 2; *dir == '/'; dir++) ! continue; ! if (dir[0] == '.' && !dir[1]) ! dir++; ! return dir; ! } ! /* The file_name_map structure holds a mapping of file names for a ! particular directory. This mapping is read from the file named ! FILE_NAME_MAP_FILE in that directory. Such a file can be used to ! map filenames on a file system with severe filename restrictions, ! such as DOS. The format of the file name map file is just a series ! of lines with two tokens on each line. The first token is the name ! to map, and the second token is the actual name to use. */ ! struct file_name_map ! { ! struct file_name_map *map_next; ! char *map_from; ! char *map_to; ! }; ! #define FILE_NAME_MAP_FILE "header.gcc" ! /* Current maximum length of directory names in the search path ! for include files. (Altered as we get more of them.) */ ! static int max_include_len = 0; ! struct file_name_list ! { ! struct file_name_list *next; ! char *fname; ! /* Mapping of file names for this directory. */ ! struct file_name_map *name_map; ! /* Non-zero if name_map is valid. */ ! int got_name_map; ! }; ! static struct file_name_list *include = NULL; /* First dir to search */ ! static struct file_name_list *last_include = NULL; /* Last in chain */ ! /* I/O buffer structure. ! The `fname' field is nonzero for source files and #include files ! and for the dummy text used for -D and -U. ! It is zero for rescanning results of macro expansion ! and for expanding macro arguments. */ ! #define INPUT_STACK_MAX 400 ! static struct file_buf { ! char *fname; ! /* Filename specified with #line command. */ ! char *nominal_fname; ! /* Record where in the search path this file was found. ! For #include_next. */ ! struct file_name_list *dir; ! ffewhereLine line; ! ffewhereColumn column; ! } instack[INPUT_STACK_MAX]; ! static int last_error_tick = 0; /* Incremented each time we print it. */ ! static int input_file_stack_tick = 0; /* Incremented when status changes. */ - /* Current nesting level of input sources. - `instack[indepth]' is the level currently being read. */ - static int indepth = -1; ! typedef struct file_buf FILE_BUF; ! typedef unsigned char U_CHAR; ! /* table to tell if char can be part of a C identifier. */ ! U_CHAR is_idchar[256]; ! /* table to tell if char can be first char of a c identifier. */ ! U_CHAR is_idstart[256]; ! /* table to tell if c is horizontal space. */ ! U_CHAR is_hor_space[256]; ! /* table to tell if c is horizontal or vertical space. */ ! static U_CHAR is_space[256]; - #define SKIP_WHITE_SPACE(p) do { while (is_hor_space[*p]) p++; } while (0) - #define SKIP_ALL_WHITE_SPACE(p) do { while (is_space[*p]) p++; } while (0) - /* Nonzero means -I- has been seen, - so don't look for #include "foo" the source-file directory. */ - static int ignore_srcdir; - #ifndef INCLUDE_LEN_FUDGE - #define INCLUDE_LEN_FUDGE 0 - #endif ! static void append_include_chain (struct file_name_list *first, ! struct file_name_list *last); ! static FILE *open_include_file (char *filename, ! struct file_name_list *searchptr); ! static void print_containing_files (ffebadSeverity sev); ! static char *skip_redundant_dir_prefix (char *); ! static char *read_filename_string (int ch, FILE *f); ! static struct file_name_map *read_name_map (char *dirname); ! static char *savestring (char *input); - /* Append a chain of `struct file_name_list's - to the end of the main include chain. - FIRST is the beginning of the chain to append, and LAST is the end. */ - static void - append_include_chain (first, last) - struct file_name_list *first, *last; - { - struct file_name_list *dir; - if (!first || !last) - return; ! if (include == 0) ! include = first; ! else ! last_include->next = first; - for (dir = first; ; dir = dir->next) { - int len = strlen (dir->fname) + INCLUDE_LEN_FUDGE; - if (len > max_include_len) - max_include_len = len; - if (dir == last) - break; - } - last->next = NULL; - last_include = last; - } - /* Try to open include file FILENAME. SEARCHPTR is the directory - being tried from the include file search path. This function maps - filenames on file systems based on information read by - read_name_map. */ ! static FILE * ! open_include_file (filename, searchptr) ! char *filename; ! struct file_name_list *searchptr; ! { ! register struct file_name_map *map; ! register char *from; ! char *p, *dir; - if (searchptr && ! searchptr->got_name_map) - { - searchptr->name_map = read_name_map (searchptr->fname - ? searchptr->fname : "."); - searchptr->got_name_map = 1; - } - /* First check the mapping for the directory we are using. */ - if (searchptr && searchptr->name_map) - { - from = filename; - if (searchptr->fname) - from += strlen (searchptr->fname) + 1; - for (map = searchptr->name_map; map; map = map->map_next) - { - if (! strcmp (map->map_from, from)) - { - /* Found a match. */ - return fopen (map->map_to, "r"); - } - } - } - /* Try to find a mapping file for the particular directory we are - looking in. Thus #include will look up sys/types.h - in /usr/include/header.gcc and look up types.h in - /usr/include/sys/header.gcc. */ - p = rindex (filename, '/'); - #ifdef DIR_SEPARATOR - if (! p) p = rindex (filename, DIR_SEPARATOR); - else { - char *tmp = rindex (filename, DIR_SEPARATOR); - if (tmp != NULL && tmp > p) p = tmp; - } - #endif - if (! p) - p = filename; - if (searchptr - && searchptr->fname - && strlen (searchptr->fname) == (size_t) (p - filename) - && ! strncmp (searchptr->fname, filename, (int) (p - filename))) - { - /* FILENAME is in SEARCHPTR, which we've already checked. */ - return fopen (filename, "r"); - } - if (p == filename) - { - from = filename; - map = read_name_map ("."); - } - else - { - dir = (char *) xmalloc (p - filename + 1); - memcpy (dir, filename, p - filename); - dir[p - filename] = '\0'; - from = p + 1; - map = read_name_map (dir); - free (dir); - } - for (; map; map = map->map_next) - if (! strcmp (map->map_from, from)) - return fopen (map->map_to, "r"); - return fopen (filename, "r"); - } - /* Print the file names and line numbers of the #include - commands which led to the current file. */ - static void - print_containing_files (ffebadSeverity sev) - { - FILE_BUF *ip = NULL; - int i; - int first = 1; - char *str1; - char *str2; ! /* If stack of files hasn't changed since we last printed ! this info, don't repeat it. */ ! if (last_error_tick == input_file_stack_tick) ! return; - for (i = indepth; i >= 0; i--) - if (instack[i].fname != NULL) { - ip = &instack[i]; - break; - } ! /* Give up if we don't find a source file. */ ! if (ip == NULL) ! return; ! /* Find the other, outer source files. */ ! for (i--; i >= 0; i--) ! if (instack[i].fname != NULL) ! { ! ip = &instack[i]; ! if (first) ! { ! first = 0; ! str1 = "In file included"; ! } ! else ! { ! str1 = "... ..."; ! } ! if (i == 1) ! str2 = ":"; ! else ! str2 = ""; ! ffebad_start_msg ("%A from %B at %0%C", sev); ! ffebad_here (0, ip->line, ip->column); ! ffebad_string (str1); ! ffebad_string (ip->nominal_fname); ! ffebad_string (str2); ! ffebad_finish (); ! } ! /* Record we have printed the status as of this time. */ ! last_error_tick = input_file_stack_tick; ! } ! /* Read a space delimited string of unlimited length from a stdio ! file. */ - static char * - read_filename_string (ch, f) - int ch; - FILE *f; - { - char *alloc, *set; - int len; - len = 20; - set = alloc = xmalloc (len + 1); - if (! is_space[ch]) - { - *set++ = ch; - while ((ch = getc (f)) != EOF && ! is_space[ch]) - { - if (set - alloc == len) - { - len *= 2; - alloc = xrealloc (alloc, len + 1); - set = alloc + len / 2; - } - *set++ = ch; - } - } - *set = '\0'; - ungetc (ch, f); - return alloc; - } ! /* Read the file name map file for DIRNAME. */ ! static struct file_name_map * ! read_name_map (dirname) ! char *dirname; ! { ! /* This structure holds a linked list of file name maps, one per ! directory. */ ! struct file_name_map_list ! { ! struct file_name_map_list *map_list_next; ! char *map_list_name; ! struct file_name_map *map_list_map; ! }; ! static struct file_name_map_list *map_list; ! register struct file_name_map_list *map_list_ptr; ! char *name; ! FILE *f; ! size_t dirlen; ! int separator_needed; ! dirname = skip_redundant_dir_prefix (dirname); ! for (map_list_ptr = map_list; map_list_ptr; ! map_list_ptr = map_list_ptr->map_list_next) ! if (! strcmp (map_list_ptr->map_list_name, dirname)) ! return map_list_ptr->map_list_map; - map_list_ptr = ((struct file_name_map_list *) - xmalloc (sizeof (struct file_name_map_list))); - map_list_ptr->map_list_name = savestring (dirname); - map_list_ptr->map_list_map = NULL; - 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); - f = fopen (name, "r"); - free (name); - if (!f) - map_list_ptr->map_list_map = NULL; - else - { - int ch; - while ((ch = getc (f)) != EOF) - { - char *from, *to; - struct file_name_map *ptr; - if (is_space[ch]) - continue; - from = read_filename_string (ch, f); - while ((ch = getc (f)) != EOF && is_hor_space[ch]) - ; - to = read_filename_string (ch, f); - ptr = ((struct file_name_map *) - xmalloc (sizeof (struct file_name_map))); - ptr->map_from = from; - /* Make the real filename absolute. */ - if (*to == '/') - 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); - free (to); - } - ptr->map_next = map_list_ptr->map_list_map; - map_list_ptr->map_list_map = ptr; ! while ((ch = getc (f)) != '\n') ! if (ch == EOF) ! break; ! } ! fclose (f); ! } - map_list_ptr->map_list_next = map_list; - map_list = map_list_ptr; - return map_list_ptr->map_list_map; - } - static char * - savestring (input) - char *input; - { - unsigned size = strlen (input); - char *output = xmalloc (size + 1); - strcpy (output, input); - return output; - } ! static void ! ffecom_file_ (char *name) ! { ! FILE_BUF *fp; ! /* Do partial setup of input buffer for the sake of generating ! early #line directives (when -g is in effect). */ ! fp = &instack[++indepth]; ! memset ((char *) fp, 0, sizeof (FILE_BUF)); ! if (name == NULL) ! name = ""; ! fp->nominal_fname = fp->fname = name; ! } - /* Initialize syntactic classifications of characters. */ ! static void ! ffecom_initialize_char_syntax_ () ! { ! register int i; - /* - * Set up is_idchar and is_idstart tables. These should be - * faster than saying (is_alpha (c) || c == '_'), etc. - * Set up these things before calling any routines tthat - * refer to them. - */ - for (i = 'a'; i <= 'z'; i++) { - is_idchar[i - 'a' + 'A'] = 1; - is_idchar[i] = 1; - is_idstart[i - 'a' + 'A'] = 1; - is_idstart[i] = 1; - } - for (i = '0'; i <= '9'; i++) - is_idchar[i] = 1; - is_idchar['_'] = 1; - is_idstart['_'] = 1; - /* horizontal space table */ - is_hor_space[' '] = 1; - is_hor_space['\t'] = 1; - is_hor_space['\v'] = 1; - is_hor_space['\f'] = 1; - is_hor_space['\r'] = 1; - is_space[' '] = 1; - is_space['\t'] = 1; - is_space['\v'] = 1; - is_space['\f'] = 1; - is_space['\n'] = 1; - is_space['\r'] = 1; - } - static void - ffecom_close_include_ (FILE *f) - { - fclose (f); - indepth--; - input_file_stack_tick++; - ffewhere_line_kill (instack[indepth].line); - ffewhere_column_kill (instack[indepth].column); - } - static int - ffecom_decode_include_option_ (char *spec) - { - struct file_name_list *dirtmp; - if (! ignore_srcdir && !strcmp (spec, "-")) - ignore_srcdir = 1; - else - { - dirtmp = (struct file_name_list *) - xmalloc (sizeof (struct file_name_list)); - dirtmp->next = 0; /* New one goes on the end */ - if (spec[0] != 0) - dirtmp->fname = spec; - else - fatal ("Directory name must immediately follow -I option with no intervening spaces, as in `-Idir', not `-I dir'"); - dirtmp->got_name_map = 0; - append_include_chain (dirtmp, dirtmp); - } - return 1; - } - /* Open INCLUDEd file. */ - static FILE * - ffecom_open_include_ (char *name, ffewhereLine l, ffewhereColumn c) - { - char *fbeg = name; - size_t flen = strlen (fbeg); - struct file_name_list *search_start = include; /* Chain of dirs to search */ - struct file_name_list dsp[1]; /* First in chain, if #include "..." */ - struct file_name_list *searchptr = 0; - char *fname; /* Dynamically allocated fname buffer */ - FILE *f; - FILE_BUF *fp; - if (flen == 0) - return NULL; - dsp[0].fname = NULL; - /* If -I- was specified, don't search current dir, only spec'd ones. */ - if (!ignore_srcdir) - { - for (fp = &instack[indepth]; fp >= instack; fp--) - { - int n; - char *ep; - char *nam; - if ((nam = fp->nominal_fname) != NULL) - { - /* Found a named file. Figure out dir of the file, - and put it in front of the search list. */ - dsp[0].next = search_start; - search_start = dsp; - #ifndef VMS - ep = rindex (nam, '/'); - #ifdef DIR_SEPARATOR - if (ep == NULL) ep = rindex (nam, DIR_SEPARATOR); - else { - char *tmp = rindex (nam, DIR_SEPARATOR); - if (tmp != NULL && tmp > ep) ep = tmp; - } - #endif - #else /* VMS */ - ep = rindex (nam, ']'); - if (ep == NULL) ep = rindex (nam, '>'); - if (ep == NULL) ep = rindex (nam, ':'); - if (ep != NULL) ep++; - #endif /* VMS */ - if (ep != NULL) - { - n = ep - nam; - dsp[0].fname = (char *) xmalloc (n + 1); - strncpy (dsp[0].fname, nam, n); - dsp[0].fname[n] = '\0'; - if (n + INCLUDE_LEN_FUDGE > max_include_len) - max_include_len = n + INCLUDE_LEN_FUDGE; - } - else - dsp[0].fname = NULL; /* Current directory */ - dsp[0].got_name_map = 0; - break; - } - } - } - /* Allocate this permanently, because it gets stored in the definitions - of macros. */ - fname = xmalloc (max_include_len + flen + 4); - /* + 2 above for slash and terminating null. */ - /* + 2 added for '.h' on VMS (to support '#include filename') (NOT USED - for g77 yet). */ - /* If specified file name is absolute, just open it. */ - if (*fbeg == '/' - #ifdef DIR_SEPARATOR - || *fbeg == DIR_SEPARATOR - #endif - ) - { - strncpy (fname, (char *) fbeg, flen); - fname[flen] = 0; - f = open_include_file (fname, NULL_PTR); - } - else - { - f = NULL; - /* Search directory path, trying to open the file. - Copy each filename tried into FNAME. */ - for (searchptr = search_start; searchptr; searchptr = searchptr->next) - { - if (searchptr->fname) - { - /* The empty string in a search path is ignored. - This makes it possible to turn off entirely - a standard piece of the list. */ - if (searchptr->fname[0] == 0) - continue; - strcpy (fname, skip_redundant_dir_prefix (searchptr->fname)); - if (fname[0] && fname[strlen (fname) - 1] != '/') - strcat (fname, "/"); - fname[strlen (fname) + flen] = 0; - } - else - fname[0] = 0; - strncat (fname, fbeg, flen); - #ifdef VMS - /* Change this 1/2 Unix 1/2 VMS file specification into a - full VMS file specification */ - if (searchptr->fname && (searchptr->fname[0] != 0)) - { - /* Fix up the filename */ - hack_vms_include_specification (fname); - } - else - { - /* This is a normal VMS filespec, so use it unchanged. */ - strncpy (fname, (char *) fbeg, flen); - fname[flen] = 0; - #if 0 /* Not for g77. */ - /* if it's '#include filename', add the missing .h */ - if (index (fname, '.') == NULL) - strcat (fname, ".h"); - #endif - } - #endif /* VMS */ - f = open_include_file (fname, searchptr); - #ifdef EACCES - if (f == NULL && errno == EACCES) - { - print_containing_files (FFEBAD_severityWARNING); - ffebad_start_msg ("At %0, INCLUDE file %A exists, but is not readable", - FFEBAD_severityWARNING); - ffebad_string (fname); - ffebad_here (0, l, c); - ffebad_finish (); - } - #endif - if (f != NULL) - break; - } - } - if (f == NULL) - { - /* A file that was not found. */ - strncpy (fname, (char *) fbeg, flen); - fname[flen] = 0; - print_containing_files (ffebad_severity (FFEBAD_OPEN_INCLUDE)); - ffebad_start (FFEBAD_OPEN_INCLUDE); - ffebad_here (0, l, c); - ffebad_string (fname); - ffebad_finish (); - } ! if (dsp[0].fname != NULL) ! free (dsp[0].fname); ! if (f == NULL) ! return NULL; ! if (indepth >= (INPUT_STACK_MAX - 1)) ! { ! print_containing_files (FFEBAD_severityFATAL); ! ffebad_start_msg ("At %0, INCLUDE nesting too deep", ! FFEBAD_severityFATAL); ! ffebad_string (fname); ! ffebad_here (0, l, c); ! ffebad_finish (); ! return NULL; ! } ! instack[indepth].line = ffewhere_line_use (l); ! instack[indepth].column = ffewhere_column_use (c); ! fp = &instack[indepth + 1]; ! memset ((char *) fp, 0, sizeof (FILE_BUF)); ! fp->nominal_fname = fp->fname = fname; ! fp->dir = searchptr; ! indepth++; ! input_file_stack_tick++; ! return f; ! } ! #endif /* FFECOM_GCC_INCLUDE */ --- 5552,17447 ---- assert (gfrt != FFECOM_gfrt); /* Must have an implementation! */ expr_tree = ffecom_arglist_expr_ (ffecom_gfrt_args_ (gfrt), ffebld_right (expr)); return ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ffecom_gfrt_kindtype (gfrt), (ffe_is_f2c_library () && ffecom_gfrt_complex_[gfrt]), tree_type, expr_tree, dest_tree, dest, dest_used, ! NULL_TREE, TRUE, ! ffebld_nonter_hook (expr)); ! /* See bottom of this file for f2c transforms used to determine ! many of the above implementations. The info seems to confuse ! Emacs's C mode indentation, which is why it's been moved to ! the bottom of this source file. */ ! } ! #endif ! /* For power (exponentiation) where right-hand operand is type INTEGER, ! generate in-line code to do it the fast way (which, if the operand ! is a constant, might just mean a series of multiplies). */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_expr_power_integer_ (ffebld expr) ! { ! tree l = ffecom_expr (ffebld_left (expr)); ! tree r = ffecom_expr (ffebld_right (expr)); ! tree ltype = TREE_TYPE (l); ! tree rtype = TREE_TYPE (r); ! tree result = NULL_TREE; + if (l == error_mark_node + || r == error_mark_node) + return error_mark_node; + if (TREE_CODE (r) == INTEGER_CST) + { + int sgn = tree_int_cst_sgn (r); + if (sgn == 0) + return convert (ltype, integer_one_node); ! if ((TREE_CODE (ltype) == INTEGER_TYPE) ! && (sgn < 0)) ! { ! /* Reciprocal of integer is either 0, -1, or 1, so after ! calculating that (which we leave to the back end to do ! or not do optimally), don't bother with any multiplying. */ + result = ffecom_tree_divide_ (ltype, + convert (ltype, integer_one_node), + l, + NULL_TREE, NULL, NULL, NULL_TREE); + r = ffecom_1 (NEGATE_EXPR, + rtype, + r); + if ((TREE_INT_CST_LOW (r) & 1) == 0) + result = ffecom_1 (ABS_EXPR, rtype, + result); + } + /* Generate appropriate series of multiplies, preceded + by divide if the exponent is negative. */ + l = save_expr (l); ! if (sgn < 0) ! { ! l = ffecom_tree_divide_ (ltype, ! convert (ltype, integer_one_node), ! l, ! NULL_TREE, NULL, NULL, ! ffebld_nonter_hook (expr)); ! r = ffecom_1 (NEGATE_EXPR, rtype, r); ! assert (TREE_CODE (r) == INTEGER_CST); + if (tree_int_cst_sgn (r) < 0) + { /* The "most negative" number. */ + r = ffecom_1 (NEGATE_EXPR, rtype, + ffecom_2 (RSHIFT_EXPR, rtype, + r, + integer_one_node)); + l = save_expr (l); + l = ffecom_2 (MULT_EXPR, ltype, + l, + l); + } + } + for (;;) + { + if (TREE_INT_CST_LOW (r) & 1) + { + if (result == NULL_TREE) + result = l; + else + result = ffecom_2 (MULT_EXPR, ltype, + result, + l); + } + r = ffecom_2 (RSHIFT_EXPR, rtype, + r, + integer_one_node); + if (integer_zerop (r)) + break; + assert (TREE_CODE (r) == INTEGER_CST); ! l = save_expr (l); ! l = ffecom_2 (MULT_EXPR, ltype, ! l, ! l); ! } ! return result; ! } + /* Though rhs isn't a constant, in-line code cannot be expanded + while transforming dummies + because the back end cannot be easily convinced to generate + stores (MODIFY_EXPR), handle temporaries, and so on before + all the appropriate rtx's have been generated for things like + dummy args referenced in rhs -- which doesn't happen until + store_parm_decls() is called (expand_function_start, I believe, + does the actual rtx-stuffing of PARM_DECLs). + So, in this case, let the caller generate the call to the + run-time-library function to evaluate the power for us. */ + if (ffecom_transform_only_dummies_) + return NULL_TREE; + /* Right-hand operand not a constant, expand in-line code to figure + out how to do the multiplies, &c. + The returned expression is expressed this way in GNU C, where l and + r are the "inputs": + ({ typeof (r) rtmp = r; + typeof (l) ltmp = l; + typeof (l) result; ! if (rtmp == 0) ! result = 1; ! else ! { ! if ((basetypeof (l) == basetypeof (int)) ! && (rtmp < 0)) ! { ! result = ((typeof (l)) 1) / ltmp; ! if ((ltmp < 0) && (((-rtmp) & 1) == 0)) ! result = -result; ! } ! else ! { ! result = 1; ! if ((basetypeof (l) != basetypeof (int)) ! && (rtmp < 0)) ! { ! ltmp = ((typeof (l)) 1) / ltmp; ! rtmp = -rtmp; ! if (rtmp < 0) ! { ! rtmp = -(rtmp >> 1); ! ltmp *= ltmp; ! } ! } ! for (;;) ! { ! if (rtmp & 1) ! result *= ltmp; ! if ((rtmp >>= 1) == 0) ! break; ! ltmp *= ltmp; ! } ! } ! } ! result; ! }) + Note that some of the above is compile-time collapsable, such as + the first part of the if statements that checks the base type of + l against int. The if statements are phrased that way to suggest + an easy way to generate the if/else constructs here, knowing that + the back end should (and probably does) eliminate the resulting + dead code (either the int case or the non-int case), something + it couldn't do without the redundant phrasing, requiring explicit + dead-code elimination here, which would be kind of difficult to + read. */ + { + tree rtmp; + tree ltmp; + tree divide; + tree basetypeof_l_is_int; + tree se; + tree t; + basetypeof_l_is_int + = build_int_2 ((TREE_CODE (ltype) == INTEGER_TYPE), 0); ! se = expand_start_stmt_expr (); ! ffecom_start_compstmt (); ! #ifndef HAHA ! rtmp = ffecom_make_tempvar ("power_r", rtype, ! FFETARGET_charactersizeNONE, -1); ! ltmp = ffecom_make_tempvar ("power_l", ltype, ! FFETARGET_charactersizeNONE, -1); ! result = ffecom_make_tempvar ("power_res", ltype, ! FFETARGET_charactersizeNONE, -1); ! if (TREE_CODE (ltype) == COMPLEX_TYPE ! || TREE_CODE (ltype) == RECORD_TYPE) ! divide = ffecom_make_tempvar ("power_div", ltype, ! 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, ! r)); ! expand_expr_stmt (ffecom_modify (void_type_node, ! ltmp, ! l)); ! expand_start_cond (ffecom_truth_value ! (ffecom_2 (EQ_EXPR, integer_type_node, ! rtmp, ! convert (rtype, integer_zero_node))), ! 0); ! expand_expr_stmt (ffecom_modify (void_type_node, ! result, ! convert (ltype, integer_one_node))); ! expand_start_else (); ! if (! integer_zerop (basetypeof_l_is_int)) ! { ! expand_start_cond (ffecom_2 (LT_EXPR, integer_type_node, ! rtmp, ! convert (rtype, ! integer_zero_node)), ! 0); ! expand_expr_stmt (ffecom_modify (void_type_node, ! result, ! ffecom_tree_divide_ ! (ltype, ! convert (ltype, integer_one_node), ! ltmp, ! NULL_TREE, NULL, NULL, ! divide))); ! expand_start_cond (ffecom_truth_value ! (ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node, ! ffecom_2 (LT_EXPR, integer_type_node, ! ltmp, ! convert (ltype, ! integer_zero_node)), ! ffecom_2 (EQ_EXPR, integer_type_node, ! ffecom_2 (BIT_AND_EXPR, ! rtype, ! ffecom_1 (NEGATE_EXPR, ! rtype, ! rtmp), ! convert (rtype, ! integer_one_node)), ! convert (rtype, ! integer_zero_node)))), ! 0); ! expand_expr_stmt (ffecom_modify (void_type_node, ! result, ! ffecom_1 (NEGATE_EXPR, ! ltype, ! result))); ! expand_end_cond (); ! expand_start_else (); ! } ! expand_expr_stmt (ffecom_modify (void_type_node, ! result, ! convert (ltype, integer_one_node))); ! expand_start_cond (ffecom_truth_value ! (ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node, ! ffecom_truth_value_invert ! (basetypeof_l_is_int), ! ffecom_2 (LT_EXPR, integer_type_node, ! rtmp, ! convert (rtype, ! integer_zero_node)))), ! 0); ! expand_expr_stmt (ffecom_modify (void_type_node, ! ltmp, ! ffecom_tree_divide_ ! (ltype, ! convert (ltype, integer_one_node), ! ltmp, ! NULL_TREE, NULL, NULL, ! divide))); ! expand_expr_stmt (ffecom_modify (void_type_node, ! rtmp, ! ffecom_1 (NEGATE_EXPR, rtype, ! rtmp))); ! expand_start_cond (ffecom_truth_value ! (ffecom_2 (LT_EXPR, integer_type_node, ! rtmp, ! convert (rtype, integer_zero_node))), ! 0); ! expand_expr_stmt (ffecom_modify (void_type_node, ! rtmp, ! ffecom_1 (NEGATE_EXPR, rtype, ! ffecom_2 (RSHIFT_EXPR, ! rtype, ! rtmp, ! integer_one_node)))); ! expand_expr_stmt (ffecom_modify (void_type_node, ! ltmp, ! ffecom_2 (MULT_EXPR, ltype, ! ltmp, ! ltmp))); ! expand_end_cond (); ! expand_end_cond (); ! expand_start_loop (1); ! expand_start_cond (ffecom_truth_value ! (ffecom_2 (BIT_AND_EXPR, rtype, ! rtmp, ! convert (rtype, integer_one_node))), ! 0); ! expand_expr_stmt (ffecom_modify (void_type_node, ! result, ! ffecom_2 (MULT_EXPR, ltype, ! result, ! ltmp))); ! expand_end_cond (); ! expand_exit_loop_if_false (NULL, ! ffecom_truth_value ! (ffecom_modify (rtype, ! rtmp, ! ffecom_2 (RSHIFT_EXPR, ! rtype, ! rtmp, ! integer_one_node)))); ! expand_expr_stmt (ffecom_modify (void_type_node, ! ltmp, ! ffecom_2 (MULT_EXPR, ltype, ! ltmp, ! ltmp))); ! expand_end_loop (); ! expand_end_cond (); ! if (!integer_zerop (basetypeof_l_is_int)) ! expand_end_cond (); ! expand_expr_stmt (result); + t = ffecom_end_compstmt (); + result = expand_end_stmt_expr (se); + /* This code comes from c-parse.in, after its expand_end_stmt_expr. */ + if (TREE_CODE (t) == BLOCK) + { + /* Make a BIND_EXPR for the BLOCK already made. */ + result = build (BIND_EXPR, TREE_TYPE (result), + NULL_TREE, result, t); + /* Remove the block from the tree at this point. + It gets put back at the proper place + when the BIND_EXPR is expanded. */ + delete_block (t); + } + else + result = t; + } + return result; + } + #endif + /* ffecom_expr_transform_ -- Transform symbols in expr + ffebld expr; // FFE expression. + ffecom_expr_transform_ (expr); + Recursive descent on expr while transforming any untransformed SYMTERs. */ + #if FFECOM_targetCURRENT == FFECOM_targetGCC + static void + ffecom_expr_transform_ (ffebld expr) + { + tree t; + ffesymbol s; + tail_recurse: /* :::::::::::::::::::: */ + if (expr == NULL) + return; + switch (ffebld_op (expr)) + { + case FFEBLD_opSYMTER: + s = ffebld_symter (expr); + t = ffesymbol_hook (s).decl_tree; + if ((t == NULL_TREE) + && ((ffesymbol_kind (s) != FFEINFO_kindNONE) + || ((ffesymbol_where (s) != FFEINFO_whereNONE) + && (ffesymbol_where (s) != FFEINFO_whereINTRINSIC)))) + { + s = ffecom_sym_transform_ (s); + t = ffesymbol_hook (s).decl_tree; /* Sfunc expr non-dummy, + DIMENSION expr? */ + } + break; /* Ok if (t == NULL) here. */ + case FFEBLD_opITEM: + ffecom_expr_transform_ (ffebld_head (expr)); + expr = ffebld_trail (expr); + goto tail_recurse; /* :::::::::::::::::::: */ + default: + break; + } + switch (ffebld_arity (expr)) + { + case 2: + ffecom_expr_transform_ (ffebld_left (expr)); + expr = ffebld_right (expr); + goto tail_recurse; /* :::::::::::::::::::: */ + case 1: + expr = ffebld_left (expr); + goto tail_recurse; /* :::::::::::::::::::: */ + default: + break; + } + return; + } + #endif + /* Make a type based on info in live f2c.h file. */ + #if FFECOM_targetCURRENT == FFECOM_targetGCC + static void + ffecom_f2c_make_type_ (tree *type, int tcode, const char *name) + { + switch (tcode) + { + case FFECOM_f2ccodeCHAR: + *type = make_signed_type (CHAR_TYPE_SIZE); + break; + case FFECOM_f2ccodeSHORT: + *type = make_signed_type (SHORT_TYPE_SIZE); + break; + case FFECOM_f2ccodeINT: + *type = make_signed_type (INT_TYPE_SIZE); + break; ! case FFECOM_f2ccodeLONG: ! *type = make_signed_type (LONG_TYPE_SIZE); ! break; ! case FFECOM_f2ccodeLONGLONG: ! *type = make_signed_type (LONG_LONG_TYPE_SIZE); ! break; ! case FFECOM_f2ccodeCHARPTR: ! *type = build_pointer_type (DEFAULT_SIGNED_CHAR ! ? signed_char_type_node ! : unsigned_char_type_node); ! break; + case FFECOM_f2ccodeFLOAT: + *type = make_node (REAL_TYPE); + TYPE_PRECISION (*type) = FLOAT_TYPE_SIZE; + layout_type (*type); + break; ! case FFECOM_f2ccodeDOUBLE: ! *type = make_node (REAL_TYPE); ! TYPE_PRECISION (*type) = DOUBLE_TYPE_SIZE; ! layout_type (*type); ! break; ! ! case FFECOM_f2ccodeLONGDOUBLE: ! *type = make_node (REAL_TYPE); ! TYPE_PRECISION (*type) = LONG_DOUBLE_TYPE_SIZE; ! layout_type (*type); ! break; ! ! case FFECOM_f2ccodeTWOREALS: ! *type = ffecom_make_complex_type_ (ffecom_f2c_real_type_node); ! break; ! ! case FFECOM_f2ccodeTWODOUBLEREALS: ! *type = ffecom_make_complex_type_ (ffecom_f2c_doublereal_type_node); ! break; ! ! default: ! assert ("unexpected FFECOM_f2ccodeXYZZY!" == NULL); ! *type = error_mark_node; ! return; ! } ! ! pushdecl (build_decl (TYPE_DECL, ! ffecom_get_invented_identifier ("__g77_f2c_%s", ! name, -1), ! *type)); ! } ! ! #endif ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! /* Set the f2c list-directed-I/O code for whatever (integral) type has the ! given size. */ ! ! static void ! ffecom_f2c_set_lio_code_ (ffeinfoBasictype bt, int size, ! int code) ! { ! int j; ! tree t; ! ! for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j) ! if (((t = ffecom_tree_type[bt][j]) != NULL_TREE) ! && (TREE_INT_CST_LOW (TYPE_SIZE (t)) == size)) ! { ! assert (code != -1); ! ffecom_f2c_typecode_[bt][j] = code; ! code = -1; ! } ! } ! ! #endif ! /* Finish up globals after doing all program units in file ! ! Need to handle only uninitialized COMMON areas. */ ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static ffeglobal ! ffecom_finish_global_ (ffeglobal global) ! { ! tree cbtype; ! tree cbt; ! tree size; ! ! if (ffeglobal_type (global) != FFEGLOBAL_typeCOMMON) ! return global; ! ! if (ffeglobal_common_init (global)) ! return global; ! ! cbt = ffeglobal_hook (global); ! if ((cbt == NULL_TREE) ! || !ffeglobal_common_have_size (global)) ! return global; /* No need to make common, never ref'd. */ ! ! suspend_momentary (); ! ! DECL_EXTERNAL (cbt) = 0; ! ! /* Give the array a size now. */ ! ! size = build_int_2 ((ffeglobal_common_size (global) ! + ffeglobal_common_pad (global)) - 1, ! 0); ! ! cbtype = TREE_TYPE (cbt); ! TYPE_DOMAIN (cbtype) = build_range_type (integer_type_node, ! integer_zero_node, ! size); ! if (!TREE_TYPE (size)) ! TREE_TYPE (size) = TYPE_DOMAIN (cbtype); ! layout_type (cbtype); ! ! cbt = start_decl (cbt, FALSE); ! assert (cbt == ffeglobal_hook (global)); ! ! finish_decl (cbt, NULL_TREE, FALSE); ! ! return global; ! } ! ! #endif ! /* Finish up any untransformed symbols. */ ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static ffesymbol ! ffecom_finish_symbol_transform_ (ffesymbol s) ! { ! if ((s == NULL) || (TREE_CODE (current_function_decl) == ERROR_MARK)) ! return s; ! ! /* It's easy to know to transform an untransformed symbol, to make sure ! we put out debugging info for it. But COMMON variables, unlike ! EQUIVALENCE ones, aren't given declarations in addition to the ! tree expressions that specify offsets, because COMMON variables ! can be referenced in the outer scope where only dummy arguments ! (PARM_DECLs) should really be seen. To be safe, just don't do any ! VAR_DECLs for COMMON variables when we transform them for real ! use, and therefore we do all the VAR_DECL creating here. */ ! ! if (ffesymbol_hook (s).decl_tree == NULL_TREE) ! { ! if (ffesymbol_kind (s) != FFEINFO_kindNONE ! || (ffesymbol_where (s) != FFEINFO_whereNONE ! && ffesymbol_where (s) != FFEINFO_whereINTRINSIC ! && ffesymbol_where (s) != FFEINFO_whereDUMMY)) ! /* Not transformed, and not CHARACTER*(*), and not a dummy ! argument, which can happen only if the entry point names ! it "rides in on" are all invalidated for other reasons. */ ! s = ffecom_sym_transform_ (s); ! } ! ! if ((ffesymbol_where (s) == FFEINFO_whereCOMMON) ! && (ffesymbol_hook (s).decl_tree != error_mark_node)) ! { ! #ifdef SOMEONE_GETS_DEBUG_SUPPORT_WORKING ! int yes = suspend_momentary (); ! /* This isn't working, at least for dbxout. The .s file looks ! okay to me (burley), but in gdb 4.9 at least, the variables ! appear to reside somewhere outside of the common area, so ! it doesn't make sense to mislead anyone by generating the info ! on those variables until this is fixed. NOTE: Same problem ! with EQUIVALENCE, sadly...see similar #if later. */ ! ffecom_member_phase2_ (ffesymbol_storage (ffesymbol_common (s)), ! ffesymbol_storage (s)); ! resume_momentary (yes); ! #endif ! } ! return s; ! } ! #endif ! /* Append underscore(s) to name before calling get_identifier. "us" ! is nonzero if the name already contains an underscore and thus ! needs two underscores appended. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_get_appended_identifier_ (char us, const char *name) ! { ! int i; ! char *newname; ! tree id; ! newname = xmalloc ((i = strlen (name)) + 1 ! + ffe_is_underscoring () ! + us); ! memcpy (newname, name, i); ! newname[i] = '_'; ! newname[i + us] = '_'; ! newname[i + 1 + us] = '\0'; ! id = get_identifier (newname); ! free (newname); ! return id; ! } ! #endif ! /* Decide whether to append underscore to name before calling ! get_identifier. */ ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_get_external_identifier_ (ffesymbol s) ! { ! char us; ! const char *name = ffesymbol_text (s); ! ! /* If name is a built-in name, just return it as is. */ ! ! if (!ffe_is_underscoring () ! || (strcmp (name, FFETARGET_nameBLANK_COMMON) == 0) ! #if FFETARGET_isENFORCED_MAIN_NAME ! || (strcmp (name, FFETARGET_nameENFORCED_NAME) == 0) ! #else ! || (strcmp (name, FFETARGET_nameUNNAMED_MAIN) == 0) ! #endif ! || (strcmp (name, FFETARGET_nameUNNAMED_BLOCK_DATA) == 0)) ! return get_identifier (name); ! ! us = ffe_is_second_underscore () ! ? (strchr (name, '_') != NULL) ! : 0; ! ! return ffecom_get_appended_identifier_ (us, name); ! } ! ! #endif ! /* Decide whether to append underscore to internal name before calling ! get_identifier. ! ! This is for non-external, top-function-context names only. Transform ! identifier so it doesn't conflict with the transformed result ! of using a _different_ external name. E.g. if "CALL FOO" is ! transformed into "FOO_();", then the variable in "FOO_ = 3" ! must be transformed into something that does not conflict, since ! these two things should be independent. ! ! The transformation is as follows. If the name does not contain ! an underscore, there is no possible conflict, so just return. ! If the name does contain an underscore, then transform it just ! like we transform an external identifier. */ ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_get_identifier_ (const char *name) ! { ! /* If name does not contain an underscore, just return it as is. */ ! ! if (!ffe_is_underscoring () ! || (strchr (name, '_') == NULL)) ! return get_identifier (name); ! ! return ffecom_get_appended_identifier_ (ffe_is_second_underscore (), ! name); ! } ! ! #endif ! /* ffecom_gen_sfuncdef_ -- Generate definition of statement function ! ! tree t; ! ffesymbol s; // kindFUNCTION, whereIMMEDIATE. ! t = ffecom_gen_sfuncdef_(s,ffesymbol_basictype(s), ! ffesymbol_kindtype(s)); ! ! Call after setting up containing function and getting trees for all ! other symbols. */ ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_gen_sfuncdef_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt) ! { ! ffebld expr = ffesymbol_sfexpr (s); ! tree type; ! tree func; ! tree result; ! bool charfunc = (bt == FFEINFO_basictypeCHARACTER); ! static bool recurse = FALSE; ! int yes; ! int old_lineno = lineno; ! char *old_input_filename = input_filename; ! ! ffecom_nested_entry_ = s; ! ! /* For now, we don't have a handy pointer to where the sfunc is actually ! defined, though that should be easy to add to an ffesymbol. (The ! token/where info available might well point to the place where the type ! of the sfunc is declared, especially if that precedes the place where ! the sfunc itself is defined, which is typically the case.) We should ! put out a null pointer rather than point somewhere wrong, but I want to ! see how it works at this point. */ ! ! input_filename = ffesymbol_where_filename (s); ! lineno = ffesymbol_where_filelinenum (s); ! ! /* Pretransform the expression so any newly discovered things belong to the ! outer program unit, not to the statement function. */ ! ! ffecom_expr_transform_ (expr); ! ! /* Make sure no recursive invocation of this fn (a specific case of failing ! to pretransform an sfunc's expression, i.e. where its expression ! references another untransformed sfunc) happens. */ ! ! assert (!recurse); ! recurse = TRUE; ! ! yes = suspend_momentary (); ! ! push_f_function_context (); ! ! if (charfunc) ! type = void_type_node; ! else ! { ! type = ffecom_tree_type[bt][kt]; ! if (type == NULL_TREE) ! type = integer_type_node; /* _sym_exec_transition reports ! error. */ ! } ! ! start_function (ffecom_get_identifier_ (ffesymbol_text (s)), ! build_function_type (type, NULL_TREE), ! 1, /* nested/inline */ ! 0); /* TREE_PUBLIC */ ! ! /* We don't worry about COMPLEX return values here, because this is ! entirely internal to our code, and gcc has the ability to return COMPLEX ! directly as a value. */ ! ! yes = suspend_momentary (); ! ! if (charfunc) ! { /* Prepend arg for where result goes. */ ! tree type; ! ! type = ffecom_tree_type[FFEINFO_basictypeCHARACTER][kt]; ! ! result = ffecom_get_invented_identifier ("__g77_%s", ! "result", -1); ! ! ffecom_char_enhance_arg_ (&type, s); /* Ignore returned length. */ ! ! type = build_pointer_type (type); ! result = build_decl (PARM_DECL, result, type); ! ! push_parm_decl (result); ! } ! else ! result = NULL_TREE; /* Not ref'd if !charfunc. */ ! ! ffecom_push_dummy_decls_ (ffesymbol_dummyargs (s), TRUE); ! ! resume_momentary (yes); ! ! store_parm_decls (0); ! ! ffecom_start_compstmt (); ! ! if (expr != NULL) ! { ! if (charfunc) ! { ! ffetargetCharacterSize sz = ffesymbol_size (s); ! tree result_length; ! ! result_length = build_int_2 (sz, 0); ! TREE_TYPE (result_length) = ffecom_f2c_ftnlen_type_node; ! ! ffecom_prepare_let_char_ (sz, expr); ! ! ffecom_prepare_end (); ! ! ffecom_let_char_ (result, result_length, sz, expr); ! expand_null_return (); ! } ! else ! { ! ffecom_prepare_expr (expr); ! ! ffecom_prepare_end (); ! ! expand_return (ffecom_modify (NULL_TREE, ! DECL_RESULT (current_function_decl), ! ffecom_expr (expr))); ! } ! ! clear_momentary (); ! } ! ! ffecom_end_compstmt (); ! ! func = current_function_decl; ! finish_function (1); ! ! pop_f_function_context (); ! ! resume_momentary (yes); ! ! recurse = FALSE; ! ! lineno = old_lineno; ! input_filename = old_input_filename; ! ffecom_nested_entry_ = NULL; ! return func; } #endif #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static const char * ! ffecom_gfrt_args_ (ffecomGfrt ix) { ! return ffecom_gfrt_argstring_[ix]; ! } ! #endif ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_gfrt_tree_ (ffecomGfrt ix) ! { ! if (ffecom_gfrt_[ix] == NULL_TREE) ! ffecom_make_gfrt_ (ix); ! return ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (ffecom_gfrt_[ix])), ! ffecom_gfrt_[ix]); ! } ! #endif ! /* Return initialize-to-zero expression for this VAR_DECL. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_init_zero_ (tree decl) ! { ! tree init; ! int incremental = TREE_STATIC (decl); ! tree type = TREE_TYPE (decl); ! if (incremental) ! { ! int momentary = suspend_momentary (); ! push_obstacks_nochange (); ! if (TREE_PERMANENT (decl)) ! end_temporary_allocation (); ! make_decl_rtl (decl, NULL, TREE_PUBLIC (decl) ? 1 : 0); ! assemble_variable (decl, TREE_PUBLIC (decl) ? 1 : 0, 0, 1); ! pop_obstacks (); ! resume_momentary (momentary); ! } ! push_momentary (); ! if ((TREE_CODE (type) != ARRAY_TYPE) ! && (TREE_CODE (type) != RECORD_TYPE) ! && (TREE_CODE (type) != UNION_TYPE) ! && !incremental) ! init = convert (type, integer_zero_node); ! else if (!incremental) ! { ! int momentary = suspend_momentary (); ! init = build (CONSTRUCTOR, type, NULL_TREE, NULL_TREE); ! TREE_CONSTANT (init) = 1; ! TREE_STATIC (init) = 1; ! resume_momentary (momentary); ! } ! else ! { ! int momentary = suspend_momentary (); ! assemble_zeros (int_size_in_bytes (type)); ! init = error_mark_node; ! resume_momentary (momentary); } ! pop_momentary_nofree (); ! return init; ! } ! #endif ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg, ! tree *maybe_tree) ! { ! tree expr_tree; ! tree length_tree; ! switch (ffebld_op (arg)) ! { ! case FFEBLD_opCONTER: /* For F90, check 0-length. */ ! if (ffetarget_length_character1 ! (ffebld_constant_character1 ! (ffebld_conter (arg))) == 0) ! { ! *maybe_tree = integer_zero_node; ! return convert (tree_type, integer_zero_node); ! } ! *maybe_tree = integer_one_node; ! expr_tree = build_int_2 (*ffetarget_text_character1 ! (ffebld_constant_character1 ! (ffebld_conter (arg))), ! 0); ! TREE_TYPE (expr_tree) = tree_type; ! return expr_tree; ! case FFEBLD_opSYMTER: ! case FFEBLD_opARRAYREF: ! case FFEBLD_opFUNCREF: ! case FFEBLD_opSUBSTR: ! ffecom_char_args_ (&expr_tree, &length_tree, arg); ! if ((expr_tree == error_mark_node) ! || (length_tree == error_mark_node)) ! { ! *maybe_tree = error_mark_node; ! return error_mark_node; ! } ! if (integer_zerop (length_tree)) ! { ! *maybe_tree = integer_zero_node; ! return convert (tree_type, integer_zero_node); ! } ! expr_tree ! = ffecom_1 (INDIRECT_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (expr_tree))), ! expr_tree); ! expr_tree ! = ffecom_2 (ARRAY_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (expr_tree))), ! expr_tree, ! integer_one_node); ! expr_tree = convert (tree_type, expr_tree); ! if (TREE_CODE (length_tree) == INTEGER_CST) ! *maybe_tree = integer_one_node; ! else /* Must check length at run time. */ ! *maybe_tree ! = ffecom_truth_value ! (ffecom_2 (GT_EXPR, integer_type_node, ! length_tree, ! ffecom_f2c_ftnlen_zero_node)); ! return expr_tree; ! case FFEBLD_opPAREN: ! case FFEBLD_opCONVERT: ! if (ffeinfo_size (ffebld_info (arg)) == 0) ! { ! *maybe_tree = integer_zero_node; ! return convert (tree_type, integer_zero_node); ! } ! return ffecom_intrinsic_ichar_ (tree_type, ffebld_left (arg), ! maybe_tree); ! case FFEBLD_opCONCATENATE: { ! tree maybe_left; ! tree maybe_right; ! tree expr_left; ! tree expr_right; ! expr_left = ffecom_intrinsic_ichar_ (tree_type, ffebld_left (arg), ! &maybe_left); ! expr_right = ffecom_intrinsic_ichar_ (tree_type, ffebld_right (arg), ! &maybe_right); ! *maybe_tree = ffecom_2 (TRUTH_ORIF_EXPR, integer_type_node, ! maybe_left, ! maybe_right); ! expr_tree = ffecom_3 (COND_EXPR, tree_type, ! maybe_left, ! expr_left, ! expr_right); ! return expr_tree; ! } ! default: ! assert ("bad op in ICHAR" == NULL); ! return error_mark_node; ! } } #endif ! /* ffecom_intrinsic_len_ -- Return length info for char arg (LEN()) ! tree length_arg; ! ffebld expr; ! length_arg = ffecom_intrinsic_len_ (expr); ! Handles CHARACTER-type CONTER, SYMTER, SUBSTR, ARRAYREF, and FUNCREF ! subexpressions by constructing the appropriate tree for the ! length-of-character-text argument in a calling sequence. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_intrinsic_len_ (ffebld expr) { ! ffetargetCharacter1 val; ! tree length; ! switch (ffebld_op (expr)) ! { ! case FFEBLD_opCONTER: ! val = ffebld_constant_character1 (ffebld_conter (expr)); ! length = build_int_2 (ffetarget_length_character1 (val), 0); ! TREE_TYPE (length) = ffecom_f2c_ftnlen_type_node; ! break; ! ! case FFEBLD_opSYMTER: ! { ! ffesymbol s = ffebld_symter (expr); ! tree item; ! ! item = ffesymbol_hook (s).decl_tree; ! if (item == NULL_TREE) ! { ! s = ffecom_sym_transform_ (s); ! item = ffesymbol_hook (s).decl_tree; ! } ! if (ffesymbol_kind (s) == FFEINFO_kindENTITY) ! { ! if (ffesymbol_size (s) == FFETARGET_charactersizeNONE) ! length = ffesymbol_hook (s).length_tree; ! else ! { ! length = build_int_2 (ffesymbol_size (s), 0); ! TREE_TYPE (length) = ffecom_f2c_ftnlen_type_node; ! } ! } ! else if (item == error_mark_node) ! length = error_mark_node; ! else /* FFEINFO_kindFUNCTION: */ ! length = NULL_TREE; ! } ! break; ! ! case FFEBLD_opARRAYREF: ! length = ffecom_intrinsic_len_ (ffebld_left (expr)); ! break; ! ! case FFEBLD_opSUBSTR: ! { ! ffebld start; ! ffebld end; ! ffebld thing = ffebld_right (expr); ! tree start_tree; ! tree end_tree; ! ! assert (ffebld_op (thing) == FFEBLD_opITEM); ! start = ffebld_head (thing); ! thing = ffebld_trail (thing); ! assert (ffebld_trail (thing) == NULL); ! end = ffebld_head (thing); ! ! length = ffecom_intrinsic_len_ (ffebld_left (expr)); ! ! if (length == error_mark_node) ! break; ! ! if (start == NULL) ! { ! if (end == NULL) ! ; ! else ! { ! length = convert (ffecom_f2c_ftnlen_type_node, ! ffecom_expr (end)); ! } ! } ! else ! { ! start_tree = convert (ffecom_f2c_ftnlen_type_node, ! ffecom_expr (start)); ! if (start_tree == error_mark_node) ! { ! length = error_mark_node; ! break; ! } ! if (end == NULL) ! { ! length = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node, ! ffecom_f2c_ftnlen_one_node, ! ffecom_2 (MINUS_EXPR, ! ffecom_f2c_ftnlen_type_node, ! length, ! start_tree)); ! } ! else ! { ! end_tree = convert (ffecom_f2c_ftnlen_type_node, ! ffecom_expr (end)); ! if (end_tree == error_mark_node) ! { ! length = error_mark_node; ! break; ! } ! length = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node, ! ffecom_f2c_ftnlen_one_node, ! ffecom_2 (MINUS_EXPR, ! ffecom_f2c_ftnlen_type_node, ! end_tree, start_tree)); ! } ! } ! } break; ! case FFEBLD_opCONCATENATE: ! length ! = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node, ! ffecom_intrinsic_len_ (ffebld_left (expr)), ! ffecom_intrinsic_len_ (ffebld_right (expr))); ! break; ! case FFEBLD_opFUNCREF: ! case FFEBLD_opCONVERT: ! length = build_int_2 (ffebld_size (expr), 0); ! TREE_TYPE (length) = ffecom_f2c_ftnlen_type_node; ! break; default: + assert ("bad op for single char arg expr" == NULL); + length = ffecom_f2c_ftnlen_zero_node; break; } ! assert (length != NULL_TREE); ! ! return length; } #endif ! /* Handle CHARACTER assignments. ! ! Generates code to do the assignment. Used by ordinary assignment ! statement handler ffecom_let_stmt and by statement-function ! handler to generate code for a statement function. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC static void ! ffecom_let_char_ (tree dest_tree, tree dest_length, ! ffetargetCharacterSize dest_size, ffebld source) { ! ffecomConcatList_ catlist; ! tree source_length; ! tree source_tree; ! tree expr_tree; ! if ((dest_tree == error_mark_node) ! || (dest_length == error_mark_node)) ! return; ! assert (dest_tree != NULL_TREE); ! assert (dest_length != NULL_TREE); ! /* Source might be an opCONVERT, which just means it is a different size ! than the destination. Since the underlying implementation here handles ! that (directly or via the s_copy or s_cat run-time-library functions), ! we don't need the "convenience" of an opCONVERT that tells us to ! truncate or blank-pad, particularly since the resulting implementation ! would probably be slower than otherwise. */ ! while (ffebld_op (source) == FFEBLD_opCONVERT) ! source = ffebld_left (source); ! catlist = ffecom_concat_list_new_ (source, dest_size); ! switch (ffecom_concat_list_count_ (catlist)) ! { ! case 0: /* Shouldn't happen, but in case it does... */ ! ffecom_concat_list_kill_ (catlist); ! source_tree = null_pointer_node; ! source_length = ffecom_f2c_ftnlen_zero_node; ! expr_tree = build_tree_list (NULL_TREE, dest_tree); ! TREE_CHAIN (expr_tree) = build_tree_list (NULL_TREE, source_tree); ! TREE_CHAIN (TREE_CHAIN (expr_tree)) ! = build_tree_list (NULL_TREE, dest_length); ! TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (expr_tree))) ! = build_tree_list (NULL_TREE, source_length); ! expr_tree = ffecom_call_gfrt (FFECOM_gfrtCOPY, expr_tree, NULL_TREE); ! TREE_SIDE_EFFECTS (expr_tree) = 1; ! expand_expr_stmt (expr_tree); ! return; ! case 1: /* The (fairly) easy case. */ ! ffecom_char_args_ (&source_tree, &source_length, ! ffecom_concat_list_expr_ (catlist, 0)); ! ffecom_concat_list_kill_ (catlist); ! assert (source_tree != NULL_TREE); ! assert (source_length != NULL_TREE); ! if ((source_tree == error_mark_node) ! || (source_length == error_mark_node)) ! return; ! if (dest_size == 1) ! { ! dest_tree ! = ffecom_1 (INDIRECT_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE ! (dest_tree))), ! dest_tree); ! dest_tree ! = ffecom_2 (ARRAY_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE ! (dest_tree))), ! dest_tree, ! integer_one_node); ! source_tree ! = ffecom_1 (INDIRECT_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE ! (source_tree))), ! source_tree); ! source_tree ! = ffecom_2 (ARRAY_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE ! (source_tree))), ! source_tree, ! integer_one_node); ! expr_tree = ffecom_modify (void_type_node, dest_tree, source_tree); ! expand_expr_stmt (expr_tree); ! return; ! } ! expr_tree = build_tree_list (NULL_TREE, dest_tree); ! TREE_CHAIN (expr_tree) = build_tree_list (NULL_TREE, source_tree); ! TREE_CHAIN (TREE_CHAIN (expr_tree)) ! = build_tree_list (NULL_TREE, dest_length); ! TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (expr_tree))) ! = build_tree_list (NULL_TREE, source_length); ! expr_tree = ffecom_call_gfrt (FFECOM_gfrtCOPY, expr_tree, NULL_TREE); ! TREE_SIDE_EFFECTS (expr_tree) = 1; ! expand_expr_stmt (expr_tree); ! return; ! default: /* Must actually concatenate things. */ ! break; ! } ! /* Heavy-duty concatenation. */ ! { ! int count = ffecom_concat_list_count_ (catlist); ! int i; ! tree lengths; ! tree items; ! tree length_array; ! tree item_array; ! 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; ! hook = ffebld_nonter_hook (source); ! assert (hook); ! assert (TREE_CODE (hook) == TREE_VEC); ! assert (TREE_VEC_LENGTH (hook) == 2); ! length_array = lengths = TREE_VEC_ELT (hook, 0); ! item_array = items = TREE_VEC_ELT (hook, 1); ! } ! #endif ! for (i = 0; i < count; ++i) ! { ! ffecom_char_args_ (&citem, &clength, ! ffecom_concat_list_expr_ (catlist, i)); ! if ((citem == error_mark_node) ! || (clength == error_mark_node)) ! { ! ffecom_concat_list_kill_ (catlist); ! return; ! } ! items ! = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (items), ! ffecom_modify (void_type_node, ! ffecom_2 (ARRAY_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item_array))), ! item_array, ! build_int_2 (i, 0)), ! citem), ! items); ! lengths ! = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (lengths), ! ffecom_modify (void_type_node, ! ffecom_2 (ARRAY_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (length_array))), ! length_array, ! build_int_2 (i, 0)), ! clength), ! lengths); ! } ! expr_tree = build_tree_list (NULL_TREE, dest_tree); ! TREE_CHAIN (expr_tree) ! = build_tree_list (NULL_TREE, ! ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (items)), ! items)); ! TREE_CHAIN (TREE_CHAIN (expr_tree)) ! = build_tree_list (NULL_TREE, ! ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (lengths)), ! lengths)); ! TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (expr_tree))) ! = build_tree_list ! (NULL_TREE, ! ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnlen_type_node, ! convert (ffecom_f2c_ftnlen_type_node, ! build_int_2 (count, 0)))); ! TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (expr_tree)))) ! = build_tree_list (NULL_TREE, dest_length); ! expr_tree = ffecom_call_gfrt (FFECOM_gfrtCAT, expr_tree, NULL_TREE); ! TREE_SIDE_EFFECTS (expr_tree) = 1; ! expand_expr_stmt (expr_tree); ! } ! ffecom_concat_list_kill_ (catlist); } #endif ! /* ffecom_make_gfrt_ -- Make initial info for run-time routine ! ! ffecomGfrt ix; ! ffecom_make_gfrt_(ix); ! ! Assumes gfrt_[ix] is NULL_TREE, and replaces it with the FUNCTION_DECL ! for the indicated run-time routine (ix). */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void ! ffecom_make_gfrt_ (ffecomGfrt ix) { ! tree t; ! tree ttype; ! push_obstacks_nochange (); ! end_temporary_allocation (); ! switch (ffecom_gfrt_type_[ix]) { ! case FFECOM_rttypeVOID_: ! ttype = void_type_node; ! break; ! case FFECOM_rttypeVOIDSTAR_: ! ttype = TREE_TYPE (null_pointer_node); /* `void *'. */ ! break; ! case FFECOM_rttypeFTNINT_: ! ttype = ffecom_f2c_ftnint_type_node; ! break; ! case FFECOM_rttypeINTEGER_: ! ttype = ffecom_f2c_integer_type_node; ! break; ! case FFECOM_rttypeLONGINT_: ! ttype = ffecom_f2c_longint_type_node; ! break; ! case FFECOM_rttypeLOGICAL_: ! ttype = ffecom_f2c_logical_type_node; ! break; ! case FFECOM_rttypeREAL_F2C_: ! ttype = double_type_node; ! break; ! case FFECOM_rttypeREAL_GNU_: ! ttype = float_type_node; ! break; ! case FFECOM_rttypeCOMPLEX_F2C_: ! ttype = void_type_node; ! break; ! case FFECOM_rttypeCOMPLEX_GNU_: ! ttype = ffecom_f2c_complex_type_node; ! break; ! case FFECOM_rttypeDOUBLE_: ! ttype = double_type_node; ! break; ! case FFECOM_rttypeDOUBLEREAL_: ! ttype = ffecom_f2c_doublereal_type_node; ! break; ! case FFECOM_rttypeDBLCMPLX_F2C_: ! ttype = void_type_node; ! break; ! case FFECOM_rttypeDBLCMPLX_GNU_: ! ttype = ffecom_f2c_doublecomplex_type_node; ! break; ! ! case FFECOM_rttypeCHARACTER_: ! ttype = void_type_node; ! break; ! ! default: ! ttype = NULL; ! assert ("bad rttype" == NULL); ! break; ! } ! ! ttype = build_function_type (ttype, NULL_TREE); ! t = build_decl (FUNCTION_DECL, ! get_identifier (ffecom_gfrt_name_[ix]), ! ttype); ! DECL_EXTERNAL (t) = 1; ! TREE_PUBLIC (t) = 1; ! TREE_THIS_VOLATILE (t) = ffecom_gfrt_volatile_[ix] ? 1 : 0; ! t = start_decl (t, TRUE); ! finish_decl (t, NULL_TREE, TRUE); ! resume_temporary_allocation (); ! pop_obstacks (); ! ffecom_gfrt_[ix] = t; ! } ! #endif ! /* Phase 1 pass over each member of a COMMON/EQUIVALENCE group. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void ! ffecom_member_phase1_ (ffestorag mst UNUSED, ffestorag st) { ! ffesymbol s = ffestorag_symbol (st); ! if (ffesymbol_namelisted (s)) ! ffecom_member_namelisted_ = TRUE; } #endif ! /* Phase 2 pass over each member of a COMMON/EQUIVALENCE group. Declare ! the member so debugger will see it. Otherwise nobody should be ! referencing the member. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #ifdef SOMEONE_GETS_DEBUG_SUPPORT_WORKING ! static void ! ffecom_member_phase2_ (ffestorag mst, ffestorag st) { ! ffesymbol s; ! tree t; ! tree mt; tree type; ! if ((mst == NULL) ! || ((mt = ffestorag_hook (mst)) == NULL) ! || (mt == error_mark_node)) ! return; ! if ((st == NULL) ! || ((s = ffestorag_symbol (st)) == NULL)) ! return; ! type = ffecom_type_localvar_ (s, ! ffesymbol_basictype (s), ! ffesymbol_kindtype (s)); ! if (type == error_mark_node) ! return; ! t = build_decl (VAR_DECL, ! ffecom_get_identifier_ (ffesymbol_text (s)), ! type); ! TREE_STATIC (t) = TREE_STATIC (mt); ! DECL_INITIAL (t) = NULL_TREE; ! TREE_ASM_WRITTEN (t) = 1; ! DECL_RTL (t) ! = gen_rtx (MEM, TYPE_MODE (type), ! plus_constant (XEXP (DECL_RTL (mt), 0), ! ffestorag_modulo (mst) ! + ffestorag_offset (st) ! - ffestorag_offset (mst))); ! t = start_decl (t, FALSE); ! finish_decl (t, NULL_TREE, FALSE); ! } ! #endif ! #endif ! /* Prepare source expression for assignment into a destination perhaps known ! to be of a specific size. */ ! ! static void ! ffecom_prepare_let_char_ (ffetargetCharacterSize dest_size, ffebld source) ! { ! ffecomConcatList_ catlist; ! int count; ! int i; ! tree ltmp; ! tree itmp; ! tree tempvar = NULL_TREE; ! while (ffebld_op (source) == FFEBLD_opCONVERT) ! source = ffebld_left (source); ! catlist = ffecom_concat_list_new_ (source, dest_size); ! count = ffecom_concat_list_count_ (catlist); ! ! if (count >= 2) { ! ltmp ! = ffecom_make_tempvar ("let_char_len", ffecom_f2c_ftnlen_type_node, ! FFETARGET_charactersizeNONE, count); ! itmp ! = ffecom_make_tempvar ("let_char_item", ffecom_f2c_address_type_node, ! FFETARGET_charactersizeNONE, count); ! tempvar = make_tree_vec (2); ! TREE_VEC_ELT (tempvar, 0) = ltmp; ! TREE_VEC_ELT (tempvar, 1) = itmp; ! } ! for (i = 0; i < count; ++i) ! ffecom_prepare_arg_ptr_to_expr (ffecom_concat_list_expr_ (catlist, i)); ! ffecom_concat_list_kill_ (catlist); ! if (tempvar) ! { ! ffebld_nonter_set_hook (source, tempvar); ! current_binding_level->prep_state = 1; ! } ! } ! /* ffecom_push_dummy_decls_ -- Transform dummy args, push parm decls in order ! Ignores STAR (alternate-return) dummies. All other get exec-transitioned ! (which generates their trees) and then their trees get push_parm_decl'd. ! The second arg is TRUE if the dummies are for a statement function, in ! which case lengths are not pushed for character arguments (since they are ! always known by both the caller and the callee, though the code allows ! for someday permitting CHAR*(*) stmtfunc dummies). */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void ! ffecom_push_dummy_decls_ (ffebld dummy_list, bool stmtfunc) ! { ! ffebld dummy; ! ffebld dumlist; ! ffesymbol s; ! tree parm; ! ffecom_transform_only_dummies_ = TRUE; ! /* First push the parms corresponding to actual dummy "contents". */ ! for (dumlist = dummy_list; dumlist != NULL; dumlist = ffebld_trail (dumlist)) ! { ! dummy = ffebld_head (dumlist); ! switch (ffebld_op (dummy)) ! { ! case FFEBLD_opSTAR: ! case FFEBLD_opANY: ! continue; /* Forget alternate returns. */ ! default: ! break; ! } ! assert (ffebld_op (dummy) == FFEBLD_opSYMTER); ! s = ffebld_symter (dummy); ! parm = ffesymbol_hook (s).decl_tree; ! if (parm == NULL_TREE) ! { ! s = ffecom_sym_transform_ (s); ! parm = ffesymbol_hook (s).decl_tree; ! assert (parm != NULL_TREE); ! } ! if (parm != error_mark_node) ! push_parm_decl (parm); ! } ! /* Then, for CHARACTER dummies, push the parms giving their lengths. */ ! for (dumlist = dummy_list; dumlist != NULL; dumlist = ffebld_trail (dumlist)) { ! dummy = ffebld_head (dumlist); ! switch (ffebld_op (dummy)) { ! case FFEBLD_opSTAR: ! case FFEBLD_opANY: ! continue; /* Forget alternate returns, they mean ! NOTHING! */ ! default: ! break; } ! s = ffebld_symter (dummy); ! if (ffesymbol_basictype (s) != FFEINFO_basictypeCHARACTER) ! continue; /* Only looking for CHARACTER arguments. */ ! if (stmtfunc && (ffesymbol_size (s) != FFETARGET_charactersizeNONE)) ! continue; /* Stmtfunc arg with known size needs no ! length param. */ ! if (ffesymbol_kind (s) != FFEINFO_kindENTITY) ! continue; /* Only looking for variables and arrays. */ ! parm = ffesymbol_hook (s).length_tree; ! assert (parm != NULL_TREE); ! if (parm != error_mark_node) ! push_parm_decl (parm); ! } ! ! ffecom_transform_only_dummies_ = FALSE; ! } ! ! #endif ! /* ffecom_start_progunit_ -- Beginning of program unit ! ! Does GNU back end stuff necessary to teach it about the start of its ! equivalent of a Fortran program unit. */ ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void ! ffecom_start_progunit_ () ! { ! ffesymbol fn = ffecom_primary_entry_; ! ffebld arglist; ! tree id; /* Identifier (name) of function. */ ! tree type; /* Type of function. */ ! tree result; /* Result of function. */ ! ffeinfoBasictype bt; ! ffeinfoKindtype kt; ! ffeglobal g; ! ffeglobalType gt; ! ffeglobalType egt = FFEGLOBAL_type; ! bool charfunc; ! bool cmplxfunc; ! bool altentries = (ffecom_num_entrypoints_ != 0); ! bool multi ! = altentries ! && (ffecom_primary_entry_kind_ == FFEINFO_kindFUNCTION) ! && (ffecom_master_bt_ == FFEINFO_basictypeNONE); ! bool main_program = FALSE; ! int old_lineno = lineno; ! char *old_input_filename = input_filename; ! int yes; ! assert (fn != NULL); ! assert (ffesymbol_hook (fn).decl_tree == NULL_TREE); ! input_filename = ffesymbol_where_filename (fn); ! lineno = ffesymbol_where_filelinenum (fn); ! /* c-parse.y indeed does call suspend_momentary and not only ignores the ! return value, but also never calls resume_momentary, when starting an ! outer function (see "fndef:", "setspecs:", and so on). So g77 does the ! same thing. It shouldn't be a problem since start_function calls ! temporary_allocation, but it might be necessary. If it causes a problem ! here, then maybe there's a bug lurking in gcc. NOTE: This identical ! comment appears twice in thist file. */ ! suspend_momentary (); ! switch (ffecom_primary_entry_kind_) ! { ! case FFEINFO_kindPROGRAM: ! main_program = TRUE; ! gt = FFEGLOBAL_typeMAIN; ! bt = FFEINFO_basictypeNONE; ! kt = FFEINFO_kindtypeNONE; ! type = ffecom_tree_fun_type_void; ! charfunc = FALSE; ! cmplxfunc = FALSE; ! break; ! case FFEINFO_kindBLOCKDATA: ! gt = FFEGLOBAL_typeBDATA; ! bt = FFEINFO_basictypeNONE; ! kt = FFEINFO_kindtypeNONE; ! type = ffecom_tree_fun_type_void; ! charfunc = FALSE; ! cmplxfunc = FALSE; ! break; ! case FFEINFO_kindFUNCTION: ! gt = FFEGLOBAL_typeFUNC; ! egt = FFEGLOBAL_typeEXT; ! bt = ffesymbol_basictype (fn); ! kt = ffesymbol_kindtype (fn); ! if (bt == FFEINFO_basictypeNONE) ! { ! ffeimplic_establish_symbol (fn); ! if (ffesymbol_funcresult (fn) != NULL) ! ffeimplic_establish_symbol (ffesymbol_funcresult (fn)); ! bt = ffesymbol_basictype (fn); ! kt = ffesymbol_kindtype (fn); ! } ! if (multi) ! charfunc = cmplxfunc = FALSE; ! else if (bt == FFEINFO_basictypeCHARACTER) ! charfunc = TRUE, cmplxfunc = FALSE; ! else if ((bt == FFEINFO_basictypeCOMPLEX) ! && ffesymbol_is_f2c (fn) ! && !altentries) ! charfunc = FALSE, cmplxfunc = TRUE; ! else ! charfunc = cmplxfunc = FALSE; ! if (multi || charfunc) ! type = ffecom_tree_fun_type_void; ! else if (ffesymbol_is_f2c (fn) && !altentries) ! type = ffecom_tree_fun_type[bt][kt]; ! else ! type = build_function_type (ffecom_tree_type[bt][kt], NULL_TREE); ! if ((type == NULL_TREE) ! || (TREE_TYPE (type) == NULL_TREE)) ! type = ffecom_tree_fun_type_void; /* _sym_exec_transition. */ ! break; ! case FFEINFO_kindSUBROUTINE: ! gt = FFEGLOBAL_typeSUBR; ! egt = FFEGLOBAL_typeEXT; ! bt = FFEINFO_basictypeNONE; ! kt = FFEINFO_kindtypeNONE; ! if (ffecom_is_altreturning_) ! type = ffecom_tree_subr_type; ! else ! type = ffecom_tree_fun_type_void; ! charfunc = FALSE; ! cmplxfunc = FALSE; ! break; ! default: ! assert ("say what??" == NULL); ! /* Fall through. */ ! case FFEINFO_kindANY: ! gt = FFEGLOBAL_typeANY; ! bt = FFEINFO_basictypeNONE; ! kt = FFEINFO_kindtypeNONE; ! type = error_mark_node; ! charfunc = FALSE; ! cmplxfunc = FALSE; ! break; ! } + if (altentries) + { + id = ffecom_get_invented_identifier ("__g77_masterfun_%s", + ffesymbol_text (fn), + -1); + } + #if FFETARGET_isENFORCED_MAIN + else if (main_program) + id = get_identifier (FFETARGET_nameENFORCED_MAIN_NAME); #endif ! else ! id = ffecom_get_external_identifier_ (fn); ! start_function (id, ! type, ! 0, /* nested/inline */ ! !altentries); /* TREE_PUBLIC */ ! TREE_USED (current_function_decl) = 1; /* Avoid spurious warning if altentries. */ ! if (!altentries ! && ((g = ffesymbol_global (fn)) != NULL) ! && ((ffeglobal_type (g) == gt) ! || (ffeglobal_type (g) == egt))) { ! ffeglobal_set_hook (g, current_function_decl); } ! yes = suspend_momentary (); ! /* Arg handling needs exec-transitioned ffesymbols to work with. But ! exec-transitioning needs current_function_decl to be filled in. So we ! do these things in two phases. */ ! if (altentries) ! { /* 1st arg identifies which entrypoint. */ ! ffecom_which_entrypoint_decl_ ! = build_decl (PARM_DECL, ! ffecom_get_invented_identifier ("__g77_%s", ! "which_entrypoint", ! -1), ! integer_type_node); ! push_parm_decl (ffecom_which_entrypoint_decl_); } ! if (charfunc ! || cmplxfunc ! || multi) ! { /* Arg for result (return value). */ ! tree type; ! tree length; ! if (charfunc) ! type = ffecom_tree_type[FFEINFO_basictypeCHARACTER][kt]; ! else if (cmplxfunc) ! type = ffecom_tree_type[FFEINFO_basictypeCOMPLEX][kt]; ! else ! type = ffecom_multi_type_node_; ! result = ffecom_get_invented_identifier ("__g77_%s", ! "result", -1); ! /* Make length arg _and_ enhance type info for CHAR arg itself. */ ! if (charfunc) ! length = ffecom_char_enhance_arg_ (&type, fn); ! else ! length = NULL_TREE; /* Not ref'd if !charfunc. */ ! type = build_pointer_type (type); ! result = build_decl (PARM_DECL, result, type); ! push_parm_decl (result); ! if (multi) ! ffecom_multi_retval_ = result; ! else ! ffecom_func_result_ = result; ! if (charfunc) { ! push_parm_decl (length); ! ffecom_func_length_ = length; } + } ! if (ffecom_primary_entry_is_proc_) ! { ! if (altentries) ! arglist = ffecom_master_arglist_; ! else ! arglist = ffesymbol_dummyargs (fn); ! ffecom_push_dummy_decls_ (arglist, FALSE); ! } ! resume_momentary (yes); ! if (TREE_CODE (current_function_decl) != ERROR_MARK) ! store_parm_decls (main_program ? 1 : 0); ! ffecom_start_compstmt (); ! /* Disallow temp vars at this level. */ ! current_binding_level->prep_state = 2; ! lineno = old_lineno; ! input_filename = old_input_filename; ! /* This handles any symbols still untransformed, in case -g specified. ! This used to be done in ffecom_finish_progunit, but it turns out to ! be necessary to do it here so that statement functions are ! expanded before code. But don't bother for BLOCK DATA. */ ! if (ffecom_primary_entry_kind_ != FFEINFO_kindBLOCKDATA) ! ffesymbol_drive (ffecom_finish_symbol_transform_); } #endif ! /* ffecom_sym_transform_ -- Transform FFE sym into backend sym ! ffesymbol s; ! ffecom_sym_transform_(s); ! The ffesymbol_hook info for s is updated with appropriate backend info ! on the symbol. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static ffesymbol ! ffecom_sym_transform_ (ffesymbol s) { ! tree t; /* Transformed thingy. */ ! tree tlen; /* Length if CHAR*(*). */ ! bool addr; /* Is t the address of the thingy? */ ! ffeinfoBasictype bt; ! ffeinfoKindtype kt; ! ffeglobal g; ! int yes; ! int old_lineno = lineno; ! char *old_input_filename = input_filename; ! /* Must ensure special ASSIGN variables are declared at top of outermost ! block, else they'll end up in the innermost block when their first ! ASSIGN is seen, which leaves them out of scope when they're the ! subject of a GOTO or I/O statement. ! ! We make this variable even if -fugly-assign. Just let it go unused, ! in case it turns out there are cases where we really want to use this ! variable anyway (e.g. ASSIGN to INTEGER*2 variable). */ ! ! if (! ffecom_transform_only_dummies_ ! && ffesymbol_assigned (s) ! && ! ffesymbol_hook (s).assign_tree) ! s = ffecom_sym_transform_assign_ (s); ! if (ffesymbol_sfdummyparent (s) == NULL) ! { ! input_filename = ffesymbol_where_filename (s); ! lineno = ffesymbol_where_filelinenum (s); ! } ! else ! { ! ffesymbol sf = ffesymbol_sfdummyparent (s); ! input_filename = ffesymbol_where_filename (sf); ! lineno = ffesymbol_where_filelinenum (sf); ! } ! bt = ffeinfo_basictype (ffebld_info (s)); ! kt = ffeinfo_kindtype (ffebld_info (s)); ! t = NULL_TREE; ! tlen = NULL_TREE; ! addr = FALSE; ! switch (ffesymbol_kind (s)) ! { ! case FFEINFO_kindNONE: ! switch (ffesymbol_where (s)) ! { ! case FFEINFO_whereDUMMY: /* Subroutine or function. */ ! assert (ffecom_transform_only_dummies_); ! /* Before 0.4, this could be ENTITY/DUMMY, but see ! ffestu_sym_end_transition -- no longer true (in particular, if ! it could be an ENTITY, it _will_ be made one, so that ! possibility won't come through here). So we never make length ! arg for CHARACTER type. */ ! t = build_decl (PARM_DECL, ! ffecom_get_identifier_ (ffesymbol_text (s)), ! ffecom_tree_ptr_to_subr_type); ! #if BUILT_FOR_270 ! DECL_ARTIFICIAL (t) = 1; ! #endif ! addr = TRUE; break; ! case FFEINFO_whereGLOBAL: /* Subroutine or function. */ ! assert (!ffecom_transform_only_dummies_); ! if (((g = ffesymbol_global (s)) != NULL) ! && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR) ! || (ffeglobal_type (g) == FFEGLOBAL_typeFUNC) ! || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)) ! && (ffeglobal_hook (g) != NULL_TREE) ! && ffe_is_globals ()) ! { ! t = ffeglobal_hook (g); ! break; ! } ! push_obstacks_nochange (); ! end_temporary_allocation (); ! t = build_decl (FUNCTION_DECL, ! ffecom_get_external_identifier_ (s), ! ffecom_tree_subr_type); /* Assume subr. */ ! DECL_EXTERNAL (t) = 1; ! TREE_PUBLIC (t) = 1; ! t = start_decl (t, FALSE); ! finish_decl (t, NULL_TREE, FALSE); ! if ((g != NULL) ! && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR) ! || (ffeglobal_type (g) == FFEGLOBAL_typeFUNC) ! || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))) ! ffeglobal_set_hook (g, t); ! resume_temporary_allocation (); ! pop_obstacks (); ! break; ! ! default: ! assert ("NONE where unexpected" == NULL); ! /* Fall through. */ ! case FFEINFO_whereANY: ! break; ! } break; ! case FFEINFO_kindENTITY: ! switch (ffeinfo_where (ffesymbol_info (s))) ! { ! case FFEINFO_whereCONSTANT: ! /* ~~Debugging info needed? */ ! assert (!ffecom_transform_only_dummies_); ! t = error_mark_node; /* Shouldn't ever see this in expr. */ ! break; ! case FFEINFO_whereLOCAL: ! assert (!ffecom_transform_only_dummies_); ! { ! ffestorag st = ffesymbol_storage (s); ! tree type; ! if ((st != NULL) ! && (ffestorag_size (st) == 0)) ! { ! t = error_mark_node; ! break; ! } ! yes = suspend_momentary (); ! type = ffecom_type_localvar_ (s, bt, kt); ! resume_momentary (yes); ! if (type == error_mark_node) ! { ! t = error_mark_node; ! break; ! } ! if ((st != NULL) ! && (ffestorag_parent (st) != NULL)) ! { /* Child of EQUIVALENCE parent. */ ! ffestorag est; ! tree et; ! int yes; ! ffetargetOffset offset; ! est = ffestorag_parent (st); ! ffecom_transform_equiv_ (est); ! et = ffestorag_hook (est); ! assert (et != NULL_TREE); ! if (! TREE_STATIC (et)) ! put_var_into_stack (et); ! yes = suspend_momentary (); ! offset = ffestorag_modulo (est) ! + ffestorag_offset (ffesymbol_storage (s)) ! - ffestorag_offset (est); ! ffecom_debug_kludge_ (et, "EQUIVALENCE", s, type, offset); ! /* (t_type *) (((char *) &et) + offset) */ ! t = convert (string_type_node, /* (char *) */ ! ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (et)), ! et)); ! t = ffecom_2 (PLUS_EXPR, TREE_TYPE (t), ! t, ! build_int_2 (offset, 0)); ! t = convert (build_pointer_type (type), ! t); ! TREE_CONSTANT (t) = staticp (et); ! addr = TRUE; ! resume_momentary (yes); ! } ! else ! { ! tree initexpr; ! bool init = ffesymbol_is_init (s); ! yes = suspend_momentary (); ! t = build_decl (VAR_DECL, ! ffecom_get_identifier_ (ffesymbol_text (s)), ! type); ! if (init ! || ffesymbol_namelisted (s) ! #ifdef FFECOM_sizeMAXSTACKITEM ! || ((st != NULL) ! && (ffestorag_size (st) > FFECOM_sizeMAXSTACKITEM)) ! #endif ! || ((ffecom_primary_entry_kind_ != FFEINFO_kindPROGRAM) ! && (ffecom_primary_entry_kind_ ! != FFEINFO_kindBLOCKDATA) ! && (ffesymbol_is_save (s) || ffe_is_saveall ()))) ! TREE_STATIC (t) = !ffesymbol_attr (s, FFESYMBOL_attrADJUSTABLE); ! else ! TREE_STATIC (t) = 0; /* No need to make static. */ ! if (init || ffe_is_init_local_zero ()) ! DECL_INITIAL (t) = error_mark_node; ! /* Keep -Wunused from complaining about var if it ! is used as sfunc arg or DATA implied-DO. */ ! if (ffesymbol_attrs (s) & FFESYMBOL_attrsSFARG) ! DECL_IN_SYSTEM_HEADER (t) = 1; ! t = start_decl (t, FALSE); ! if (init) ! { ! if (ffesymbol_init (s) != NULL) ! initexpr = ffecom_expr (ffesymbol_init (s)); ! else ! initexpr = ffecom_init_zero_ (t); ! } ! else if (ffe_is_init_local_zero ()) ! initexpr = ffecom_init_zero_ (t); ! else ! initexpr = NULL_TREE; /* Not ref'd if !init. */ ! finish_decl (t, initexpr, FALSE); ! if ((st != NULL) && (DECL_SIZE (t) != error_mark_node)) ! { ! tree size_tree; ! size_tree = size_binop (CEIL_DIV_EXPR, ! DECL_SIZE (t), ! size_int (BITS_PER_UNIT)); ! assert (TREE_INT_CST_HIGH (size_tree) == 0); ! assert (TREE_INT_CST_LOW (size_tree) == ffestorag_size (st)); ! } ! resume_momentary (yes); ! } } + break; ! case FFEINFO_whereRESULT: ! assert (!ffecom_transform_only_dummies_); ! if (bt == FFEINFO_basictypeCHARACTER) ! { /* Result is already in list of dummies, use ! it (& length). */ ! t = ffecom_func_result_; ! tlen = ffecom_func_length_; ! addr = TRUE; ! break; ! } ! if ((ffecom_num_entrypoints_ == 0) ! && (bt == FFEINFO_basictypeCOMPLEX) ! && (ffesymbol_is_f2c (ffecom_primary_entry_))) ! { /* Result is already in list of dummies, use ! it. */ ! t = ffecom_func_result_; ! addr = TRUE; ! break; ! } ! if (ffecom_func_result_ != NULL_TREE) ! { ! t = ffecom_func_result_; ! break; ! } ! if ((ffecom_num_entrypoints_ != 0) ! && (ffecom_master_bt_ == FFEINFO_basictypeNONE)) ! { ! yes = suspend_momentary (); ! assert (ffecom_multi_retval_ != NULL_TREE); ! t = ffecom_1 (INDIRECT_REF, ffecom_multi_type_node_, ! ffecom_multi_retval_); ! t = ffecom_2 (COMPONENT_REF, ffecom_tree_type[bt][kt], ! t, ffecom_multi_fields_[bt][kt]); ! resume_momentary (yes); ! break; ! } ! yes = suspend_momentary (); ! t = build_decl (VAR_DECL, ! ffecom_get_identifier_ (ffesymbol_text (s)), ! ffecom_tree_type[bt][kt]); ! TREE_STATIC (t) = 0; /* Put result on stack. */ ! t = start_decl (t, FALSE); ! finish_decl (t, NULL_TREE, FALSE); ! ffecom_func_result_ = t; ! resume_momentary (yes); ! break; ! case FFEINFO_whereDUMMY: ! { ! tree type; ! ffebld dl; ! ffebld dim; ! tree low; ! tree high; ! tree old_sizes; ! bool adjustable = FALSE; /* Conditionally adjustable? */ ! type = ffecom_tree_type[bt][kt]; ! if (ffesymbol_sfdummyparent (s) != NULL) ! { ! if (current_function_decl == ffecom_outer_function_decl_) ! { /* Exec transition before sfunc ! context; get it later. */ ! break; ! } ! t = ffecom_get_identifier_ (ffesymbol_text ! (ffesymbol_sfdummyparent (s))); ! } ! else ! t = ffecom_get_identifier_ (ffesymbol_text (s)); ! assert (ffecom_transform_only_dummies_); ! old_sizes = get_pending_sizes (); ! put_pending_sizes (old_sizes); ! if (bt == FFEINFO_basictypeCHARACTER) ! tlen = ffecom_char_enhance_arg_ (&type, s); ! type = ffecom_check_size_overflow_ (s, type, TRUE); ! for (dl = ffesymbol_dims (s); dl != NULL; dl = ffebld_trail (dl)) ! { ! if (type == error_mark_node) ! break; ! dim = ffebld_head (dl); ! assert (ffebld_op (dim) == FFEBLD_opBOUNDS); ! if ((ffebld_left (dim) == NULL) || ffecom_doing_entry_) ! low = ffecom_integer_one_node; ! else ! low = ffecom_expr (ffebld_left (dim)); ! assert (ffebld_right (dim) != NULL); ! if ((ffebld_op (ffebld_right (dim)) == FFEBLD_opSTAR) ! || ffecom_doing_entry_) ! { ! /* Used to just do high=low. But for ffecom_tree_ ! canonize_ref_, it probably is important to correctly ! assess the size. E.g. given COMPLEX C(*),CFUNC and ! C(2)=CFUNC(C), overlap can happen, while it can't ! for, say, C(1)=CFUNC(C(2)). */ ! /* Even more recently used to set to INT_MAX, but that ! broke when some overflow checking went into the back ! end. Now we just leave the upper bound unspecified. */ ! high = NULL; ! } ! else ! high = ffecom_expr (ffebld_right (dim)); ! /* Determine whether array is conditionally adjustable, ! to decide whether back-end magic is needed. ! Normally the front end uses the back-end function ! variable_size to wrap SAVE_EXPR's around expressions ! affecting the size/shape of an array so that the ! size/shape info doesn't change during execution ! of the compiled code even though variables and ! functions referenced in those expressions might. ! variable_size also makes sure those saved expressions ! get evaluated immediately upon entry to the ! compiled procedure -- the front end normally doesn't ! have to worry about that. ! However, there is a problem with this that affects ! g77's implementation of entry points, and that is ! that it is _not_ true that each invocation of the ! compiled procedure is permitted to evaluate ! array size/shape info -- because it is possible ! that, for some invocations, that info is invalid (in ! which case it is "promised" -- i.e. a violation of ! the Fortran standard -- that the compiled code ! won't reference the array or its size/shape ! during that particular invocation). ! To phrase this in C terms, consider this gcc function: ! void foo (int *n, float (*a)[*n]) ! { ! // a is "pointer to array ...", fyi. ! } ! Suppose that, for some invocations, it is permitted ! for a caller of foo to do this: ! foo (NULL, NULL); ! ! Now the _written_ code for foo can take such a call ! into account by either testing explicitly for whether ! (a == NULL) || (n == NULL) -- presumably it is ! not permitted to reference *a in various fashions ! if (n == NULL) I suppose -- or it can avoid it by ! looking at other info (other arguments, static/global ! data, etc.). ! ! However, this won't work in gcc 2.5.8 because it'll ! automatically emit the code to save the "*n" ! expression, which'll yield a NULL dereference for ! the "foo (NULL, NULL)" call, something the code ! for foo cannot prevent. ! g77 definitely needs to avoid executing such ! code anytime the pointer to the adjustable array ! is NULL, because even if its bounds expressions ! don't have any references to possible "absent" ! variables like "*n" -- say all variable references ! are to COMMON variables, i.e. global (though in C, ! local static could actually make sense) -- the ! expressions could yield other run-time problems ! for allowably "dead" values in those variables. ! For example, let's consider a more complicated ! version of foo: ! extern int i; ! extern int j; ! void foo (float (*a)[i/j]) ! { ! ... ! } ! The above is (essentially) quite valid for Fortran ! but, again, for a call like "foo (NULL);", it is ! permitted for i and j to be undefined when the ! call is made. If j happened to be zero, for ! example, emitting the code to evaluate "i/j" ! could result in a run-time error. ! Offhand, though I don't have my F77 or F90 ! standards handy, it might even be valid for a ! bounds expression to contain a function reference, ! in which case I doubt it is permitted for an ! implementation to invoke that function in the ! Fortran case involved here (invocation of an ! alternate ENTRY point that doesn't have the adjustable ! array as one of its arguments). ! So, the code that the compiler would normally emit ! to preevaluate the size/shape info for an ! adjustable array _must not_ be executed at run time ! in certain cases. Specifically, for Fortran, ! the case is when the pointer to the adjustable ! array == NULL. (For gnu-ish C, it might be nice ! for the source code itself to specify an expression ! that, if TRUE, inhibits execution of the code. Or ! reverse the sense for elegance.) ! (Note that g77 could use a different test than NULL, ! actually, since it happens to always pass an ! integer to the called function that specifies which ! entry point is being invoked. Hmm, this might ! solve the next problem.) ! One way a user could, I suppose, write "foo" so ! it works is to insert COND_EXPR's for the ! size/shape info so the dangerous stuff isn't ! actually done, as in: ! void foo (int *n, float (*a)[(a == NULL) ? 0 : *n]) ! { ! ... ! } ! The next problem is that the front end needs to ! be able to tell the back end about the array's ! decl _before_ it tells it about the conditional ! expression to inhibit evaluation of size/shape info, ! as shown above. ! To solve this, the front end needs to be able ! to give the back end the expression to inhibit ! generation of the preevaluation code _after_ ! it makes the decl for the adjustable array. ! Until then, the above example using the COND_EXPR ! doesn't pass muster with gcc because the "(a == NULL)" ! part has a reference to "a", which is still ! undefined at that point. ! g77 will therefore use a different mechanism in the ! meantime. */ ! if (!adjustable ! && ((TREE_CODE (low) != INTEGER_CST) ! || (high && TREE_CODE (high) != INTEGER_CST))) ! adjustable = TRUE; ! #if 0 /* Old approach -- see below. */ ! if (TREE_CODE (low) != INTEGER_CST) ! low = ffecom_3 (COND_EXPR, integer_type_node, ! ffecom_adjarray_passed_ (s), ! low, ! ffecom_integer_zero_node); ! if (high && TREE_CODE (high) != INTEGER_CST) ! high = ffecom_3 (COND_EXPR, integer_type_node, ! ffecom_adjarray_passed_ (s), ! high, ! ffecom_integer_zero_node); ! #endif ! /* ~~~gcc/stor-layout.c (layout_type) should do this, ! probably. Fixes 950302-1.f. */ ! if (TREE_CODE (low) != INTEGER_CST) ! low = variable_size (low); ! /* ~~~Similarly, this fixes dumb0.f. The C front end ! does this, which is why dumb0.c would work. */ ! if (high && TREE_CODE (high) != INTEGER_CST) ! high = variable_size (high); ! type ! = build_array_type ! (type, ! build_range_type (ffecom_integer_type_node, ! low, high)); ! type = ffecom_check_size_overflow_ (s, type, TRUE); ! } ! if (type == error_mark_node) ! { ! t = error_mark_node; ! break; ! } ! if ((ffesymbol_sfdummyparent (s) == NULL) ! || (ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER)) ! { ! type = build_pointer_type (type); ! addr = TRUE; ! } ! t = build_decl (PARM_DECL, t, type); ! #if BUILT_FOR_270 ! DECL_ARTIFICIAL (t) = 1; ! #endif ! /* If this arg is present in every entry point's list of ! dummy args, then we're done. */ ! if (ffesymbol_numentries (s) ! == (ffecom_num_entrypoints_ + 1)) ! break; ! #if 1 ! /* If variable_size in stor-layout has been called during ! the above, then get_pending_sizes should have the ! yet-to-be-evaluated saved expressions pending. ! Make the whole lot of them get emitted, conditionally ! on whether the array decl ("t" above) is not NULL. */ ! { ! tree sizes = get_pending_sizes (); ! tree tem; ! for (tem = sizes; ! tem != old_sizes; ! tem = TREE_CHAIN (tem)) ! { ! tree temv = TREE_VALUE (tem); ! if (sizes == tem) ! sizes = temv; ! else ! sizes ! = ffecom_2 (COMPOUND_EXPR, ! TREE_TYPE (sizes), ! temv, ! sizes); ! } ! if (sizes != tem) ! { ! sizes ! = ffecom_3 (COND_EXPR, ! TREE_TYPE (sizes), ! ffecom_2 (NE_EXPR, ! integer_type_node, ! t, ! null_pointer_node), ! sizes, ! convert (TREE_TYPE (sizes), ! integer_zero_node)); ! sizes = ffecom_save_tree (sizes); ! sizes ! = tree_cons (NULL_TREE, sizes, tem); ! } ! if (sizes) ! put_pending_sizes (sizes); ! } ! #else ! #if 0 ! if (adjustable ! && (ffesymbol_numentries (s) ! != ffecom_num_entrypoints_ + 1)) ! DECL_SOMETHING (t) ! = ffecom_2 (NE_EXPR, integer_type_node, ! t, ! null_pointer_node); ! #else ! #if 0 ! if (adjustable ! && (ffesymbol_numentries (s) ! != ffecom_num_entrypoints_ + 1)) ! { ! ffebad_start (FFEBAD_MISSING_ADJARRAY_UNSUPPORTED); ! ffebad_here (0, ffesymbol_where_line (s), ! ffesymbol_where_column (s)); ! ffebad_string (ffesymbol_text (s)); ! ffebad_finish (); ! } ! #endif ! #endif ! #endif ! } ! break; ! case FFEINFO_whereCOMMON: ! { ! ffesymbol cs; ! ffeglobal cg; ! tree ct; ! ffestorag st = ffesymbol_storage (s); ! tree type; ! int yes; ! cs = ffesymbol_common (s); /* The COMMON area itself. */ ! if (st != NULL) /* Else not laid out. */ ! { ! ffecom_transform_common_ (cs); ! st = ffesymbol_storage (s); ! } ! yes = suspend_momentary (); ! type = ffecom_type_localvar_ (s, bt, kt); ! cg = ffesymbol_global (cs); /* The global COMMON info. */ ! if ((cg == NULL) ! || (ffeglobal_type (cg) != FFEGLOBAL_typeCOMMON)) ! ct = NULL_TREE; ! else ! ct = ffeglobal_hook (cg); /* The common area's tree. */ ! if ((ct == NULL_TREE) ! || (st == NULL) ! || (type == error_mark_node)) ! t = error_mark_node; ! else ! { ! ffetargetOffset offset; ! ffestorag cst; ! cst = ffestorag_parent (st); ! assert (cst == ffesymbol_storage (cs)); ! offset = ffestorag_modulo (cst) ! + ffestorag_offset (st) ! - ffestorag_offset (cst); ! ffecom_debug_kludge_ (ct, "COMMON", s, type, offset); ! /* (t_type *) (((char *) &ct) + offset) */ ! t = convert (string_type_node, /* (char *) */ ! ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (ct)), ! ct)); ! t = ffecom_2 (PLUS_EXPR, TREE_TYPE (t), ! t, ! build_int_2 (offset, 0)); ! t = convert (build_pointer_type (type), ! t); ! TREE_CONSTANT (t) = 1; ! addr = TRUE; ! } ! resume_momentary (yes); ! } ! break; ! case FFEINFO_whereIMMEDIATE: ! case FFEINFO_whereGLOBAL: ! case FFEINFO_whereFLEETING: ! case FFEINFO_whereFLEETING_CADDR: ! case FFEINFO_whereFLEETING_IADDR: ! case FFEINFO_whereINTRINSIC: ! case FFEINFO_whereCONSTANT_SUBOBJECT: ! default: ! assert ("ENTITY where unheard of" == NULL); ! /* Fall through. */ ! case FFEINFO_whereANY: ! t = error_mark_node; ! break; ! } ! break; ! case FFEINFO_kindFUNCTION: ! switch (ffeinfo_where (ffesymbol_info (s))) ! { ! case FFEINFO_whereLOCAL: /* Me. */ ! assert (!ffecom_transform_only_dummies_); ! t = current_function_decl; ! break; ! case FFEINFO_whereGLOBAL: ! assert (!ffecom_transform_only_dummies_); ! if (((g = ffesymbol_global (s)) != NULL) ! && ((ffeglobal_type (g) == FFEGLOBAL_typeFUNC) ! || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)) ! && (ffeglobal_hook (g) != NULL_TREE) ! && ffe_is_globals ()) ! { ! t = ffeglobal_hook (g); ! break; ! } ! push_obstacks_nochange (); ! end_temporary_allocation (); ! if (ffesymbol_is_f2c (s) ! && (ffesymbol_where (s) != FFEINFO_whereCONSTANT)) ! t = ffecom_tree_fun_type[bt][kt]; ! else ! t = build_function_type (ffecom_tree_type[bt][kt], NULL_TREE); ! t = build_decl (FUNCTION_DECL, ! ffecom_get_external_identifier_ (s), ! t); ! DECL_EXTERNAL (t) = 1; ! TREE_PUBLIC (t) = 1; ! t = start_decl (t, FALSE); ! finish_decl (t, NULL_TREE, FALSE); ! if ((g != NULL) ! && ((ffeglobal_type (g) == FFEGLOBAL_typeFUNC) ! || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))) ! ffeglobal_set_hook (g, t); ! resume_temporary_allocation (); ! pop_obstacks (); ! break; ! case FFEINFO_whereDUMMY: ! assert (ffecom_transform_only_dummies_); ! if (ffesymbol_is_f2c (s) ! && (ffesymbol_where (s) != FFEINFO_whereCONSTANT)) ! t = ffecom_tree_ptr_to_fun_type[bt][kt]; ! else ! t = build_pointer_type ! (build_function_type (ffecom_tree_type[bt][kt], NULL_TREE)); ! t = build_decl (PARM_DECL, ! ffecom_get_identifier_ (ffesymbol_text (s)), ! t); ! #if BUILT_FOR_270 ! DECL_ARTIFICIAL (t) = 1; ! #endif ! addr = TRUE; ! break; ! case FFEINFO_whereCONSTANT: /* Statement function. */ ! assert (!ffecom_transform_only_dummies_); ! t = ffecom_gen_sfuncdef_ (s, bt, kt); ! break; ! case FFEINFO_whereINTRINSIC: ! assert (!ffecom_transform_only_dummies_); ! break; /* Let actual references generate their ! decls. */ ! default: ! assert ("FUNCTION where unheard of" == NULL); ! /* Fall through. */ ! case FFEINFO_whereANY: ! t = error_mark_node; ! break; ! } ! break; ! case FFEINFO_kindSUBROUTINE: ! switch (ffeinfo_where (ffesymbol_info (s))) ! { ! case FFEINFO_whereLOCAL: /* Me. */ ! assert (!ffecom_transform_only_dummies_); ! t = current_function_decl; ! break; ! case FFEINFO_whereGLOBAL: ! assert (!ffecom_transform_only_dummies_); ! if (((g = ffesymbol_global (s)) != NULL) ! && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR) ! || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)) ! && (ffeglobal_hook (g) != NULL_TREE) ! && ffe_is_globals ()) ! { ! t = ffeglobal_hook (g); ! break; ! } ! push_obstacks_nochange (); ! end_temporary_allocation (); ! t = build_decl (FUNCTION_DECL, ! ffecom_get_external_identifier_ (s), ! ffecom_tree_subr_type); ! DECL_EXTERNAL (t) = 1; ! TREE_PUBLIC (t) = 1; ! t = start_decl (t, FALSE); ! finish_decl (t, NULL_TREE, FALSE); ! if ((g != NULL) ! && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR) ! || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))) ! ffeglobal_set_hook (g, t); ! resume_temporary_allocation (); ! pop_obstacks (); ! break; ! case FFEINFO_whereDUMMY: ! assert (ffecom_transform_only_dummies_); ! t = build_decl (PARM_DECL, ! ffecom_get_identifier_ (ffesymbol_text (s)), ! ffecom_tree_ptr_to_subr_type); ! #if BUILT_FOR_270 ! DECL_ARTIFICIAL (t) = 1; ! #endif ! addr = TRUE; ! break; ! case FFEINFO_whereINTRINSIC: ! assert (!ffecom_transform_only_dummies_); ! break; /* Let actual references generate their ! decls. */ ! default: ! assert ("SUBROUTINE where unheard of" == NULL); ! /* Fall through. */ ! case FFEINFO_whereANY: ! t = error_mark_node; ! break; ! } ! break; ! case FFEINFO_kindPROGRAM: ! switch (ffeinfo_where (ffesymbol_info (s))) ! { ! case FFEINFO_whereLOCAL: /* Me. */ ! assert (!ffecom_transform_only_dummies_); ! t = current_function_decl; ! break; ! case FFEINFO_whereCOMMON: ! case FFEINFO_whereDUMMY: ! case FFEINFO_whereGLOBAL: ! case FFEINFO_whereRESULT: ! case FFEINFO_whereFLEETING: ! case FFEINFO_whereFLEETING_CADDR: ! case FFEINFO_whereFLEETING_IADDR: ! case FFEINFO_whereIMMEDIATE: ! case FFEINFO_whereINTRINSIC: ! case FFEINFO_whereCONSTANT: ! case FFEINFO_whereCONSTANT_SUBOBJECT: ! default: ! assert ("PROGRAM where unheard of" == NULL); ! /* Fall through. */ ! case FFEINFO_whereANY: ! t = error_mark_node; break; + } + break; ! case FFEINFO_kindBLOCKDATA: ! switch (ffeinfo_where (ffesymbol_info (s))) ! { ! case FFEINFO_whereLOCAL: /* Me. */ assert (!ffecom_transform_only_dummies_); + t = current_function_decl; + break; ! case FFEINFO_whereGLOBAL: ! assert (!ffecom_transform_only_dummies_); push_obstacks_nochange (); end_temporary_allocation (); t = build_decl (FUNCTION_DECL, ffecom_get_external_identifier_ (s), ! ffecom_tree_blockdata_type); DECL_EXTERNAL (t) = 1; TREE_PUBLIC (t) = 1; t = start_decl (t, FALSE); finish_decl (t, NULL_TREE, FALSE); resume_temporary_allocation (); pop_obstacks (); break; + case FFEINFO_whereCOMMON: + case FFEINFO_whereDUMMY: + case FFEINFO_whereRESULT: + case FFEINFO_whereFLEETING: + case FFEINFO_whereFLEETING_CADDR: + case FFEINFO_whereFLEETING_IADDR: + case FFEINFO_whereIMMEDIATE: + case FFEINFO_whereINTRINSIC: + case FFEINFO_whereCONSTANT: + case FFEINFO_whereCONSTANT_SUBOBJECT: default: ! assert ("BLOCKDATA where unheard of" == NULL); /* Fall through. */ case FFEINFO_whereANY: + t = error_mark_node; break; } break; ! case FFEINFO_kindCOMMON: switch (ffeinfo_where (ffesymbol_info (s))) { ! case FFEINFO_whereLOCAL: assert (!ffecom_transform_only_dummies_); ! ffecom_transform_common_ (s); ! break; ! ! case FFEINFO_whereNONE: ! case FFEINFO_whereCOMMON: ! case FFEINFO_whereDUMMY: ! case FFEINFO_whereGLOBAL: ! case FFEINFO_whereRESULT: ! case FFEINFO_whereFLEETING: ! case FFEINFO_whereFLEETING_CADDR: ! case FFEINFO_whereFLEETING_IADDR: ! case FFEINFO_whereIMMEDIATE: ! case FFEINFO_whereINTRINSIC: ! case FFEINFO_whereCONSTANT: ! case FFEINFO_whereCONSTANT_SUBOBJECT: ! default: ! assert ("COMMON where unheard of" == NULL); ! /* Fall through. */ ! case FFEINFO_whereANY: ! t = error_mark_node; break; + } + break; + case FFEINFO_kindCONSTRUCT: + switch (ffeinfo_where (ffesymbol_info (s))) + { case FFEINFO_whereLOCAL: assert (!ffecom_transform_only_dummies_); + break; ! case FFEINFO_whereNONE: ! case FFEINFO_whereCOMMON: ! case FFEINFO_whereDUMMY: ! case FFEINFO_whereGLOBAL: ! case FFEINFO_whereRESULT: ! case FFEINFO_whereFLEETING: ! case FFEINFO_whereFLEETING_CADDR: ! case FFEINFO_whereFLEETING_IADDR: ! case FFEINFO_whereIMMEDIATE: ! case FFEINFO_whereINTRINSIC: ! case FFEINFO_whereCONSTANT: ! case FFEINFO_whereCONSTANT_SUBOBJECT: ! default: ! assert ("CONSTRUCT where unheard of" == NULL); ! /* Fall through. */ ! case FFEINFO_whereANY: ! t = error_mark_node; ! break; ! } ! break; ! case FFEINFO_kindNAMELIST: ! switch (ffeinfo_where (ffesymbol_info (s))) ! { ! case FFEINFO_whereLOCAL: ! assert (!ffecom_transform_only_dummies_); ! t = ffecom_transform_namelist_ (s); ! break; ! case FFEINFO_whereNONE: ! case FFEINFO_whereCOMMON: ! case FFEINFO_whereDUMMY: ! case FFEINFO_whereGLOBAL: ! case FFEINFO_whereRESULT: ! case FFEINFO_whereFLEETING: ! case FFEINFO_whereFLEETING_CADDR: ! case FFEINFO_whereFLEETING_IADDR: ! case FFEINFO_whereIMMEDIATE: ! case FFEINFO_whereINTRINSIC: ! case FFEINFO_whereCONSTANT: ! case FFEINFO_whereCONSTANT_SUBOBJECT: ! default: ! assert ("NAMELIST where unheard of" == NULL); ! /* Fall through. */ ! case FFEINFO_whereANY: ! t = error_mark_node; ! break; ! } ! break; ! default: ! assert ("kind unheard of" == NULL); ! /* Fall through. */ ! case FFEINFO_kindANY: ! t = error_mark_node; ! break; ! } ! ffesymbol_hook (s).decl_tree = t; ! ffesymbol_hook (s).length_tree = tlen; ! ffesymbol_hook (s).addr = addr; ! lineno = old_lineno; ! input_filename = old_input_filename; ! return s; ! } ! #endif ! /* Transform into ASSIGNable symbol. ! Symbol has already been transformed, but for whatever reason, the ! resulting decl_tree has been deemed not usable for an ASSIGN target. ! (E.g. it isn't wide enough to hold a pointer.) So, here we invent ! another local symbol of type void * and stuff that in the assign_tree ! argument. The F77/F90 standards allow this implementation. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static ffesymbol ! ffecom_sym_transform_assign_ (ffesymbol s) ! { ! tree t; /* Transformed thingy. */ ! int yes; ! int old_lineno = lineno; ! char *old_input_filename = input_filename; ! if (ffesymbol_sfdummyparent (s) == NULL) ! { ! input_filename = ffesymbol_where_filename (s); ! lineno = ffesymbol_where_filelinenum (s); ! } ! else ! { ! ffesymbol sf = ffesymbol_sfdummyparent (s); ! input_filename = ffesymbol_where_filename (sf); ! lineno = ffesymbol_where_filelinenum (sf); ! } ! assert (!ffecom_transform_only_dummies_); ! yes = suspend_momentary (); ! t = build_decl (VAR_DECL, ! ffecom_get_invented_identifier ("__g77_ASSIGN_%s", ! ffesymbol_text (s), ! -1), ! TREE_TYPE (null_pointer_node)); ! switch (ffesymbol_where (s)) ! { ! case FFEINFO_whereLOCAL: ! /* Unlike for regular vars, SAVE status is easy to determine for ! ASSIGNed vars, since there's no initialization, there's no ! effective storage association (so "SAVE J" does not apply to ! K even given "EQUIVALENCE (J,K)"), there's no size issue ! to worry about, etc. */ ! if ((ffesymbol_is_save (s) || ffe_is_saveall ()) ! && (ffecom_primary_entry_kind_ != FFEINFO_kindPROGRAM) ! && (ffecom_primary_entry_kind_ != FFEINFO_kindBLOCKDATA)) ! TREE_STATIC (t) = 1; /* SAVEd in proc, make static. */ ! else ! TREE_STATIC (t) = 0; /* No need to make static. */ ! break; ! case FFEINFO_whereCOMMON: ! TREE_STATIC (t) = 1; /* Assume COMMONs always SAVEd. */ ! break; ! case FFEINFO_whereDUMMY: ! /* Note that twinning a DUMMY means the caller won't see ! the ASSIGNed value. But both F77 and F90 allow implementations ! to do this, i.e. disallow Fortran code that would try and ! take advantage of actually putting a label into a variable ! via a dummy argument (or any other storage association, for ! that matter). */ ! TREE_STATIC (t) = 0; ! break; ! default: ! TREE_STATIC (t) = 0; ! break; ! } ! t = start_decl (t, FALSE); ! finish_decl (t, NULL_TREE, FALSE); ! resume_momentary (yes); ! ffesymbol_hook (s).assign_tree = t; ! lineno = old_lineno; ! input_filename = old_input_filename; ! return s; ! } ! #endif ! /* Implement COMMON area in back end. ! Because COMMON-based variables can be referenced in the dimension ! expressions of dummy (adjustable) arrays, and because dummies ! (in the gcc back end) need to be put in the outer binding level ! of a function (which has two binding levels, the outer holding ! the dummies and the inner holding the other vars), special care ! must be taken to handle COMMON areas. ! The current strategy is basically to always tell the back end about ! the COMMON area as a top-level external reference to just a block ! of storage of the master type of that area (e.g. integer, real, ! character, whatever -- not a structure). As a distinct action, ! if initial values are provided, tell the back end about the area ! as a top-level non-external (initialized) area and remember not to ! allow further initialization or expansion of the area. Meanwhile, ! if no initialization happens at all, tell the back end about ! the largest size we've seen declared so the space does get reserved. ! (This function doesn't handle all that stuff, but it does some ! of the important things.) ! Meanwhile, for COMMON variables themselves, just keep creating ! references like *((float *) (&common_area + offset)) each time ! we reference the variable. In other words, don't make a VAR_DECL ! or any kind of component reference (like we used to do before 0.4), ! though we might do that as well just for debugging purposes (and ! stuff the rtl with the appropriate offset expression). */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void ! ffecom_transform_common_ (ffesymbol s) ! { ! ffestorag st = ffesymbol_storage (s); ! ffeglobal g = ffesymbol_global (s); ! tree cbt; ! tree cbtype; ! tree init; ! tree high; ! bool is_init = ffestorag_is_init (st); ! assert (st != NULL); ! if ((g == NULL) ! || (ffeglobal_type (g) != FFEGLOBAL_typeCOMMON)) ! return; ! /* First update the size of the area in global terms. */ ! ffeglobal_size_common (s, ffestorag_size (st)); ! if (!ffeglobal_common_init (g)) ! is_init = FALSE; /* No explicit init, don't let erroneous joins init. */ ! cbt = ffeglobal_hook (g); ! /* If we already have declared this common block for a previous program ! unit, and either we already initialized it or we don't have new ! initialization for it, just return what we have without changing it. */ ! if ((cbt != NULL_TREE) ! && (!is_init ! || !DECL_EXTERNAL (cbt))) ! return; ! /* Process inits. */ ! if (is_init) ! { ! if (ffestorag_init (st) != NULL) ! { ! ffebld sexp; ! /* Set the padding for the expression, so ffecom_expr ! knows to insert that many zeros. */ ! switch (ffebld_op (sexp = ffestorag_init (st))) ! { ! case FFEBLD_opCONTER: ! ffebld_conter_set_pad (sexp, ffestorag_modulo (st)); ! break; ! case FFEBLD_opARRTER: ! ffebld_arrter_set_pad (sexp, ffestorag_modulo (st)); ! break; ! case FFEBLD_opACCTER: ! ffebld_accter_set_pad (sexp, ffestorag_modulo (st)); ! break; ! default: ! assert ("bad op for cmn init (pad)" == NULL); ! break; ! } ! init = ffecom_expr (sexp); ! if (init == error_mark_node) ! { /* Hopefully the back end complained! */ ! init = NULL_TREE; ! if (cbt != NULL_TREE) ! return; ! } ! } ! else ! init = error_mark_node; ! } ! else ! init = NULL_TREE; ! push_obstacks_nochange (); ! end_temporary_allocation (); ! /* cbtype must be permanently allocated! */ ! /* Allocate the MAX of the areas so far, seen filewide. */ ! high = build_int_2 ((ffeglobal_common_size (g) ! + ffeglobal_common_pad (g)) - 1, 0); ! TREE_TYPE (high) = ffecom_integer_type_node; ! if (init) ! cbtype = build_array_type (char_type_node, ! build_range_type (integer_type_node, ! integer_zero_node, ! high)); ! else ! cbtype = build_array_type (char_type_node, NULL_TREE); ! if (cbt == NULL_TREE) ! { ! cbt ! = build_decl (VAR_DECL, ! ffecom_get_external_identifier_ (s), ! cbtype); ! TREE_STATIC (cbt) = 1; ! TREE_PUBLIC (cbt) = 1; ! } ! else ! { ! assert (is_init); ! TREE_TYPE (cbt) = cbtype; ! } ! DECL_EXTERNAL (cbt) = init ? 0 : 1; ! DECL_INITIAL (cbt) = init ? error_mark_node : NULL_TREE; ! cbt = start_decl (cbt, TRUE); ! if (ffeglobal_hook (g) != NULL) ! assert (cbt == ffeglobal_hook (g)); ! assert (!init || !DECL_EXTERNAL (cbt)); ! /* Make sure that any type can live in COMMON and be referenced ! without getting a bus error. We could pick the most restrictive ! alignment of all entities actually placed in the COMMON, but ! this seems easy enough. */ ! DECL_ALIGN (cbt) = BIGGEST_ALIGNMENT; ! if (is_init && (ffestorag_init (st) == NULL)) ! init = ffecom_init_zero_ (cbt); ! finish_decl (cbt, init, TRUE); ! if (is_init) ! ffestorag_set_init (st, ffebld_new_any ()); ! if (init) ! { ! tree size_tree; ! assert (DECL_SIZE (cbt) != NULL_TREE); ! assert (TREE_CODE (DECL_SIZE (cbt)) == INTEGER_CST); ! size_tree = size_binop (CEIL_DIV_EXPR, ! DECL_SIZE (cbt), ! size_int (BITS_PER_UNIT)); ! assert (TREE_INT_CST_HIGH (size_tree) == 0); ! assert (TREE_INT_CST_LOW (size_tree) ! == ffeglobal_common_size (g) + ffeglobal_common_pad (g)); ! } ! ffeglobal_set_hook (g, cbt); ! ffestorag_set_hook (st, cbt); ! ! resume_temporary_allocation (); ! pop_obstacks (); ! } ! #endif ! /* Make master area for local EQUIVALENCE. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void ! ffecom_transform_equiv_ (ffestorag eqst) ! { ! tree eqt; ! tree eqtype; ! tree init; ! tree high; ! bool is_init = ffestorag_is_init (eqst); ! int yes; ! assert (eqst != NULL); ! eqt = ffestorag_hook (eqst); ! if (eqt != NULL_TREE) ! return; ! /* Process inits. */ ! if (is_init) ! { ! if (ffestorag_init (eqst) != NULL) ! { ! ffebld sexp; ! /* Set the padding for the expression, so ffecom_expr ! knows to insert that many zeros. */ ! switch (ffebld_op (sexp = ffestorag_init (eqst))) ! { ! case FFEBLD_opCONTER: ! ffebld_conter_set_pad (sexp, ffestorag_modulo (eqst)); ! break; ! case FFEBLD_opARRTER: ! ffebld_arrter_set_pad (sexp, ffestorag_modulo (eqst)); ! break; ! case FFEBLD_opACCTER: ! ffebld_accter_set_pad (sexp, ffestorag_modulo (eqst)); ! break; ! default: ! assert ("bad op for eqv init (pad)" == NULL); ! break; ! } ! init = ffecom_expr (sexp); ! if (init == error_mark_node) ! init = NULL_TREE; /* Hopefully the back end complained! */ ! } ! else ! init = error_mark_node; ! } ! else if (ffe_is_init_local_zero ()) ! init = error_mark_node; ! else ! init = NULL_TREE; ! ffecom_member_namelisted_ = FALSE; ! ffestorag_drive (ffestorag_list_equivs (eqst), ! &ffecom_member_phase1_, ! eqst); ! yes = suspend_momentary (); ! high = build_int_2 ((ffestorag_size (eqst) ! + ffestorag_modulo (eqst)) - 1, 0); ! TREE_TYPE (high) = ffecom_integer_type_node; ! eqtype = build_array_type (char_type_node, ! build_range_type (ffecom_integer_type_node, ! ffecom_integer_zero_node, ! high)); ! eqt = build_decl (VAR_DECL, ! ffecom_get_invented_identifier ("__g77_equiv_%s", ! ffesymbol_text ! (ffestorag_symbol ! (eqst)), ! -1), ! eqtype); ! DECL_EXTERNAL (eqt) = 0; ! if (is_init ! || ffecom_member_namelisted_ ! #ifdef FFECOM_sizeMAXSTACKITEM ! || (ffestorag_size (eqst) > FFECOM_sizeMAXSTACKITEM) ! #endif ! || ((ffecom_primary_entry_kind_ != FFEINFO_kindPROGRAM) ! && (ffecom_primary_entry_kind_ != FFEINFO_kindBLOCKDATA) ! && (ffestorag_is_save (eqst) || ffe_is_saveall ()))) ! TREE_STATIC (eqt) = 1; ! else ! TREE_STATIC (eqt) = 0; ! TREE_PUBLIC (eqt) = 0; ! DECL_CONTEXT (eqt) = current_function_decl; ! if (init) ! DECL_INITIAL (eqt) = error_mark_node; ! else ! DECL_INITIAL (eqt) = NULL_TREE; ! eqt = start_decl (eqt, FALSE); ! /* Make sure that any type can live in EQUIVALENCE and be referenced ! without getting a bus error. We could pick the most restrictive ! alignment of all entities actually placed in the EQUIVALENCE, but ! this seems easy enough. */ ! DECL_ALIGN (eqt) = BIGGEST_ALIGNMENT; ! if ((!is_init && ffe_is_init_local_zero ()) ! || (is_init && (ffestorag_init (eqst) == NULL))) ! init = ffecom_init_zero_ (eqt); ! finish_decl (eqt, init, FALSE); ! if (is_init) ! ffestorag_set_init (eqst, ffebld_new_any ()); ! { ! tree size_tree; ! size_tree = size_binop (CEIL_DIV_EXPR, ! DECL_SIZE (eqt), ! size_int (BITS_PER_UNIT)); ! assert (TREE_INT_CST_HIGH (size_tree) == 0); ! assert (TREE_INT_CST_LOW (size_tree) ! == ffestorag_size (eqst) + ffestorag_modulo (eqst)); ! } ! ffestorag_set_hook (eqst, eqt); ! #ifdef SOMEONE_GETS_DEBUG_SUPPORT_WORKING ! ffestorag_drive (ffestorag_list_equivs (eqst), ! &ffecom_member_phase2_, ! eqst); ! #endif ! resume_momentary (yes); ! } ! #endif ! /* Implement NAMELIST in back end. See f2c/format.c for more info. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_transform_namelist_ (ffesymbol s) ! { ! tree nmlt; ! tree nmltype = ffecom_type_namelist_ (); ! tree nmlinits; ! tree nameinit; ! tree varsinit; ! tree nvarsinit; ! tree field; ! tree high; ! int yes; ! int i; ! static int mynumber = 0; ! yes = suspend_momentary (); ! nmlt = build_decl (VAR_DECL, ! ffecom_get_invented_identifier ("__g77_namelist_%d", ! NULL, mynumber++), ! nmltype); ! TREE_STATIC (nmlt) = 1; ! DECL_INITIAL (nmlt) = error_mark_node; ! nmlt = start_decl (nmlt, FALSE); ! /* Process inits. */ ! i = strlen (ffesymbol_text (s)); ! high = build_int_2 (i, 0); ! TREE_TYPE (high) = ffecom_f2c_ftnlen_type_node; ! nameinit = ffecom_build_f2c_string_ (i + 1, ! ffesymbol_text (s)); ! TREE_TYPE (nameinit) ! = build_type_variant ! (build_array_type ! (char_type_node, ! build_range_type (ffecom_f2c_ftnlen_type_node, ! ffecom_f2c_ftnlen_one_node, ! high)), ! 1, 0); ! TREE_CONSTANT (nameinit) = 1; ! TREE_STATIC (nameinit) = 1; ! nameinit = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (nameinit)), ! nameinit); ! varsinit = ffecom_vardesc_array_ (s); ! varsinit = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (varsinit)), ! varsinit); ! TREE_CONSTANT (varsinit) = 1; ! TREE_STATIC (varsinit) = 1; ! { ! ffebld b; ! for (i = 0, b = ffesymbol_namelist (s); b != NULL; b = ffebld_trail (b)) ! ++i; ! } ! nvarsinit = build_int_2 (i, 0); ! TREE_TYPE (nvarsinit) = integer_type_node; ! TREE_CONSTANT (nvarsinit) = 1; ! TREE_STATIC (nvarsinit) = 1; ! nmlinits = build_tree_list ((field = TYPE_FIELDS (nmltype)), nameinit); ! TREE_CHAIN (nmlinits) = build_tree_list ((field = TREE_CHAIN (field)), ! varsinit); ! TREE_CHAIN (TREE_CHAIN (nmlinits)) ! = build_tree_list ((field = TREE_CHAIN (field)), nvarsinit); ! nmlinits = build (CONSTRUCTOR, nmltype, NULL_TREE, nmlinits); ! TREE_CONSTANT (nmlinits) = 1; ! TREE_STATIC (nmlinits) = 1; ! finish_decl (nmlt, nmlinits, FALSE); ! nmlt = ffecom_1 (ADDR_EXPR, build_pointer_type (nmltype), nmlt); ! resume_momentary (yes); ! return nmlt; ! } ! #endif ! /* A subroutine of ffecom_tree_canonize_ref_. The incoming tree is ! analyzed on the assumption it is calculating a pointer to be ! indirected through. It must return the proper decl and offset, ! taking into account different units of measurements for offsets. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void ! ffecom_tree_canonize_ptr_ (tree *decl, tree *offset, ! tree t) ! { ! switch (TREE_CODE (t)) ! { ! case NOP_EXPR: ! case CONVERT_EXPR: ! case NON_LVALUE_EXPR: ! ffecom_tree_canonize_ptr_ (decl, offset, TREE_OPERAND (t, 0)); ! break; ! case PLUS_EXPR: ! ffecom_tree_canonize_ptr_ (decl, offset, TREE_OPERAND (t, 0)); ! if ((*decl == NULL_TREE) ! || (*decl == error_mark_node)) ! break; ! if (TREE_CODE (TREE_OPERAND (t, 1)) == INTEGER_CST) ! { ! /* An offset into COMMON. */ ! *offset = size_binop (PLUS_EXPR, ! *offset, ! TREE_OPERAND (t, 1)); ! /* Convert offset (presumably in bytes) into canonical units ! (presumably bits). */ ! *offset = size_binop (MULT_EXPR, ! TYPE_SIZE (TREE_TYPE (TREE_TYPE (t))), ! *offset); break; } + /* Not a COMMON reference, so an unrecognized pattern. */ + *decl = error_mark_node; break; ! case PARM_DECL: ! *decl = t; ! *offset = bitsize_int (0L, 0L); ! break; ! case ADDR_EXPR: ! if (TREE_CODE (TREE_OPERAND (t, 0)) == VAR_DECL) ! { ! /* A reference to COMMON. */ ! *decl = TREE_OPERAND (t, 0); ! *offset = bitsize_int (0L, 0L); break; } + /* Fall through. */ + default: + /* Not a COMMON reference, so an unrecognized pattern. */ + *decl = error_mark_node; break; + } + } + #endif ! /* Given a tree that is possibly intended for use as an lvalue, return ! information representing a canonical view of that tree as a decl, an ! offset into that decl, and a size for the lvalue. ! If there's no applicable decl, NULL_TREE is returned for the decl, ! and the other fields are left undefined. ! If the tree doesn't fit the recognizable forms, an ERROR_MARK node ! is returned for the decl, and the other fields are left undefined. ! Otherwise, the decl returned currently is either a VAR_DECL or a ! PARM_DECL. ! The offset returned is always valid, but of course not necessarily ! a constant, and not necessarily converted into the appropriate ! type, leaving that up to the caller (so as to avoid that overhead ! if the decls being looked at are different anyway). ! If the size cannot be determined (e.g. an adjustable array), ! an ERROR_MARK node is returned for the size. Otherwise, the ! size returned is valid, not necessarily a constant, and not ! necessarily converted into the appropriate type as with the ! offset. ! Note that the offset and size expressions are expressed in the ! base storage units (usually bits) rather than in the units of ! the type of the decl, because two decls with different types ! might overlap but with apparently non-overlapping array offsets, ! whereas converting the array offsets to consistant offsets will ! reveal the overlap. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void ! ffecom_tree_canonize_ref_ (tree *decl, tree *offset, ! tree *size, tree t) ! { ! /* The default path is to report a nonexistant decl. */ ! *decl = NULL_TREE; ! if (t == NULL_TREE) ! return; ! switch (TREE_CODE (t)) ! { ! case ERROR_MARK: ! case IDENTIFIER_NODE: ! case INTEGER_CST: ! case REAL_CST: ! case COMPLEX_CST: ! case STRING_CST: ! case CONST_DECL: ! case PLUS_EXPR: ! case MINUS_EXPR: ! case MULT_EXPR: ! case TRUNC_DIV_EXPR: ! case CEIL_DIV_EXPR: ! case FLOOR_DIV_EXPR: ! case ROUND_DIV_EXPR: ! case TRUNC_MOD_EXPR: ! case CEIL_MOD_EXPR: ! case FLOOR_MOD_EXPR: ! case ROUND_MOD_EXPR: ! case RDIV_EXPR: ! case EXACT_DIV_EXPR: ! case FIX_TRUNC_EXPR: ! case FIX_CEIL_EXPR: ! case FIX_FLOOR_EXPR: ! case FIX_ROUND_EXPR: ! case FLOAT_EXPR: ! case EXPON_EXPR: ! case NEGATE_EXPR: ! case MIN_EXPR: ! case MAX_EXPR: ! case ABS_EXPR: ! case FFS_EXPR: ! case LSHIFT_EXPR: ! case RSHIFT_EXPR: ! case LROTATE_EXPR: ! case RROTATE_EXPR: ! case BIT_IOR_EXPR: ! case BIT_XOR_EXPR: ! case BIT_AND_EXPR: ! case BIT_ANDTC_EXPR: ! case BIT_NOT_EXPR: ! case TRUTH_ANDIF_EXPR: ! case TRUTH_ORIF_EXPR: ! case TRUTH_AND_EXPR: ! case TRUTH_OR_EXPR: ! case TRUTH_XOR_EXPR: ! case TRUTH_NOT_EXPR: ! case LT_EXPR: ! case LE_EXPR: ! case GT_EXPR: ! case GE_EXPR: ! case EQ_EXPR: ! case NE_EXPR: ! case COMPLEX_EXPR: ! case CONJ_EXPR: ! case REALPART_EXPR: ! case IMAGPART_EXPR: ! case LABEL_EXPR: ! case COMPONENT_REF: ! case COMPOUND_EXPR: ! case ADDR_EXPR: ! return; ! case VAR_DECL: ! case PARM_DECL: ! *decl = t; ! *offset = bitsize_int (0L, 0L); ! *size = TYPE_SIZE (TREE_TYPE (t)); ! return; ! case ARRAY_REF: ! { ! tree array = TREE_OPERAND (t, 0); ! tree element = TREE_OPERAND (t, 1); ! tree init_offset; ! if ((array == NULL_TREE) ! || (element == NULL_TREE)) ! { ! *decl = error_mark_node; ! return; ! } ! ffecom_tree_canonize_ref_ (decl, &init_offset, size, ! array); ! if ((*decl == NULL_TREE) ! || (*decl == error_mark_node)) ! return; ! ! *offset = size_binop (MULT_EXPR, ! TYPE_SIZE (TREE_TYPE (TREE_TYPE (array))), ! size_binop (MINUS_EXPR, ! element, ! TYPE_MIN_VALUE ! (TYPE_DOMAIN ! (TREE_TYPE (array))))); ! ! *offset = size_binop (PLUS_EXPR, ! init_offset, ! *offset); ! *size = TYPE_SIZE (TREE_TYPE (t)); ! return; ! } ! case INDIRECT_REF: ! /* Most of this code is to handle references to COMMON. And so ! far that is useful only for calling library functions, since ! external (user) functions might reference common areas. But ! even calling an external function, it's worthwhile to decode ! COMMON references because if not storing into COMMON, we don't ! want COMMON-based arguments to gratuitously force use of a ! temporary. */ ! *size = TYPE_SIZE (TREE_TYPE (t)); ! ! ffecom_tree_canonize_ptr_ (decl, offset, ! TREE_OPERAND (t, 0)); ! ! return; + case CONVERT_EXPR: + case NOP_EXPR: + case MODIFY_EXPR: + case NON_LVALUE_EXPR: + case RESULT_DECL: + case FIELD_DECL: + case COND_EXPR: /* More cases than we can handle. */ + case SAVE_EXPR: + case REFERENCE_EXPR: + case PREDECREMENT_EXPR: + case PREINCREMENT_EXPR: + case POSTDECREMENT_EXPR: + case POSTINCREMENT_EXPR: + case CALL_EXPR: + default: + *decl = error_mark_node; + return; + } + } #endif ! /* Do divide operation appropriate to type of operands. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_tree_divide_ (tree tree_type, tree left, tree right, ! tree dest_tree, ffebld dest, bool *dest_used, ! tree hook) { ! if ((left == error_mark_node) ! || (right == error_mark_node)) ! return error_mark_node; ! switch (TREE_CODE (tree_type)) { ! case INTEGER_TYPE: ! return ffecom_2 (TRUNC_DIV_EXPR, tree_type, ! left, ! right); ! case COMPLEX_TYPE: ! if (! optimize_size) ! return ffecom_2 (RDIV_EXPR, tree_type, ! left, ! right); ! { ! ffecomGfrt ix; ! if (TREE_TYPE (tree_type) ! == ffecom_tree_type [FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1]) ! ix = FFECOM_gfrtDIV_CC; /* Overlapping result okay. */ ! else ! ix = FFECOM_gfrtDIV_ZZ; /* Overlapping result okay. */ ! left = ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (left)), ! left); ! left = build_tree_list (NULL_TREE, left); ! right = ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (right)), ! right); ! right = build_tree_list (NULL_TREE, right); ! TREE_CHAIN (left) = right; ! return ffecom_call_ (ffecom_gfrt_tree_ (ix), ! ffecom_gfrt_kindtype (ix), ! ffe_is_f2c_library (), ! tree_type, ! left, ! dest_tree, dest, dest_used, ! NULL_TREE, TRUE, hook); ! } break; ! case RECORD_TYPE: ! { ! ffecomGfrt ix; ! if (TREE_TYPE (TYPE_FIELDS (tree_type)) ! == ffecom_tree_type [FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1]) ! ix = FFECOM_gfrtDIV_CC; /* Overlapping result okay. */ ! else ! ix = FFECOM_gfrtDIV_ZZ; /* Overlapping result okay. */ ! ! left = ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (left)), ! left); ! left = build_tree_list (NULL_TREE, left); ! right = ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (right)), ! right); ! right = build_tree_list (NULL_TREE, right); ! TREE_CHAIN (left) = right; ! ! return ffecom_call_ (ffecom_gfrt_tree_ (ix), ! ffecom_gfrt_kindtype (ix), ! ffe_is_f2c_library (), ! tree_type, ! left, ! dest_tree, dest, dest_used, ! NULL_TREE, TRUE, hook); ! } break; default: ! return ffecom_2 (RDIV_EXPR, tree_type, ! left, ! right); } } #endif ! /* Build type info for non-dummy variable. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_type_localvar_ (ffesymbol s, ffeinfoBasictype bt, ! ffeinfoKindtype kt) ! { ! tree type; ! ffebld dl; ! ffebld dim; ! tree lowt; ! tree hight; ! type = ffecom_tree_type[bt][kt]; ! if (bt == FFEINFO_basictypeCHARACTER) ! { ! hight = build_int_2 (ffesymbol_size (s), 0); ! TREE_TYPE (hight) = ffecom_f2c_ftnlen_type_node; ! type ! = build_array_type ! (type, ! build_range_type (ffecom_f2c_ftnlen_type_node, ! ffecom_f2c_ftnlen_one_node, ! hight)); ! type = ffecom_check_size_overflow_ (s, type, FALSE); ! } ! for (dl = ffesymbol_dims (s); dl != NULL; dl = ffebld_trail (dl)) ! { ! if (type == error_mark_node) ! break; ! dim = ffebld_head (dl); ! assert (ffebld_op (dim) == FFEBLD_opBOUNDS); ! if (ffebld_left (dim) == NULL) ! lowt = integer_one_node; ! else ! lowt = ffecom_expr (ffebld_left (dim)); ! if (TREE_CODE (lowt) != INTEGER_CST) ! lowt = variable_size (lowt); ! assert (ffebld_right (dim) != NULL); ! hight = ffecom_expr (ffebld_right (dim)); ! if (TREE_CODE (hight) != INTEGER_CST) ! hight = variable_size (hight); ! type = build_array_type (type, ! build_range_type (ffecom_integer_type_node, ! lowt, hight)); ! type = ffecom_check_size_overflow_ (s, type, FALSE); ! } ! return type; ! } ! #endif ! /* Build Namelist type. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_type_namelist_ () ! { ! static tree type = NULL_TREE; ! if (type == NULL_TREE) { ! static tree namefield, varsfield, nvarsfield; ! tree vardesctype; ! vardesctype = ffecom_type_vardesc_ (); ! push_obstacks_nochange (); ! end_temporary_allocation (); ! type = make_node (RECORD_TYPE); ! vardesctype = build_pointer_type (build_pointer_type (vardesctype)); ! namefield = ffecom_decl_field (type, NULL_TREE, "name", ! string_type_node); ! varsfield = ffecom_decl_field (type, namefield, "vars", vardesctype); ! nvarsfield = ffecom_decl_field (type, varsfield, "nvars", ! integer_type_node); ! ! TYPE_FIELDS (type) = namefield; ! layout_type (type); ! ! resume_temporary_allocation (); ! pop_obstacks (); } ! return type; ! } ! #endif ! /* Make a copy of a type, assuming caller has switched to the permanent ! obstacks and that the type is for an aggregate (array) initializer. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC && 0 /* Not used now. */ ! static tree ! ffecom_type_permanent_copy_ (tree t) ! { ! tree domain; ! tree max; ! assert (TREE_TYPE (t) != NULL_TREE); ! domain = TYPE_DOMAIN (t); ! assert (TREE_CODE (t) == ARRAY_TYPE); ! assert (TREE_PERMANENT (TREE_TYPE (t))); ! assert (TREE_PERMANENT (TREE_TYPE (domain))); ! assert (TREE_PERMANENT (TYPE_MIN_VALUE (domain))); ! max = TYPE_MAX_VALUE (domain); ! if (!TREE_PERMANENT (max)) ! { ! assert (TREE_CODE (max) == INTEGER_CST); ! max = build_int_2 (TREE_INT_CST_LOW (max), TREE_INT_CST_HIGH (max)); ! TREE_TYPE (max) = TREE_TYPE (TYPE_MIN_VALUE (domain)); ! } ! return build_array_type (TREE_TYPE (t), ! build_range_type (TREE_TYPE (domain), ! TYPE_MIN_VALUE (domain), ! max)); ! } ! #endif ! /* Build Vardesc type. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_type_vardesc_ () ! { ! static tree type = NULL_TREE; ! static tree namefield, addrfield, dimsfield, typefield; ! if (type == NULL_TREE) { ! push_obstacks_nochange (); ! end_temporary_allocation (); ! type = make_node (RECORD_TYPE); ! namefield = ffecom_decl_field (type, NULL_TREE, "name", ! string_type_node); ! addrfield = ffecom_decl_field (type, namefield, "addr", ! string_type_node); ! dimsfield = ffecom_decl_field (type, addrfield, "dims", ! ffecom_f2c_ptr_to_ftnlen_type_node); ! typefield = ffecom_decl_field (type, dimsfield, "type", ! integer_type_node); ! TYPE_FIELDS (type) = namefield; ! layout_type (type); ! resume_temporary_allocation (); ! pop_obstacks (); ! } ! ! return type; } #endif #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_vardesc_ (ffebld expr) { ! ffesymbol s; ! assert (ffebld_op (expr) == FFEBLD_opSYMTER); ! s = ffebld_symter (expr); ! if (ffesymbol_hook (s).vardesc_tree == NULL_TREE) ! { ! int i; ! tree vardesctype = ffecom_type_vardesc_ (); ! tree var; ! tree nameinit; ! tree dimsinit; ! tree addrinit; ! tree typeinit; ! tree field; ! tree varinits; ! int yes; ! static int mynumber = 0; ! yes = suspend_momentary (); ! var = build_decl (VAR_DECL, ! ffecom_get_invented_identifier ("__g77_vardesc_%d", ! NULL, mynumber++), ! vardesctype); ! TREE_STATIC (var) = 1; ! DECL_INITIAL (var) = error_mark_node; ! var = start_decl (var, FALSE); ! /* Process inits. */ ! ! nameinit = ffecom_build_f2c_string_ ((i = strlen (ffesymbol_text (s))) ! + 1, ! ffesymbol_text (s)); ! TREE_TYPE (nameinit) ! = build_type_variant ! (build_array_type ! (char_type_node, ! build_range_type (integer_type_node, ! integer_one_node, ! build_int_2 (i, 0))), ! 1, 0); ! TREE_CONSTANT (nameinit) = 1; ! TREE_STATIC (nameinit) = 1; ! nameinit = ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (nameinit)), ! nameinit); ! addrinit = ffecom_arg_ptr_to_expr (expr, &typeinit); ! dimsinit = ffecom_vardesc_dims_ (s); ! if (typeinit == NULL_TREE) ! { ! ffeinfoBasictype bt = ffesymbol_basictype (s); ! ffeinfoKindtype kt = ffesymbol_kindtype (s); ! int tc = ffecom_f2c_typecode (bt, kt); ! assert (tc != -1); ! typeinit = build_int_2 (tc, (tc < 0) ? -1 : 0); } else ! typeinit = ffecom_1 (NEGATE_EXPR, TREE_TYPE (typeinit), typeinit); ! varinits = build_tree_list ((field = TYPE_FIELDS (vardesctype)), ! nameinit); ! TREE_CHAIN (varinits) = build_tree_list ((field = TREE_CHAIN (field)), ! addrinit); ! TREE_CHAIN (TREE_CHAIN (varinits)) ! = build_tree_list ((field = TREE_CHAIN (field)), dimsinit); ! TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (varinits))) ! = build_tree_list ((field = TREE_CHAIN (field)), typeinit); ! varinits = build (CONSTRUCTOR, vardesctype, NULL_TREE, varinits); ! TREE_CONSTANT (varinits) = 1; ! TREE_STATIC (varinits) = 1; ! finish_decl (var, varinits, FALSE); ! var = ffecom_1 (ADDR_EXPR, build_pointer_type (vardesctype), var); ! resume_momentary (yes); ! ffesymbol_hook (s).vardesc_tree = var; ! } ! return ffesymbol_hook (s).vardesc_tree; ! } ! #endif ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ! ffecom_vardesc_array_ (ffesymbol s) ! { ! ffebld b; ! tree list; ! tree item = NULL_TREE; ! tree var; ! int i; ! int yes; ! static int mynumber = 0; ! for (i = 0, list = NULL_TREE, b = ffesymbol_namelist (s); ! b != NULL; ! b = ffebld_trail (b), ++i) ! { ! tree t; ! t = ffecom_vardesc_ (ffebld_head (b)); ! if (list == NULL_TREE) ! list = item = build_tree_list (NULL_TREE, t); ! else ! { ! TREE_CHAIN (item) = build_tree_list (NULL_TREE, t); ! item = TREE_CHAIN (item); ! } ! } ! yes = suspend_momentary (); ! item = build_array_type (build_pointer_type (ffecom_type_vardesc_ ()), ! build_range_type (integer_type_node, ! integer_one_node, ! build_int_2 (i, 0))); ! list = build (CONSTRUCTOR, item, NULL_TREE, list); ! TREE_CONSTANT (list) = 1; ! TREE_STATIC (list) = 1; ! var = ffecom_get_invented_identifier ("__g77_vardesc_array_%d", NULL, ! mynumber++); ! var = build_decl (VAR_DECL, var, item); ! TREE_STATIC (var) = 1; ! DECL_INITIAL (var) = error_mark_node; ! var = start_decl (var, FALSE); ! finish_decl (var, list, FALSE); resume_momentary (yes); + + return var; } #endif #if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ! ffecom_vardesc_dims_ (ffesymbol s) { ! if (ffesymbol_dims (s) == NULL) ! return convert (ffecom_f2c_ptr_to_ftnlen_type_node, ! integer_zero_node); ! { ! ffebld b; ! ffebld e; ! tree list; ! tree backlist; ! tree item = NULL_TREE; ! tree var; ! int yes; ! tree numdim; ! tree numelem; ! tree baseoff = NULL_TREE; ! static int mynumber = 0; ! numdim = build_int_2 ((int) ffesymbol_rank (s), 0); ! TREE_TYPE (numdim) = ffecom_f2c_ftnlen_type_node; ! numelem = ffecom_expr (ffesymbol_arraysize (s)); ! TREE_TYPE (numelem) = ffecom_f2c_ftnlen_type_node; ! list = NULL_TREE; ! backlist = NULL_TREE; ! for (b = ffesymbol_dims (s), e = ffesymbol_extents (s); ! b != NULL; ! b = ffebld_trail (b), e = ffebld_trail (e)) ! { ! tree t; ! tree low; ! tree back; ! if (ffebld_trail (b) == NULL) ! t = NULL_TREE; ! else ! { ! t = convert (ffecom_f2c_ftnlen_type_node, ! ffecom_expr (ffebld_head (e))); ! if (list == NULL_TREE) ! list = item = build_tree_list (NULL_TREE, t); ! else ! { ! TREE_CHAIN (item) = build_tree_list (NULL_TREE, t); ! item = TREE_CHAIN (item); ! } ! } ! ! if (ffebld_left (ffebld_head (b)) == NULL) ! low = ffecom_integer_one_node; ! else ! low = ffecom_expr (ffebld_left (ffebld_head (b))); ! low = convert (ffecom_f2c_ftnlen_type_node, low); ! ! back = build_tree_list (low, t); ! TREE_CHAIN (back) = backlist; ! backlist = back; ! } ! ! for (item = backlist; item != NULL_TREE; item = TREE_CHAIN (item)) ! { ! if (TREE_VALUE (item) == NULL_TREE) ! baseoff = TREE_PURPOSE (item); ! else ! baseoff = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node, ! TREE_PURPOSE (item), ! ffecom_2 (MULT_EXPR, ! ffecom_f2c_ftnlen_type_node, ! TREE_VALUE (item), ! baseoff)); ! } ! /* backlist now dead, along with all TREE_PURPOSEs on it. */ ! baseoff = build_tree_list (NULL_TREE, baseoff); ! TREE_CHAIN (baseoff) = list; ! numelem = build_tree_list (NULL_TREE, numelem); ! TREE_CHAIN (numelem) = baseoff; ! numdim = build_tree_list (NULL_TREE, numdim); ! TREE_CHAIN (numdim) = numelem; ! yes = suspend_momentary (); ! item = build_array_type (ffecom_f2c_ftnlen_type_node, ! build_range_type (integer_type_node, ! integer_zero_node, ! build_int_2 ! ((int) ffesymbol_rank (s) ! + 2, 0))); ! list = build (CONSTRUCTOR, item, NULL_TREE, numdim); ! TREE_CONSTANT (list) = 1; ! TREE_STATIC (list) = 1; ! var = ffecom_get_invented_identifier ("__g77_dims_%d", NULL, ! mynumber++); ! var = build_decl (VAR_DECL, var, item); ! TREE_STATIC (var) = 1; ! DECL_INITIAL (var) = error_mark_node; ! var = start_decl (var, FALSE); ! finish_decl (var, list, FALSE); ! var = ffecom_1 (ADDR_EXPR, build_pointer_type (item), var); ! resume_momentary (yes); ! return var; ! } } #endif + /* Essentially does a "fold (build1 (code, type, node))" while checking + for certain housekeeping things. ! NOTE: for building an ADDR_EXPR around a FUNCTION_DECL, use ! ffecom_1_fn instead. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_1 (enum tree_code code, tree type, tree node) { ! tree item; ! ! if ((node == error_mark_node) ! || (type == error_mark_node)) ! return error_mark_node; ! ! if (code == ADDR_EXPR) { ! if (!mark_addressable (node)) ! assert ("can't mark_addressable this node!" == NULL); ! } ! switch (ffe_is_emulate_complex () ? code : NOP_EXPR) ! { ! tree realtype; ! case REALPART_EXPR: ! item = build (COMPONENT_REF, type, node, TYPE_FIELDS (TREE_TYPE (node))); break; ! case IMAGPART_EXPR: ! item = build (COMPONENT_REF, type, node, TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (node)))); break; ! ! case NEGATE_EXPR: ! if (TREE_CODE (type) != RECORD_TYPE) { ! item = build1 (code, type, node); break; } ! node = ffecom_stabilize_aggregate_ (node); ! realtype = TREE_TYPE (TYPE_FIELDS (type)); ! item = ! ffecom_2 (COMPLEX_EXPR, type, ! ffecom_1 (NEGATE_EXPR, realtype, ! ffecom_1 (REALPART_EXPR, realtype, ! node)), ! ffecom_1 (NEGATE_EXPR, realtype, ! ffecom_1 (IMAGPART_EXPR, realtype, ! node))); ! break; ! default: ! item = build1 (code, type, node); ! break; ! } ! if (TREE_SIDE_EFFECTS (node)) ! TREE_SIDE_EFFECTS (item) = 1; ! if ((code == ADDR_EXPR) && staticp (node)) ! TREE_CONSTANT (item) = 1; ! return fold (item); ! } ! #endif ! /* Like ffecom_1 (ADDR_EXPR, TREE_TYPE (node), node), except ! handles TREE_CODE (node) == FUNCTION_DECL. In particular, ! does not set TREE_ADDRESSABLE (because calling an inline ! function does not mean the function needs to be separately ! compiled). */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_1_fn (tree node) ! { ! tree item; ! tree type; ! if (node == error_mark_node) ! return error_mark_node; ! type = build_type_variant (TREE_TYPE (node), ! TREE_READONLY (node), ! TREE_THIS_VOLATILE (node)); ! item = build1 (ADDR_EXPR, ! build_pointer_type (type), node); ! if (TREE_SIDE_EFFECTS (node)) ! TREE_SIDE_EFFECTS (item) = 1; ! if (staticp (node)) ! TREE_CONSTANT (item) = 1; ! return fold (item); ! } ! #endif ! /* Essentially does a "fold (build (code, type, node1, node2))" while ! checking for certain housekeeping things. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_2 (enum tree_code code, tree type, tree node1, ! tree node2) ! { ! tree item; ! if ((node1 == error_mark_node) ! || (node2 == error_mark_node) ! || (type == error_mark_node)) ! return error_mark_node; ! switch (ffe_is_emulate_complex () ? code : NOP_EXPR) ! { ! tree a, b, c, d, realtype; ! case CONJ_EXPR: ! assert ("no CONJ_EXPR support yet" == NULL); ! return error_mark_node; ! case COMPLEX_EXPR: ! item = build_tree_list (TYPE_FIELDS (type), node1); ! TREE_CHAIN (item) = build_tree_list (TREE_CHAIN (TYPE_FIELDS (type)), node2); ! item = build (CONSTRUCTOR, type, NULL_TREE, item); ! break; ! ! case PLUS_EXPR: ! if (TREE_CODE (type) != RECORD_TYPE) ! { ! item = build (code, type, node1, node2); ! break; ! } ! node1 = ffecom_stabilize_aggregate_ (node1); ! node2 = ffecom_stabilize_aggregate_ (node2); ! realtype = TREE_TYPE (TYPE_FIELDS (type)); ! item = ! ffecom_2 (COMPLEX_EXPR, type, ! ffecom_2 (PLUS_EXPR, realtype, ! ffecom_1 (REALPART_EXPR, realtype, ! node1), ! ffecom_1 (REALPART_EXPR, realtype, ! node2)), ! ffecom_2 (PLUS_EXPR, realtype, ! ffecom_1 (IMAGPART_EXPR, realtype, ! node1), ! ffecom_1 (IMAGPART_EXPR, realtype, ! node2))); ! break; ! ! case MINUS_EXPR: ! if (TREE_CODE (type) != RECORD_TYPE) ! { ! item = build (code, type, node1, node2); ! break; ! } ! node1 = ffecom_stabilize_aggregate_ (node1); ! node2 = ffecom_stabilize_aggregate_ (node2); ! realtype = TREE_TYPE (TYPE_FIELDS (type)); ! item = ! ffecom_2 (COMPLEX_EXPR, type, ! ffecom_2 (MINUS_EXPR, realtype, ! ffecom_1 (REALPART_EXPR, realtype, ! node1), ! ffecom_1 (REALPART_EXPR, realtype, ! node2)), ! ffecom_2 (MINUS_EXPR, realtype, ! ffecom_1 (IMAGPART_EXPR, realtype, ! node1), ! ffecom_1 (IMAGPART_EXPR, realtype, ! node2))); ! break; ! ! case MULT_EXPR: ! if (TREE_CODE (type) != RECORD_TYPE) ! { ! item = build (code, type, node1, node2); ! break; ! } ! node1 = ffecom_stabilize_aggregate_ (node1); ! node2 = ffecom_stabilize_aggregate_ (node2); ! realtype = TREE_TYPE (TYPE_FIELDS (type)); ! a = save_expr (ffecom_1 (REALPART_EXPR, realtype, ! node1)); ! b = save_expr (ffecom_1 (IMAGPART_EXPR, realtype, ! node1)); ! c = save_expr (ffecom_1 (REALPART_EXPR, realtype, ! node2)); ! d = save_expr (ffecom_1 (IMAGPART_EXPR, realtype, ! node2)); ! item = ! ffecom_2 (COMPLEX_EXPR, type, ! ffecom_2 (MINUS_EXPR, realtype, ! ffecom_2 (MULT_EXPR, realtype, ! a, ! c), ! ffecom_2 (MULT_EXPR, realtype, ! b, ! d)), ! ffecom_2 (PLUS_EXPR, realtype, ! ffecom_2 (MULT_EXPR, realtype, ! a, ! d), ! ffecom_2 (MULT_EXPR, realtype, ! c, ! b))); ! break; ! ! case EQ_EXPR: ! if ((TREE_CODE (node1) != RECORD_TYPE) ! && (TREE_CODE (node2) != RECORD_TYPE)) ! { ! item = build (code, type, node1, node2); ! break; ! } ! assert (TREE_CODE (node1) == RECORD_TYPE); ! assert (TREE_CODE (node2) == RECORD_TYPE); ! node1 = ffecom_stabilize_aggregate_ (node1); ! node2 = ffecom_stabilize_aggregate_ (node2); ! realtype = TREE_TYPE (TYPE_FIELDS (type)); ! item = ! ffecom_2 (TRUTH_ANDIF_EXPR, type, ! ffecom_2 (code, type, ! ffecom_1 (REALPART_EXPR, realtype, ! node1), ! ffecom_1 (REALPART_EXPR, realtype, ! node2)), ! ffecom_2 (code, type, ! ffecom_1 (IMAGPART_EXPR, realtype, ! node1), ! ffecom_1 (IMAGPART_EXPR, realtype, ! node2))); ! break; ! ! case NE_EXPR: ! if ((TREE_CODE (node1) != RECORD_TYPE) ! && (TREE_CODE (node2) != RECORD_TYPE)) ! { ! item = build (code, type, node1, node2); ! break; ! } ! assert (TREE_CODE (node1) == RECORD_TYPE); ! assert (TREE_CODE (node2) == RECORD_TYPE); ! node1 = ffecom_stabilize_aggregate_ (node1); ! node2 = ffecom_stabilize_aggregate_ (node2); ! realtype = TREE_TYPE (TYPE_FIELDS (type)); ! item = ! ffecom_2 (TRUTH_ORIF_EXPR, type, ! ffecom_2 (code, type, ! ffecom_1 (REALPART_EXPR, realtype, ! node1), ! ffecom_1 (REALPART_EXPR, realtype, ! node2)), ! ffecom_2 (code, type, ! ffecom_1 (IMAGPART_EXPR, realtype, ! node1), ! ffecom_1 (IMAGPART_EXPR, realtype, ! node2))); ! break; default: ! item = build (code, type, node1, node2); ! break; } ! if (TREE_SIDE_EFFECTS (node1) || TREE_SIDE_EFFECTS (node2)) ! TREE_SIDE_EFFECTS (item) = 1; ! return fold (item); ! } ! #endif ! /* ffecom_2pass_advise_entrypoint -- Advise that there's this entrypoint ! ffesymbol s; // the ENTRY point itself ! if (ffecom_2pass_advise_entrypoint(s)) ! // the ENTRY point has been accepted ! Does whatever compiler needs to do when it learns about the entrypoint, ! like determine the return type of the master function, count the ! number of entrypoints, etc. Returns FALSE if the return type is ! not compatible with the return type(s) of other entrypoint(s). ! NOTE: for every call to this fn that returns TRUE, _do_entrypoint must ! later (after _finish_progunit) be called with the same entrypoint(s) ! as passed to this fn for which TRUE was returned. ! 03-Jan-92 JCB 2.0 ! Return FALSE if the return type conflicts with previous entrypoints. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! bool ! ffecom_2pass_advise_entrypoint (ffesymbol entry) ! { ! ffebld list; /* opITEM. */ ! ffebld mlist; /* opITEM. */ ! ffebld plist; /* opITEM. */ ! ffebld arg; /* ffebld_head(opITEM). */ ! ffebld item; /* opITEM. */ ! ffesymbol s; /* ffebld_symter(arg). */ ! ffeinfoBasictype bt = ffesymbol_basictype (entry); ! ffeinfoKindtype kt = ffesymbol_kindtype (entry); ! ffetargetCharacterSize size = ffesymbol_size (entry); ! bool ok; ! if (ffecom_num_entrypoints_ == 0) ! { /* First entrypoint, make list of main ! arglist's dummies. */ ! assert (ffecom_primary_entry_ != NULL); ! ffecom_master_bt_ = ffesymbol_basictype (ffecom_primary_entry_); ! ffecom_master_kt_ = ffesymbol_kindtype (ffecom_primary_entry_); ! ffecom_master_size_ = ffesymbol_size (ffecom_primary_entry_); ! for (plist = NULL, list = ffesymbol_dummyargs (ffecom_primary_entry_); ! list != NULL; ! list = ffebld_trail (list)) ! { ! arg = ffebld_head (list); ! if (ffebld_op (arg) != FFEBLD_opSYMTER) ! continue; /* Alternate return or some such thing. */ ! item = ffebld_new_item (arg, NULL); ! if (plist == NULL) ! ffecom_master_arglist_ = item; ! else ! ffebld_set_trail (plist, item); ! plist = item; ! } } ! /* If necessary, scan entry arglist for alternate returns. Do this scan ! apparently redundantly (it's done below to UNIONize the arglists) so ! that we don't complain about RETURN 1 if an offending ENTRY is the only ! one with an alternate return. */ ! if (!ffecom_is_altreturning_) ! { ! for (list = ffesymbol_dummyargs (entry); ! list != NULL; ! list = ffebld_trail (list)) ! { ! arg = ffebld_head (list); ! if (ffebld_op (arg) == FFEBLD_opSTAR) ! { ! ffecom_is_altreturning_ = TRUE; ! break; ! } ! } ! } ! /* Now check type compatibility. */ ! switch (ffecom_master_bt_) ! { ! case FFEINFO_basictypeNONE: ! ok = (bt != FFEINFO_basictypeCHARACTER); ! break; ! case FFEINFO_basictypeCHARACTER: ! ok ! = (bt == FFEINFO_basictypeCHARACTER) ! && (kt == ffecom_master_kt_) ! && (size == ffecom_master_size_); ! break; ! case FFEINFO_basictypeANY: ! return FALSE; /* Just don't bother. */ ! default: ! if (bt == FFEINFO_basictypeCHARACTER) ! { ! ok = FALSE; ! break; ! } ! ok = TRUE; ! if ((bt != ffecom_master_bt_) || (kt != ffecom_master_kt_)) ! { ! ffecom_master_bt_ = FFEINFO_basictypeNONE; ! ffecom_master_kt_ = FFEINFO_kindtypeNONE; ! } ! break; } ! if (!ok) { ! ffebad_start (FFEBAD_ENTRY_CONFLICTS); ! ffest_ffebad_here_current_stmt (0); ! ffebad_finish (); ! return FALSE; /* Can't handle entrypoint. */ ! } ! /* Entrypoint type compatible with previous types. */ ! ++ffecom_num_entrypoints_; ! /* Master-arg-list = UNION(Master-arg-list,entry-arg-list). */ ! for (list = ffesymbol_dummyargs (entry); ! list != NULL; ! list = ffebld_trail (list)) ! { ! arg = ffebld_head (list); ! if (ffebld_op (arg) != FFEBLD_opSYMTER) ! continue; /* Alternate return or some such thing. */ ! s = ffebld_symter (arg); ! for (plist = NULL, mlist = ffecom_master_arglist_; ! mlist != NULL; ! plist = mlist, mlist = ffebld_trail (mlist)) ! { /* plist points to previous item for easy ! appending of arg. */ ! if (ffebld_symter (ffebld_head (mlist)) == s) ! break; /* Already have this arg in the master list. */ ! } ! if (mlist != NULL) ! continue; /* Already have this arg in the master list. */ ! /* Append this arg to the master list. */ ! item = ffebld_new_item (arg, NULL); ! if (plist == NULL) ! ffecom_master_arglist_ = item; ! else ! ffebld_set_trail (plist, item); } ! return TRUE; } #endif ! /* ffecom_2pass_do_entrypoint -- Do compilation of entrypoint ! ! ffesymbol s; // the ENTRY point itself ! ffecom_2pass_do_entrypoint(s); ! ! Does whatever compiler needs to do to make the entrypoint actually ! happen. Must be called for each entrypoint after ! ffecom_finish_progunit is called. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! void ! ffecom_2pass_do_entrypoint (ffesymbol entry) { ! static int mfn_num = 0; ! static int ent_num; ! if (mfn_num != ffecom_num_fns_) ! { /* First entrypoint for this program unit. */ ! ent_num = 1; ! mfn_num = ffecom_num_fns_; ! ffecom_do_entry_ (ffecom_primary_entry_, 0); ! } ! else ! ++ent_num; ! --ffecom_num_entrypoints_; ! ffecom_do_entry_ (entry, ent_num); ! } ! #endif ! /* Essentially does a "fold (build (code, type, node1, node2))" while ! checking for certain housekeeping things. Always sets ! TREE_SIDE_EFFECTS. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_2s (enum tree_code code, tree type, tree node1, ! tree node2) ! { ! tree item; ! if ((node1 == error_mark_node) ! || (node2 == error_mark_node) ! || (type == error_mark_node)) ! return error_mark_node; ! item = build (code, type, node1, node2); ! TREE_SIDE_EFFECTS (item) = 1; ! return fold (item); } #endif + /* Essentially does a "fold (build (code, type, node1, node2, node3))" while + checking for certain housekeeping things. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_3 (enum tree_code code, tree type, tree node1, ! tree node2, tree node3) { ! tree item; ! if ((node1 == error_mark_node) ! || (node2 == error_mark_node) ! || (node3 == error_mark_node) ! || (type == error_mark_node)) ! return error_mark_node; ! item = build (code, type, node1, node2, node3); ! if (TREE_SIDE_EFFECTS (node1) || TREE_SIDE_EFFECTS (node2) ! || (node3 != NULL_TREE && TREE_SIDE_EFFECTS (node3))) ! TREE_SIDE_EFFECTS (item) = 1; ! return fold (item); ! } ! #endif ! /* Essentially does a "fold (build (code, type, node1, node2, node3))" while ! checking for certain housekeeping things. Always sets ! TREE_SIDE_EFFECTS. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_3s (enum tree_code code, tree type, tree node1, ! tree node2, tree node3) ! { ! tree item; ! if ((node1 == error_mark_node) ! || (node2 == error_mark_node) ! || (node3 == error_mark_node) ! || (type == error_mark_node)) ! return error_mark_node; ! item = build (code, type, node1, node2, node3); ! TREE_SIDE_EFFECTS (item) = 1; ! return fold (item); } + #endif ! /* ffecom_arg_expr -- Transform argument expr into gcc tree ! See use by ffecom_list_expr. ! If expression is NULL, returns an integer zero tree. If it is not ! a CHARACTER expression, returns whatever ffecom_expr ! returns and sets the length return value to NULL_TREE. Otherwise ! generates code to evaluate the character expression, returns the proper ! pointer to the result, but does NOT set the length return value to a tree ! that specifies the length of the result. (In other words, the length ! variable is always set to NULL_TREE, because a length is never passed.) ! 21-Dec-91 JCB 1.1 ! Don't set returned length, since nobody needs it (yet; someday if ! we allow CHARACTER*(*) dummies to statement functions, we'll need ! it). */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_arg_expr (ffebld expr, tree *length) ! { ! tree ign; ! *length = NULL_TREE; ! if (expr == NULL) ! return integer_zero_node; ! if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER) ! return ffecom_expr (expr); ! ! return ffecom_arg_ptr_to_expr (expr, &ign); } #endif + /* Transform expression into constant argument-pointer-to-expression tree. ! If the expression can be transformed into a argument-pointer-to-expression ! tree that is constant, that is done, and the tree returned. Else ! NULL_TREE is returned. ! ! That way, a caller can attempt to provide compile-time initialization ! of a variable and, if that fails, *then* choose to start a new block ! and resort to using temporaries, as appropriate. */ ! ! tree ! ffecom_arg_ptr_to_const_expr (ffebld expr, tree *length) { ! if (! expr) ! return integer_zero_node; ! if (ffebld_op (expr) == FFEBLD_opANY) ! { ! if (length) ! *length = error_mark_node; ! return error_mark_node; ! } ! if (ffebld_arity (expr) == 0 ! && (ffebld_op (expr) != FFEBLD_opSYMTER ! || ffebld_where (expr) == FFEINFO_whereCOMMON ! || ffebld_where (expr) == FFEINFO_whereGLOBAL ! || ffebld_where (expr) == FFEINFO_whereINTRINSIC)) { ! tree t; ! t = ffecom_arg_ptr_to_expr (expr, length); ! assert (TREE_CONSTANT (t)); ! assert (! length || TREE_CONSTANT (*length)); ! return t; ! } ! if (length ! && ffebld_size (expr) != FFETARGET_charactersizeNONE) ! *length = build_int_2 (ffebld_size (expr), 0); ! else if (length) ! *length = NULL_TREE; ! return NULL_TREE; ! } ! /* ffecom_arg_ptr_to_expr -- Transform argument expr into gcc tree ! See use by ffecom_list_ptr_to_expr. ! If expression is NULL, returns an integer zero tree. If it is not ! a CHARACTER expression, returns whatever ffecom_ptr_to_expr ! returns and sets the length return value to NULL_TREE. Otherwise ! generates code to evaluate the character expression, returns the proper ! pointer to the result, AND sets the length return value to a tree that ! specifies the length of the result. ! If the length argument is NULL, this is a slightly special ! case of building a FORMAT expression, that is, an expression that ! will be used at run time without regard to length. For the current ! implementation, which uses the libf2c library, this means it is nice ! to append a null byte to the end of the expression, where feasible, ! to make sure any diagnostic about the FORMAT string terminates at ! some useful point. ! ! For now, treat %REF(char-expr) as the same as char-expr with a NULL ! length argument. This might even be seen as a feature, if a null ! byte can always be appended. */ ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_arg_ptr_to_expr (ffebld expr, tree *length) ! { ! tree item; ! tree ign_length; ! ffecomConcatList_ catlist; ! if (length != NULL) ! *length = NULL_TREE; ! if (expr == NULL) ! return integer_zero_node; ! switch (ffebld_op (expr)) ! { ! case FFEBLD_opPERCENT_VAL: ! if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER) ! return ffecom_expr (ffebld_left (expr)); ! { ! tree temp_exp; ! tree temp_length; ! temp_exp = ffecom_arg_ptr_to_expr (ffebld_left (expr), &temp_length); ! if (temp_exp == error_mark_node) ! return error_mark_node; ! return ffecom_1 (INDIRECT_REF, TREE_TYPE (TREE_TYPE (temp_exp)), ! temp_exp); ! } ! case FFEBLD_opPERCENT_REF: ! if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER) ! return ffecom_ptr_to_expr (ffebld_left (expr)); ! if (length != NULL) ! { ! ign_length = NULL_TREE; ! length = &ign_length; ! } ! expr = ffebld_left (expr); ! break; ! case FFEBLD_opPERCENT_DESCR: ! switch (ffeinfo_basictype (ffebld_info (expr))) ! { ! #ifdef PASS_HOLLERITH_BY_DESCRIPTOR ! case FFEINFO_basictypeHOLLERITH: ! #endif ! case FFEINFO_basictypeCHARACTER: ! break; /* Passed by descriptor anyway. */ ! default: ! item = ffecom_ptr_to_expr (expr); ! if (item != error_mark_node) ! *length = TYPE_SIZE (TREE_TYPE (TREE_TYPE (item))); ! break; ! } ! break; ! default: ! break; } ! #ifdef PASS_HOLLERITH_BY_DESCRIPTOR ! if ((ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeHOLLERITH) ! && (length != NULL)) ! { /* Pass Hollerith by descriptor. */ ! ffetargetHollerith h; + assert (ffebld_op (expr) == FFEBLD_opCONTER); + h = ffebld_cu_val_hollerith (ffebld_constant_union + (ffebld_conter (expr))); + *length + = build_int_2 (h.length, 0); + TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node; + } #endif ! if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER) ! return ffecom_ptr_to_expr (expr); ! assert (ffeinfo_kindtype (ffebld_info (expr)) ! == FFEINFO_kindtypeCHARACTER1); ! while (ffebld_op (expr) == FFEBLD_opPAREN) ! expr = ffebld_left (expr); ! ! catlist = ffecom_concat_list_new_ (expr, FFETARGET_charactersizeNONE); ! switch (ffecom_concat_list_count_ (catlist)) ! { ! case 0: /* Shouldn't happen, but in case it does... */ ! if (length != NULL) { ! *length = ffecom_f2c_ftnlen_zero_node; ! TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node; } ! ffecom_concat_list_kill_ (catlist); ! return null_pointer_node; ! case 1: /* The (fairly) easy case. */ ! if (length == NULL) ! ffecom_char_args_with_null_ (&item, &ign_length, ! ffecom_concat_list_expr_ (catlist, 0)); ! else ! ffecom_char_args_ (&item, length, ! ffecom_concat_list_expr_ (catlist, 0)); ! ffecom_concat_list_kill_ (catlist); ! assert (item != NULL_TREE); ! return item; ! default: /* Must actually concatenate things. */ ! break; ! } ! { ! int count = ffecom_concat_list_count_ (catlist); ! int i; ! tree lengths; ! tree items; ! tree length_array; ! tree item_array; ! tree citem; ! tree clength; ! tree temporary; ! tree num; ! tree known_length; ! ffetargetCharacterSize sz; ! sz = ffecom_concat_list_maxlen_ (catlist); ! /* ~~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; + hook = ffebld_nonter_hook (expr); + assert (hook); + assert (TREE_CODE (hook) == TREE_VEC); + assert (TREE_VEC_LENGTH (hook) == 3); + length_array = lengths = TREE_VEC_ELT (hook, 0); + item_array = items = TREE_VEC_ELT (hook, 1); + temporary = TREE_VEC_ELT (hook, 2); + } #endif ! known_length = ffecom_f2c_ftnlen_zero_node; ! for (i = 0; i < count; ++i) { ! if ((i == count) ! && (length == NULL)) ! ffecom_char_args_with_null_ (&citem, &clength, ! ffecom_concat_list_expr_ (catlist, i)); else + ffecom_char_args_ (&citem, &clength, + ffecom_concat_list_expr_ (catlist, i)); + if ((citem == error_mark_node) + || (clength == error_mark_node)) { ! ffecom_concat_list_kill_ (catlist); ! *length = error_mark_node; ! return error_mark_node; } ! items ! = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (items), ! ffecom_modify (void_type_node, ! ffecom_2 (ARRAY_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item_array))), ! item_array, ! build_int_2 (i, 0)), ! citem), ! items); ! clength = ffecom_save_tree (clength); ! if (length != NULL) ! known_length ! = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node, ! known_length, ! clength); ! lengths ! = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (lengths), ! ffecom_modify (void_type_node, ! ffecom_2 (ARRAY_REF, ! TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (length_array))), ! length_array, ! build_int_2 (i, 0)), ! clength), ! lengths); } ! temporary = ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (temporary)), ! temporary); ! item = build_tree_list (NULL_TREE, temporary); ! TREE_CHAIN (item) ! = build_tree_list (NULL_TREE, ! ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (items)), ! items)); ! TREE_CHAIN (TREE_CHAIN (item)) ! = build_tree_list (NULL_TREE, ! ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (lengths)), ! lengths)); ! TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (item))) ! = build_tree_list ! (NULL_TREE, ! ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnlen_type_node, ! convert (ffecom_f2c_ftnlen_type_node, ! build_int_2 (count, 0)))); ! num = build_int_2 (sz, 0); ! TREE_TYPE (num) = ffecom_f2c_ftnlen_type_node; ! TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (item)))) ! = build_tree_list (NULL_TREE, num); ! item = ffecom_call_gfrt (FFECOM_gfrtCAT, item, NULL_TREE); ! TREE_SIDE_EFFECTS (item) = 1; ! item = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (temporary), ! item, ! temporary); ! if (length != NULL) ! *length = known_length; ! } ! ffecom_concat_list_kill_ (catlist); ! assert (item != NULL_TREE); ! return item; ! } ! #endif ! /* Generate call to run-time function. ! The first arg is the GNU Fortran Run-Time function index, the second ! arg is the list of arguments to pass to it. Returned is the expression ! (WITHOUT TREE_SIDE_EFFECTS set!) that makes the call and returns the ! result (which may be void). */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_call_gfrt (ffecomGfrt ix, tree args, tree hook) ! { ! return ffecom_call_ (ffecom_gfrt_tree_ (ix), ! ffecom_gfrt_kindtype (ix), ! ffe_is_f2c_library () && ffecom_gfrt_complex_[ix], ! NULL_TREE, args, NULL_TREE, NULL, ! NULL, NULL_TREE, TRUE, hook); } #endif ! /* Transform constant-union to tree. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC tree ! ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt, ! ffeinfoKindtype kt, tree tree_type) { tree item; ! switch (bt) { ! case FFEINFO_basictypeINTEGER: ! { ! int val; ! switch (kt) ! { ! #if FFETARGET_okINTEGER1 ! case FFEINFO_kindtypeINTEGER1: ! val = ffebld_cu_val_integer1 (*cu); ! break; ! #endif ! #if FFETARGET_okINTEGER2 ! case FFEINFO_kindtypeINTEGER2: ! val = ffebld_cu_val_integer2 (*cu); ! break; ! #endif ! #if FFETARGET_okINTEGER3 ! case FFEINFO_kindtypeINTEGER3: ! val = ffebld_cu_val_integer3 (*cu); ! break; ! #endif + #if FFETARGET_okINTEGER4 + case FFEINFO_kindtypeINTEGER4: + val = ffebld_cu_val_integer4 (*cu); + break; + #endif ! default: ! assert ("bad INTEGER constant kind type" == NULL); ! /* Fall through. */ ! case FFEINFO_kindtypeANY: ! return error_mark_node; ! } ! item = build_int_2 (val, (val < 0) ? -1 : 0); ! TREE_TYPE (item) = tree_type; ! } break; ! case FFEINFO_basictypeLOGICAL: ! { ! int val; ! ! switch (kt) ! { ! #if FFETARGET_okLOGICAL1 ! case FFEINFO_kindtypeLOGICAL1: ! val = ffebld_cu_val_logical1 (*cu); ! break; ! #endif ! ! #if FFETARGET_okLOGICAL2 ! case FFEINFO_kindtypeLOGICAL2: ! val = ffebld_cu_val_logical2 (*cu); ! break; ! #endif ! ! #if FFETARGET_okLOGICAL3 ! case FFEINFO_kindtypeLOGICAL3: ! val = ffebld_cu_val_logical3 (*cu); ! break; ! #endif ! ! #if FFETARGET_okLOGICAL4 ! case FFEINFO_kindtypeLOGICAL4: ! val = ffebld_cu_val_logical4 (*cu); ! break; ! #endif ! ! default: ! assert ("bad LOGICAL constant kind type" == NULL); ! /* Fall through. */ ! case FFEINFO_kindtypeANY: ! return error_mark_node; ! } ! item = build_int_2 (val, (val < 0) ? -1 : 0); ! TREE_TYPE (item) = tree_type; ! } break; ! case FFEINFO_basictypeREAL: ! { ! REAL_VALUE_TYPE val; ! ! switch (kt) ! { ! #if FFETARGET_okREAL1 ! case FFEINFO_kindtypeREAL1: ! val = ffetarget_value_real1 (ffebld_cu_val_real1 (*cu)); ! break; ! #endif ! ! #if FFETARGET_okREAL2 ! case FFEINFO_kindtypeREAL2: ! val = ffetarget_value_real2 (ffebld_cu_val_real2 (*cu)); ! break; ! #endif ! ! #if FFETARGET_okREAL3 ! case FFEINFO_kindtypeREAL3: ! val = ffetarget_value_real3 (ffebld_cu_val_real3 (*cu)); ! break; #endif ! #if FFETARGET_okREAL4 ! case FFEINFO_kindtypeREAL4: ! val = ffetarget_value_real4 (ffebld_cu_val_real4 (*cu)); ! break; ! #endif ! default: ! assert ("bad REAL constant kind type" == NULL); ! /* Fall through. */ ! case FFEINFO_kindtypeANY: ! return error_mark_node; ! } ! item = build_real (tree_type, val); ! } ! break; ! case FFEINFO_basictypeCOMPLEX: ! { ! REAL_VALUE_TYPE real; ! REAL_VALUE_TYPE imag; ! tree el_type = ffecom_tree_type[FFEINFO_basictypeREAL][kt]; ! switch (kt) ! { ! #if FFETARGET_okCOMPLEX1 ! case FFEINFO_kindtypeREAL1: ! real = ffetarget_value_real1 (ffebld_cu_val_complex1 (*cu).real); ! imag = ffetarget_value_real1 (ffebld_cu_val_complex1 (*cu).imaginary); ! break; #endif ! #if FFETARGET_okCOMPLEX2 ! case FFEINFO_kindtypeREAL2: ! real = ffetarget_value_real2 (ffebld_cu_val_complex2 (*cu).real); ! imag = ffetarget_value_real2 (ffebld_cu_val_complex2 (*cu).imaginary); ! break; ! #endif ! #if FFETARGET_okCOMPLEX3 ! case FFEINFO_kindtypeREAL3: ! real = ffetarget_value_real3 (ffebld_cu_val_complex3 (*cu).real); ! imag = ffetarget_value_real3 (ffebld_cu_val_complex3 (*cu).imaginary); ! break; ! #endif ! #if FFETARGET_okCOMPLEX4 ! case FFEINFO_kindtypeREAL4: ! real = ffetarget_value_real4 (ffebld_cu_val_complex4 (*cu).real); ! imag = ffetarget_value_real4 (ffebld_cu_val_complex4 (*cu).imaginary); ! break; ! #endif ! default: ! assert ("bad REAL constant kind type" == NULL); ! /* Fall through. */ ! case FFEINFO_kindtypeANY: ! return error_mark_node; ! } ! item = ffecom_build_complex_constant_ (tree_type, ! build_real (el_type, real), ! build_real (el_type, imag)); ! } ! break; ! case FFEINFO_basictypeCHARACTER: ! { /* Happens only in DATA and similar contexts. */ ! ffetargetCharacter1 val; ! switch (kt) ! { ! #if FFETARGET_okCHARACTER1 ! case FFEINFO_kindtypeLOGICAL1: ! val = ffebld_cu_val_character1 (*cu); ! break; ! #endif ! default: ! assert ("bad CHARACTER constant kind type" == NULL); ! /* Fall through. */ ! case FFEINFO_kindtypeANY: ! return error_mark_node; ! } ! item = build_string (ffetarget_length_character1 (val), ! ffetarget_text_character1 (val)); ! TREE_TYPE (item) ! = build_type_variant (build_array_type (char_type_node, ! build_range_type ! (integer_type_node, ! integer_one_node, ! build_int_2 ! (ffetarget_length_character1 ! (val), 0))), ! 1, 0); ! } break; ! case FFEINFO_basictypeHOLLERITH: ! { ! ffetargetHollerith h; ! h = ffebld_cu_val_hollerith (*cu); ! /* If not at least as wide as default INTEGER, widen it. */ ! if (h.length >= FLOAT_TYPE_SIZE / CHAR_TYPE_SIZE) ! item = build_string (h.length, h.text); ! else ! { ! char str[FLOAT_TYPE_SIZE / CHAR_TYPE_SIZE]; ! ! memcpy (str, h.text, h.length); ! memset (&str[h.length], ' ', ! FLOAT_TYPE_SIZE / CHAR_TYPE_SIZE ! - h.length); ! item = build_string (FLOAT_TYPE_SIZE / CHAR_TYPE_SIZE, ! str); ! } ! TREE_TYPE (item) ! = build_type_variant (build_array_type (char_type_node, ! build_range_type ! (integer_type_node, ! integer_one_node, ! build_int_2 ! (h.length, 0))), ! 1, 0); ! } break; ! case FFEINFO_basictypeTYPELESS: ! { ! ffetargetInteger1 ival; ! ffetargetTypeless tless; ! ffebad error; ! ! tless = ffebld_cu_val_typeless (*cu); ! error = ffetarget_convert_integer1_typeless (&ival, tless); ! assert (error == FFEBAD); ! ! item = build_int_2 ((int) ival, 0); ! } break; default: ! assert ("not yet on constant type" == NULL); ! /* Fall through. */ ! case FFEINFO_basictypeANY: ! return error_mark_node; } ! TREE_CONSTANT (item) = 1; ! ! return item; } #endif ! /* Transform expression into constant tree. ! If the expression can be transformed into a tree that is constant, ! that is done, and the tree returned. Else NULL_TREE is returned. ! That way, a caller can attempt to provide compile-time initialization ! of a variable and, if that fails, *then* choose to start a new block ! and resort to using temporaries, as appropriate. */ ! tree ! ffecom_const_expr (ffebld expr) ! { ! if (! expr) ! return integer_zero_node; ! ! if (ffebld_op (expr) == FFEBLD_opANY) ! return error_mark_node; ! ! if (ffebld_arity (expr) == 0 ! && (ffebld_op (expr) != FFEBLD_opSYMTER ! #if NEWCOMMON ! /* ~~Enable once common/equivalence is handled properly? */ ! || ffebld_where (expr) == FFEINFO_whereCOMMON ! #endif ! || ffebld_where (expr) == FFEINFO_whereGLOBAL ! || ffebld_where (expr) == FFEINFO_whereINTRINSIC)) ! { ! tree t; ! ! t = ffecom_expr (expr); ! assert (TREE_CONSTANT (t)); ! return t; ! } ! ! return NULL_TREE; ! } ! ! /* Handy way to make a field in a struct/union. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_decl_field (tree context, tree prevfield, ! const char *name, tree type) { ! tree field; ! field = build_decl (FIELD_DECL, get_identifier (name), type); ! DECL_CONTEXT (field) = context; ! DECL_FRAME_SIZE (field) = 0; ! if (prevfield != NULL_TREE) ! TREE_CHAIN (prevfield) = field; ! return field; ! } ! #endif ! ! void ! ffecom_close_include (FILE *f) ! { ! #if FFECOM_GCC_INCLUDE ! ffecom_close_include_ (f); ! #endif ! } ! ! int ! ffecom_decode_include_option (char *spec) ! { ! #if FFECOM_GCC_INCLUDE ! return ffecom_decode_include_option_ (spec); ! #else ! return 1; ! #endif ! } ! ! /* End a compound statement (block). */ ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_end_compstmt (void) ! { ! return bison_rule_compstmt_ (); ! } ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ ! ! /* ffecom_end_transition -- Perform end transition on all symbols ! ! ffecom_end_transition(); ! ! Calls ffecom_sym_end_transition for each global and local symbol. */ ! ! void ! ffecom_end_transition () ! { ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! ffebld item; ! #endif ! ! if (ffe_is_ffedebug ()) ! fprintf (dmpout, "; end_stmt_transition\n"); ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! ffecom_list_blockdata_ = NULL; ! ffecom_list_common_ = NULL; ! #endif ! ! ffesymbol_drive (ffecom_sym_end_transition); ! if (ffe_is_ffedebug ()) ! { ! ffestorag_report (); ! #if FFECOM_targetCURRENT == FFECOM_targetFFE ! ffesymbol_report_all (); ! #endif ! } ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! ffecom_start_progunit_ (); ! ! for (item = ffecom_list_blockdata_; ! item != NULL; ! item = ffebld_trail (item)) ! { ! ffebld callee; ! ffesymbol s; ! tree dt; ! tree t; ! tree var; ! int yes; ! static int number = 0; ! ! callee = ffebld_head (item); ! s = ffebld_symter (callee); ! t = ffesymbol_hook (s).decl_tree; ! if (t == NULL_TREE) { ! s = ffecom_sym_transform_ (s); ! t = ffesymbol_hook (s).decl_tree; } + + yes = suspend_momentary (); + + dt = build_pointer_type (TREE_TYPE (t)); + + var = build_decl (VAR_DECL, + ffecom_get_invented_identifier ("__g77_forceload_%d", + NULL, number++), + dt); + DECL_EXTERNAL (var) = 0; + TREE_STATIC (var) = 1; + TREE_PUBLIC (var) = 0; + DECL_INITIAL (var) = error_mark_node; + TREE_USED (var) = 1; + + var = start_decl (var, FALSE); + + t = ffecom_1 (ADDR_EXPR, dt, t); + + finish_decl (var, t, FALSE); + + resume_momentary (yes); } ! /* This handles any COMMON areas that weren't referenced but have, for ! example, important initial data. */ ! ! for (item = ffecom_list_common_; ! item != NULL; ! item = ffebld_trail (item)) ! ffecom_transform_common_ (ffebld_symter (ffebld_head (item))); ! ! ffecom_list_common_ = NULL; ! #endif ! } ! ! /* ffecom_exec_transition -- Perform exec transition on all symbols ! ! ffecom_exec_transition(); ! ! Calls ffecom_sym_exec_transition for each global and local symbol. ! Make sure error updating not inhibited. */ ! ! void ! ffecom_exec_transition () ! { ! bool inhibited; ! ! if (ffe_is_ffedebug ()) ! fprintf (dmpout, "; exec_stmt_transition\n"); ! ! inhibited = ffebad_inhibit (); ! ffebad_set_inhibit (FALSE); ! ffesymbol_drive (ffecom_sym_exec_transition); /* Don't retract! */ ! ffeequiv_exec_transition (); /* Handle all pending EQUIVALENCEs. */ ! if (ffe_is_ffedebug ()) { ! ffestorag_report (); ! #if FFECOM_targetCURRENT == FFECOM_targetFFE ! ffesymbol_report_all (); ! #endif } ! if (inhibited) ! ffebad_set_inhibit (TRUE); ! } ! /* Handle assignment statement. ! Convert dest and source using ffecom_expr, then join them ! with an ASSIGN op and pass the whole thing to expand_expr_stmt. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! void ! ffecom_expand_let_stmt (ffebld dest, ffebld source) ! { ! tree dest_tree; ! tree dest_length; ! tree source_tree; ! tree expr_tree; ! if (ffeinfo_basictype (ffebld_info (dest)) != FFEINFO_basictypeCHARACTER) ! { ! bool dest_used; ! tree assign_temp; ! ! /* This attempts to replicate the test below, but must not be ! true when the test below is false. (Always err on the side ! of creating unused temporaries, to avoid ICEs.) */ ! if (ffebld_op (dest) != FFEBLD_opSYMTER ! || ((dest_tree = ffesymbol_hook (ffebld_symter (dest)).decl_tree) ! && (TREE_CODE (dest_tree) != VAR_DECL ! || TREE_ADDRESSABLE (dest_tree)))) { ! ffecom_prepare_expr_ (source, dest); ! dest_used = TRUE; } ! else { ! ffecom_prepare_expr_ (source, NULL); ! dest_used = FALSE; } ! ffecom_prepare_expr_w (NULL_TREE, dest); ! /* For COMPLEX assignment like C1=C2, if partial overlap is possible, ! create a temporary through which the assignment is to take place, ! since MODIFY_EXPR doesn't handle partial overlap properly. */ ! if (ffebld_basictype (dest) == FFEINFO_basictypeCOMPLEX ! && ffecom_possible_partial_overlap_ (dest, source)) ! { ! assign_temp = ffecom_make_tempvar ("complex_let", ! ffecom_tree_type ! [ffebld_basictype (dest)] ! [ffebld_kindtype (dest)], ! FFETARGET_charactersizeNONE, ! -1); ! } ! else ! assign_temp = NULL_TREE; ! ffecom_prepare_end (); ! dest_tree = ffecom_expr_w (NULL_TREE, dest); ! if (dest_tree == error_mark_node) ! return; ! if ((TREE_CODE (dest_tree) != VAR_DECL) ! || TREE_ADDRESSABLE (dest_tree)) ! source_tree = ffecom_expr_ (source, dest_tree, dest, &dest_used, ! FALSE, FALSE); ! else ! { ! assert (! dest_used); ! dest_used = FALSE; ! source_tree = ffecom_expr (source); } ! if (source_tree == error_mark_node) ! return; ! if (dest_used) ! expr_tree = source_tree; ! else if (assign_temp) ! { ! #ifdef MOVE_EXPR ! /* The back end understands a conceptual move (evaluate source; ! store into dest), so use that, in case it can determine ! that it is going to use, say, two registers as temporaries ! anyway. So don't use the temp (and someday avoid generating ! it, once this code starts triggering regularly). */ ! expr_tree = ffecom_2s (MOVE_EXPR, void_type_node, ! dest_tree, ! source_tree); ! #else ! expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node, ! assign_temp, ! source_tree); ! expand_expr_stmt (expr_tree); ! expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node, ! dest_tree, ! assign_temp); ! #endif ! } else ! expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node, ! dest_tree, ! source_tree); ! ! expand_expr_stmt (expr_tree); ! return; } ! ffecom_prepare_let_char_ (ffebld_size_known (dest), source); ! ffecom_prepare_expr_w (NULL_TREE, dest); ! ! ffecom_prepare_end (); ! ! ffecom_char_args_ (&dest_tree, &dest_length, dest); ! ffecom_let_char_ (dest_tree, dest_length, ffebld_size_known (dest), ! source); } #endif ! /* ffecom_expr -- Transform expr into gcc tree ! tree t; ! ffebld expr; // FFE expression. ! tree = ffecom_expr(expr); ! Recursive descent on expr while making corresponding tree nodes and ! attaching type info and such. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_expr (ffebld expr) { ! return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, FALSE, FALSE); } #endif ! /* Like ffecom_expr, but return tree usable for assigned GOTO or FORMAT. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC tree ! ffecom_expr_assign (ffebld expr) { ! return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, TRUE, FALSE); } #endif ! /* Like ffecom_expr_rw, but return tree usable for ASSIGN. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC tree ! ffecom_expr_assign_w (ffebld expr) { ! return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, TRUE, FALSE); } #endif ! /* Transform expr for use as into read/write tree and stabilize the ! reference. Not for use on CHARACTER expressions. ! ! Recursive descent on expr while making corresponding tree nodes and ! attaching type info and such. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC tree ! ffecom_expr_rw (tree type, ffebld expr) { ! assert (expr != NULL); ! /* Different target types not yet supported. */ ! assert (type == NULL_TREE || type == ffecom_type_expr (expr)); ! return stabilize_reference (ffecom_expr (expr)); } #endif ! /* Transform expr for use as into write tree and stabilize the ! reference. Not for use on CHARACTER expressions. ! Recursive descent on expr while making corresponding tree nodes and ! attaching type info and such. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC tree ! ffecom_expr_w (tree type, ffebld expr) { ! assert (expr != NULL); ! /* Different target types not yet supported. */ ! assert (type == NULL_TREE || type == ffecom_type_expr (expr)); ! return stabilize_reference (ffecom_expr (expr)); ! } ! ! #endif ! /* Do global stuff. */ ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! void ! ffecom_finish_compile () ! { ! assert (ffecom_outer_function_decl_ == NULL_TREE); ! assert (current_function_decl == NULL_TREE); ! ffeglobal_drive (ffecom_finish_global_); ! } ! #endif ! /* Public entry point for front end to access finish_decl. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! void ! ffecom_finish_decl (tree decl, tree init, bool is_top_level) ! { ! assert (!is_top_level); ! finish_decl (decl, init, FALSE); } #endif ! /* Finish a program unit. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! void ! ffecom_finish_progunit () ! { ! ffecom_end_compstmt (); ! ffecom_previous_function_decl_ = current_function_decl; ! ffecom_which_entrypoint_decl_ = NULL_TREE; ! finish_function (0); ! } ! #endif ! /* Wrapper for get_identifier. pattern is sprintf-like, assumed to contain ! one %s if text is not NULL, assumed to contain one %d if number is ! not -1. If both are assumed, the %s is assumed to precede the %d. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC tree ! ffecom_get_invented_identifier (const char *pattern, const char *text, ! int number) { ! tree decl; ! char *nam; ! mallocSize lenlen; ! char space[66]; ! lenlen = 0; ! if (text) ! lenlen += strlen (text); ! if (number != -1) ! lenlen += 20; ! if (text || number != -1) ! { ! lenlen += strlen (pattern); ! if (lenlen > ARRAY_SIZE (space)) ! nam = malloc_new_ks (malloc_pool_image (), pattern, lenlen); ! else ! nam = &space[0]; ! } ! else { ! lenlen = 0; ! nam = (char *) pattern; ! } ! if (text == NULL) ! { ! if (number != -1) ! sprintf (&nam[0], pattern, number); ! } ! else ! { ! if (number == -1) ! sprintf (&nam[0], pattern, text); ! else ! sprintf (&nam[0], pattern, text, number); ! } ! decl = get_identifier (nam); ! if (lenlen > ARRAY_SIZE (space)) ! malloc_kill_ks (malloc_pool_image (), nam, lenlen); ! IDENTIFIER_INVENTED (decl) = 1; ! return decl; ! } ! ffeinfoBasictype ! ffecom_gfrt_basictype (ffecomGfrt gfrt) ! { ! assert (gfrt < FFECOM_gfrt); ! switch (ffecom_gfrt_type_[gfrt]) ! { ! case FFECOM_rttypeVOID_: ! case FFECOM_rttypeVOIDSTAR_: ! return FFEINFO_basictypeNONE; ! case FFECOM_rttypeFTNINT_: ! return FFEINFO_basictypeINTEGER; ! case FFECOM_rttypeINTEGER_: ! return FFEINFO_basictypeINTEGER; ! case FFECOM_rttypeLONGINT_: ! return FFEINFO_basictypeINTEGER; ! case FFECOM_rttypeLOGICAL_: ! return FFEINFO_basictypeLOGICAL; ! case FFECOM_rttypeREAL_F2C_: ! case FFECOM_rttypeREAL_GNU_: ! return FFEINFO_basictypeREAL; ! case FFECOM_rttypeCOMPLEX_F2C_: ! case FFECOM_rttypeCOMPLEX_GNU_: ! return FFEINFO_basictypeCOMPLEX; ! case FFECOM_rttypeDOUBLE_: ! case FFECOM_rttypeDOUBLEREAL_: ! return FFEINFO_basictypeREAL; ! case FFECOM_rttypeDBLCMPLX_F2C_: ! case FFECOM_rttypeDBLCMPLX_GNU_: ! return FFEINFO_basictypeCOMPLEX; ! case FFECOM_rttypeCHARACTER_: ! return FFEINFO_basictypeCHARACTER; ! default: ! return FFEINFO_basictypeANY; ! } ! } ! ffeinfoKindtype ! ffecom_gfrt_kindtype (ffecomGfrt gfrt) ! { ! assert (gfrt < FFECOM_gfrt); ! switch (ffecom_gfrt_type_[gfrt]) ! { ! case FFECOM_rttypeVOID_: ! case FFECOM_rttypeVOIDSTAR_: ! return FFEINFO_kindtypeNONE; ! case FFECOM_rttypeFTNINT_: ! return FFEINFO_kindtypeINTEGER1; ! case FFECOM_rttypeINTEGER_: ! return FFEINFO_kindtypeINTEGER1; ! case FFECOM_rttypeLONGINT_: ! return FFEINFO_kindtypeINTEGER4; ! case FFECOM_rttypeLOGICAL_: ! return FFEINFO_kindtypeLOGICAL1; ! case FFECOM_rttypeREAL_F2C_: ! case FFECOM_rttypeREAL_GNU_: ! return FFEINFO_kindtypeREAL1; ! case FFECOM_rttypeCOMPLEX_F2C_: ! case FFECOM_rttypeCOMPLEX_GNU_: ! return FFEINFO_kindtypeREAL1; ! case FFECOM_rttypeDOUBLE_: ! case FFECOM_rttypeDOUBLEREAL_: ! return FFEINFO_kindtypeREAL2; ! case FFECOM_rttypeDBLCMPLX_F2C_: ! case FFECOM_rttypeDBLCMPLX_GNU_: ! return FFEINFO_kindtypeREAL2; ! case FFECOM_rttypeCHARACTER_: ! return FFEINFO_kindtypeCHARACTER1; ! default: ! return FFEINFO_kindtypeANY; ! } ! } ! void ! ffecom_init_0 () { ! tree endlink; ! int i; ! int j; ! tree t; ! tree field; ! ffetype type; ! ffetype base_type; ! /* This block of code comes from the now-obsolete cktyps.c. It checks ! whether the compiler environment is buggy in known ways, some of which ! would, if not explicitly checked here, result in subtle bugs in g77. */ ! ! if (ffe_is_do_internal_checks ()) { ! static char names[][12] ! = ! {"bar", "bletch", "foo", "foobar"}; ! char *name; ! unsigned long ul; ! double fl; ! name = bsearch ("foo", &names[0], ARRAY_SIZE (names), sizeof (names[0]), ! (int (*)()) strcmp); ! if (name != (char *) &names[2]) ! { ! assert ("bsearch doesn't work, #define FFEPROJ_BSEARCH 0 in proj.h" ! == NULL); ! abort (); ! } ! ul = strtoul ("123456789", NULL, 10); ! if (ul != 123456789L) ! { ! assert ("strtoul doesn't have enough range, #define FFEPROJ_STRTOUL 0\ ! in proj.h" == NULL); ! abort (); ! } ! fl = atof ("56.789"); ! if ((fl < 56.788) || (fl > 56.79)) ! { ! assert ("atof not type double, fix your #include " ! == NULL); ! abort (); ! } ! } ! #if FFECOM_GCC_INCLUDE ! ffecom_initialize_char_syntax_ (); #endif ! ffecom_outer_function_decl_ = NULL_TREE; ! current_function_decl = NULL_TREE; ! named_labels = NULL_TREE; ! current_binding_level = NULL_BINDING_LEVEL; ! free_binding_level = NULL_BINDING_LEVEL; ! /* Make the binding_level structure for global names. */ ! pushlevel (0); ! global_binding_level = current_binding_level; ! current_binding_level->prep_state = 2; ! /* Define `int' and `char' first so that dbx will output them first. */ ! integer_type_node = make_signed_type (INT_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("int"), ! integer_type_node)); ! char_type_node = make_unsigned_type (CHAR_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("char"), ! char_type_node)); ! long_integer_type_node = make_signed_type (LONG_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("long int"), ! long_integer_type_node)); ! unsigned_type_node = make_unsigned_type (INT_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned int"), ! unsigned_type_node)); ! long_unsigned_type_node = make_unsigned_type (LONG_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("long unsigned int"), ! long_unsigned_type_node)); ! ! long_long_integer_type_node = make_signed_type (LONG_LONG_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("long long int"), ! long_long_integer_type_node)); ! ! long_long_unsigned_type_node = make_unsigned_type (LONG_LONG_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("long long unsigned int"), ! long_long_unsigned_type_node)); ! ! short_integer_type_node = make_signed_type (SHORT_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("short int"), ! short_integer_type_node)); ! ! short_unsigned_type_node = make_unsigned_type (SHORT_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("short unsigned int"), ! short_unsigned_type_node)); ! ! /* Set the sizetype before we make other types. This *should* be the ! first type we create. */ ! ! set_sizetype ! (TREE_TYPE (IDENTIFIER_GLOBAL_VALUE (get_identifier (SIZE_TYPE)))); ! ffecom_typesize_pointer_ ! = TREE_INT_CST_LOW (TYPE_SIZE (sizetype)) / BITS_PER_UNIT; ! ! error_mark_node = make_node (ERROR_MARK); ! TREE_TYPE (error_mark_node) = error_mark_node; ! ! /* Define both `signed char' and `unsigned char'. */ ! signed_char_type_node = make_signed_type (CHAR_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("signed char"), ! signed_char_type_node)); ! ! unsigned_char_type_node = make_unsigned_type (CHAR_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned char"), ! unsigned_char_type_node)); ! float_type_node = make_node (REAL_TYPE); ! TYPE_PRECISION (float_type_node) = FLOAT_TYPE_SIZE; ! layout_type (float_type_node); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("float"), ! float_type_node)); ! double_type_node = make_node (REAL_TYPE); ! TYPE_PRECISION (double_type_node) = DOUBLE_TYPE_SIZE; ! layout_type (double_type_node); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("double"), ! double_type_node)); ! long_double_type_node = make_node (REAL_TYPE); ! TYPE_PRECISION (long_double_type_node) = LONG_DOUBLE_TYPE_SIZE; ! layout_type (long_double_type_node); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("long double"), ! long_double_type_node)); ! complex_integer_type_node = ffecom_make_complex_type_ (integer_type_node); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("complex int"), ! complex_integer_type_node)); ! complex_float_type_node = ffecom_make_complex_type_ (float_type_node); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("complex float"), ! complex_float_type_node)); ! complex_double_type_node = ffecom_make_complex_type_ (double_type_node); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("complex double"), ! complex_double_type_node)); ! complex_long_double_type_node = ffecom_make_complex_type_ (long_double_type_node); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("complex long double"), ! complex_long_double_type_node)); ! integer_zero_node = build_int_2 (0, 0); ! TREE_TYPE (integer_zero_node) = integer_type_node; ! integer_one_node = build_int_2 (1, 0); ! TREE_TYPE (integer_one_node) = integer_type_node; ! size_zero_node = build_int_2 (0, 0); ! TREE_TYPE (size_zero_node) = sizetype; ! size_one_node = build_int_2 (1, 0); ! TREE_TYPE (size_one_node) = sizetype; ! void_type_node = make_node (VOID_TYPE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("void"), ! void_type_node)); ! layout_type (void_type_node); /* Uses integer_zero_node */ ! /* We are not going to have real types in C with less than byte alignment, ! so we might as well not have any types that claim to have it. */ ! TYPE_ALIGN (void_type_node) = BITS_PER_UNIT; ! null_pointer_node = build_int_2 (0, 0); ! TREE_TYPE (null_pointer_node) = build_pointer_type (void_type_node); ! layout_type (TREE_TYPE (null_pointer_node)); ! string_type_node = build_pointer_type (char_type_node); ! ffecom_tree_fun_type_void ! = build_function_type (void_type_node, NULL_TREE); ! ffecom_tree_ptr_to_fun_type_void ! = build_pointer_type (ffecom_tree_fun_type_void); ! endlink = tree_cons (NULL_TREE, void_type_node, NULL_TREE); ! float_ftype_float ! = build_function_type (float_type_node, ! tree_cons (NULL_TREE, float_type_node, endlink)); ! double_ftype_double ! = build_function_type (double_type_node, ! tree_cons (NULL_TREE, double_type_node, endlink)); ! ldouble_ftype_ldouble ! = build_function_type (long_double_type_node, ! tree_cons (NULL_TREE, long_double_type_node, ! endlink)); ! for (i = 0; ((size_t) i) < ARRAY_SIZE (ffecom_tree_type); ++i) ! for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j) ! { ! ffecom_tree_type[i][j] = NULL_TREE; ! ffecom_tree_fun_type[i][j] = NULL_TREE; ! ffecom_tree_ptr_to_fun_type[i][j] = NULL_TREE; ! ffecom_f2c_typecode_[i][j] = -1; } ! /* Set up standard g77 types. Note that INTEGER and LOGICAL are set ! to size FLOAT_TYPE_SIZE because they have to be the same size as ! REAL, which also is FLOAT_TYPE_SIZE, according to the standard. ! Compiler options and other such stuff that change the ways these ! types are set should not affect this particular setup. */ ! ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER1] ! = t = make_signed_type (FLOAT_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("integer"), ! t)); ! type = ffetype_new (); ! base_type = type; ! ffeinfo_set_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER1, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 1, type); ! ffecom_typesize_integer1_ = ffetype_size (type); ! assert (ffetype_size (type) == sizeof (ffetargetInteger1)); ! ffecom_tree_type[FFEINFO_basictypeHOLLERITH][FFEINFO_kindtypeINTEGER1] ! = t = make_unsigned_type (FLOAT_TYPE_SIZE); /* HOLLERITH means unsigned. */ ! pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned"), ! t)); ! ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER2] ! = t = make_signed_type (CHAR_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("byte"), ! t)); ! type = ffetype_new (); ! ffeinfo_set_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER2, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 3, type); ! assert (ffetype_size (type) == sizeof (ffetargetInteger2)); ! ffecom_tree_type[FFEINFO_basictypeHOLLERITH][FFEINFO_kindtypeINTEGER2] ! = t = make_unsigned_type (CHAR_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned byte"), ! t)); ! ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER3] ! = t = make_signed_type (CHAR_TYPE_SIZE * 2); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("word"), ! t)); ! type = ffetype_new (); ! ffeinfo_set_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER3, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 6, type); ! assert (ffetype_size (type) == sizeof (ffetargetInteger3)); ! ffecom_tree_type[FFEINFO_basictypeHOLLERITH][FFEINFO_kindtypeINTEGER3] ! = t = make_unsigned_type (CHAR_TYPE_SIZE * 2); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned word"), ! t)); ! ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER4] ! = t = make_signed_type (FLOAT_TYPE_SIZE * 2); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("integer4"), ! t)); ! type = ffetype_new (); ! ffeinfo_set_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER4, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 2, type); ! assert (ffetype_size (type) == sizeof (ffetargetInteger4)); ! ffecom_tree_type[FFEINFO_basictypeHOLLERITH][FFEINFO_kindtypeINTEGER4] ! = t = make_unsigned_type (FLOAT_TYPE_SIZE * 2); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned4"), ! t)); ! #if 0 ! if (ffe_is_do_internal_checks () ! && LONG_TYPE_SIZE != FLOAT_TYPE_SIZE ! && LONG_TYPE_SIZE != CHAR_TYPE_SIZE ! && LONG_TYPE_SIZE != SHORT_TYPE_SIZE ! && LONG_TYPE_SIZE != LONG_LONG_TYPE_SIZE) ! { ! fprintf (stderr, "Sorry, no g77 support for LONG_TYPE_SIZE (%d bits) yet.\n", ! LONG_TYPE_SIZE); ! } ! #endif ! ffecom_tree_type[FFEINFO_basictypeLOGICAL][FFEINFO_kindtypeLOGICAL1] ! = t = make_signed_type (FLOAT_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("logical"), ! t)); ! type = ffetype_new (); ! base_type = type; ! ffeinfo_set_type (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL1, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 1, type); ! assert (ffetype_size (type) == sizeof (ffetargetLogical1)); ! ffecom_tree_type[FFEINFO_basictypeLOGICAL][FFEINFO_kindtypeLOGICAL2] ! = t = make_signed_type (CHAR_TYPE_SIZE); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("logical2"), ! t)); ! type = ffetype_new (); ! ffeinfo_set_type (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL2, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 3, type); ! assert (ffetype_size (type) == sizeof (ffetargetLogical2)); ! ffecom_tree_type[FFEINFO_basictypeLOGICAL][FFEINFO_kindtypeLOGICAL3] ! = t = make_signed_type (CHAR_TYPE_SIZE * 2); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("logical3"), ! t)); ! type = ffetype_new (); ! ffeinfo_set_type (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL3, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 6, type); ! assert (ffetype_size (type) == sizeof (ffetargetLogical3)); ! ffecom_tree_type[FFEINFO_basictypeLOGICAL][FFEINFO_kindtypeLOGICAL4] ! = t = make_signed_type (FLOAT_TYPE_SIZE * 2); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("logical4"), ! t)); ! type = ffetype_new (); ! ffeinfo_set_type (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL4, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 2, type); ! assert (ffetype_size (type) == sizeof (ffetargetLogical4)); ! ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1] ! = t = make_node (REAL_TYPE); ! TYPE_PRECISION (t) = FLOAT_TYPE_SIZE; ! pushdecl (build_decl (TYPE_DECL, get_identifier ("real"), ! t)); ! layout_type (t); ! type = ffetype_new (); ! base_type = type; ! ffeinfo_set_type (FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL1, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 1, type); ! ffecom_f2c_typecode_[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1] ! = FFETARGET_f2cTYREAL; ! assert (ffetype_size (type) == sizeof (ffetargetReal1)); ! ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREALDOUBLE] ! = t = make_node (REAL_TYPE); ! TYPE_PRECISION (t) = FLOAT_TYPE_SIZE * 2; /* Always twice REAL. */ ! pushdecl (build_decl (TYPE_DECL, get_identifier ("double precision"), ! t)); ! layout_type (t); ! type = ffetype_new (); ! ffeinfo_set_type (FFEINFO_basictypeREAL, FFEINFO_kindtypeREALDOUBLE, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 2, type); ! ffecom_f2c_typecode_[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL2] ! = FFETARGET_f2cTYDREAL; ! assert (ffetype_size (type) == sizeof (ffetargetReal2)); ! ffecom_tree_type[FFEINFO_basictypeCOMPLEX][FFEINFO_kindtypeREAL1] ! = t = ffecom_make_complex_type_ (ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1]); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("complex"), ! t)); ! type = ffetype_new (); ! base_type = type; ! ffeinfo_set_type (FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL1, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 1, type); ! ffecom_f2c_typecode_[FFEINFO_basictypeCOMPLEX][FFEINFO_kindtypeREAL1] ! = FFETARGET_f2cTYCOMPLEX; ! assert (ffetype_size (type) == sizeof (ffetargetComplex1)); ! ffecom_tree_type[FFEINFO_basictypeCOMPLEX][FFEINFO_kindtypeREALDOUBLE] ! = t = ffecom_make_complex_type_ (ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL2]); ! pushdecl (build_decl (TYPE_DECL, get_identifier ("double complex"), ! t)); ! type = ffetype_new (); ! ffeinfo_set_type (FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREALDOUBLE, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_star (base_type, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE, ! type); ! ffetype_set_kind (base_type, 2, ! type); ! ffecom_f2c_typecode_[FFEINFO_basictypeCOMPLEX][FFEINFO_kindtypeREAL2] ! = FFETARGET_f2cTYDCOMPLEX; ! assert (ffetype_size (type) == sizeof (ffetargetComplex2)); ! /* Make function and ptr-to-function types for non-CHARACTER types. */ ! for (i = 0; ((size_t) i) < ARRAY_SIZE (ffecom_tree_type); ++i) ! for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j) ! { ! if ((t = ffecom_tree_type[i][j]) != NULL_TREE) ! { ! if (i == FFEINFO_basictypeINTEGER) ! { ! /* Figure out the smallest INTEGER type that can hold ! a pointer on this machine. */ ! if (GET_MODE_SIZE (TYPE_MODE (t)) ! >= GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node)))) ! { ! if ((ffecom_pointer_kind_ == FFEINFO_kindtypeNONE) ! || (GET_MODE_SIZE (TYPE_MODE (ffecom_tree_type[i][ffecom_pointer_kind_])) ! > GET_MODE_SIZE (TYPE_MODE (t)))) ! ffecom_pointer_kind_ = j; ! } ! } ! else if (i == FFEINFO_basictypeCOMPLEX) ! t = void_type_node; ! /* For f2c compatibility, REAL functions are really ! implemented as DOUBLE PRECISION. */ ! else if ((i == FFEINFO_basictypeREAL) ! && (j == FFEINFO_kindtypeREAL1)) ! t = ffecom_tree_type ! [FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL2]; ! t = ffecom_tree_fun_type[i][j] = build_function_type (t, ! NULL_TREE); ! ffecom_tree_ptr_to_fun_type[i][j] = build_pointer_type (t); ! } ! } ! /* Set up pointer types. */ ! if (ffecom_pointer_kind_ == FFEINFO_basictypeNONE) ! fatal ("no INTEGER type can hold a pointer on this configuration"); ! else if (0 && ffe_is_do_internal_checks ()) ! fprintf (stderr, "Pointer type kt=%d\n", ffecom_pointer_kind_); ! ffetype_set_kind (ffeinfo_type (FFEINFO_basictypeINTEGER, ! FFEINFO_kindtypeINTEGERDEFAULT), ! 7, ! ffeinfo_type (FFEINFO_basictypeINTEGER, ! ffecom_pointer_kind_)); ! if (ffe_is_ugly_assign ()) ! ffecom_label_kind_ = ffecom_pointer_kind_; /* Require ASSIGN etc to this. */ ! else ! ffecom_label_kind_ = FFEINFO_kindtypeINTEGERDEFAULT; ! if (0 && ffe_is_do_internal_checks ()) ! fprintf (stderr, "Label type kt=%d\n", ffecom_label_kind_); ! ffecom_integer_type_node ! = ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER1]; ! ffecom_integer_zero_node = convert (ffecom_integer_type_node, ! integer_zero_node); ! ffecom_integer_one_node = convert (ffecom_integer_type_node, ! integer_one_node); ! /* Yes, the "FLOAT_TYPE_SIZE" references below are intentional. ! Turns out that by TYLONG, runtime/libI77/lio.h really means ! "whatever size an ftnint is". For consistency and sanity, ! com.h and runtime/f2c.h.in agree that flag, ftnint, and ftlen ! all are INTEGER, which we also make out of whatever back-end ! integer type is FLOAT_TYPE_SIZE bits wide. This change, from ! LONG_TYPE_SIZE, for TYLONG and TYLOGICAL, was necessary to ! accommodate machines like the Alpha. Note that this suggests ! f2c and libf2c are missing a distinction perhaps needed on ! some machines between "int" and "long int". -- burley 0.5.5 950215 */ ! ffecom_f2c_set_lio_code_ (FFEINFO_basictypeINTEGER, FLOAT_TYPE_SIZE, ! FFETARGET_f2cTYLONG); ! ffecom_f2c_set_lio_code_ (FFEINFO_basictypeINTEGER, SHORT_TYPE_SIZE, ! FFETARGET_f2cTYSHORT); ! ffecom_f2c_set_lio_code_ (FFEINFO_basictypeINTEGER, CHAR_TYPE_SIZE, ! FFETARGET_f2cTYINT1); ! ffecom_f2c_set_lio_code_ (FFEINFO_basictypeINTEGER, LONG_LONG_TYPE_SIZE, ! FFETARGET_f2cTYQUAD); ! ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, FLOAT_TYPE_SIZE, ! FFETARGET_f2cTYLOGICAL); ! ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, SHORT_TYPE_SIZE, ! FFETARGET_f2cTYLOGICAL2); ! ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, CHAR_TYPE_SIZE, ! FFETARGET_f2cTYLOGICAL1); ! /* ~~~Not really such a type in libf2c, e.g. I/O support? */ ! ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, LONG_LONG_TYPE_SIZE, ! FFETARGET_f2cTYQUAD); ! /* CHARACTER stuff is all special-cased, so it is not handled in the above ! loop. CHARACTER items are built as arrays of unsigned char. */ ! ffecom_tree_type[FFEINFO_basictypeCHARACTER] ! [FFEINFO_kindtypeCHARACTER1] = t = char_type_node; ! type = ffetype_new (); ! base_type = type; ! ffeinfo_set_type (FFEINFO_basictypeCHARACTER, ! FFEINFO_kindtypeCHARACTER1, ! type); ! ffetype_set_ams (type, ! TYPE_ALIGN (t) / BITS_PER_UNIT, 0, ! TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT); ! ffetype_set_kind (base_type, 1, type); ! assert (ffetype_size (type) ! == sizeof (((ffetargetCharacter1) { 0, NULL }).text[0])); ! ffecom_tree_fun_type[FFEINFO_basictypeCHARACTER] ! [FFEINFO_kindtypeCHARACTER1] = ffecom_tree_fun_type_void; ! ffecom_tree_ptr_to_fun_type[FFEINFO_basictypeCHARACTER] ! [FFEINFO_kindtypeCHARACTER1] ! = ffecom_tree_ptr_to_fun_type_void; ! ffecom_f2c_typecode_[FFEINFO_basictypeCHARACTER][FFEINFO_kindtypeCHARACTER1] ! = FFETARGET_f2cTYCHAR; ! ffecom_f2c_typecode_[FFEINFO_basictypeANY][FFEINFO_kindtypeANY] ! = 0; ! /* Make multi-return-value type and fields. */ ! ffecom_multi_type_node_ = make_node (UNION_TYPE); ! field = NULL_TREE; ! for (i = 0; ((size_t) i) < ARRAY_SIZE (ffecom_tree_type); ++i) ! for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j) ! { ! char name[30]; ! if (ffecom_tree_type[i][j] == NULL_TREE) ! continue; /* Not supported. */ ! sprintf (&name[0], "bt_%s_kt_%s", ! ffeinfo_basictype_string ((ffeinfoBasictype) i), ! ffeinfo_kindtype_string ((ffeinfoKindtype) j)); ! ffecom_multi_fields_[i][j] = build_decl (FIELD_DECL, ! get_identifier (name), ! ffecom_tree_type[i][j]); ! DECL_CONTEXT (ffecom_multi_fields_[i][j]) ! = ffecom_multi_type_node_; ! DECL_FRAME_SIZE (ffecom_multi_fields_[i][j]) = 0; ! TREE_CHAIN (ffecom_multi_fields_[i][j]) = field; ! field = ffecom_multi_fields_[i][j]; ! } ! TYPE_FIELDS (ffecom_multi_type_node_) = field; ! layout_type (ffecom_multi_type_node_); ! /* Subroutines usually return integer because they might have alternate ! returns. */ ! ffecom_tree_subr_type ! = build_function_type (integer_type_node, NULL_TREE); ! ffecom_tree_ptr_to_subr_type ! = build_pointer_type (ffecom_tree_subr_type); ! ffecom_tree_blockdata_type ! = build_function_type (void_type_node, NULL_TREE); ! builtin_function ("__builtin_sqrtf", float_ftype_float, ! BUILT_IN_FSQRT, "sqrtf"); ! builtin_function ("__builtin_fsqrt", double_ftype_double, ! BUILT_IN_FSQRT, "sqrt"); ! builtin_function ("__builtin_sqrtl", ldouble_ftype_ldouble, ! BUILT_IN_FSQRT, "sqrtl"); ! builtin_function ("__builtin_sinf", float_ftype_float, ! BUILT_IN_SIN, "sinf"); ! builtin_function ("__builtin_sin", double_ftype_double, ! BUILT_IN_SIN, "sin"); ! builtin_function ("__builtin_sinl", ldouble_ftype_ldouble, ! BUILT_IN_SIN, "sinl"); ! builtin_function ("__builtin_cosf", float_ftype_float, ! BUILT_IN_COS, "cosf"); ! builtin_function ("__builtin_cos", double_ftype_double, ! BUILT_IN_COS, "cos"); ! builtin_function ("__builtin_cosl", ldouble_ftype_ldouble, ! BUILT_IN_COS, "cosl"); ! #if BUILT_FOR_270 ! pedantic_lvalues = FALSE; #endif ! ffecom_f2c_make_type_ (&ffecom_f2c_integer_type_node, ! FFECOM_f2cINTEGER, ! "integer"); ! ffecom_f2c_make_type_ (&ffecom_f2c_address_type_node, ! FFECOM_f2cADDRESS, ! "address"); ! ffecom_f2c_make_type_ (&ffecom_f2c_real_type_node, ! FFECOM_f2cREAL, ! "real"); ! ffecom_f2c_make_type_ (&ffecom_f2c_doublereal_type_node, ! FFECOM_f2cDOUBLEREAL, ! "doublereal"); ! ffecom_f2c_make_type_ (&ffecom_f2c_complex_type_node, ! FFECOM_f2cCOMPLEX, ! "complex"); ! ffecom_f2c_make_type_ (&ffecom_f2c_doublecomplex_type_node, ! FFECOM_f2cDOUBLECOMPLEX, ! "doublecomplex"); ! ffecom_f2c_make_type_ (&ffecom_f2c_longint_type_node, ! FFECOM_f2cLONGINT, ! "longint"); ! ffecom_f2c_make_type_ (&ffecom_f2c_logical_type_node, ! FFECOM_f2cLOGICAL, ! "logical"); ! ffecom_f2c_make_type_ (&ffecom_f2c_flag_type_node, ! FFECOM_f2cFLAG, ! "flag"); ! ffecom_f2c_make_type_ (&ffecom_f2c_ftnlen_type_node, ! FFECOM_f2cFTNLEN, ! "ftnlen"); ! ffecom_f2c_make_type_ (&ffecom_f2c_ftnint_type_node, ! FFECOM_f2cFTNINT, ! "ftnint"); ! ffecom_f2c_ftnlen_zero_node ! = convert (ffecom_f2c_ftnlen_type_node, integer_zero_node); ! ffecom_f2c_ftnlen_one_node ! = convert (ffecom_f2c_ftnlen_type_node, integer_one_node); ! ffecom_f2c_ftnlen_two_node = build_int_2 (2, 0); ! TREE_TYPE (ffecom_f2c_ftnlen_two_node) = ffecom_integer_type_node; ! ffecom_f2c_ptr_to_ftnlen_type_node ! = build_pointer_type (ffecom_f2c_ftnlen_type_node); ! ffecom_f2c_ptr_to_ftnint_type_node ! = build_pointer_type (ffecom_f2c_ftnint_type_node); ! ffecom_f2c_ptr_to_integer_type_node ! = build_pointer_type (ffecom_f2c_integer_type_node); ! ffecom_f2c_ptr_to_real_type_node ! = build_pointer_type (ffecom_f2c_real_type_node); ! ffecom_float_zero_ = build_real (float_type_node, dconst0); ! ffecom_double_zero_ = build_real (double_type_node, dconst0); ! { ! 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); ! } ! /* Do "extern int xargc;". */ ! ffecom_tree_xargc_ = build_decl (VAR_DECL, ! get_identifier ("f__xargc"), ! integer_type_node); ! DECL_EXTERNAL (ffecom_tree_xargc_) = 1; ! TREE_STATIC (ffecom_tree_xargc_) = 1; ! TREE_PUBLIC (ffecom_tree_xargc_) = 1; ! ffecom_tree_xargc_ = start_decl (ffecom_tree_xargc_, FALSE); ! finish_decl (ffecom_tree_xargc_, NULL_TREE, FALSE); + #if 0 /* This is being fixed, and seems to be working now. */ + if ((FLOAT_TYPE_SIZE != 32) + || (TREE_INT_CST_LOW (TYPE_SIZE (TREE_TYPE (null_pointer_node))) != 32)) + { + warning ("configuration: REAL, INTEGER, and LOGICAL are %d bits wide,", + (int) FLOAT_TYPE_SIZE); + warning ("and pointers are %d bits wide, but g77 doesn't yet work", + (int) TREE_INT_CST_LOW (TYPE_SIZE (TREE_TYPE (null_pointer_node)))); + warning ("properly unless they all are 32 bits wide."); + warning ("Please keep this in mind before you report bugs. g77 should"); + warning ("support non-32-bit machines better as of version 0.6."); + } #endif + #if 0 /* Code in ste.c that would crash has been commented out. */ + if (TYPE_PRECISION (ffecom_f2c_ftnlen_type_node) + < TYPE_PRECISION (string_type_node)) + /* I/O will probably crash. */ + warning ("configuration: char * holds %d bits, but ftnlen only %d", + TYPE_PRECISION (string_type_node), + TYPE_PRECISION (ffecom_f2c_ftnlen_type_node)); #endif + #if 0 /* ASSIGN-related stuff has been changed to accommodate this. */ + if (TYPE_PRECISION (ffecom_integer_type_node) + < TYPE_PRECISION (string_type_node)) + /* ASSIGN 10 TO I will crash. */ + warning ("configuration: char * holds %d bits, but INTEGER only %d --\n\ + ASSIGN statement might fail", + TYPE_PRECISION (string_type_node), + TYPE_PRECISION (ffecom_integer_type_node)); #endif } #endif ! /* ffecom_init_2 -- Initialize ! ! ffecom_init_2(); */ #if FFECOM_targetCURRENT == FFECOM_targetGCC void ! ffecom_init_2 () { assert (ffecom_outer_function_decl_ == NULL_TREE); assert (current_function_decl == NULL_TREE); + assert (ffecom_which_entrypoint_decl_ == NULL_TREE); ! ffecom_master_arglist_ = NULL; ! ++ffecom_num_fns_; ! ffecom_primary_entry_ = NULL; ! ffecom_is_altreturning_ = FALSE; ! ffecom_func_result_ = NULL_TREE; ! ffecom_multi_retval_ = NULL_TREE; } #endif ! /* ffecom_list_expr -- Transform list of exprs into gcc tree ! tree t; ! ffebld expr; // FFE opITEM list. ! tree = ffecom_list_expr(expr); ! List of actual args is transformed into corresponding gcc backend list. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC tree ! ffecom_list_expr (ffebld expr) { ! tree list; ! tree *plist = &list; ! tree trail = NULL_TREE; /* Append char length args here. */ ! tree *ptrail = &trail; ! tree length; ! while (expr != NULL) { ! tree texpr = ffecom_arg_expr (ffebld_head (expr), &length); ! if (texpr == error_mark_node) ! return error_mark_node; ! *plist = build_tree_list (NULL_TREE, texpr); ! plist = &TREE_CHAIN (*plist); ! expr = ffebld_trail (expr); ! if (length != NULL_TREE) ! { ! *ptrail = build_tree_list (NULL_TREE, length); ! ptrail = &TREE_CHAIN (*ptrail); ! } ! } ! *plist = trail; ! return list; ! } ! #endif ! /* ffecom_list_ptr_to_expr -- Transform list of exprs into gcc tree ! tree t; ! ffebld expr; // FFE opITEM list. ! tree = ffecom_list_ptr_to_expr(expr); ! List of actual args is transformed into corresponding gcc backend list for ! use in calling an external procedure (vs. a statement function). */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_list_ptr_to_expr (ffebld expr) { ! tree list; ! tree *plist = &list; ! tree trail = NULL_TREE; /* Append char length args here. */ ! tree *ptrail = &trail; ! tree length; ! while (expr != NULL) { ! tree texpr = ffecom_arg_ptr_to_expr (ffebld_head (expr), &length); ! if (texpr == error_mark_node) ! return error_mark_node; ! *plist = build_tree_list (NULL_TREE, texpr); ! plist = &TREE_CHAIN (*plist); ! expr = ffebld_trail (expr); ! if (length != NULL_TREE) { ! *ptrail = build_tree_list (NULL_TREE, length); ! ptrail = &TREE_CHAIN (*ptrail); } } ! *plist = trail; ! return list; ! } #endif + /* Obtain gcc's LABEL_DECL tree for label. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_lookup_label (ffelab label) ! { ! tree glabel; ! if (ffelab_hook (label) == NULL_TREE) ! { ! char labelname[16]; ! switch (ffelab_type (label)) ! { ! case FFELAB_typeLOOPEND: ! case FFELAB_typeNOTLOOP: ! case FFELAB_typeENDIF: ! sprintf (labelname, "%" ffelabValue_f "u", ffelab_value (label)); ! glabel = build_decl (LABEL_DECL, get_identifier (labelname), ! void_type_node); ! DECL_CONTEXT (glabel) = current_function_decl; ! DECL_MODE (glabel) = VOIDmode; ! break; ! case FFELAB_typeFORMAT: ! push_obstacks_nochange (); ! end_temporary_allocation (); ! glabel = build_decl (VAR_DECL, ! ffecom_get_invented_identifier ! ("__g77_format_%d", NULL, ! (int) ffelab_value (label)), ! build_type_variant (build_array_type ! (char_type_node, ! NULL_TREE), ! 1, 0)); ! TREE_CONSTANT (glabel) = 1; ! TREE_STATIC (glabel) = 1; ! DECL_CONTEXT (glabel) = 0; ! DECL_INITIAL (glabel) = NULL; ! make_decl_rtl (glabel, NULL, 0); ! expand_decl (glabel); ! resume_temporary_allocation (); ! pop_obstacks (); ! break; ! case FFELAB_typeANY: ! glabel = error_mark_node; ! break; ! default: ! assert ("bad label type" == NULL); ! glabel = NULL; ! break; ! } ! ffelab_set_hook (label, glabel); ! } ! else ! { ! glabel = ffelab_hook (label); ! } ! return glabel; ! } ! #endif ! /* Stabilizes the arguments. Don't use this if the lhs and rhs come from ! a single source specification (as in the fourth argument of MVBITS). ! If the type is NULL_TREE, the type of lhs is used to make the type of ! the MODIFY_EXPR. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_modify (tree newtype, tree lhs, ! tree rhs) ! { ! if (lhs == error_mark_node || rhs == error_mark_node) ! return error_mark_node; ! if (newtype == NULL_TREE) ! newtype = TREE_TYPE (lhs); ! if (TREE_SIDE_EFFECTS (lhs)) ! lhs = stabilize_reference (lhs); ! return ffecom_2s (MODIFY_EXPR, newtype, lhs, rhs); ! } ! #endif ! ! /* Register source file name. */ ! ! void ! ffecom_file (char *name) ! { ! #if FFECOM_GCC_INCLUDE ! ffecom_file_ (name); ! #endif ! } ! ! /* ffecom_notify_init_storage -- An aggregate storage is now fully init'ed ! ! ffestorag st; ! ffecom_notify_init_storage(st); ! Gets called when all possible units in an aggregate storage area (a LOCAL ! with equivalences or a COMMON) have been initialized. The initialization ! info either is in ffestorag_init or, if that is NULL, ! ffestorag_accretion: ! ffestorag_init may contain an opCONTER or opARRTER. opCONTER may occur ! even for an array if the array is one element in length! ! ffestorag_accretion will contain an opACCTER. It is much like an ! opARRTER except it has an ffebit object in it instead of just a size. ! The back end can use the info in the ffebit object, if it wants, to ! reduce the amount of actual initialization, but in any case it should ! kill the ffebit object when done. Also, set accretion to NULL but ! init to a non-NULL value. ! After performing initialization, DO NOT set init to NULL, because that'll ! tell the front end it is ok for more initialization to happen. Instead, ! set init to an opANY expression or some such thing that you can use to ! tell that you've already initialized the object. ! 27-Oct-91 JCB 1.1 ! Support two-pass FFE. */ ! void ! ffecom_notify_init_storage (ffestorag st) ! { ! ffebld init; /* The initialization expression. */ ! #if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC ! ffetargetOffset size; /* The size of the entity. */ ! ffetargetAlign pad; /* Its initial padding. */ ! #endif ! if (ffestorag_init (st) == NULL) ! { ! init = ffestorag_accretion (st); ! assert (init != NULL); ! ffestorag_set_accretion (st, NULL); ! ffestorag_set_accretes (st, 0); ! #if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC ! /* For GNU backend, just turn ACCTER into ARRTER and proceed. */ ! size = ffebld_accter_size (init); ! pad = ffebld_accter_pad (init); ! ffebit_kill (ffebld_accter_bits (init)); ! ffebld_set_op (init, FFEBLD_opARRTER); ! ffebld_set_arrter (init, ffebld_accter (init)); ! ffebld_arrter_set_size (init, size); ! ffebld_arrter_set_pad (init, size); ! #endif ! #if FFECOM_TWOPASS ! ffestorag_set_init (st, init); ! #endif ! } ! #if FFECOM_ONEPASS ! else ! init = ffestorag_init (st); ! #endif ! #if FFECOM_ONEPASS /* Process the inits, wipe 'em out. */ ! ffestorag_set_init (st, ffebld_new_any ()); ! if (ffebld_op (init) == FFEBLD_opANY) ! return; /* Oh, we already did this! */ ! #if FFECOM_targetCURRENT == FFECOM_targetFFE ! { ! ffesymbol s; ! if (ffestorag_symbol (st) != NULL) ! s = ffestorag_symbol (st); ! else ! s = ffestorag_typesymbol (st); ! fprintf (dmpout, "= initialize_storage \"%s\" ", ! (s != NULL) ? ffesymbol_text (s) : "(unnamed)"); ! ffebld_dump (init); ! fputc ('\n', dmpout); ! } ! #endif ! #endif /* if FFECOM_ONEPASS */ ! } ! /* ffecom_notify_init_symbol -- A symbol is now fully init'ed ! ffesymbol s; ! ffecom_notify_init_symbol(s); ! Gets called when all possible units in a symbol (not placed in COMMON ! or involved in EQUIVALENCE, unless it as yet has no ffestorag object) ! have been initialized. The initialization info either is in ! ffesymbol_init or, if that is NULL, ffesymbol_accretion: ! ffesymbol_init may contain an opCONTER or opARRTER. opCONTER may occur ! even for an array if the array is one element in length! ! ffesymbol_accretion will contain an opACCTER. It is much like an ! opARRTER except it has an ffebit object in it instead of just a size. ! The back end can use the info in the ffebit object, if it wants, to ! reduce the amount of actual initialization, but in any case it should ! kill the ffebit object when done. Also, set accretion to NULL but ! init to a non-NULL value. ! After performing initialization, DO NOT set init to NULL, because that'll ! tell the front end it is ok for more initialization to happen. Instead, ! set init to an opANY expression or some such thing that you can use to ! tell that you've already initialized the object. ! 27-Oct-91 JCB 1.1 ! Support two-pass FFE. */ ! void ! ffecom_notify_init_symbol (ffesymbol s) ! { ! ffebld init; /* The initialization expression. */ ! #if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC ! ffetargetOffset size; /* The size of the entity. */ ! ffetargetAlign pad; /* Its initial padding. */ ! #endif ! if (ffesymbol_storage (s) == NULL) ! return; /* Do nothing until COMMON/EQUIVALENCE ! possibilities checked. */ ! if ((ffesymbol_init (s) == NULL) ! && ((init = ffesymbol_accretion (s)) != NULL)) ! { ! ffesymbol_set_accretion (s, NULL); ! ffesymbol_set_accretes (s, 0); ! #if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC ! /* For GNU backend, just turn ACCTER into ARRTER and proceed. */ ! size = ffebld_accter_size (init); ! pad = ffebld_accter_pad (init); ! ffebit_kill (ffebld_accter_bits (init)); ! ffebld_set_op (init, FFEBLD_opARRTER); ! ffebld_set_arrter (init, ffebld_accter (init)); ! ffebld_arrter_set_size (init, size); ! ffebld_arrter_set_pad (init, size); ! #endif ! #if FFECOM_TWOPASS ! ffesymbol_set_init (s, init); ! #endif } + #if FFECOM_ONEPASS + else + init = ffesymbol_init (s); #endif ! #if FFECOM_ONEPASS ! ffesymbol_set_init (s, ffebld_new_any ()); ! if (ffebld_op (init) == FFEBLD_opANY) ! return; /* Oh, we already did this! */ ! #if FFECOM_targetCURRENT == FFECOM_targetFFE ! fprintf (dmpout, "= initialize_symbol \"%s\" ", ffesymbol_text (s)); ! ffebld_dump (init); ! fputc ('\n', dmpout); ! #endif ! #endif /* if FFECOM_ONEPASS */ ! } ! /* ffecom_notify_primary_entry -- Learn which is the primary entry point ! ffesymbol s; ! ffecom_notify_primary_entry(s); ! Gets called when implicit or explicit PROGRAM statement seen or when ! FUNCTION, SUBROUTINE, or BLOCK DATA statement seen, with the primary ! global symbol that serves as the entry point. */ ! void ! ffecom_notify_primary_entry (ffesymbol s) ! { ! ffecom_primary_entry_ = s; ! ffecom_primary_entry_kind_ = ffesymbol_kind (s); ! if ((ffecom_primary_entry_kind_ == FFEINFO_kindFUNCTION) ! || (ffecom_primary_entry_kind_ == FFEINFO_kindSUBROUTINE)) ! ffecom_primary_entry_is_proc_ = TRUE; ! else ! ffecom_primary_entry_is_proc_ = FALSE; ! if (!ffe_is_silent ()) ! { ! if (ffecom_primary_entry_kind_ == FFEINFO_kindPROGRAM) ! fprintf (stderr, "%s:\n", ffesymbol_text (s)); ! else ! fprintf (stderr, " %s:\n", ffesymbol_text (s)); ! } ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! if (ffecom_primary_entry_kind_ == FFEINFO_kindSUBROUTINE) ! { ! ffebld list; ! ffebld arg; ! for (list = ffesymbol_dummyargs (s); ! list != NULL; ! list = ffebld_trail (list)) ! { ! arg = ffebld_head (list); ! if (ffebld_op (arg) == FFEBLD_opSTAR) ! { ! ffecom_is_altreturning_ = TRUE; ! break; ! } ! } ! } ! #endif ! } ! FILE * ! ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c) ! { ! #if FFECOM_GCC_INCLUDE ! return ffecom_open_include_ (name, l, c); ! #else ! return fopen (name, "r"); ! #endif ! } ! /* ffecom_ptr_to_expr -- Transform expr into gcc tree with & in front ! tree t; ! ffebld expr; // FFE expression. ! tree = ffecom_ptr_to_expr(expr); ! Like ffecom_expr, but sticks address-of in front of most things. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_ptr_to_expr (ffebld expr) ! { ! tree item; ! ffeinfoBasictype bt; ! ffeinfoKindtype kt; ! ffesymbol s; ! assert (expr != NULL); ! switch (ffebld_op (expr)) ! { ! case FFEBLD_opSYMTER: ! s = ffebld_symter (expr); ! if (ffesymbol_where (s) == FFEINFO_whereINTRINSIC) ! { ! ffecomGfrt ix; ! ix = ffeintrin_gfrt_indirect (ffebld_symter_implementation (expr)); ! assert (ix != FFECOM_gfrt); ! if ((item = ffecom_gfrt_[ix]) == NULL_TREE) ! { ! ffecom_make_gfrt_ (ix); ! item = ffecom_gfrt_[ix]; ! } ! } ! else ! { ! item = ffesymbol_hook (s).decl_tree; ! if (item == NULL_TREE) ! { ! s = ffecom_sym_transform_ (s); ! item = ffesymbol_hook (s).decl_tree; ! } ! } ! assert (item != NULL); ! if (item == error_mark_node) ! return item; ! if (!ffesymbol_hook (s).addr) ! item = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (item)), ! item); ! return item; ! case FFEBLD_opARRAYREF: ! return ffecom_arrayref_ (NULL_TREE, expr, 1); ! case FFEBLD_opCONTER: ! bt = ffeinfo_basictype (ffebld_info (expr)); ! kt = ffeinfo_kindtype (ffebld_info (expr)); ! item = ffecom_constantunion (&ffebld_constant_union ! (ffebld_conter (expr)), bt, kt, ! ffecom_tree_type[bt][kt]); ! if (item == error_mark_node) ! return error_mark_node; ! item = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (item)), ! item); ! return item; ! case FFEBLD_opANY: ! return error_mark_node; ! default: ! bt = ffeinfo_basictype (ffebld_info (expr)); ! kt = ffeinfo_kindtype (ffebld_info (expr)); ! item = ffecom_expr (expr); ! if (item == error_mark_node) ! return error_mark_node; ! /* The back end currently optimizes a bit too zealously for us, in that ! we fail JCB001 if the following block of code is omitted. It checks ! to see if the transformed expression is a symbol or array reference, ! and encloses it in a SAVE_EXPR if that is the case. */ ! STRIP_NOPS (item); ! if ((TREE_CODE (item) == VAR_DECL) ! || (TREE_CODE (item) == PARM_DECL) ! || (TREE_CODE (item) == RESULT_DECL) ! || (TREE_CODE (item) == INDIRECT_REF) ! || (TREE_CODE (item) == ARRAY_REF) ! || (TREE_CODE (item) == COMPONENT_REF) ! #ifdef OFFSET_REF ! || (TREE_CODE (item) == OFFSET_REF) ! #endif ! || (TREE_CODE (item) == BUFFER_REF) ! || (TREE_CODE (item) == REALPART_EXPR) ! || (TREE_CODE (item) == IMAGPART_EXPR)) ! { ! item = ffecom_save_tree (item); ! } ! item = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (item)), ! item); ! return item; ! } ! assert ("fall-through error" == NULL); ! return error_mark_node; ! } ! #endif ! /* Obtain a temp var with given data type. ! size is FFETARGET_charactersizeNONE for a non-CHARACTER type ! or >= 0 for a CHARACTER type. ! elements is -1 for a scalar or > 0 for an array of type. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_make_tempvar (const char *commentary, tree type, ! ffetargetCharacterSize size, int elements) ! { ! int yes; ! tree t; ! static int mynumber; ! assert (current_binding_level->prep_state < 2); ! if (type == error_mark_node) ! return error_mark_node; ! yes = suspend_momentary (); ! if (size != FFETARGET_charactersizeNONE) ! type = build_array_type (type, ! build_range_type (ffecom_f2c_ftnlen_type_node, ! ffecom_f2c_ftnlen_one_node, ! build_int_2 (size, 0))); ! if (elements != -1) ! type = build_array_type (type, ! build_range_type (integer_type_node, ! integer_zero_node, ! build_int_2 (elements - 1, ! 0))); ! t = build_decl (VAR_DECL, ! ffecom_get_invented_identifier ("__g77_%s_%d", ! commentary, ! mynumber++), ! type); ! t = start_decl (t, FALSE); ! finish_decl (t, NULL_TREE, FALSE); ! resume_momentary (yes); ! ! return t; ! } #endif ! /* Prepare argument pointer to expression. ! Like ffecom_prepare_expr, except for expressions to be evaluated ! via ffecom_arg_ptr_to_expr. */ ! void ! ffecom_prepare_arg_ptr_to_expr (ffebld expr) ! { ! /* ~~For now, it seems to be the same thing. */ ! ffecom_prepare_expr (expr); ! return; ! } ! /* End of preparations. */ ! bool ! ffecom_prepare_end (void) ! { ! int prep_state = current_binding_level->prep_state; ! ! assert (prep_state < 2); ! current_binding_level->prep_state = 2; ! ! return (prep_state == 1) ? TRUE : FALSE; } ! /* Prepare expression. ! This is called before any code is generated for the current block. ! It scans the expression, declares any temporaries that might be needed ! during evaluation of the expression, and stores those temporaries in ! the appropriate "hook" fields of the expression. `dest', if not NULL, ! specifies the destination that ffecom_expr_ will see, in case that ! helps avoid generating unused temporaries. ! ! ~~Improve to avoid allocating unused temporaries by taking `dest' ! into account vis-a-vis aliasing requirements of complex/character ! functions. */ void ! ffecom_prepare_expr_ (ffebld expr, ffebld dest UNUSED) { ! ffeinfoBasictype bt; ! ffeinfoKindtype kt; ! ffetargetCharacterSize sz; ! tree tempvar = NULL_TREE; ! assert (current_binding_level->prep_state < 2); ! if (! expr) ! return; ! bt = ffeinfo_basictype (ffebld_info (expr)); ! kt = ffeinfo_kindtype (ffebld_info (expr)); ! sz = ffeinfo_size (ffebld_info (expr)); ! /* Generate whatever temporaries are needed to represent the result ! of the expression. */ ! if (bt == FFEINFO_basictypeCHARACTER) ! { ! while (ffebld_op (expr) == FFEBLD_opPAREN) ! expr = ffebld_left (expr); ! } ! switch (ffebld_op (expr)) { ! default: ! /* Don't make temps for SYMTER, CONTER, etc. */ ! if (ffebld_arity (expr) == 0) ! break; ! ! switch (bt) { ! case FFEINFO_basictypeCOMPLEX: ! if (ffebld_op (expr) == FFEBLD_opFUNCREF) ! { ! ffesymbol s; ! if (ffebld_op (ffebld_left (expr)) != FFEBLD_opSYMTER) ! break; ! s = ffebld_symter (ffebld_left (expr)); ! if (ffesymbol_where (s) == FFEINFO_whereCONSTANT ! || (ffesymbol_where (s) != FFEINFO_whereINTRINSIC ! && ! ffesymbol_is_f2c (s)) ! || (ffesymbol_where (s) == FFEINFO_whereINTRINSIC ! && ! ffe_is_f2c_library ())) ! break; ! } ! else if (ffebld_op (expr) == FFEBLD_opPOWER) ! { ! /* Requires special treatment. There's no POW_CC function ! in libg2c, so POW_ZZ is used, which means we always ! need a double-complex temp, not a single-complex. */ ! kt = FFEINFO_kindtypeREAL2; ! } ! else if (ffebld_op (expr) != FFEBLD_opDIVIDE) ! /* The other ops don't need temps for complex operands. */ ! break; ! /* ~~~Avoid making temps for some intrinsics, such as AIMAG(C), ! REAL(C). See 19990325-0.f, routine `check', for cases. */ ! tempvar = ffecom_make_tempvar ("complex", ! ffecom_tree_type ! [FFEINFO_basictypeCOMPLEX][kt], ! FFETARGET_charactersizeNONE, ! -1); ! break; ! case FFEINFO_basictypeCHARACTER: ! if (ffebld_op (expr) != FFEBLD_opFUNCREF) ! break; ! if (sz == FFETARGET_charactersizeNONE) ! /* ~~Kludge alert! This should someday be fixed. */ ! sz = 24; ! tempvar = ffecom_make_tempvar ("char", char_type_node, sz, -1); ! break; ! default: ! break; } ! 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 ! is needed for a tree of these -- the tree is treated as ! a flattened list of concatenations when generating code. */ ! ! ffecomConcatList_ catlist; ! tree ltmp, itmp, result; ! int count; ! int i; ! catlist = ffecom_concat_list_new_ (expr, FFETARGET_charactersizeNONE); ! count = ffecom_concat_list_count_ (catlist); ! ! if (count >= 2) ! { ! ltmp ! = ffecom_make_tempvar ("concat_len", ! ffecom_f2c_ftnlen_type_node, ! FFETARGET_charactersizeNONE, count); ! itmp ! = ffecom_make_tempvar ("concat_item", ! ffecom_f2c_address_type_node, ! FFETARGET_charactersizeNONE, count); ! result ! = ffecom_make_tempvar ("concat_res", ! char_type_node, ! ffecom_concat_list_maxlen_ (catlist), ! -1); ! ! tempvar = make_tree_vec (3); ! TREE_VEC_ELT (tempvar, 0) = ltmp; ! TREE_VEC_ELT (tempvar, 1) = itmp; ! TREE_VEC_ELT (tempvar, 2) = result; ! } ! ! for (i = 0; i < count; ++i) ! ffecom_prepare_arg_ptr_to_expr (ffecom_concat_list_expr_ (catlist, ! i)); ! ! ffecom_concat_list_kill_ (catlist); ! ! if (tempvar) ! { ! ffebld_nonter_set_hook (expr, tempvar); ! current_binding_level->prep_state = 1; ! } ! } ! return; ! ! case FFEBLD_opCONVERT: ! if (bt == FFEINFO_basictypeCHARACTER ! && ((ffebld_size_known (ffebld_left (expr)) ! == FFETARGET_charactersizeNONE) ! || (ffebld_size_known (ffebld_left (expr)) >= sz))) ! tempvar = ffecom_make_tempvar ("convert", char_type_node, sz, -1); ! break; ! } ! ! if (tempvar) { ! ffebld_nonter_set_hook (expr, tempvar); ! current_binding_level->prep_state = 1; ! } ! /* Prepare subexpressions for this expr. */ ! switch (ffebld_op (expr)) ! { ! case FFEBLD_opPERCENT_LOC: ! ffecom_prepare_ptr_to_expr (ffebld_left (expr)); ! break; ! case FFEBLD_opPERCENT_VAL: ! case FFEBLD_opPERCENT_REF: ! ffecom_prepare_expr (ffebld_left (expr)); ! break; ! case FFEBLD_opPERCENT_DESCR: ! ffecom_prepare_arg_ptr_to_expr (ffebld_left (expr)); ! break; ! ! case FFEBLD_opITEM: ! { ! ffebld item; ! ! for (item = expr; ! item != NULL; ! item = ffebld_trail (item)) ! if (ffebld_head (item) != NULL) ! ffecom_prepare_expr (ffebld_head (item)); ! } ! break; + default: + /* Need to handle character conversion specially. */ + switch (ffebld_arity (expr)) + { + case 2: + ffecom_prepare_expr (ffebld_left (expr)); + ffecom_prepare_expr (ffebld_right (expr)); break; ! case 1: ! ffecom_prepare_expr (ffebld_left (expr)); break; default: break; } } ! return; } ! /* Prepare expression for reading and writing. ! Like ffecom_prepare_expr, except for expressions to be evaluated ! via ffecom_expr_rw. */ ! void ! ffecom_prepare_expr_rw (tree type, ffebld expr) ! { ! /* This is all we support for now. */ ! assert (type == NULL_TREE || type == ffecom_type_expr (expr)); ! /* ~~For now, it seems to be the same thing. */ ! ffecom_prepare_expr (expr); ! return; } ! /* Prepare expression for writing. ! Like ffecom_prepare_expr, except for expressions to be evaluated ! via ffecom_expr_w. */ void ! ffecom_prepare_expr_w (tree type, ffebld expr) { ! /* This is all we support for now. */ ! assert (type == NULL_TREE || type == ffecom_type_expr (expr)); ! /* ~~For now, it seems to be the same thing. */ ! ffecom_prepare_expr (expr); ! return; ! } ! /* Prepare expression for returning. ! Like ffecom_prepare_expr, except for expressions to be evaluated ! via ffecom_return_expr. */ void ! ffecom_prepare_return_expr (ffebld expr) { ! assert (current_binding_level->prep_state < 2); ! if (ffecom_primary_entry_kind_ == FFEINFO_kindSUBROUTINE ! && ffecom_is_altreturning_ ! && expr != NULL) ! ffecom_prepare_expr (expr); } ! /* Prepare pointer to expression. ! Like ffecom_prepare_expr, except for expressions to be evaluated ! via ffecom_ptr_to_expr. */ ! void ! ffecom_prepare_ptr_to_expr (ffebld expr) ! { ! /* ~~For now, it seems to be the same thing. */ ! ffecom_prepare_expr (expr); ! return; ! } ! /* Transform expression into constant pointer-to-expression tree. ! If the expression can be transformed into a pointer-to-expression tree ! that is constant, that is done, and the tree returned. Else NULL_TREE ! is returned. ! ! That way, a caller can attempt to provide compile-time initialization ! of a variable and, if that fails, *then* choose to start a new block ! and resort to using temporaries, as appropriate. */ ! tree ! ffecom_ptr_to_const_expr (ffebld expr) { ! if (! expr) ! return integer_zero_node; ! if (ffebld_op (expr) == FFEBLD_opANY) ! return error_mark_node; ! if (ffebld_arity (expr) == 0 ! && (ffebld_op (expr) != FFEBLD_opSYMTER ! || ffebld_where (expr) == FFEINFO_whereCOMMON ! || ffebld_where (expr) == FFEINFO_whereGLOBAL ! || ffebld_where (expr) == FFEINFO_whereINTRINSIC)) { ! tree t; ! t = ffecom_ptr_to_expr (expr); ! assert (TREE_CONSTANT (t)); ! return t; } ! return NULL_TREE; } ! /* ffecom_return_expr -- Returns return-value expr given alt return expr ! tree rtn; // NULL_TREE means use expand_null_return() ! ffebld expr; // NULL if no alt return expr to RETURN stmt ! rtn = ffecom_return_expr(expr); ! Based on the program unit type and other info (like return function ! type, return master function type when alternate ENTRY points, ! whether subroutine has any alternate RETURN points, etc), returns the ! appropriate expression to be returned to the caller, or NULL_TREE ! meaning no return value or the caller expects it to be returned somewhere ! else (which is handled by other parts of this module). */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_return_expr (ffebld expr) { ! tree rtn; ! switch (ffecom_primary_entry_kind_) { ! case FFEINFO_kindPROGRAM: ! case FFEINFO_kindBLOCKDATA: ! rtn = NULL_TREE; ! break; ! ! case FFEINFO_kindSUBROUTINE: ! if (!ffecom_is_altreturning_) ! rtn = NULL_TREE; /* No alt returns, never an expr. */ ! else if (expr == NULL) ! rtn = integer_zero_node; else ! rtn = ffecom_expr (expr); ! break; ! case FFEINFO_kindFUNCTION: ! if ((ffecom_multi_retval_ != NULL_TREE) ! || (ffesymbol_basictype (ffecom_primary_entry_) ! == FFEINFO_basictypeCHARACTER) ! || ((ffesymbol_basictype (ffecom_primary_entry_) ! == FFEINFO_basictypeCOMPLEX) ! && (ffecom_num_entrypoints_ == 0) ! && ffesymbol_is_f2c (ffecom_primary_entry_))) ! { /* Value is returned by direct assignment ! into (implicit) dummy. */ ! rtn = NULL_TREE; ! break; ! } ! rtn = ffecom_func_result_; ! #if 0 ! /* Spurious error if RETURN happens before first reference! So elide ! this code. In particular, for debugging registry, rtn should always ! be non-null after all, but TREE_USED won't be set until we encounter ! a reference in the code. Perfectly okay (but weird) code that, ! e.g., has "GOTO 20;10 RETURN;20 RTN=0;GOTO 10", would result in ! this diagnostic for no reason. Have people use -O -Wuninitialized ! and leave it to the back end to find obviously weird cases. */ ! /* Used to "assert(rtn != NULL_TREE);" here, but it's kind of a valid ! situation; if the return value has never been referenced, it won't ! have a tree under 2pass mode. */ ! if ((rtn == NULL_TREE) ! || !TREE_USED (rtn)) { ! ffebad_start (FFEBAD_RETURN_VALUE_UNSET); ! ffebad_here (0, ffesymbol_where_line (ffecom_primary_entry_), ! ffesymbol_where_column (ffecom_primary_entry_)); ! ffebad_string (ffesymbol_text (ffesymbol_funcresult ! (ffecom_primary_entry_))); ! ffebad_finish (); } #endif ! break; ! default: ! assert ("bad unit kind" == NULL); ! case FFEINFO_kindANY: ! rtn = error_mark_node; ! break; ! } ! return rtn; ! } ! #endif ! /* Do save_expr only if tree is not error_mark_node. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_save_tree (tree t) { ! return save_expr (t); } #endif ! ! /* Start a compound statement (block). */ #if FFECOM_targetCURRENT == FFECOM_targetGCC void ! ffecom_start_compstmt (void) { ! bison_rule_pushlevel_ (); ! } ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ ! /* Public entry point for front end to access start_decl. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_start_decl (tree decl, bool is_initialized) ! { ! DECL_INITIAL (decl) = is_initialized ? error_mark_node : NULL_TREE; ! return start_decl (decl, FALSE); } #endif ! /* ffecom_sym_commit -- Symbol's state being committed to reality ! ffesymbol s; ! ffecom_sym_commit(s); ! Does whatever the backend needs when a symbol is committed after having ! been backtrackable for a period of time. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! void ! ffecom_sym_commit (ffesymbol s UNUSED) { ! assert (!ffesymbol_retractable ()); ! } ! #endif ! /* ffecom_sym_end_transition -- Perform end transition on all symbols ! ffecom_sym_end_transition(); ! Does backend-specific stuff and also calls ffest_sym_end_transition ! to do the necessary FFE stuff. ! Backtracking is never enabled when this fn is called, so don't worry ! about it. */ ! ffesymbol ! ffecom_sym_end_transition (ffesymbol s) ! { ! ffestorag st; ! assert (!ffesymbol_retractable ()); ! s = ffest_sym_end_transition (s); ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! if ((ffesymbol_kind (s) == FFEINFO_kindBLOCKDATA) ! && (ffesymbol_where (s) == FFEINFO_whereGLOBAL)) ! { ! ffecom_list_blockdata_ ! = ffebld_new_item (ffebld_new_symter (s, FFEINTRIN_genNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_impNONE), ! ffecom_list_blockdata_); ! } ! #endif ! /* This is where we finally notice that a symbol has partial initialization ! and finalize it. */ ! if (ffesymbol_accretion (s) != NULL) ! { ! assert (ffesymbol_init (s) == NULL); ! ffecom_notify_init_symbol (s); ! } ! else if (((st = ffesymbol_storage (s)) != NULL) ! && ((st = ffestorag_parent (st)) != NULL) ! && (ffestorag_accretion (st) != NULL)) ! { ! assert (ffestorag_init (st) == NULL); ! ffecom_notify_init_storage (st); ! } ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! if ((ffesymbol_kind (s) == FFEINFO_kindCOMMON) ! && (ffesymbol_where (s) == FFEINFO_whereLOCAL) ! && (ffesymbol_storage (s) != NULL)) ! { ! ffecom_list_common_ ! = ffebld_new_item (ffebld_new_symter (s, FFEINTRIN_genNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_impNONE), ! ffecom_list_common_); ! } ! #endif ! return s; ! } ! /* ffecom_sym_exec_transition -- Perform exec transition on all symbols ! ffecom_sym_exec_transition(); ! Does backend-specific stuff and also calls ffest_sym_exec_transition ! to do the necessary FFE stuff. ! See the long-winded description in ffecom_sym_learned for info ! on handling the situation where backtracking is inhibited. */ ! ffesymbol ! ffecom_sym_exec_transition (ffesymbol s) ! { ! s = ffest_sym_exec_transition (s); ! return s; } ! /* ffecom_sym_learned -- Initial or more info gained on symbol after exec ! ffesymbol s; ! s = ffecom_sym_learned(s); ! Called when a new symbol is seen after the exec transition or when more ! info (perhaps) is gained for an UNCERTAIN symbol. The symbol state when ! it arrives here is that all its latest info is updated already, so its ! state may be UNCERTAIN or UNDERSTOOD, it might already have the hook ! field filled in if its gone through here or exec_transition first, and ! so on. ! ! The backend probably wants to check ffesymbol_retractable() to see if ! backtracking is in effect. If so, the FFE's changes to the symbol may ! be retracted (undone) or committed (ratified), at which time the ! appropriate ffecom_sym_retract or _commit function will be called ! for that function. ! ! If the backend has its own backtracking mechanism, great, use it so that ! committal is a simple operation. Though it doesn't make much difference, ! I suppose: the reason for tentative symbol evolution in the FFE is to ! enable error detection in weird incorrect statements early and to disable ! incorrect error detection on a correct statement. The backend is not ! likely to introduce any information that'll get involved in these ! considerations, so it is probably just fine that the implementation ! model for this fn and for _exec_transition is to not do anything ! (besides the required FFE stuff) if ffesymbol_retractable() returns TRUE ! and instead wait until ffecom_sym_commit is called (which it never ! will be as long as we're using ambiguity-detecting statement analysis in ! the FFE, which we are initially to shake out the code, but don't depend ! on this), otherwise go ahead and do whatever is needed. ! ! In essence, then, when this fn and _exec_transition get called while ! backtracking is enabled, a general mechanism would be to flag which (or ! both) of these were called (and in what order? neat question as to what ! might happen that I'm too lame to think through right now) and then when ! _commit is called reproduce the original calling sequence, if any, for ! the two fns (at which point backtracking will, of course, be disabled). */ ! ! ffesymbol ! ffecom_sym_learned (ffesymbol s) { ! ffestorag_exec_layout (s); ! ! return s; } ! /* ffecom_sym_retract -- Symbol's state being retracted from reality ! ! ffesymbol s; ! ffecom_sym_retract(s); ! Does whatever the backend needs when a symbol is retracted after having ! been backtrackable for a period of time. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! void ! ffecom_sym_retract (ffesymbol s UNUSED) { ! assert (!ffesymbol_retractable ()); ! #if 0 /* GCC doesn't commit any backtrackable sins, ! so nothing needed here. */ ! switch (ffesymbol_hook (s).state) { ! case 0: /* nothing happened yet. */ ! break; ! case 1: /* exec transition happened. */ ! break; ! case 2: /* learned happened. */ ! break; ! case 3: /* learned then exec. */ ! break; ! case 4: /* exec then learned. */ ! break; ! default: ! assert ("bad hook state" == NULL); ! break; ! } ! #endif ! } ! #endif ! /* Create temporary gcc label. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_temp_label () ! { ! tree glabel; ! static int mynumber = 0; ! glabel = build_decl (LABEL_DECL, ! ffecom_get_invented_identifier ("__g77_label_%d", ! NULL, ! mynumber++), ! void_type_node); ! DECL_CONTEXT (glabel) = current_function_decl; ! DECL_MODE (glabel) = VOIDmode; ! return glabel; ! } ! #endif ! /* Return an expression that is usable as an arg in a conditional context ! (IF, DO WHILE, .NOT., and so on). ! Use the one provided for the back end as of >2.6.0. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_truth_value (tree expr) ! { ! return truthvalue_conversion (expr); } #endif ! /* Return the inversion of a truth value (the inversion of what ! ffecom_truth_value builds). ! Apparently invert_truthvalue, which is properly in the back end, is ! enough for now, so just use it. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC tree ! ffecom_truth_value_invert (tree expr) { ! return invert_truthvalue (ffecom_truth_value (expr)); ! } ! #endif ! /* Return the tree that is the type of the expression, as would be ! returned in TREE_TYPE(ffecom_expr(expr)), without otherwise ! transforming the expression, generating temporaries, etc. */ ! tree ! ffecom_type_expr (ffebld expr) ! { ! ffeinfoBasictype bt; ! ffeinfoKindtype kt; ! tree tree_type; ! assert (expr != NULL); ! ! bt = ffeinfo_basictype (ffebld_info (expr)); ! kt = ffeinfo_kindtype (ffebld_info (expr)); ! tree_type = ffecom_tree_type[bt][kt]; ! ! switch (ffebld_op (expr)) ! { ! case FFEBLD_opCONTER: ! case FFEBLD_opSYMTER: ! case FFEBLD_opARRAYREF: ! case FFEBLD_opUPLUS: ! case FFEBLD_opPAREN: ! case FFEBLD_opUMINUS: ! case FFEBLD_opADD: ! case FFEBLD_opSUBTRACT: ! case FFEBLD_opMULTIPLY: ! case FFEBLD_opDIVIDE: ! case FFEBLD_opPOWER: ! case FFEBLD_opNOT: ! case FFEBLD_opFUNCREF: ! case FFEBLD_opSUBRREF: ! case FFEBLD_opAND: ! case FFEBLD_opOR: ! case FFEBLD_opXOR: ! case FFEBLD_opNEQV: ! case FFEBLD_opEQV: ! case FFEBLD_opCONVERT: ! case FFEBLD_opLT: ! case FFEBLD_opLE: ! case FFEBLD_opEQ: ! case FFEBLD_opNE: ! case FFEBLD_opGT: ! case FFEBLD_opGE: ! case FFEBLD_opPERCENT_LOC: ! return tree_type; + case FFEBLD_opACCTER: + case FFEBLD_opARRTER: + case FFEBLD_opITEM: + case FFEBLD_opSTAR: + case FFEBLD_opBOUNDS: + case FFEBLD_opREPEAT: + case FFEBLD_opLABTER: + case FFEBLD_opLABTOK: + case FFEBLD_opIMPDO: + case FFEBLD_opCONCATENATE: + case FFEBLD_opSUBSTR: default: ! assert ("bad op for ffecom_type_expr" == NULL); ! /* Fall through. */ ! case FFEBLD_opANY: ! return error_mark_node; } } ! /* Return PARM_DECL for arg#1 of master fn containing alternate ENTRY points ! If the PARM_DECL already exists, return it, else create it. It's an ! integer_type_node argument for the master function that implements a ! subroutine or function with more than one entrypoint and is bound at ! run time with the entrypoint number (0 for SUBROUTINE/FUNCTION, 1 for ! first ENTRY statement, and so on). */ #if FFECOM_targetCURRENT == FFECOM_targetGCC tree ! ffecom_which_entrypoint_decl () { ! assert (ffecom_which_entrypoint_decl_ != NULL_TREE); ! ! return ffecom_which_entrypoint_decl_; } #endif ! ! /* The following sections consists of private and public functions ! that have the same names and perform roughly the same functions ! as counterparts in the C front end. Changes in the C front end ! might affect how things should be done here. Only functions ! needed by the back end should be public here; the rest should ! be private (static in the C sense). Functions needed by other ! g77 front-end modules should be accessed by them via public ! ffecom_* names, which should themselves call private versions ! in this section so the private versions are easy to recognize ! when upgrading to a new gcc and finding interesting changes ! in the front end. ! Functions named after rule "foo:" in c-parse.y are named ! "bison_rule_foo_" so they are easy to find. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! ! static void ! bison_rule_pushlevel_ () { ! emit_line_note (input_filename, lineno); ! pushlevel (0); ! clear_last_expr (); ! push_momentary (); ! expand_start_bindings (0); } ! static tree ! bison_rule_compstmt_ () { ! tree t; ! int keep = kept_level_p (); ! /* Make the temps go away. */ ! if (! keep) ! current_binding_level->names = NULL_TREE; ! emit_line_note (input_filename, lineno); ! expand_end_bindings (getdecls (), keep, 0); ! t = poplevel (keep, 1, 0); ! pop_momentary (); ! return t; ! } ! /* Return a definition for a builtin function named NAME and whose data type ! is TYPE. TYPE should be a function type with argument types. ! FUNCTION_CODE tells later passes how to compile calls to this function. ! 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. */ ! static tree ! builtin_function (const char *name, tree type, ! enum built_in_function function_code, ! const char *library_name) ! { ! tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type); ! DECL_EXTERNAL (decl) = 1; ! TREE_PUBLIC (decl) = 1; ! if (library_name) ! DECL_ASSEMBLER_NAME (decl) = get_identifier (library_name); ! make_decl_rtl (decl, NULL_PTR, 1); ! pushdecl (decl); ! if (function_code != NOT_BUILT_IN) { ! DECL_BUILT_IN (decl) = 1; ! DECL_FUNCTION_CODE (decl) = function_code; } ! return decl; } ! /* Handle when a new declaration NEWDECL ! has the same name as an old one OLDDECL ! in the same binding contour. ! Prints an error message if appropriate. ! If safely possible, alter OLDDECL to look like NEWDECL, and return 1. ! Otherwise, return 0. */ ! static int ! duplicate_decls (tree newdecl, tree olddecl) { ! int types_match = 1; ! int new_is_definition = (TREE_CODE (newdecl) == FUNCTION_DECL ! && DECL_INITIAL (newdecl) != 0); ! tree oldtype = TREE_TYPE (olddecl); ! tree newtype = TREE_TYPE (newdecl); ! if (olddecl == newdecl) ! return 1; ! if (TREE_CODE (newtype) == ERROR_MARK ! || TREE_CODE (oldtype) == ERROR_MARK) ! types_match = 0; ! /* New decl is completely inconsistent with the old one => ! tell caller to replace the old one. ! This is always an error except in the case of shadowing a builtin. */ ! if (TREE_CODE (olddecl) != TREE_CODE (newdecl)) ! return 0; ! /* For real parm decl following a forward decl, ! return 1 so old decl will be reused. */ ! if (types_match && TREE_CODE (newdecl) == PARM_DECL ! && TREE_ASM_WRITTEN (olddecl) && ! TREE_ASM_WRITTEN (newdecl)) ! return 1; ! /* The new declaration is the same kind of object as the old one. ! The declarations may partially match. Print warnings if they don't ! match enough. Ultimately, copy most of the information from the new ! decl to the old one, and keep using the old one. */ ! if (TREE_CODE (olddecl) == FUNCTION_DECL ! && DECL_BUILT_IN (olddecl)) ! { ! /* A function declaration for a built-in function. */ ! if (!TREE_PUBLIC (newdecl)) ! return 0; ! else if (!types_match) ! { ! /* Accept the return type of the new declaration if same modes. */ ! tree oldreturntype = TREE_TYPE (TREE_TYPE (olddecl)); ! tree newreturntype = TREE_TYPE (TREE_TYPE (newdecl)); ! /* Make sure we put the new type in the same obstack as the old ones. ! If the old types are not both in the same obstack, use the ! permanent one. */ ! if (TYPE_OBSTACK (oldtype) == TYPE_OBSTACK (newtype)) ! push_obstacks (TYPE_OBSTACK (oldtype), TYPE_OBSTACK (oldtype)); ! else ! { ! push_obstacks_nochange (); ! end_temporary_allocation (); ! } ! if (TYPE_MODE (oldreturntype) == TYPE_MODE (newreturntype)) ! { ! /* Function types may be shared, so we can't just modify ! the return type of olddecl's function type. */ ! tree newtype ! = build_function_type (newreturntype, ! TYPE_ARG_TYPES (TREE_TYPE (olddecl))); ! types_match = 1; ! if (types_match) ! TREE_TYPE (olddecl) = newtype; ! } ! pop_obstacks (); ! } ! if (!types_match) ! return 0; ! } ! else if (TREE_CODE (olddecl) == FUNCTION_DECL ! && DECL_SOURCE_LINE (olddecl) == 0) { ! /* A function declaration for a predeclared function ! that isn't actually built in. */ ! if (!TREE_PUBLIC (newdecl)) ! return 0; ! else if (!types_match) ! { ! /* If the types don't match, preserve volatility indication. ! Later on, we will discard everything else about the ! default declaration. */ ! TREE_THIS_VOLATILE (newdecl) |= TREE_THIS_VOLATILE (olddecl); ! } ! } ! /* Copy all the DECL_... slots specified in the new decl ! except for any that we copy here from the old type. ! Past this point, we don't change OLDTYPE and NEWTYPE ! even if we change the types of NEWDECL and OLDDECL. */ ! if (types_match) ! { ! /* Make sure we put the new type in the same obstack as the old ones. ! If the old types are not both in the same obstack, use the permanent ! one. */ ! if (TYPE_OBSTACK (oldtype) == TYPE_OBSTACK (newtype)) ! push_obstacks (TYPE_OBSTACK (oldtype), TYPE_OBSTACK (oldtype)); ! else ! { ! push_obstacks_nochange (); ! end_temporary_allocation (); ! } ! /* Merge the data types specified in the two decls. */ ! if (TREE_CODE (newdecl) != FUNCTION_DECL || !DECL_BUILT_IN (olddecl)) ! TREE_TYPE (newdecl) ! = TREE_TYPE (olddecl) ! = TREE_TYPE (newdecl); ! /* Lay the type out, unless already done. */ ! if (oldtype != TREE_TYPE (newdecl)) ! { ! if (TREE_TYPE (newdecl) != error_mark_node) ! layout_type (TREE_TYPE (newdecl)); ! if (TREE_CODE (newdecl) != FUNCTION_DECL ! && TREE_CODE (newdecl) != TYPE_DECL ! && TREE_CODE (newdecl) != CONST_DECL) ! layout_decl (newdecl, 0); ! } ! else ! { ! /* Since the type is OLDDECL's, make OLDDECL's size go with. */ ! DECL_SIZE (newdecl) = DECL_SIZE (olddecl); ! if (TREE_CODE (olddecl) != FUNCTION_DECL) ! if (DECL_ALIGN (olddecl) > DECL_ALIGN (newdecl)) ! DECL_ALIGN (newdecl) = DECL_ALIGN (olddecl); ! } ! /* Keep the old rtl since we can safely use it. */ ! DECL_RTL (newdecl) = DECL_RTL (olddecl); ! /* Merge the type qualifiers. */ ! if (DECL_BUILT_IN_NONANSI (olddecl) && TREE_THIS_VOLATILE (olddecl) ! && !TREE_THIS_VOLATILE (newdecl)) ! TREE_THIS_VOLATILE (olddecl) = 0; ! if (TREE_READONLY (newdecl)) ! TREE_READONLY (olddecl) = 1; ! if (TREE_THIS_VOLATILE (newdecl)) ! { ! TREE_THIS_VOLATILE (olddecl) = 1; ! if (TREE_CODE (newdecl) == VAR_DECL) ! make_var_volatile (newdecl); ! } ! /* Keep source location of definition rather than declaration. ! Likewise, keep decl at outer scope. */ ! if ((DECL_INITIAL (newdecl) == 0 && DECL_INITIAL (olddecl) != 0) ! || (DECL_CONTEXT (newdecl) != 0 && DECL_CONTEXT (olddecl) == 0)) ! { ! DECL_SOURCE_LINE (newdecl) = DECL_SOURCE_LINE (olddecl); ! DECL_SOURCE_FILE (newdecl) = DECL_SOURCE_FILE (olddecl); ! if (DECL_CONTEXT (olddecl) == 0 ! && TREE_CODE (newdecl) != FUNCTION_DECL) ! DECL_CONTEXT (newdecl) = 0; ! } ! /* Merge the unused-warning information. */ ! if (DECL_IN_SYSTEM_HEADER (olddecl)) ! DECL_IN_SYSTEM_HEADER (newdecl) = 1; ! else if (DECL_IN_SYSTEM_HEADER (newdecl)) ! DECL_IN_SYSTEM_HEADER (olddecl) = 1; ! /* Merge the initialization information. */ ! if (DECL_INITIAL (newdecl) == 0) ! DECL_INITIAL (newdecl) = DECL_INITIAL (olddecl); ! /* Merge the section attribute. ! We want to issue an error if the sections conflict but that must be ! done later in decl_attributes since we are called before attributes ! are assigned. */ ! if (DECL_SECTION_NAME (newdecl) == NULL_TREE) ! DECL_SECTION_NAME (newdecl) = DECL_SECTION_NAME (olddecl); + #if BUILT_FOR_270 + if (TREE_CODE (newdecl) == FUNCTION_DECL) + { + DECL_STATIC_CONSTRUCTOR(newdecl) |= DECL_STATIC_CONSTRUCTOR(olddecl); + DECL_STATIC_DESTRUCTOR (newdecl) |= DECL_STATIC_DESTRUCTOR (olddecl); + } #endif ! pop_obstacks (); ! } ! /* If cannot merge, then use the new type and qualifiers, ! and don't preserve the old rtl. */ ! else ! { ! TREE_TYPE (olddecl) = TREE_TYPE (newdecl); ! TREE_READONLY (olddecl) = TREE_READONLY (newdecl); ! TREE_THIS_VOLATILE (olddecl) = TREE_THIS_VOLATILE (newdecl); ! TREE_SIDE_EFFECTS (olddecl) = TREE_SIDE_EFFECTS (newdecl); ! } ! /* Merge the storage class information. */ ! /* For functions, static overrides non-static. */ ! if (TREE_CODE (newdecl) == FUNCTION_DECL) ! { ! TREE_PUBLIC (newdecl) &= TREE_PUBLIC (olddecl); ! /* This is since we don't automatically ! copy the attributes of NEWDECL into OLDDECL. */ ! TREE_PUBLIC (olddecl) = TREE_PUBLIC (newdecl); ! /* If this clears `static', clear it in the identifier too. */ ! if (! TREE_PUBLIC (olddecl)) ! TREE_PUBLIC (DECL_NAME (olddecl)) = 0; ! } ! if (DECL_EXTERNAL (newdecl)) ! { ! TREE_STATIC (newdecl) = TREE_STATIC (olddecl); ! DECL_EXTERNAL (newdecl) = DECL_EXTERNAL (olddecl); ! /* An extern decl does not override previous storage class. */ ! TREE_PUBLIC (newdecl) = TREE_PUBLIC (olddecl); ! } ! else ! { ! TREE_STATIC (olddecl) = TREE_STATIC (newdecl); ! TREE_PUBLIC (olddecl) = TREE_PUBLIC (newdecl); ! } ! /* If either decl says `inline', this fn is inline, ! unless its definition was passed already. */ ! if (DECL_INLINE (newdecl) && DECL_INITIAL (olddecl) == 0) ! DECL_INLINE (olddecl) = 1; ! DECL_INLINE (newdecl) = DECL_INLINE (olddecl); ! /* Get rid of any built-in function if new arg types don't match it ! or if we have a function definition. */ ! if (TREE_CODE (newdecl) == FUNCTION_DECL ! && DECL_BUILT_IN (olddecl) ! && (!types_match || new_is_definition)) ! { ! TREE_TYPE (olddecl) = TREE_TYPE (newdecl); ! DECL_BUILT_IN (olddecl) = 0; ! } ! /* If redeclaring a builtin function, and not a definition, ! it stays built in. ! Also preserve various other info from the definition. */ ! if (TREE_CODE (newdecl) == FUNCTION_DECL && !new_is_definition) ! { ! if (DECL_BUILT_IN (olddecl)) ! { ! DECL_BUILT_IN (newdecl) = 1; ! DECL_FUNCTION_CODE (newdecl) = DECL_FUNCTION_CODE (olddecl); ! } ! else ! DECL_FRAME_SIZE (newdecl) = DECL_FRAME_SIZE (olddecl); ! DECL_RESULT (newdecl) = DECL_RESULT (olddecl); ! DECL_INITIAL (newdecl) = DECL_INITIAL (olddecl); ! DECL_SAVED_INSNS (newdecl) = DECL_SAVED_INSNS (olddecl); ! DECL_ARGUMENTS (newdecl) = DECL_ARGUMENTS (olddecl); ! } ! /* Copy most of the decl-specific fields of NEWDECL into OLDDECL. ! But preserve olddecl's DECL_UID. */ ! { ! register unsigned olddecl_uid = DECL_UID (olddecl); ! memcpy ((char *) olddecl + sizeof (struct tree_common), ! (char *) newdecl + sizeof (struct tree_common), ! sizeof (struct tree_decl) - sizeof (struct tree_common)); ! DECL_UID (olddecl) = olddecl_uid; ! } ! return 1; } + /* Finish processing of a declaration; + install its initial value. + If the length of an array type is not known before, + it must be determined now, from the initial value, or it is an error. */ + static void ! finish_decl (tree decl, tree init, bool is_top_level) { ! register tree type = TREE_TYPE (decl); ! int was_incomplete = (DECL_SIZE (decl) == 0); ! int temporary = allocation_temporary_p (); ! bool at_top_level = (current_binding_level == global_binding_level); ! bool top_level = is_top_level || at_top_level; ! /* Caller should pass TRUE for is_top_level only if we wouldn't be at top ! level anyway. */ ! assert (!is_top_level || !at_top_level); ! if (TREE_CODE (decl) == PARM_DECL) ! assert (init == NULL_TREE); ! /* Remember that PARM_DECL doesn't have a DECL_INITIAL field per se -- it ! overlaps DECL_ARG_TYPE. */ ! else if (init == NULL_TREE) ! assert (DECL_INITIAL (decl) == NULL_TREE); ! else ! assert (DECL_INITIAL (decl) == error_mark_node); ! if (init != NULL_TREE) { ! if (TREE_CODE (decl) != TYPE_DECL) ! DECL_INITIAL (decl) = init; ! else ! { ! /* typedef foo = bar; store the type of bar as the type of foo. */ ! TREE_TYPE (decl) = TREE_TYPE (init); ! DECL_INITIAL (decl) = init = 0; ! } } ! /* Pop back to the obstack that is current for this binding level. This is ! because MAXINDEX, rtl, etc. to be made below must go in the permanent ! obstack. But don't discard the temporary data yet. */ ! pop_obstacks (); ! /* Deduce size of array from initialization, if not already known */ ! if (TREE_CODE (type) == ARRAY_TYPE ! && TYPE_DOMAIN (type) == 0 ! && TREE_CODE (decl) != TYPE_DECL) ! { ! assert (top_level); ! assert (was_incomplete); ! layout_decl (decl, 0); ! } ! if (TREE_CODE (decl) == VAR_DECL) ! { ! if (DECL_SIZE (decl) == NULL_TREE ! && TYPE_SIZE (TREE_TYPE (decl)) != NULL_TREE) ! layout_decl (decl, 0); ! if (DECL_SIZE (decl) == NULL_TREE ! && (TREE_STATIC (decl) ! ? ! /* A static variable with an incomplete type is an error if it is ! initialized. Also if it is not file scope. Otherwise, let it ! through, but if it is not `extern' then it may cause an error ! message later. */ ! (DECL_INITIAL (decl) != 0 || DECL_CONTEXT (decl) != 0) ! : ! /* An automatic variable with an incomplete type is an error. */ ! !DECL_EXTERNAL (decl))) ! { ! assert ("storage size not known" == NULL); ! abort (); ! } ! if ((DECL_EXTERNAL (decl) || TREE_STATIC (decl)) ! && (DECL_SIZE (decl) != 0) ! && (TREE_CODE (DECL_SIZE (decl)) != INTEGER_CST)) ! { ! assert ("storage size not constant" == NULL); ! abort (); ! } ! } ! /* Output the assembler code and/or RTL code for variables and functions, ! unless the type is an undefined structure or union. If not, it will get ! done when the type is completed. */ ! if (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == FUNCTION_DECL) { ! rest_of_decl_compilation (decl, NULL, ! DECL_CONTEXT (decl) == 0, ! 0); ! if (DECL_CONTEXT (decl) != 0) ! { ! /* Recompute the RTL of a local array now if it used to be an ! incomplete type. */ ! if (was_incomplete ! && !TREE_STATIC (decl) && !DECL_EXTERNAL (decl)) { ! /* If we used it already as memory, it must stay in memory. */ ! TREE_ADDRESSABLE (decl) = TREE_USED (decl); ! /* If it's still incomplete now, no init will save it. */ ! if (DECL_SIZE (decl) == 0) ! DECL_INITIAL (decl) = 0; ! expand_decl (decl); } + /* Compute and store the initial value. */ + if (TREE_CODE (decl) != FUNCTION_DECL) + expand_decl_init (decl); + } + } + else if (TREE_CODE (decl) == TYPE_DECL) + { + rest_of_decl_compilation (decl, NULL_PTR, + DECL_CONTEXT (decl) == 0, + 0); + } ! /* This test used to include TREE_PERMANENT, however, we have the same ! problem with initializers at the function level. Such initializers get ! saved until the end of the function on the momentary_obstack. */ ! if (!(TREE_CODE (decl) == FUNCTION_DECL && DECL_INLINE (decl)) ! && temporary ! /* DECL_INITIAL is not defined in PARM_DECLs, since it shares space with ! DECL_ARG_TYPE. */ ! && TREE_CODE (decl) != PARM_DECL) ! { ! /* We need to remember that this array HAD an initialization, but ! discard the actual temporary nodes, since we can't have a permanent ! node keep pointing to them. */ ! /* We make an exception for inline functions, since it's normal for a ! local extern redeclaration of an inline function to have a copy of ! the top-level decl's DECL_INLINE. */ ! if ((DECL_INITIAL (decl) != 0) ! && (DECL_INITIAL (decl) != error_mark_node)) ! { ! /* If this is a const variable, then preserve the ! initializer instead of discarding it so that we can optimize ! references to it. */ ! /* This test used to include TREE_STATIC, but this won't be set ! for function level initializers. */ ! if (TREE_READONLY (decl)) { ! preserve_initializer (); ! /* Hack? Set the permanent bit for something that is ! permanent, but not on the permenent obstack, so as to ! convince output_constant_def to make its rtl on the ! permanent obstack. */ ! TREE_PERMANENT (DECL_INITIAL (decl)) = 1; ! /* The initializer and DECL must have the same (or equivalent ! types), but if the initializer is a STRING_CST, its type ! might not be on the right obstack, so copy the type ! of DECL. */ ! TREE_TYPE (DECL_INITIAL (decl)) = type; } ! else ! DECL_INITIAL (decl) = error_mark_node; } } ! ! /* If requested, warn about definitions of large data objects. */ ! ! if (warn_larger_than ! && (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == PARM_DECL) ! && !DECL_EXTERNAL (decl)) { ! register tree decl_size = DECL_SIZE (decl); ! ! if (decl_size && TREE_CODE (decl_size) == INTEGER_CST) { ! unsigned units = TREE_INT_CST_LOW (decl_size) / BITS_PER_UNIT; ! ! if (units > larger_than_size) ! warning_with_decl (decl, "size of `%s' is %u bytes", units); } } ! /* If we have gone back from temporary to permanent allocation, actually ! free the temporary space that we no longer need. */ ! if (temporary && !allocation_temporary_p ()) ! permanent_allocation (0); ! /* At the end of a declaration, throw away any variable type sizes of types ! defined inside that declaration. There is no use computing them in the ! following function definition. */ ! if (current_binding_level == global_binding_level) ! get_pending_sizes (); ! } ! /* Finish up a function declaration and compile that function ! all the way to assembler language output. The free the storage ! for the function definition. ! This is called after parsing the body of the function definition. ! NESTED is nonzero if the function being finished is nested in another. */ ! ! static void ! finish_function (int nested) ! { ! register tree fndecl = current_function_decl; ! ! assert (fndecl != NULL_TREE); ! if (TREE_CODE (fndecl) != ERROR_MARK) ! { ! if (nested) ! assert (DECL_CONTEXT (fndecl) != NULL_TREE); else ! assert (DECL_CONTEXT (fndecl) == NULL_TREE); ! } ! /* TREE_READONLY (fndecl) = 1; ! This caused &foo to be of type ptr-to-const-function ! which then got a warning when stored in a ptr-to-function variable. */ ! poplevel (1, 0, 1); ! if (TREE_CODE (fndecl) != ERROR_MARK) ! { ! BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl; ! /* Must mark the RESULT_DECL as being in this function. */ ! DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl; ! /* Obey `register' declarations if `setjmp' is called in this fn. */ ! /* Generate rtl for function exit. */ ! expand_function_end (input_filename, lineno, 0); ! /* So we can tell if jump_optimize sets it to 1. */ ! can_reach_end = 0; ! /* Run the optimizers and output the assembler code for this function. */ ! rest_of_compilation (fndecl); ! } ! /* Free all the tree nodes making up this function. */ ! /* Switch back to allocating nodes permanently until we start another ! function. */ ! if (!nested) ! permanent_allocation (1); ! ! if (TREE_CODE (fndecl) != ERROR_MARK ! && !nested ! && DECL_SAVED_INSNS (fndecl) == 0) ! { ! /* Stop pointing to the local nodes about to be freed. */ ! /* But DECL_INITIAL must remain nonzero so we know this was an actual ! function definition. */ ! /* For a nested function, this is done in pop_f_function_context. */ ! /* If rest_of_compilation set this to 0, leave it 0. */ ! if (DECL_INITIAL (fndecl) != 0) ! DECL_INITIAL (fndecl) = error_mark_node; ! DECL_ARGUMENTS (fndecl) = 0; } ! ! if (!nested) { ! /* Let the error reporting routines know that we're outside a function. ! For a nested function, this value is used in pop_c_function_context ! and then reset via pop_function_context. */ ! ffecom_outer_function_decl_ = current_function_decl = NULL; } + } ! /* Plug-in replacement for identifying the name of a decl and, for a ! function, what we call it in diagnostics. For now, "program unit" ! should suffice, since it's a bit of a hassle to figure out which ! of several kinds of things it is. Note that it could conceivably ! be a statement function, which probably isn't really a program unit ! per se, but if that comes up, it should be easy to check (being a ! nested function and all). */ ! ! static char * ! lang_printable_name (tree decl, int v) ! { ! /* Just to keep GCC quiet about the unused variable. ! In theory, differing values of V should produce different ! output. */ ! switch (v) { ! default: ! if (TREE_CODE (decl) == ERROR_MARK) ! return "erroneous code"; ! return IDENTIFIER_POINTER (DECL_NAME (decl)); } ! } ! ! /* g77's function to print out name of current function that caused ! an error. */ ! ! #if BUILT_FOR_270 ! void ! lang_print_error_function (file) ! char *file; ! { ! static ffeglobal last_g = NULL; ! static ffesymbol last_s = NULL; ! ffeglobal g; ! ffesymbol s; ! const char *kind; ! ! if ((ffecom_primary_entry_ == NULL) ! || (ffesymbol_global (ffecom_primary_entry_) == NULL)) { ! g = NULL; ! s = NULL; ! kind = NULL; } else { ! g = ffesymbol_global (ffecom_primary_entry_); ! if (ffecom_nested_entry_ == NULL) ! { ! s = ffecom_primary_entry_; ! switch (ffesymbol_kind (s)) ! { ! case FFEINFO_kindFUNCTION: ! kind = "function"; ! break; ! case FFEINFO_kindSUBROUTINE: ! kind = "subroutine"; ! break; ! case FFEINFO_kindPROGRAM: ! kind = "program"; ! break; ! ! case FFEINFO_kindBLOCKDATA: ! kind = "block-data"; ! break; ! ! default: ! kind = ffeinfo_kind_message (ffesymbol_kind (s)); ! break; ! } ! } ! else ! { ! s = ffecom_nested_entry_; ! kind = "statement function"; ! } } ! if ((last_g != g) || (last_s != s)) { ! if (file) ! fprintf (stderr, "%s: ", file); ! ! if (s == NULL) ! fprintf (stderr, "Outside of any program unit:\n"); ! else { ! const char *name = ffesymbol_text (s); ! ! fprintf (stderr, "In %s `%s':\n", kind, name); } ! last_g = g; ! last_s = s; } + } + #endif ! /* Similar to `lookup_name' but look only at current binding level. */ ! static tree ! lookup_name_current_level (tree name) ! { ! register tree t; ! if (current_binding_level == global_binding_level) ! return IDENTIFIER_GLOBAL_VALUE (name); ! ! if (IDENTIFIER_LOCAL_VALUE (name) == 0) ! return 0; ! ! for (t = current_binding_level->names; t; t = TREE_CHAIN (t)) ! if (DECL_NAME (t) == name) ! break; ! ! return t; } ! /* Create a new `struct binding_level'. */ ! static struct binding_level * ! make_binding_level () { ! /* NOSTRICT */ ! return (struct binding_level *) xmalloc (sizeof (struct binding_level)); ! } ! /* Save and restore the variables in this file and elsewhere ! that keep track of the progress of compilation of the current function. ! Used for nested functions. */ ! struct f_function ! { ! struct f_function *next; ! tree named_labels; ! tree shadowed_labels; ! struct binding_level *binding_level; ! }; ! struct f_function *f_function_chain; ! ! /* Restore the variables used during compilation of a C function. */ ! ! static void ! pop_f_function_context () ! { ! struct f_function *p = f_function_chain; ! tree link; ! ! /* Bring back all the labels that were shadowed. */ ! for (link = shadowed_labels; link; link = TREE_CHAIN (link)) ! if (DECL_NAME (TREE_VALUE (link)) != 0) ! IDENTIFIER_LABEL_VALUE (DECL_NAME (TREE_VALUE (link))) ! = TREE_VALUE (link); ! ! if (current_function_decl != error_mark_node ! && DECL_SAVED_INSNS (current_function_decl) == 0) { ! /* Stop pointing to the local nodes about to be freed. */ ! /* But DECL_INITIAL must remain nonzero so we know this was an actual ! function definition. */ ! DECL_INITIAL (current_function_decl) = error_mark_node; ! DECL_ARGUMENTS (current_function_decl) = 0; } ! pop_function_context (); ! f_function_chain = p->next; ! named_labels = p->named_labels; ! shadowed_labels = p->shadowed_labels; ! current_binding_level = p->binding_level; ! free (p); ! } ! /* Save and reinitialize the variables ! used during compilation of a C function. */ ! static void ! push_f_function_context () ! { ! struct f_function *p ! = (struct f_function *) xmalloc (sizeof (struct f_function)); ! push_function_context (); ! p->next = f_function_chain; ! f_function_chain = p; ! p->named_labels = named_labels; ! p->shadowed_labels = shadowed_labels; ! p->binding_level = current_binding_level; ! } ! static void ! push_parm_decl (tree parm) ! { ! int old_immediate_size_expand = immediate_size_expand; ! /* Don't try computing parm sizes now -- wait till fn is called. */ ! immediate_size_expand = 0; ! push_obstacks_nochange (); ! /* Fill in arg stuff. */ ! DECL_ARG_TYPE (parm) = TREE_TYPE (parm); ! DECL_ARG_TYPE_AS_WRITTEN (parm) = TREE_TYPE (parm); ! TREE_READONLY (parm) = 1; /* All implementation args are read-only. */ ! parm = pushdecl (parm); ! immediate_size_expand = old_immediate_size_expand; ! finish_decl (parm, NULL_TREE, FALSE); } ! /* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL, if appropriate. */ ! static tree ! pushdecl_top_level (x) ! tree x; ! { ! register tree t; ! register struct binding_level *b = current_binding_level; ! register tree f = current_function_decl; ! current_binding_level = global_binding_level; ! current_function_decl = NULL_TREE; ! t = pushdecl (x); ! current_binding_level = b; ! current_function_decl = f; ! return t; ! } ! ! /* Store the list of declarations of the current level. ! This is done for the parameter declarations of a function being defined, ! after they are modified in the light of any missing parameters. */ ! ! static tree ! storedecls (decls) ! tree decls; ! { ! return current_binding_level->names = decls; ! } ! ! /* Store the parameter declarations into the current function declaration. ! This is called after parsing the parameter declarations, before ! digesting the body of the function. ! ! For an old-style definition, modify the function's type ! to specify at least the number of arguments. */ static void ! store_parm_decls (int is_main_program UNUSED) { register tree fndecl = current_function_decl; ! if (fndecl == error_mark_node) ! return; ! /* This is a chain of PARM_DECLs from old-style parm declarations. */ ! DECL_ARGUMENTS (fndecl) = storedecls (nreverse (getdecls ())); ! /* Initialize the RTL code for the function. */ ! init_function_start (fndecl, input_filename, lineno); ! /* Set up parameters and prepare for return, for the function. */ ! expand_function_start (fndecl, 0); ! } ! static tree ! start_decl (tree decl, bool is_top_level) ! { ! register tree tem; ! bool at_top_level = (current_binding_level == global_binding_level); ! bool top_level = is_top_level || at_top_level; ! /* Caller should pass TRUE for is_top_level only if we wouldn't be at top ! level anyway. */ ! assert (!is_top_level || !at_top_level); ! /* The corresponding pop_obstacks is in finish_decl. */ ! push_obstacks_nochange (); ! ! if (DECL_INITIAL (decl) != NULL_TREE) ! { ! assert (DECL_INITIAL (decl) == error_mark_node); ! assert (!DECL_EXTERNAL (decl)); } + else if (top_level) + assert ((TREE_STATIC (decl) == 1) || DECL_EXTERNAL (decl) == 1); ! /* For Fortran, we by default put things in .common when possible. */ ! DECL_COMMON (decl) = 1; ! ! /* Add this decl to the current binding level. TEM may equal DECL or it may ! be a previous decl of the same name. */ ! if (is_top_level) ! tem = pushdecl_top_level (decl); ! else ! tem = pushdecl (decl); ! /* For a local variable, define the RTL now. */ ! if (!top_level ! /* But not if this is a duplicate decl and we preserved the rtl from the ! previous one (which may or may not happen). */ ! && DECL_RTL (tem) == 0) { ! if (TYPE_SIZE (TREE_TYPE (tem)) != 0) ! expand_decl (tem); ! else if (TREE_CODE (TREE_TYPE (tem)) == ARRAY_TYPE ! && DECL_INITIAL (tem) != 0) ! expand_decl (tem); } ! if (DECL_INITIAL (tem) != NULL_TREE) { ! /* When parsing and digesting the initializer, use temporary storage. ! Do this even if we will ignore the value. */ ! if (at_top_level) ! temporary_allocation (); } + + return tem; } ! /* Create the FUNCTION_DECL for a function definition. ! DECLSPECS and DECLARATOR are the parts of the declaration; ! they describe the function's name and the type it returns, ! but twisted together in a fashion that parallels the syntax of C. ! This function creates a binding context for the function body ! as well as setting up the FUNCTION_DECL in current_function_decl. ! 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. ! NESTED is nonzero for a function nested within another function. */ ! ! static void ! start_function (tree name, tree type, int nested, int public) { ! tree decl1; ! tree restype; ! int old_immediate_size_expand = immediate_size_expand; ! named_labels = 0; ! shadowed_labels = 0; ! ! /* Don't expand any sizes in the return type of the function. */ ! immediate_size_expand = 0; ! ! if (nested) { ! assert (!public); ! assert (current_function_decl != NULL_TREE); ! assert (DECL_CONTEXT (current_function_decl) == NULL_TREE); } else { ! assert (current_function_decl == NULL_TREE); ! } ! if (TREE_CODE (type) == ERROR_MARK) ! decl1 = current_function_decl = error_mark_node; ! else ! { ! decl1 = build_decl (FUNCTION_DECL, ! name, ! type); ! TREE_PUBLIC (decl1) = public ? 1 : 0; ! if (nested) ! DECL_INLINE (decl1) = 1; ! TREE_STATIC (decl1) = 1; ! DECL_EXTERNAL (decl1) = 0; ! announce_function (decl1); ! /* Make the init_value nonzero so pushdecl knows this is not tentative. ! error_mark_node is replaced below (in poplevel) with the BLOCK. */ ! DECL_INITIAL (decl1) = error_mark_node; ! /* Record the decl so that the function name is defined. If we already have ! a decl for this name, and it is a FUNCTION_DECL, use the old decl. */ ! ! current_function_decl = pushdecl (decl1); } ! if (!nested) ! ffecom_outer_function_decl_ = current_function_decl; ! pushlevel (0); ! current_binding_level->prep_state = 2; ! if (TREE_CODE (current_function_decl) != ERROR_MARK) ! { ! make_function_rtl (current_function_decl); ! restype = TREE_TYPE (TREE_TYPE (current_function_decl)); ! DECL_RESULT (current_function_decl) ! = build_decl (RESULT_DECL, NULL_TREE, restype); } ! if (!nested) ! /* Allocate further tree nodes temporarily during compilation of this ! function only. */ ! temporary_allocation (); ! if (!nested && (TREE_CODE (current_function_decl) != ERROR_MARK)) ! TREE_ADDRESSABLE (current_function_decl) = 1; ! ! immediate_size_expand = old_immediate_size_expand; ! } ! ! /* Here are the public functions the GNU back end needs. */ ! ! tree ! convert (type, expr) ! tree type, expr; { ! register tree e = expr; ! register enum tree_code code = TREE_CODE (type); ! if (type == TREE_TYPE (e) ! || TREE_CODE (e) == ERROR_MARK) ! return e; ! if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (e))) ! return fold (build1 (NOP_EXPR, type, e)); ! if (TREE_CODE (TREE_TYPE (e)) == ERROR_MARK ! || code == ERROR_MARK) ! return error_mark_node; ! if (TREE_CODE (TREE_TYPE (e)) == VOID_TYPE) ! { ! assert ("void value not ignored as it ought to be" == NULL); ! return error_mark_node; ! } ! if (code == VOID_TYPE) ! return build1 (CONVERT_EXPR, type, e); ! if ((code != RECORD_TYPE) ! && (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE)) ! e = ffecom_1 (REALPART_EXPR, TREE_TYPE (TYPE_FIELDS (TREE_TYPE (e))), ! e); ! if (code == INTEGER_TYPE || code == ENUMERAL_TYPE) ! return fold (convert_to_integer (type, e)); ! if (code == POINTER_TYPE) ! return fold (convert_to_pointer (type, e)); ! if (code == REAL_TYPE) ! return fold (convert_to_real (type, e)); ! if (code == COMPLEX_TYPE) ! return fold (convert_to_complex (type, e)); ! if (code == RECORD_TYPE) ! return fold (ffecom_convert_to_complex_ (type, e)); ! assert ("conversion to non-scalar type requested" == NULL); ! 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 ! store the result back using `storedecls' or you will lose. */ ! tree ! getdecls () { ! return current_binding_level->names; } ! /* Nonzero if we are currently in the global binding level. */ ! int ! 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); ! } ! ! void ! init_decl_processing () { ! malloc_init (); ! ffe_init_0 (); ! } ! char * ! init_parse (filename) ! char *filename; ! { ! #if BUILT_FOR_270 ! extern void (*print_error_function) (char *); ! #endif ! /* Open input file. */ ! if (filename == 0 || !strcmp (filename, "-")) { ! finput = stdin; ! filename = "stdin"; } + else + finput = fopen (filename, "r"); + if (finput == 0) + pfatal_with_name (filename); ! #ifdef IO_BUFFER_SIZE ! setvbuf (finput, (char *) xmalloc (IO_BUFFER_SIZE), _IOFBF, IO_BUFFER_SIZE); ! #endif ! /* Make identifier nodes long enough for the language-specific slots. */ ! set_identifier_size (sizeof (struct lang_identifier)); ! decl_printable_name = lang_printable_name; ! #if BUILT_FOR_270 ! print_error_function = lang_print_error_function; ! #endif ! ! return filename; ! } ! ! void ! finish_parse () ! { ! fclose (finput); ! } ! ! /* Delete the node BLOCK from the current binding level. ! This is used for the block inside a stmt expr ({...}) ! so that the block can be reinserted where appropriate. */ ! ! static void ! delete_block (block) ! tree block; ! { ! tree t; ! if (current_binding_level->blocks == block) ! current_binding_level->blocks = TREE_CHAIN (block); ! for (t = current_binding_level->blocks; t;) ! { ! if (TREE_CHAIN (t) == block) ! TREE_CHAIN (t) = TREE_CHAIN (block); ! else ! t = TREE_CHAIN (t); ! } ! TREE_CHAIN (block) = NULL; ! /* Clear TREE_USED which is always set by poplevel. ! The flag is set again if insert_block is called. */ ! TREE_USED (block) = 0; ! } ! void ! insert_block (block) ! tree block; ! { ! TREE_USED (block) = 1; ! current_binding_level->blocks ! = chainon (current_binding_level->blocks, block); ! } ! int ! lang_decode_option (argc, argv) ! int argc; ! char **argv; ! { ! return ffe_decode_option (argc, argv); } ! /* used by print-tree.c */ ! void ! lang_print_xnode (file, node, indent) ! FILE *file UNUSED; ! tree node UNUSED; ! int indent UNUSED; { ! } ! void ! lang_finish () ! { ! ffe_terminate_0 (); ! if (ffe_is_ffedebug ()) ! malloc_pool_display (malloc_pool_image ()); ! } ! char * ! lang_identify () ! { ! return "f77"; } ! void ! lang_init_options () { ! /* Set default options for Fortran. */ ! flag_move_all_movables = 1; ! flag_reduce_all_givs = 1; ! flag_argument_noalias = 2; ! flag_errno_math = 0; ! flag_complex_divide_method = 1; ! } ! void ! lang_init () ! { ! /* If the file is output from cpp, it should contain a first line ! `# 1 "real-filename"', and the current design of gcc (toplev.c ! in particular and the way it sets up information relied on by ! INCLUDE) requires that we read this now, and store the ! "real-filename" info in master_input_filename. Ask the lexer ! to try doing this. */ ! ffelex_hash_kludge (finput); ! } ! int ! mark_addressable (exp) ! tree exp; ! { ! register tree x = exp; ! while (1) ! switch (TREE_CODE (x)) ! { ! case ADDR_EXPR: ! case COMPONENT_REF: ! case ARRAY_REF: ! x = TREE_OPERAND (x, 0); ! break; ! case CONSTRUCTOR: ! TREE_ADDRESSABLE (x) = 1; ! return 1; ! case VAR_DECL: ! case CONST_DECL: ! case PARM_DECL: ! case RESULT_DECL: ! if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x) ! && DECL_NONLOCAL (x)) ! { ! if (TREE_PUBLIC (x)) ! { ! assert ("address of global register var requested" == NULL); ! return 0; ! } ! assert ("address of register variable requested" == NULL); ! } ! else if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x)) ! { ! if (TREE_PUBLIC (x)) ! { ! assert ("address of global register var requested" == NULL); ! return 0; ! } ! assert ("address of register var requested" == NULL); ! } ! put_var_into_stack (x); ! /* drops in */ ! case FUNCTION_DECL: ! TREE_ADDRESSABLE (x) = 1; ! #if 0 /* poplevel deals with this now. */ ! if (DECL_CONTEXT (x) == 0) ! TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (x)) = 1; ! #endif ! default: ! return 1; ! } ! } ! /* 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. ! If KEEP is nonzero, this level had explicit declarations, so ! and create a "block" (a BLOCK node) for the level ! to record its declarations and subblocks for symbol table output. ! If FUNCTIONBODY is nonzero, this level is the body of a function, ! so create a block as if KEEP were set and also clear out all ! label names. ! If REVERSE is nonzero, reverse the order of decls before putting ! them into the BLOCK. */ ! tree ! poplevel (keep, reverse, functionbody) ! int keep; ! int reverse; ! int functionbody; { ! register tree link; ! /* The chain of decls was accumulated in reverse order. ! Put it into forward order, just for cleanliness. */ ! tree decls; ! tree subblocks = current_binding_level->blocks; ! tree block = 0; ! tree decl; ! int block_previously_created; ! /* Get the decls in the order they were written. ! Usually current_binding_level->names is in reverse order. ! But parameter decls were previously put in forward order. */ ! if (reverse) ! current_binding_level->names ! = decls = nreverse (current_binding_level->names); ! else ! decls = current_binding_level->names; ! /* Output any nested inline functions within this block ! if they weren't already output. */ ! for (decl = decls; decl; decl = TREE_CHAIN (decl)) ! if (TREE_CODE (decl) == FUNCTION_DECL ! && ! TREE_ASM_WRITTEN (decl) ! && DECL_INITIAL (decl) != 0 ! && TREE_ADDRESSABLE (decl)) ! { ! /* If this decl was copied from a file-scope decl ! on account of a block-scope extern decl, ! propagate TREE_ADDRESSABLE to the file-scope decl. ! ! DECL_ABSTRACT_ORIGIN can be set to itself if warn_return_type is ! true, since then the decl goes through save_for_inline_copying. */ ! if (DECL_ABSTRACT_ORIGIN (decl) != 0 ! && DECL_ABSTRACT_ORIGIN (decl) != decl) ! TREE_ADDRESSABLE (DECL_ABSTRACT_ORIGIN (decl)) = 1; ! else if (DECL_SAVED_INSNS (decl) != 0) ! { ! push_function_context (); ! output_inline_function (decl); ! pop_function_context (); ! } ! } ! /* If there were any declarations or structure tags in that level, ! or if this level is a function body, ! create a BLOCK to record them for the life of this function. */ ! block = 0; ! block_previously_created = (current_binding_level->this_block != 0); ! if (block_previously_created) ! block = current_binding_level->this_block; ! else if (keep || functionbody) ! block = make_node (BLOCK); ! if (block != 0) ! { ! BLOCK_VARS (block) = decls; ! BLOCK_SUBBLOCKS (block) = subblocks; ! remember_end_note (block); ! } ! /* In each subblock, record that this is its superior. */ ! for (link = subblocks; link; link = TREE_CHAIN (link)) ! BLOCK_SUPERCONTEXT (link) = block; ! /* Clear out the meanings of the local variables of this level. */ ! for (link = decls; link; link = TREE_CHAIN (link)) ! { ! if (DECL_NAME (link) != 0) ! { ! /* If the ident. was used or addressed via a local extern decl, ! don't forget that fact. */ ! if (DECL_EXTERNAL (link)) ! { ! if (TREE_USED (link)) ! TREE_USED (DECL_NAME (link)) = 1; ! if (TREE_ADDRESSABLE (link)) ! TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (link)) = 1; ! } ! IDENTIFIER_LOCAL_VALUE (DECL_NAME (link)) = 0; ! } ! } ! /* If the level being exited is the top level of a function, ! check over all the labels, and clear out the current ! (function local) meanings of their names. */ ! if (functionbody) { ! /* If this is the top level block of a function, ! the vars are the function's parameters. ! Don't leave them in the BLOCK because they are ! found in the FUNCTION_DECL instead. */ ! ! BLOCK_VARS (block) = 0; } ! /* Pop the current level, and free the structure for reuse. */ ! { ! register struct binding_level *level = current_binding_level; ! current_binding_level = current_binding_level->level_chain; ! level->level_chain = free_binding_level; ! free_binding_level = level; ! } ! /* Dispose of the block that we just made inside some higher level. */ ! if (functionbody ! && current_function_decl != error_mark_node) ! DECL_INITIAL (current_function_decl) = block; ! else if (block) { ! if (!block_previously_created) ! current_binding_level->blocks ! = chainon (current_binding_level->blocks, block); } + /* If we did not make a block for the level just exited, + any blocks made for inner levels + (since they cannot be recorded as subblocks in that level) + must be carried forward so they will later become subblocks + of something else. */ + else if (subblocks) + current_binding_level->blocks + = chainon (current_binding_level->blocks, subblocks); ! if (block) ! TREE_USED (block) = 1; ! return block; } ! void ! print_lang_decl (file, node, indent) ! FILE *file UNUSED; ! tree node UNUSED; ! int indent UNUSED; ! { ! } ! void ! print_lang_identifier (file, node, indent) ! FILE *file; ! tree node; ! int indent; ! { ! print_node (file, "global", IDENTIFIER_GLOBAL_VALUE (node), indent + 4); ! print_node (file, "local", IDENTIFIER_LOCAL_VALUE (node), indent + 4); ! } ! void ! print_lang_statistics () ! { ! } ! void ! print_lang_type (file, node, indent) ! FILE *file UNUSED; ! tree node UNUSED; ! int indent UNUSED; { ! } ! /* Record a decl-node X as belonging to the current lexical scope. ! Check for errors (such as an incompatible declaration for the same ! name already seen in the same scope). ! Returns either X or an old decl for the same name. ! If an old decl is returned, it may have been smashed ! to agree with what X says. */ ! tree ! pushdecl (x) ! tree x; ! { ! register tree t; ! register tree name = DECL_NAME (x); ! register struct binding_level *b = current_binding_level; ! if ((TREE_CODE (x) == FUNCTION_DECL) ! && (DECL_INITIAL (x) == 0) ! && DECL_EXTERNAL (x)) ! DECL_CONTEXT (x) = NULL_TREE; else + DECL_CONTEXT (x) = current_function_decl; + + if (name) { ! if (IDENTIFIER_INVENTED (name)) ! { ! #if BUILT_FOR_270 ! DECL_ARTIFICIAL (x) = 1; ! #endif ! DECL_IN_SYSTEM_HEADER (x) = 1; ! } ! t = lookup_name_current_level (name); ! assert ((t == NULL_TREE) || (DECL_CONTEXT (x) == NULL_TREE)); ! /* Don't push non-parms onto list for parms until we understand ! why we're doing this and whether it works. */ ! assert ((b == global_binding_level) ! || !ffecom_transform_only_dummies_ ! || TREE_CODE (x) == PARM_DECL); ! if ((t != NULL_TREE) && duplicate_decls (x, t)) ! return t; ! /* If we are processing a typedef statement, generate a whole new ! ..._TYPE node (which will be just an variant of the existing ! ..._TYPE node with identical properties) and then install the ! TYPE_DECL node generated to represent the typedef name as the ! TYPE_NAME of this brand new (duplicate) ..._TYPE node. ! The whole point here is to end up with a situation where each and every ! ..._TYPE node the compiler creates will be uniquely associated with ! AT MOST one node representing a typedef name. This way, even though ! the compiler substitutes corresponding ..._TYPE nodes for TYPE_DECL ! (i.e. "typedef name") nodes very early on, later parts of the ! compiler can always do the reverse translation and get back the ! corresponding typedef name. For example, given: ! typedef struct S MY_TYPE; MY_TYPE object; ! Later parts of the compiler might only know that `object' was of type ! `struct S' if it were not for code just below. With this code ! however, later parts of the compiler see something like: ! struct S' == struct S typedef struct S' MY_TYPE; struct S' object; ! And they can then deduce (from the node for type struct S') that the ! original object declaration was: ! MY_TYPE object; ! Being able to do this is important for proper support of protoize, and ! also for generating precise symbolic debugging information which ! takes full account of the programmer's (typedef) vocabulary. ! Obviously, we don't want to generate a duplicate ..._TYPE node if the ! TYPE_DECL node that we are now processing really represents a ! standard built-in type. ! ! Since all standard types are effectively declared at line zero in the ! source file, we can easily check to see if we are working on a ! standard type by checking the current value of lineno. */ ! if (TREE_CODE (x) == TYPE_DECL) ! { ! if (DECL_SOURCE_LINE (x) == 0) ! { ! if (TYPE_NAME (TREE_TYPE (x)) == 0) ! TYPE_NAME (TREE_TYPE (x)) = x; ! } ! else if (TREE_TYPE (x) != error_mark_node) ! { ! tree tt = TREE_TYPE (x); ! tt = build_type_copy (tt); ! TYPE_NAME (tt) = x; ! TREE_TYPE (x) = tt; ! } ! } ! /* This name is new in its binding level. Install the new declaration ! and return it. */ ! if (b == global_binding_level) ! IDENTIFIER_GLOBAL_VALUE (name) = x; ! else ! IDENTIFIER_LOCAL_VALUE (name) = x; ! } ! /* Put decls on list in reverse order. We will reverse them later if ! necessary. */ ! TREE_CHAIN (x) = b->names; ! b->names = x; ! ! return x; } ! /* Nonzero if the current level needs to have a BLOCK made. */ ! static int ! kept_level_p () { ! tree decl; ! ! for (decl = current_binding_level->names; ! decl; ! decl = TREE_CHAIN (decl)) ! { ! if (TREE_USED (decl) || TREE_CODE (decl) != VAR_DECL ! || (DECL_NAME (decl) && ! DECL_ARTIFICIAL (decl))) ! /* Currently, there aren't supposed to be non-artificial names ! at other than the top block for a function -- they're ! believed to always be temps. But it's wise to check anyway. */ ! return 1; ! } ! return 0; } ! /* Enter a new binding level. ! If TAG_TRANSPARENT is nonzero, do so only for the name space of variables, ! not for that of tags. */ void ! pushlevel (tag_transparent) ! int tag_transparent; { ! register struct binding_level *newlevel = NULL_BINDING_LEVEL; ! assert (! tag_transparent); ! if (current_binding_level == global_binding_level) ! { ! named_labels = 0; ! } ! /* Reuse or create a struct for this binding level. */ ! if (free_binding_level) { ! newlevel = free_binding_level; ! free_binding_level = free_binding_level->level_chain; } else ! { ! newlevel = make_binding_level (); ! } ! /* Add this level to the front of the chain (stack) of levels that ! are active. */ ! *newlevel = clear_binding_level; ! newlevel->level_chain = current_binding_level; ! current_binding_level = newlevel; } ! /* Set the BLOCK node for the innermost scope ! (the one we are currently in). */ void ! set_block (block) ! register tree block; { ! current_binding_level->this_block = block; } ! /* ~~gcc/tree.h *should* declare this, because toplev.c references it. */ ! /* Can't 'yydebug' a front end not generated by yacc/bison! */ void ! set_yydebug (value) ! int value; { + if (value) + fprintf (stderr, "warning: no yacc/bison-generated output to debug!\n"); } ! tree ! signed_or_unsigned_type (unsignedp, type) ! int unsignedp; ! tree type; { ! tree type2; ! if (! INTEGRAL_TYPE_P (type)) ! return type; ! if (TYPE_PRECISION (type) == TYPE_PRECISION (signed_char_type_node)) ! return unsignedp ? unsigned_char_type_node : signed_char_type_node; ! if (TYPE_PRECISION (type) == TYPE_PRECISION (integer_type_node)) ! return unsignedp ? unsigned_type_node : integer_type_node; ! if (TYPE_PRECISION (type) == TYPE_PRECISION (short_integer_type_node)) ! return unsignedp ? short_unsigned_type_node : short_integer_type_node; ! if (TYPE_PRECISION (type) == TYPE_PRECISION (long_integer_type_node)) ! return unsignedp ? long_unsigned_type_node : long_integer_type_node; ! if (TYPE_PRECISION (type) == TYPE_PRECISION (long_long_integer_type_node)) ! return (unsignedp ? long_long_unsigned_type_node ! : long_long_integer_type_node); ! type2 = type_for_size (TYPE_PRECISION (type), unsignedp); ! if (type2 == NULL_TREE) ! return type; ! return type2; } ! tree ! signed_type (type) ! tree type; { ! tree type1 = TYPE_MAIN_VARIANT (type); ! ffeinfoKindtype kt; ! tree type2; ! if (type1 == unsigned_char_type_node || type1 == char_type_node) ! return signed_char_type_node; ! if (type1 == unsigned_type_node) ! return integer_type_node; ! if (type1 == short_unsigned_type_node) ! return short_integer_type_node; ! if (type1 == long_unsigned_type_node) ! return long_integer_type_node; ! if (type1 == long_long_unsigned_type_node) ! return long_long_integer_type_node; ! #if 0 /* gcc/c-* files only */ ! if (type1 == unsigned_intDI_type_node) ! return intDI_type_node; ! if (type1 == unsigned_intSI_type_node) ! return intSI_type_node; ! if (type1 == unsigned_intHI_type_node) ! return intHI_type_node; ! if (type1 == unsigned_intQI_type_node) ! return intQI_type_node; #endif ! type2 = type_for_size (TYPE_PRECISION (type1), 0); ! if (type2 != NULL_TREE) ! return type2; ! ! for (kt = 0; kt < ARRAY_SIZE (ffecom_tree_type[0]); ++kt) ! { ! type2 = ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt]; ! ! if (type1 == type2) ! return ffecom_tree_type[FFEINFO_basictypeINTEGER][kt]; ! } ! ! return type; } ! /* Prepare expr to be an argument of a TRUTH_NOT_EXPR, ! or validate its data type for an `if' or `while' statement or ?..: exp. ! ! This preparation consists of taking the ordinary ! representation of an expression expr and producing a valid tree ! boolean expression describing whether expr is nonzero. We could ! simply always do build_binary_op (NE_EXPR, expr, integer_zero_node, 1), ! but we optimize comparisons, &&, ||, and !. ! ! The resulting type should always be `integer_type_node'. */ tree ! truthvalue_conversion (expr) ! tree expr; { ! if (TREE_CODE (expr) == ERROR_MARK) ! return expr; ! #if 0 /* This appears to be wrong for C++. */ ! /* These really should return error_mark_node after 2.4 is stable. ! But not all callers handle ERROR_MARK properly. */ ! switch (TREE_CODE (TREE_TYPE (expr))) ! { ! case RECORD_TYPE: ! error ("struct type value used where scalar is required"); ! return integer_zero_node; ! case UNION_TYPE: ! error ("union type value used where scalar is required"); ! return integer_zero_node; ! case ARRAY_TYPE: ! error ("array type value used where scalar is required"); ! return integer_zero_node; ! default: ! break; ! } ! #endif /* 0 */ ! switch (TREE_CODE (expr)) ! { ! /* It is simpler and generates better code to have only TRUTH_*_EXPR ! or comparison expressions as truth values at this level. */ ! #if 0 ! case COMPONENT_REF: ! /* A one-bit unsigned bit-field is already acceptable. */ ! if (1 == TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (expr, 1))) ! && TREE_UNSIGNED (TREE_OPERAND (expr, 1))) ! return expr; ! break; ! #endif ! case EQ_EXPR: ! /* It is simpler and generates better code to have only TRUTH_*_EXPR ! or comparison expressions as truth values at this level. */ ! #if 0 ! if (integer_zerop (TREE_OPERAND (expr, 1))) ! return build_unary_op (TRUTH_NOT_EXPR, TREE_OPERAND (expr, 0), 0); ! #endif ! case NE_EXPR: case LE_EXPR: case GE_EXPR: case LT_EXPR: case GT_EXPR: ! case TRUTH_ANDIF_EXPR: ! case TRUTH_ORIF_EXPR: ! case TRUTH_AND_EXPR: ! case TRUTH_OR_EXPR: ! case TRUTH_XOR_EXPR: ! TREE_TYPE (expr) = integer_type_node; ! return expr; ! case ERROR_MARK: ! return expr; ! case INTEGER_CST: ! return integer_zerop (expr) ? integer_zero_node : integer_one_node; ! case REAL_CST: ! return real_zerop (expr) ? integer_zero_node : integer_one_node; ! case ADDR_EXPR: ! if (TREE_SIDE_EFFECTS (TREE_OPERAND (expr, 0))) ! return build (COMPOUND_EXPR, integer_type_node, ! TREE_OPERAND (expr, 0), integer_one_node); ! else ! return integer_one_node; ! case COMPLEX_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))); ! 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)); ! case LROTATE_EXPR: ! case RROTATE_EXPR: ! /* These don't change whether an object is zero or non-zero, 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))); ! else ! return 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)))); ! case CONVERT_EXPR: ! /* Don't cancel the effect of a CONVERT_EXPR from a REFERENCE_TYPE, ! since that affects how `default_conversion' will behave. */ ! if (TREE_CODE (TREE_TYPE (expr)) == REFERENCE_TYPE ! || TREE_CODE (TREE_TYPE (TREE_OPERAND (expr, 0))) == REFERENCE_TYPE) ! break; ! /* fall through... */ ! case NOP_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)); ! break; ! ! case MINUS_EXPR: ! /* With IEEE arithmetic, x - x may not equal 0, so we can't optimize ! this case. */ ! if (TARGET_FLOAT_FORMAT == IEEE_FLOAT_FORMAT ! && TREE_CODE (TREE_TYPE (expr)) == REAL_TYPE) ! break; ! /* fall through... */ ! case BIT_XOR_EXPR: ! /* This and MINUS_EXPR can be changed into a comparison of the ! two objects. */ ! if (TREE_TYPE (TREE_OPERAND (expr, 0)) ! == TREE_TYPE (TREE_OPERAND (expr, 1))) ! return ffecom_2 (NE_EXPR, integer_type_node, ! TREE_OPERAND (expr, 0), ! TREE_OPERAND (expr, 1)); ! return ffecom_2 (NE_EXPR, integer_type_node, ! TREE_OPERAND (expr, 0), ! fold (build1 (NOP_EXPR, ! TREE_TYPE (TREE_OPERAND (expr, 0)), ! TREE_OPERAND (expr, 1)))); ! ! case BIT_AND_EXPR: ! if (integer_onep (TREE_OPERAND (expr, 1))) ! return expr; ! break; ! ! case MODIFY_EXPR: ! #if 0 /* No such thing in Fortran. */ ! if (warn_parentheses && C_EXP_ORIGINAL_CODE (expr) == MODIFY_EXPR) ! warning ("suggest parentheses around assignment used as truth value"); ! #endif ! break; ! ! default: ! break; } ! if (TREE_CODE (TREE_TYPE (expr)) == COMPLEX_TYPE) ! return (ffecom_2 ! ((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)))); ! ! return ffecom_2 (NE_EXPR, integer_type_node, ! expr, ! convert (TREE_TYPE (expr), integer_zero_node)); ! } ! tree ! type_for_mode (mode, unsignedp) ! enum machine_mode mode; ! int unsignedp; ! { ! int i; ! int j; ! tree t; ! if (mode == TYPE_MODE (integer_type_node)) ! return unsignedp ? unsigned_type_node : integer_type_node; ! if (mode == TYPE_MODE (signed_char_type_node)) ! return unsignedp ? unsigned_char_type_node : signed_char_type_node; ! if (mode == TYPE_MODE (short_integer_type_node)) ! return unsignedp ? short_unsigned_type_node : short_integer_type_node; ! if (mode == TYPE_MODE (long_integer_type_node)) ! return unsignedp ? long_unsigned_type_node : long_integer_type_node; ! if (mode == TYPE_MODE (long_long_integer_type_node)) ! return unsignedp ? long_long_unsigned_type_node : long_long_integer_type_node; ! if (mode == TYPE_MODE (float_type_node)) ! return float_type_node; ! if (mode == TYPE_MODE (double_type_node)) ! return double_type_node; ! if (mode == TYPE_MODE (build_pointer_type (char_type_node))) ! return build_pointer_type (char_type_node); ! if (mode == TYPE_MODE (build_pointer_type (integer_type_node))) ! return build_pointer_type (integer_type_node); ! for (i = 0; ((size_t) i) < ARRAY_SIZE (ffecom_tree_type); ++i) ! for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j) ! { ! if (((t = ffecom_tree_type[i][j]) != NULL_TREE) ! && (mode == TYPE_MODE (t))) ! { ! if ((i == FFEINFO_basictypeINTEGER) && unsignedp) ! return ffecom_tree_type[FFEINFO_basictypeHOLLERITH][j]; ! else ! return t; ! } ! } ! ! return 0; } ! tree ! type_for_size (bits, unsignedp) ! unsigned bits; ! int unsignedp; { ! ffeinfoKindtype kt; ! tree type_node; ! if (bits == TYPE_PRECISION (integer_type_node)) ! return unsignedp ? unsigned_type_node : integer_type_node; ! if (bits == TYPE_PRECISION (signed_char_type_node)) ! return unsignedp ? unsigned_char_type_node : signed_char_type_node; ! if (bits == TYPE_PRECISION (short_integer_type_node)) ! return unsignedp ? short_unsigned_type_node : short_integer_type_node; ! if (bits == TYPE_PRECISION (long_integer_type_node)) ! return unsignedp ? long_unsigned_type_node : long_integer_type_node; ! if (bits == TYPE_PRECISION (long_long_integer_type_node)) ! return (unsignedp ? long_long_unsigned_type_node ! : long_long_integer_type_node); ! for (kt = 0; kt < ARRAY_SIZE (ffecom_tree_type[0]); ++kt) ! { ! type_node = ffecom_tree_type[FFEINFO_basictypeINTEGER][kt]; ! if ((type_node != NULL_TREE) && (bits == TYPE_PRECISION (type_node))) ! return unsignedp ? ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt] ! : type_node; ! } ! return 0; ! } ! tree ! unsigned_type (type) ! tree type; ! { ! tree type1 = TYPE_MAIN_VARIANT (type); ! ffeinfoKindtype kt; ! tree type2; ! if (type1 == signed_char_type_node || type1 == char_type_node) ! return unsigned_char_type_node; ! if (type1 == integer_type_node) ! return unsigned_type_node; ! if (type1 == short_integer_type_node) ! return short_unsigned_type_node; ! if (type1 == long_integer_type_node) ! return long_unsigned_type_node; ! if (type1 == long_long_integer_type_node) ! return long_long_unsigned_type_node; ! #if 0 /* gcc/c-* files only */ ! if (type1 == intDI_type_node) ! return unsigned_intDI_type_node; ! if (type1 == intSI_type_node) ! return unsigned_intSI_type_node; ! if (type1 == intHI_type_node) ! return unsigned_intHI_type_node; ! if (type1 == intQI_type_node) ! return unsigned_intQI_type_node; ! #endif ! type2 = type_for_size (TYPE_PRECISION (type1), 1); ! if (type2 != NULL_TREE) ! return type2; ! for (kt = 0; kt < ARRAY_SIZE (ffecom_tree_type[0]); ++kt) ! { ! type2 = ffecom_tree_type[FFEINFO_basictypeINTEGER][kt]; ! if (type1 == type2) ! return ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt]; ! } ! return type; ! } ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ ! ! #if FFECOM_GCC_INCLUDE ! /* From gcc/cccp.c, the code to handle -I. */ ! /* Skip leading "./" from a directory name. ! This may yield the empty string, which represents the current directory. */ ! static const char * ! skip_redundant_dir_prefix (const char *dir) ! { ! while (dir[0] == '.' && dir[1] == '/') ! for (dir += 2; *dir == '/'; dir++) ! continue; ! if (dir[0] == '.' && !dir[1]) ! dir++; ! return dir; ! } ! /* The file_name_map structure holds a mapping of file names for a ! particular directory. This mapping is read from the file named ! FILE_NAME_MAP_FILE in that directory. Such a file can be used to ! map filenames on a file system with severe filename restrictions, ! such as DOS. The format of the file name map file is just a series ! of lines with two tokens on each line. The first token is the name ! to map, and the second token is the actual name to use. */ ! struct file_name_map ! { ! struct file_name_map *map_next; ! char *map_from; ! char *map_to; ! }; ! #define FILE_NAME_MAP_FILE "header.gcc" ! /* Current maximum length of directory names in the search path ! for include files. (Altered as we get more of them.) */ ! static int max_include_len = 0; ! struct file_name_list ! { ! struct file_name_list *next; ! char *fname; ! /* Mapping of file names for this directory. */ ! struct file_name_map *name_map; ! /* Non-zero if name_map is valid. */ ! int got_name_map; ! }; ! static struct file_name_list *include = NULL; /* First dir to search */ ! static struct file_name_list *last_include = NULL; /* Last in chain */ ! /* I/O buffer structure. ! The `fname' field is nonzero for source files and #include files ! and for the dummy text used for -D and -U. ! It is zero for rescanning results of macro expansion ! and for expanding macro arguments. */ ! #define INPUT_STACK_MAX 400 ! static struct file_buf { ! char *fname; ! /* Filename specified with #line command. */ ! char *nominal_fname; ! /* Record where in the search path this file was found. ! For #include_next. */ ! struct file_name_list *dir; ! ffewhereLine line; ! ffewhereColumn column; ! } instack[INPUT_STACK_MAX]; ! static int last_error_tick = 0; /* Incremented each time we print it. */ ! static int input_file_stack_tick = 0; /* Incremented when status changes. */ ! /* Current nesting level of input sources. ! `instack[indepth]' is the level currently being read. */ ! static int indepth = -1; ! typedef struct file_buf FILE_BUF; ! typedef unsigned char U_CHAR; ! /* table to tell if char can be part of a C identifier. */ ! U_CHAR is_idchar[256]; ! /* table to tell if char can be first char of a c identifier. */ ! U_CHAR is_idstart[256]; ! /* table to tell if c is horizontal space. */ ! U_CHAR is_hor_space[256]; ! /* table to tell if c is horizontal or vertical space. */ ! static U_CHAR is_space[256]; ! #define SKIP_WHITE_SPACE(p) do { while (is_hor_space[*p]) p++; } while (0) ! #define SKIP_ALL_WHITE_SPACE(p) do { while (is_space[*p]) p++; } while (0) ! /* Nonzero means -I- has been seen, ! so don't look for #include "foo" the source-file directory. */ ! static int ignore_srcdir; ! #ifndef INCLUDE_LEN_FUDGE ! #define INCLUDE_LEN_FUDGE 0 ! #endif ! static void append_include_chain (struct file_name_list *first, ! struct file_name_list *last); ! static FILE *open_include_file (char *filename, ! struct file_name_list *searchptr); ! static void print_containing_files (ffebadSeverity sev); ! static const char *skip_redundant_dir_prefix (const char *); ! static char *read_filename_string (int ch, FILE *f); ! static struct file_name_map *read_name_map (const char *dirname); ! /* Append a chain of `struct file_name_list's ! to the end of the main include chain. ! FIRST is the beginning of the chain to append, and LAST is the end. */ ! static void ! append_include_chain (first, last) ! struct file_name_list *first, *last; { ! struct file_name_list *dir; ! if (!first || !last) ! return; ! if (include == 0) ! include = first; ! else ! last_include->next = first; ! for (dir = first; ; dir = dir->next) { ! int len = strlen (dir->fname) + INCLUDE_LEN_FUDGE; ! if (len > max_include_len) ! max_include_len = len; ! if (dir == last) ! break; ! } ! last->next = NULL; ! last_include = last; } ! /* Try to open include file FILENAME. SEARCHPTR is the directory ! being tried from the include file search path. This function maps ! filenames on file systems based on information read by ! read_name_map. */ ! ! static FILE * ! open_include_file (filename, searchptr) ! char *filename; ! struct file_name_list *searchptr; { ! register struct file_name_map *map; ! register char *from; ! char *p, *dir; ! if (searchptr && ! searchptr->got_name_map) ! { ! searchptr->name_map = read_name_map (searchptr->fname ! ? searchptr->fname : "."); ! searchptr->got_name_map = 1; ! } ! /* First check the mapping for the directory we are using. */ ! if (searchptr && searchptr->name_map) ! { ! from = filename; ! if (searchptr->fname) ! from += strlen (searchptr->fname) + 1; ! for (map = searchptr->name_map; map; map = map->map_next) ! { ! if (! strcmp (map->map_from, from)) ! { ! /* Found a match. */ ! return fopen (map->map_to, "r"); ! } ! } ! } ! /* Try to find a mapping file for the particular directory we are ! looking in. Thus #include will look up sys/types.h ! in /usr/include/header.gcc and look up types.h in ! /usr/include/sys/header.gcc. */ ! p = rindex (filename, '/'); ! #ifdef DIR_SEPARATOR ! if (! p) p = rindex (filename, DIR_SEPARATOR); ! else { ! char *tmp = rindex (filename, DIR_SEPARATOR); ! if (tmp != NULL && tmp > p) p = tmp; ! } ! #endif ! if (! p) ! p = filename; ! if (searchptr ! && searchptr->fname ! && strlen (searchptr->fname) == (size_t) (p - filename) ! && ! strncmp (searchptr->fname, filename, (int) (p - filename))) { ! /* FILENAME is in SEARCHPTR, which we've already checked. */ ! return fopen (filename, "r"); ! } ! if (p == filename) ! { ! from = filename; ! map = read_name_map ("."); ! } ! else ! { ! dir = (char *) xmalloc (p - filename + 1); ! memcpy (dir, filename, p - filename); ! dir[p - filename] = '\0'; ! from = p + 1; ! map = read_name_map (dir); ! free (dir); } + for (; map; map = map->map_next) + if (! strcmp (map->map_from, from)) + return fopen (map->map_to, "r"); ! return fopen (filename, "r"); } ! /* Print the file names and line numbers of the #include ! commands which led to the current file. */ ! static void ! print_containing_files (ffebadSeverity sev) ! { ! FILE_BUF *ip = NULL; ! int i; ! int first = 1; ! const char *str1; ! const char *str2; ! /* If stack of files hasn't changed since we last printed ! this info, don't repeat it. */ ! if (last_error_tick == input_file_stack_tick) ! return; ! for (i = indepth; i >= 0; i--) ! if (instack[i].fname != NULL) { ! ip = &instack[i]; ! break; ! } ! /* Give up if we don't find a source file. */ ! if (ip == NULL) ! return; ! /* Find the other, outer source files. */ ! for (i--; i >= 0; i--) ! if (instack[i].fname != NULL) ! { ! ip = &instack[i]; ! if (first) ! { ! first = 0; ! str1 = "In file included"; ! } ! else ! { ! str1 = "... ..."; ! } ! if (i == 1) ! str2 = ":"; ! else ! str2 = ""; ! ffebad_start_msg ("%A from %B at %0%C", sev); ! ffebad_here (0, ip->line, ip->column); ! ffebad_string (str1); ! ffebad_string (ip->nominal_fname); ! ffebad_string (str2); ! ffebad_finish (); ! } ! /* Record we have printed the status as of this time. */ ! last_error_tick = input_file_stack_tick; ! } ! /* Read a space delimited string of unlimited length from a stdio ! file. */ ! static char * ! read_filename_string (ch, f) ! int ch; ! FILE *f; ! { ! char *alloc, *set; ! int len; ! len = 20; ! set = alloc = xmalloc (len + 1); ! if (! is_space[ch]) ! { ! *set++ = ch; ! while ((ch = getc (f)) != EOF && ! is_space[ch]) ! { ! if (set - alloc == len) ! { ! len *= 2; ! alloc = xrealloc (alloc, len + 1); ! set = alloc + len / 2; ! } ! *set++ = ch; ! } ! } ! *set = '\0'; ! ungetc (ch, f); ! return alloc; ! } ! /* Read the file name map file for DIRNAME. */ ! static struct file_name_map * ! read_name_map (dirname) ! const char *dirname; ! { ! /* This structure holds a linked list of file name maps, one per ! directory. */ ! struct file_name_map_list ! { ! struct file_name_map_list *map_list_next; ! char *map_list_name; ! struct file_name_map *map_list_map; ! }; ! static struct file_name_map_list *map_list; ! register struct file_name_map_list *map_list_ptr; ! char *name; ! FILE *f; ! size_t dirlen; ! int separator_needed; ! dirname = skip_redundant_dir_prefix (dirname); ! for (map_list_ptr = map_list; map_list_ptr; ! map_list_ptr = map_list_ptr->map_list_next) ! if (! strcmp (map_list_ptr->map_list_name, dirname)) ! return map_list_ptr->map_list_map; ! map_list_ptr = ((struct file_name_map_list *) ! xmalloc (sizeof (struct file_name_map_list))); ! map_list_ptr->map_list_name = xstrdup (dirname); ! map_list_ptr->map_list_map = NULL; ! 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); ! f = fopen (name, "r"); ! free (name); ! if (!f) ! map_list_ptr->map_list_map = NULL; ! else ! { ! int ch; ! while ((ch = getc (f)) != EOF) ! { ! char *from, *to; ! struct file_name_map *ptr; ! ! if (is_space[ch]) ! continue; ! from = read_filename_string (ch, f); ! while ((ch = getc (f)) != EOF && is_hor_space[ch]) ! ; ! to = read_filename_string (ch, f); ! ptr = ((struct file_name_map *) ! xmalloc (sizeof (struct file_name_map))); ! ptr->map_from = from; ! /* Make the real filename absolute. */ ! if (*to == '/') ! 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); ! free (to); ! } ! ptr->map_next = map_list_ptr->map_list_map; ! map_list_ptr->map_list_map = ptr; ! while ((ch = getc (f)) != '\n') ! if (ch == EOF) ! break; ! } ! fclose (f); } ! map_list_ptr->map_list_next = map_list; ! map_list = map_list_ptr; ! return map_list_ptr->map_list_map; } ! static void ! ffecom_file_ (char *name) { ! FILE_BUF *fp; ! /* Do partial setup of input buffer for the sake of generating ! early #line directives (when -g is in effect). */ ! fp = &instack[++indepth]; ! memset ((char *) fp, 0, sizeof (FILE_BUF)); ! if (name == NULL) ! name = ""; ! fp->nominal_fname = fp->fname = name; ! } ! /* Initialize syntactic classifications of characters. */ ! static void ! ffecom_initialize_char_syntax_ () ! { ! register int i; ! /* ! * Set up is_idchar and is_idstart tables. These should be ! * faster than saying (is_alpha (c) || c == '_'), etc. ! * Set up these things before calling any routines tthat ! * refer to them. ! */ ! for (i = 'a'; i <= 'z'; i++) { ! is_idchar[i - 'a' + 'A'] = 1; ! is_idchar[i] = 1; ! is_idstart[i - 'a' + 'A'] = 1; ! is_idstart[i] = 1; ! } ! for (i = '0'; i <= '9'; i++) ! is_idchar[i] = 1; ! is_idchar['_'] = 1; ! is_idstart['_'] = 1; ! /* horizontal space table */ ! is_hor_space[' '] = 1; ! is_hor_space['\t'] = 1; ! is_hor_space['\v'] = 1; ! is_hor_space['\f'] = 1; ! is_hor_space['\r'] = 1; ! is_space[' '] = 1; ! is_space['\t'] = 1; ! is_space['\v'] = 1; ! is_space['\f'] = 1; ! is_space['\n'] = 1; ! is_space['\r'] = 1; ! } ! static void ! ffecom_close_include_ (FILE *f) ! { ! fclose (f); ! indepth--; ! input_file_stack_tick++; ! ffewhere_line_kill (instack[indepth].line); ! ffewhere_column_kill (instack[indepth].column); ! } ! static int ! ffecom_decode_include_option_ (char *spec) ! { ! struct file_name_list *dirtmp; ! ! if (! ignore_srcdir && !strcmp (spec, "-")) ! ignore_srcdir = 1; ! else ! { ! dirtmp = (struct file_name_list *) ! xmalloc (sizeof (struct file_name_list)); ! dirtmp->next = 0; /* New one goes on the end */ ! if (spec[0] != 0) ! dirtmp->fname = spec; ! else ! fatal ("Directory name must immediately follow -I option with no intervening spaces, as in `-Idir', not `-I dir'"); ! dirtmp->got_name_map = 0; ! append_include_chain (dirtmp, dirtmp); ! } ! return 1; } ! /* Open INCLUDEd file. */ ! ! static FILE * ! ffecom_open_include_ (char *name, ffewhereLine l, ffewhereColumn c) { ! char *fbeg = name; ! size_t flen = strlen (fbeg); ! struct file_name_list *search_start = include; /* Chain of dirs to search */ ! struct file_name_list dsp[1]; /* First in chain, if #include "..." */ ! struct file_name_list *searchptr = 0; ! char *fname; /* Dynamically allocated fname buffer */ ! FILE *f; ! FILE_BUF *fp; ! if (flen == 0) ! return NULL; ! dsp[0].fname = NULL; ! /* If -I- was specified, don't search current dir, only spec'd ones. */ ! if (!ignore_srcdir) ! { ! for (fp = &instack[indepth]; fp >= instack; fp--) ! { ! int n; ! char *ep; ! char *nam; ! ! if ((nam = fp->nominal_fname) != NULL) ! { ! /* Found a named file. Figure out dir of the file, ! and put it in front of the search list. */ ! dsp[0].next = search_start; ! search_start = dsp; ! #ifndef VMS ! ep = rindex (nam, '/'); ! #ifdef DIR_SEPARATOR ! if (ep == NULL) ep = rindex (nam, DIR_SEPARATOR); ! else { ! char *tmp = rindex (nam, DIR_SEPARATOR); ! if (tmp != NULL && tmp > ep) ep = tmp; ! } ! #endif ! #else /* VMS */ ! ep = rindex (nam, ']'); ! if (ep == NULL) ep = rindex (nam, '>'); ! if (ep == NULL) ep = rindex (nam, ':'); ! if (ep != NULL) ep++; ! #endif /* VMS */ ! if (ep != NULL) ! { ! n = ep - nam; ! dsp[0].fname = (char *) xmalloc (n + 1); ! strncpy (dsp[0].fname, nam, n); ! dsp[0].fname[n] = '\0'; ! if (n + INCLUDE_LEN_FUDGE > max_include_len) ! max_include_len = n + INCLUDE_LEN_FUDGE; ! } ! else ! dsp[0].fname = NULL; /* Current directory */ ! dsp[0].got_name_map = 0; ! break; ! } ! } ! } ! /* Allocate this permanently, because it gets stored in the definitions ! of macros. */ ! fname = xmalloc (max_include_len + flen + 4); ! /* + 2 above for slash and terminating null. */ ! /* + 2 added for '.h' on VMS (to support '#include filename') (NOT USED ! for g77 yet). */ ! /* If specified file name is absolute, just open it. */ ! if (*fbeg == '/' ! #ifdef DIR_SEPARATOR ! || *fbeg == DIR_SEPARATOR ! #endif ! ) { ! strncpy (fname, (char *) fbeg, flen); ! fname[flen] = 0; ! f = open_include_file (fname, NULL_PTR); } + else + { + f = NULL; ! /* Search directory path, trying to open the file. ! Copy each filename tried into FNAME. */ ! for (searchptr = search_start; searchptr; searchptr = searchptr->next) ! { ! if (searchptr->fname) ! { ! /* The empty string in a search path is ignored. ! This makes it possible to turn off entirely ! a standard piece of the list. */ ! if (searchptr->fname[0] == 0) ! continue; ! strcpy (fname, skip_redundant_dir_prefix (searchptr->fname)); ! if (fname[0] && fname[strlen (fname) - 1] != '/') ! strcat (fname, "/"); ! fname[strlen (fname) + flen] = 0; ! } ! else ! fname[0] = 0; ! strncat (fname, fbeg, flen); ! #ifdef VMS ! /* Change this 1/2 Unix 1/2 VMS file specification into a ! full VMS file specification */ ! if (searchptr->fname && (searchptr->fname[0] != 0)) ! { ! /* Fix up the filename */ ! hack_vms_include_specification (fname); ! } ! else ! { ! /* This is a normal VMS filespec, so use it unchanged. */ ! strncpy (fname, (char *) fbeg, flen); ! fname[flen] = 0; ! #if 0 /* Not for g77. */ ! /* if it's '#include filename', add the missing .h */ ! if (index (fname, '.') == NULL) ! strcat (fname, ".h"); #endif + } + #endif /* VMS */ + f = open_include_file (fname, searchptr); + #ifdef EACCES + if (f == NULL && errno == EACCES) + { + print_containing_files (FFEBAD_severityWARNING); + ffebad_start_msg ("At %0, INCLUDE file %A exists, but is not readable", + FFEBAD_severityWARNING); + ffebad_string (fname); + ffebad_here (0, l, c); + ffebad_finish (); + } + #endif + if (f != NULL) + break; + } + } ! if (f == NULL) { ! /* A file that was not found. */ ! strncpy (fname, (char *) fbeg, flen); ! fname[flen] = 0; ! print_containing_files (ffebad_severity (FFEBAD_OPEN_INCLUDE)); ! ffebad_start (FFEBAD_OPEN_INCLUDE); ! ffebad_here (0, l, c); ! ffebad_string (fname); ! ffebad_finish (); } ! if (dsp[0].fname != NULL) ! free (dsp[0].fname); ! if (f == NULL) ! return NULL; ! if (indepth >= (INPUT_STACK_MAX - 1)) ! { ! print_containing_files (FFEBAD_severityFATAL); ! ffebad_start_msg ("At %0, INCLUDE nesting too deep", ! FFEBAD_severityFATAL); ! ffebad_string (fname); ! ffebad_here (0, l, c); ! ffebad_finish (); ! return NULL; ! } ! instack[indepth].line = ffewhere_line_use (l); ! instack[indepth].column = ffewhere_column_use (c); ! fp = &instack[indepth + 1]; ! memset ((char *) fp, 0, sizeof (FILE_BUF)); ! fp->nominal_fname = fp->fname = fname; ! fp->dir = searchptr; ! indepth++; ! input_file_stack_tick++; ! return f; ! } ! #endif /* FFECOM_GCC_INCLUDE */ ! /**INDENT* (Do not reformat this comment even with -fca option.) ! Data-gathering files: Given the source file listed below, compiled with ! f2c I obtained the output file listed after that, and from the output ! file I derived the above code. ! -------- (begin input file to f2c) ! implicit none ! character*10 A1,A2 ! complex C1,C2 ! integer I1,I2 ! real R1,R2 ! double precision D1,D2 ! C ! call getem(A1,A2,C1,C2,I1,I2,R1,R2,D1,D2) ! c / ! call fooI(I1/I2) ! call fooR(R1/I1) ! call fooD(D1/I1) ! call fooC(C1/I1) ! call fooR(R1/R2) ! call fooD(R1/D1) ! call fooD(D1/D2) ! call fooD(D1/R1) ! call fooC(C1/C2) ! call fooC(C1/R1) ! call fooZ(C1/D1) ! c ** ! call fooI(I1**I2) ! call fooR(R1**I1) ! call fooD(D1**I1) ! call fooC(C1**I1) ! call fooR(R1**R2) ! call fooD(R1**D1) ! call fooD(D1**D2) ! call fooD(D1**R1) ! call fooC(C1**C2) ! call fooC(C1**R1) ! call fooZ(C1**D1) ! c FFEINTRIN_impABS ! call fooR(ABS(R1)) ! c FFEINTRIN_impACOS ! call fooR(ACOS(R1)) ! c FFEINTRIN_impAIMAG ! call fooR(AIMAG(C1)) ! c FFEINTRIN_impAINT ! call fooR(AINT(R1)) ! c FFEINTRIN_impALOG ! call fooR(ALOG(R1)) ! c FFEINTRIN_impALOG10 ! call fooR(ALOG10(R1)) ! c FFEINTRIN_impAMAX0 ! call fooR(AMAX0(I1,I2)) ! c FFEINTRIN_impAMAX1 ! call fooR(AMAX1(R1,R2)) ! c FFEINTRIN_impAMIN0 ! call fooR(AMIN0(I1,I2)) ! c FFEINTRIN_impAMIN1 ! call fooR(AMIN1(R1,R2)) ! c FFEINTRIN_impAMOD ! call fooR(AMOD(R1,R2)) ! c FFEINTRIN_impANINT ! call fooR(ANINT(R1)) ! c FFEINTRIN_impASIN ! call fooR(ASIN(R1)) ! c FFEINTRIN_impATAN ! call fooR(ATAN(R1)) ! c FFEINTRIN_impATAN2 ! call fooR(ATAN2(R1,R2)) ! c FFEINTRIN_impCABS ! call fooR(CABS(C1)) ! c FFEINTRIN_impCCOS ! call fooC(CCOS(C1)) ! c FFEINTRIN_impCEXP ! call fooC(CEXP(C1)) ! c FFEINTRIN_impCHAR ! call fooA(CHAR(I1)) ! c FFEINTRIN_impCLOG ! call fooC(CLOG(C1)) ! c FFEINTRIN_impCONJG ! call fooC(CONJG(C1)) ! c FFEINTRIN_impCOS ! call fooR(COS(R1)) ! c FFEINTRIN_impCOSH ! call fooR(COSH(R1)) ! c FFEINTRIN_impCSIN ! call fooC(CSIN(C1)) ! c FFEINTRIN_impCSQRT ! call fooC(CSQRT(C1)) ! c FFEINTRIN_impDABS ! call fooD(DABS(D1)) ! c FFEINTRIN_impDACOS ! call fooD(DACOS(D1)) ! c FFEINTRIN_impDASIN ! call fooD(DASIN(D1)) ! c FFEINTRIN_impDATAN ! call fooD(DATAN(D1)) ! c FFEINTRIN_impDATAN2 ! call fooD(DATAN2(D1,D2)) ! c FFEINTRIN_impDCOS ! call fooD(DCOS(D1)) ! c FFEINTRIN_impDCOSH ! call fooD(DCOSH(D1)) ! c FFEINTRIN_impDDIM ! call fooD(DDIM(D1,D2)) ! c FFEINTRIN_impDEXP ! call fooD(DEXP(D1)) ! c FFEINTRIN_impDIM ! call fooR(DIM(R1,R2)) ! c FFEINTRIN_impDINT ! call fooD(DINT(D1)) ! c FFEINTRIN_impDLOG ! call fooD(DLOG(D1)) ! c FFEINTRIN_impDLOG10 ! call fooD(DLOG10(D1)) ! c FFEINTRIN_impDMAX1 ! call fooD(DMAX1(D1,D2)) ! c FFEINTRIN_impDMIN1 ! call fooD(DMIN1(D1,D2)) ! c FFEINTRIN_impDMOD ! call fooD(DMOD(D1,D2)) ! c FFEINTRIN_impDNINT ! call fooD(DNINT(D1)) ! c FFEINTRIN_impDPROD ! call fooD(DPROD(R1,R2)) ! c FFEINTRIN_impDSIGN ! call fooD(DSIGN(D1,D2)) ! c FFEINTRIN_impDSIN ! call fooD(DSIN(D1)) ! c FFEINTRIN_impDSINH ! call fooD(DSINH(D1)) ! c FFEINTRIN_impDSQRT ! call fooD(DSQRT(D1)) ! c FFEINTRIN_impDTAN ! call fooD(DTAN(D1)) ! c FFEINTRIN_impDTANH ! call fooD(DTANH(D1)) ! c FFEINTRIN_impEXP ! call fooR(EXP(R1)) ! c FFEINTRIN_impIABS ! call fooI(IABS(I1)) ! c FFEINTRIN_impICHAR ! call fooI(ICHAR(A1)) ! c FFEINTRIN_impIDIM ! call fooI(IDIM(I1,I2)) ! c FFEINTRIN_impIDNINT ! call fooI(IDNINT(D1)) ! c FFEINTRIN_impINDEX ! call fooI(INDEX(A1,A2)) ! c FFEINTRIN_impISIGN ! call fooI(ISIGN(I1,I2)) ! c FFEINTRIN_impLEN ! call fooI(LEN(A1)) ! c FFEINTRIN_impLGE ! call fooL(LGE(A1,A2)) ! c FFEINTRIN_impLGT ! call fooL(LGT(A1,A2)) ! c FFEINTRIN_impLLE ! call fooL(LLE(A1,A2)) ! c FFEINTRIN_impLLT ! call fooL(LLT(A1,A2)) ! c FFEINTRIN_impMAX0 ! call fooI(MAX0(I1,I2)) ! c FFEINTRIN_impMAX1 ! call fooI(MAX1(R1,R2)) ! c FFEINTRIN_impMIN0 ! call fooI(MIN0(I1,I2)) ! c FFEINTRIN_impMIN1 ! call fooI(MIN1(R1,R2)) ! c FFEINTRIN_impMOD ! call fooI(MOD(I1,I2)) ! c FFEINTRIN_impNINT ! call fooI(NINT(R1)) ! c FFEINTRIN_impSIGN ! call fooR(SIGN(R1,R2)) ! c FFEINTRIN_impSIN ! call fooR(SIN(R1)) ! c FFEINTRIN_impSINH ! call fooR(SINH(R1)) ! c FFEINTRIN_impSQRT ! call fooR(SQRT(R1)) ! c FFEINTRIN_impTAN ! call fooR(TAN(R1)) ! c FFEINTRIN_impTANH ! call fooR(TANH(R1)) ! c FFEINTRIN_imp_CMPLX_C ! call fooC(cmplx(C1,C2)) ! c FFEINTRIN_imp_CMPLX_D ! call fooZ(cmplx(D1,D2)) ! c FFEINTRIN_imp_CMPLX_I ! call fooC(cmplx(I1,I2)) ! c FFEINTRIN_imp_CMPLX_R ! call fooC(cmplx(R1,R2)) ! c FFEINTRIN_imp_DBLE_C ! call fooD(dble(C1)) ! c FFEINTRIN_imp_DBLE_D ! call fooD(dble(D1)) ! c FFEINTRIN_imp_DBLE_I ! call fooD(dble(I1)) ! c FFEINTRIN_imp_DBLE_R ! call fooD(dble(R1)) ! c FFEINTRIN_imp_INT_C ! call fooI(int(C1)) ! c FFEINTRIN_imp_INT_D ! call fooI(int(D1)) ! c FFEINTRIN_imp_INT_I ! call fooI(int(I1)) ! c FFEINTRIN_imp_INT_R ! call fooI(int(R1)) ! c FFEINTRIN_imp_REAL_C ! call fooR(real(C1)) ! c FFEINTRIN_imp_REAL_D ! call fooR(real(D1)) ! c FFEINTRIN_imp_REAL_I ! call fooR(real(I1)) ! c FFEINTRIN_imp_REAL_R ! call fooR(real(R1)) ! c ! c FFEINTRIN_imp_INT_D: ! c ! c FFEINTRIN_specIDINT ! call fooI(IDINT(D1)) ! c ! c FFEINTRIN_imp_INT_R: ! c ! c FFEINTRIN_specIFIX ! call fooI(IFIX(R1)) ! c FFEINTRIN_specINT ! call fooI(INT(R1)) ! c ! c FFEINTRIN_imp_REAL_D: ! c ! c FFEINTRIN_specSNGL ! call fooR(SNGL(D1)) ! c ! c FFEINTRIN_imp_REAL_I: ! c ! c FFEINTRIN_specFLOAT ! call fooR(FLOAT(I1)) ! c FFEINTRIN_specREAL ! call fooR(REAL(I1)) ! c ! end ! -------- (end input file to f2c) ! -------- (begin output from providing above input file as input to: ! -------- `f2c | gcc -E -C - | sed -e "s:/[*]*://:g" -e "s:[*]*[/]://:g" \ ! -------- -e "s:^#.*$::g"') ! // -- translated by f2c (version 19950223). ! You must link the resulting object file with the libraries: ! -lf2c -lm (in that order) ! // ! // f2c.h -- Standard Fortran to C header file // ! /// barf [ba:rf] 2. "He suggested using FORTRAN, and everybody barfed." ! - From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) // ! // F2C_INTEGER will normally be `int' but would be `long' on 16-bit systems // ! // we assume short, float are OK // ! typedef long int // long int // integer; ! typedef char *address; ! typedef short int shortint; ! typedef float real; ! typedef double doublereal; ! typedef struct { real r, i; } complex; ! typedef struct { doublereal r, i; } doublecomplex; ! typedef long int // long int // logical; ! typedef short int shortlogical; ! typedef char logical1; ! typedef char integer1; ! // typedef long long longint; // // system-dependent // ! // Extern is for use with -E // ! // I/O stuff // ! typedef long int // int or long int // flag; ! typedef long int // int or long int // ftnlen; ! typedef long int // int or long int // ftnint; ! //external read, write// ! typedef struct ! { flag cierr; ! ftnint ciunit; ! flag ciend; ! char *cifmt; ! ftnint cirec; ! } cilist; ! //internal read, write// ! typedef struct ! { flag icierr; ! char *iciunit; ! flag iciend; ! char *icifmt; ! ftnint icirlen; ! ftnint icirnum; ! } icilist; ! //open// ! typedef struct ! { flag oerr; ! ftnint ounit; ! char *ofnm; ! ftnlen ofnmlen; ! char *osta; ! char *oacc; ! char *ofm; ! ftnint orl; ! char *oblnk; ! } olist; ! //close// ! typedef struct ! { flag cerr; ! ftnint cunit; ! char *csta; ! } cllist; ! //rewind, backspace, endfile// ! typedef struct ! { flag aerr; ! ftnint aunit; ! } alist; ! // inquire // ! typedef struct ! { flag inerr; ! ftnint inunit; ! char *infile; ! ftnlen infilen; ! ftnint *inex; //parameters in standard's order// ! ftnint *inopen; ! ftnint *innum; ! ftnint *innamed; ! char *inname; ! ftnlen innamlen; ! char *inacc; ! ftnlen inacclen; ! char *inseq; ! ftnlen inseqlen; ! char *indir; ! ftnlen indirlen; ! char *infmt; ! ftnlen infmtlen; ! char *inform; ! ftnint informlen; ! char *inunf; ! ftnlen inunflen; ! ftnint *inrecl; ! ftnint *innrec; ! char *inblank; ! ftnlen inblanklen; ! } inlist; ! union Multitype { // for multiple entry points // ! integer1 g; ! shortint h; ! integer i; ! // longint j; // ! real r; ! doublereal d; ! complex c; ! doublecomplex z; ! }; ! ! typedef union Multitype Multitype; ! typedef long Long; // No longer used; formerly in Namelist // ! struct Vardesc { // for Namelist // ! char *name; ! char *addr; ! ftnlen *dims; ! int type; ! }; ! typedef struct Vardesc Vardesc; ! struct Namelist { ! char *name; ! Vardesc **vars; ! int nvars; ! }; ! typedef struct Namelist Namelist; ! // procedure parameter types for -A and -C++ // ! typedef int // Unknown procedure type // (*U_fp)(); ! typedef shortint (*J_fp)(); ! typedef integer (*I_fp)(); ! typedef real (*R_fp)(); ! typedef doublereal (*D_fp)(), (*E_fp)(); ! typedef // Complex // void (*C_fp)(); ! typedef // Double Complex // void (*Z_fp)(); ! typedef logical (*L_fp)(); ! typedef shortlogical (*K_fp)(); ! typedef // Character // void (*H_fp)(); ! typedef // Subroutine // int (*S_fp)(); ! // E_fp is for real functions when -R is not specified // ! typedef void C_f; // complex function // ! typedef void H_f; // character function // ! typedef void Z_f; // double complex function // ! typedef doublereal E_f; // real function with -R not specified // ! // undef any lower-case symbols that your C compiler predefines, e.g.: // ! // (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].) // ! // Main program // MAIN__() ! { ! // System generated locals // ! integer i__1; ! real r__1, r__2; ! doublereal d__1, d__2; ! complex q__1; ! doublecomplex z__1, z__2, z__3; ! logical L__1; ! char ch__1[1]; ! ! // Builtin functions // ! void c_div(); ! integer pow_ii(); ! double pow_ri(), pow_di(); ! void pow_ci(); ! double pow_dd(); ! void pow_zz(); ! double acos(), r_imag(), r_int(), log(), r_lg10(), r_mod(), r_nint(), ! asin(), atan(), atan2(), c_abs(); ! void c_cos(), c_exp(), c_log(), r_cnjg(); ! double cos(), cosh(); ! void c_sin(), c_sqrt(); ! double d_dim(), exp(), r_dim(), d_int(), d_lg10(), d_mod(), d_nint(), ! d_sign(), sin(), sinh(), sqrt(), tan(), tanh(); ! integer i_dim(), i_dnnt(), i_indx(), i_sign(), i_len(); ! logical l_ge(), l_gt(), l_le(), l_lt(); ! integer i_nint(); ! double r_sign(); ! ! // Local variables // ! extern // Subroutine // int fooa_(), fooc_(), food_(), fooi_(), foor_(), ! fool_(), fooz_(), getem_(); ! static char a1[10], a2[10]; ! static complex c1, c2; ! static doublereal d1, d2; ! static integer i1, i2; ! static real r1, r2; ! ! ! getem_(a1, a2, &c1, &c2, &i1, &i2, &r1, &r2, &d1, &d2, 10L, 10L); ! // / // ! i__1 = i1 / i2; ! fooi_(&i__1); ! r__1 = r1 / i1; ! foor_(&r__1); ! d__1 = d1 / i1; ! food_(&d__1); ! d__1 = (doublereal) i1; ! q__1.r = c1.r / d__1, q__1.i = c1.i / d__1; ! fooc_(&q__1); ! r__1 = r1 / r2; ! foor_(&r__1); ! d__1 = r1 / d1; ! food_(&d__1); ! d__1 = d1 / d2; ! food_(&d__1); ! d__1 = d1 / r1; ! food_(&d__1); ! c_div(&q__1, &c1, &c2); ! fooc_(&q__1); ! q__1.r = c1.r / r1, q__1.i = c1.i / r1; ! fooc_(&q__1); ! z__1.r = c1.r / d1, z__1.i = c1.i / d1; ! fooz_(&z__1); ! // ** // ! i__1 = pow_ii(&i1, &i2); ! fooi_(&i__1); ! r__1 = pow_ri(&r1, &i1); ! foor_(&r__1); ! d__1 = pow_di(&d1, &i1); ! food_(&d__1); ! pow_ci(&q__1, &c1, &i1); ! fooc_(&q__1); ! d__1 = (doublereal) r1; ! d__2 = (doublereal) r2; ! r__1 = pow_dd(&d__1, &d__2); ! foor_(&r__1); ! d__2 = (doublereal) r1; ! d__1 = pow_dd(&d__2, &d1); ! food_(&d__1); ! d__1 = pow_dd(&d1, &d2); ! food_(&d__1); ! d__2 = (doublereal) r1; ! d__1 = pow_dd(&d1, &d__2); ! food_(&d__1); ! z__2.r = c1.r, z__2.i = c1.i; ! z__3.r = c2.r, z__3.i = c2.i; ! pow_zz(&z__1, &z__2, &z__3); ! q__1.r = z__1.r, q__1.i = z__1.i; ! fooc_(&q__1); ! z__2.r = c1.r, z__2.i = c1.i; ! z__3.r = r1, z__3.i = 0.; ! pow_zz(&z__1, &z__2, &z__3); ! q__1.r = z__1.r, q__1.i = z__1.i; ! fooc_(&q__1); ! z__2.r = c1.r, z__2.i = c1.i; ! z__3.r = d1, z__3.i = 0.; ! pow_zz(&z__1, &z__2, &z__3); ! fooz_(&z__1); ! // FFEINTRIN_impABS // ! r__1 = (doublereal)(( r1 ) >= 0 ? ( r1 ) : -( r1 )) ; ! foor_(&r__1); ! // FFEINTRIN_impACOS // ! r__1 = acos(r1); ! foor_(&r__1); ! // FFEINTRIN_impAIMAG // ! r__1 = r_imag(&c1); ! foor_(&r__1); ! // FFEINTRIN_impAINT // ! r__1 = r_int(&r1); ! foor_(&r__1); ! // FFEINTRIN_impALOG // ! r__1 = log(r1); ! foor_(&r__1); ! // FFEINTRIN_impALOG10 // ! r__1 = r_lg10(&r1); ! foor_(&r__1); ! // FFEINTRIN_impAMAX0 // ! r__1 = (real) (( i1 ) >= ( i2 ) ? ( i1 ) : ( i2 )) ; ! foor_(&r__1); ! // FFEINTRIN_impAMAX1 // ! r__1 = (doublereal)(( r1 ) >= ( r2 ) ? ( r1 ) : ( r2 )) ; ! foor_(&r__1); ! // FFEINTRIN_impAMIN0 // ! r__1 = (real) (( i1 ) <= ( i2 ) ? ( i1 ) : ( i2 )) ; ! foor_(&r__1); ! // FFEINTRIN_impAMIN1 // ! r__1 = (doublereal)(( r1 ) <= ( r2 ) ? ( r1 ) : ( r2 )) ; ! foor_(&r__1); ! // FFEINTRIN_impAMOD // ! r__1 = r_mod(&r1, &r2); ! foor_(&r__1); ! // FFEINTRIN_impANINT // ! r__1 = r_nint(&r1); ! foor_(&r__1); ! // FFEINTRIN_impASIN // ! r__1 = asin(r1); ! foor_(&r__1); ! // FFEINTRIN_impATAN // ! r__1 = atan(r1); ! foor_(&r__1); ! // FFEINTRIN_impATAN2 // ! r__1 = atan2(r1, r2); ! foor_(&r__1); ! // FFEINTRIN_impCABS // ! r__1 = c_abs(&c1); ! foor_(&r__1); ! // FFEINTRIN_impCCOS // ! c_cos(&q__1, &c1); ! fooc_(&q__1); ! // FFEINTRIN_impCEXP // ! c_exp(&q__1, &c1); ! fooc_(&q__1); ! // FFEINTRIN_impCHAR // ! *(unsigned char *)&ch__1[0] = i1; ! fooa_(ch__1, 1L); ! // FFEINTRIN_impCLOG // ! c_log(&q__1, &c1); ! fooc_(&q__1); ! // FFEINTRIN_impCONJG // ! r_cnjg(&q__1, &c1); ! fooc_(&q__1); ! // FFEINTRIN_impCOS // ! r__1 = cos(r1); ! foor_(&r__1); ! // FFEINTRIN_impCOSH // ! r__1 = cosh(r1); ! foor_(&r__1); ! // FFEINTRIN_impCSIN // ! c_sin(&q__1, &c1); ! fooc_(&q__1); ! // FFEINTRIN_impCSQRT // ! c_sqrt(&q__1, &c1); ! fooc_(&q__1); ! // FFEINTRIN_impDABS // ! d__1 = (( d1 ) >= 0 ? ( d1 ) : -( d1 )) ; ! food_(&d__1); ! // FFEINTRIN_impDACOS // ! d__1 = acos(d1); ! food_(&d__1); ! // FFEINTRIN_impDASIN // ! d__1 = asin(d1); ! food_(&d__1); ! // FFEINTRIN_impDATAN // ! d__1 = atan(d1); ! food_(&d__1); ! // FFEINTRIN_impDATAN2 // ! d__1 = atan2(d1, d2); ! food_(&d__1); ! // FFEINTRIN_impDCOS // ! d__1 = cos(d1); ! food_(&d__1); ! // FFEINTRIN_impDCOSH // ! d__1 = cosh(d1); ! food_(&d__1); ! // FFEINTRIN_impDDIM // ! d__1 = d_dim(&d1, &d2); ! food_(&d__1); ! // FFEINTRIN_impDEXP // ! d__1 = exp(d1); ! food_(&d__1); ! // FFEINTRIN_impDIM // ! r__1 = r_dim(&r1, &r2); ! foor_(&r__1); ! // FFEINTRIN_impDINT // ! d__1 = d_int(&d1); ! food_(&d__1); ! // FFEINTRIN_impDLOG // ! d__1 = log(d1); ! food_(&d__1); ! // FFEINTRIN_impDLOG10 // ! d__1 = d_lg10(&d1); ! food_(&d__1); ! // FFEINTRIN_impDMAX1 // ! d__1 = (( d1 ) >= ( d2 ) ? ( d1 ) : ( d2 )) ; ! food_(&d__1); ! // FFEINTRIN_impDMIN1 // ! d__1 = (( d1 ) <= ( d2 ) ? ( d1 ) : ( d2 )) ; ! food_(&d__1); ! // FFEINTRIN_impDMOD // ! d__1 = d_mod(&d1, &d2); ! food_(&d__1); ! // FFEINTRIN_impDNINT // ! d__1 = d_nint(&d1); ! food_(&d__1); ! // FFEINTRIN_impDPROD // ! d__1 = (doublereal) r1 * r2; ! food_(&d__1); ! // FFEINTRIN_impDSIGN // ! d__1 = d_sign(&d1, &d2); ! food_(&d__1); ! // FFEINTRIN_impDSIN // ! d__1 = sin(d1); ! food_(&d__1); ! // FFEINTRIN_impDSINH // ! d__1 = sinh(d1); ! food_(&d__1); ! // FFEINTRIN_impDSQRT // ! d__1 = sqrt(d1); ! food_(&d__1); ! // FFEINTRIN_impDTAN // ! d__1 = tan(d1); ! food_(&d__1); ! // FFEINTRIN_impDTANH // ! d__1 = tanh(d1); ! food_(&d__1); ! // FFEINTRIN_impEXP // ! r__1 = exp(r1); ! foor_(&r__1); ! // FFEINTRIN_impIABS // ! i__1 = (( i1 ) >= 0 ? ( i1 ) : -( i1 )) ; ! fooi_(&i__1); ! // FFEINTRIN_impICHAR // ! i__1 = *(unsigned char *)a1; ! fooi_(&i__1); ! // FFEINTRIN_impIDIM // ! i__1 = i_dim(&i1, &i2); ! fooi_(&i__1); ! // FFEINTRIN_impIDNINT // ! i__1 = i_dnnt(&d1); ! fooi_(&i__1); ! // FFEINTRIN_impINDEX // ! i__1 = i_indx(a1, a2, 10L, 10L); ! fooi_(&i__1); ! // FFEINTRIN_impISIGN // ! i__1 = i_sign(&i1, &i2); ! fooi_(&i__1); ! // FFEINTRIN_impLEN // ! i__1 = i_len(a1, 10L); ! fooi_(&i__1); ! // FFEINTRIN_impLGE // ! L__1 = l_ge(a1, a2, 10L, 10L); ! fool_(&L__1); ! // FFEINTRIN_impLGT // ! L__1 = l_gt(a1, a2, 10L, 10L); ! fool_(&L__1); ! // FFEINTRIN_impLLE // ! L__1 = l_le(a1, a2, 10L, 10L); ! fool_(&L__1); ! // FFEINTRIN_impLLT // ! L__1 = l_lt(a1, a2, 10L, 10L); ! fool_(&L__1); ! // FFEINTRIN_impMAX0 // ! i__1 = (( i1 ) >= ( i2 ) ? ( i1 ) : ( i2 )) ; ! fooi_(&i__1); ! // FFEINTRIN_impMAX1 // ! i__1 = (integer) (doublereal)(( r1 ) >= ( r2 ) ? ( r1 ) : ( r2 )) ; ! fooi_(&i__1); ! // FFEINTRIN_impMIN0 // ! i__1 = (( i1 ) <= ( i2 ) ? ( i1 ) : ( i2 )) ; ! fooi_(&i__1); ! // FFEINTRIN_impMIN1 // ! i__1 = (integer) (doublereal)(( r1 ) <= ( r2 ) ? ( r1 ) : ( r2 )) ; ! fooi_(&i__1); ! // FFEINTRIN_impMOD // ! i__1 = i1 % i2; ! fooi_(&i__1); ! // FFEINTRIN_impNINT // ! i__1 = i_nint(&r1); ! fooi_(&i__1); ! // FFEINTRIN_impSIGN // ! r__1 = r_sign(&r1, &r2); ! foor_(&r__1); ! // FFEINTRIN_impSIN // ! r__1 = sin(r1); ! foor_(&r__1); ! // FFEINTRIN_impSINH // ! r__1 = sinh(r1); ! foor_(&r__1); ! // FFEINTRIN_impSQRT // ! r__1 = sqrt(r1); ! foor_(&r__1); ! // FFEINTRIN_impTAN // ! r__1 = tan(r1); ! foor_(&r__1); ! // FFEINTRIN_impTANH // ! r__1 = tanh(r1); ! foor_(&r__1); ! // FFEINTRIN_imp_CMPLX_C // ! r__1 = c1.r; ! r__2 = c2.r; ! q__1.r = r__1, q__1.i = r__2; ! fooc_(&q__1); ! // FFEINTRIN_imp_CMPLX_D // ! z__1.r = d1, z__1.i = d2; ! fooz_(&z__1); ! // FFEINTRIN_imp_CMPLX_I // ! r__1 = (real) i1; ! r__2 = (real) i2; ! q__1.r = r__1, q__1.i = r__2; ! fooc_(&q__1); ! // FFEINTRIN_imp_CMPLX_R // ! q__1.r = r1, q__1.i = r2; ! fooc_(&q__1); ! // FFEINTRIN_imp_DBLE_C // ! d__1 = (doublereal) c1.r; ! food_(&d__1); ! // FFEINTRIN_imp_DBLE_D // ! d__1 = d1; ! food_(&d__1); ! // FFEINTRIN_imp_DBLE_I // ! d__1 = (doublereal) i1; ! food_(&d__1); ! // FFEINTRIN_imp_DBLE_R // ! d__1 = (doublereal) r1; ! food_(&d__1); ! // FFEINTRIN_imp_INT_C // ! i__1 = (integer) c1.r; ! fooi_(&i__1); ! // FFEINTRIN_imp_INT_D // ! i__1 = (integer) d1; ! fooi_(&i__1); ! // FFEINTRIN_imp_INT_I // ! i__1 = i1; ! fooi_(&i__1); ! // FFEINTRIN_imp_INT_R // ! i__1 = (integer) r1; ! fooi_(&i__1); ! // FFEINTRIN_imp_REAL_C // ! r__1 = c1.r; ! foor_(&r__1); ! // FFEINTRIN_imp_REAL_D // ! r__1 = (real) d1; ! foor_(&r__1); ! // FFEINTRIN_imp_REAL_I // ! r__1 = (real) i1; ! foor_(&r__1); ! // FFEINTRIN_imp_REAL_R // ! r__1 = r1; ! foor_(&r__1); ! ! // FFEINTRIN_imp_INT_D: // ! ! // FFEINTRIN_specIDINT // ! i__1 = (integer) d1; ! fooi_(&i__1); ! ! // FFEINTRIN_imp_INT_R: // ! ! // FFEINTRIN_specIFIX // ! i__1 = (integer) r1; ! fooi_(&i__1); ! // FFEINTRIN_specINT // ! i__1 = (integer) r1; ! fooi_(&i__1); ! ! // FFEINTRIN_imp_REAL_D: // ! // FFEINTRIN_specSNGL // ! r__1 = (real) d1; ! foor_(&r__1); ! // FFEINTRIN_imp_REAL_I: // ! // FFEINTRIN_specFLOAT // ! r__1 = (real) i1; ! foor_(&r__1); ! // FFEINTRIN_specREAL // ! r__1 = (real) i1; ! foor_(&r__1); ! } // MAIN__ // ! -------- (end output file from f2c) ! */ diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/com.h gcc-2.95/gcc/f/com.h *** egcs-1.1.2/gcc/f/com.h Mon Jun 15 19:23:16 1998 --- gcc-2.95/gcc/f/com.h Sat Apr 17 03:58:25 1999 *************** *** 1,6 **** /* com.h -- Public #include File (module.h template V1.0) Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* com.h -- Public #include File (module.h template V1.0) Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** the Free Software Foundation, 59 Temple *** 56,61 **** --- 56,62 ---- #if FFECOM_targetCURRENT == FFECOM_targetGCC #define FFECOM_constantNULL NULL_TREE + #define FFECOM_nonterNULL NULL_TREE #define FFECOM_globalNULL NULL_TREE #define FFECOM_labelNULL NULL_TREE #define FFECOM_storageNULL NULL_TREE *************** typedef enum *** 202,207 **** --- 203,210 ---- typedef tree ffecomConstant; #define FFECOM_constantHOOK + typedef tree ffecomNonter; + #define FFECOM_nonterHOOK typedef tree ffecomLabel; #define FFECOM_globalHOOK typedef tree ffecomGlobal; *************** tree ffecom_3 (enum tree_code code, tree *** 279,293 **** tree ffecom_3s (enum tree_code code, tree type, tree node1, tree node2, tree node3); tree ffecom_arg_expr (ffebld expr, tree *length); tree ffecom_arg_ptr_to_expr (ffebld expr, tree *length); ! tree ffecom_call_gfrt (ffecomGfrt ix, tree args); tree ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt, ffeinfoKindtype kt, tree tree_type); ! tree ffecom_decl_field (tree context, tree prevfield, char *name, tree type); #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ void ffecom_close_include (FILE *f); int ffecom_decode_include_option (char *spec); void ffecom_end_transition (void); void ffecom_exec_transition (void); void ffecom_expand_let_stmt (ffebld dest, ffebld source); --- 282,301 ---- tree ffecom_3s (enum tree_code code, tree type, tree node1, tree node2, tree node3); 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 (ffebldConstantUnion *cu, ffeinfoBasictype bt, ffeinfoKindtype kt, tree tree_type); ! tree ffecom_const_expr (ffebld expr); ! tree ffecom_decl_field (tree context, tree prevfield, const char *name, tree type); #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ void ffecom_close_include (FILE *f); int ffecom_decode_include_option (char *spec); + #if FFECOM_targetCURRENT == FFECOM_targetGCC + tree ffecom_end_compstmt (void); + #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ void ffecom_end_transition (void); void ffecom_exec_transition (void); void ffecom_expand_let_stmt (ffebld dest, ffebld source); *************** void ffecom_expand_let_stmt (ffebld dest *** 295,305 **** tree ffecom_expr (ffebld expr); tree ffecom_expr_assign (ffebld expr); tree ffecom_expr_assign_w (ffebld expr); ! tree ffecom_expr_rw (ffebld expr); void ffecom_finish_compile (void); void ffecom_finish_decl (tree decl, tree init, bool is_top_level); void ffecom_finish_progunit (void); ! tree ffecom_get_invented_identifier (char *pattern, char *text, int number); ffeinfoKindtype ffecom_gfrt_basictype (ffecomGfrt ix); ffeinfoKindtype ffecom_gfrt_kindtype (ffecomGfrt ix); --- 303,314 ---- tree ffecom_expr (ffebld expr); tree ffecom_expr_assign (ffebld expr); tree ffecom_expr_assign_w (ffebld expr); ! tree ffecom_expr_rw (tree type, ffebld expr); ! tree ffecom_expr_w (tree type, ffebld expr); void ffecom_finish_compile (void); void ffecom_finish_decl (tree decl, tree init, bool is_top_level); void ffecom_finish_progunit (void); ! tree ffecom_get_invented_identifier (const char *pattern, const char *text, int number); ffeinfoKindtype ffecom_gfrt_basictype (ffecomGfrt ix); ffeinfoKindtype ffecom_gfrt_kindtype (ffecomGfrt ix); *************** void ffecom_init_2 (void); *** 308,313 **** --- 317,324 ---- tree ffecom_list_expr (ffebld list); tree ffecom_list_ptr_to_expr (ffebld list); tree ffecom_lookup_label (ffelab label); + tree ffecom_make_tempvar (const char *commentary, tree type, + ffetargetCharacterSize size, int elements); tree ffecom_modify (tree newtype, tree lhs, tree rhs); #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ void ffecom_file (char *name); *************** void ffecom_notify_init_symbol (ffesymbo *** 316,329 **** void ffecom_notify_primary_entry (ffesymbol fn); FILE *ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c); #if FFECOM_targetCURRENT == FFECOM_targetGCC ! void ffecom_pop_calltemps (void); ! void ffecom_pop_tempvar (tree var); tree ffecom_ptr_to_expr (ffebld expr); - void ffecom_push_calltemps (void); - tree ffecom_push_tempvar (tree type, ffetargetCharacterSize size, - int elements, bool auto_pop); tree ffecom_return_expr (ffebld expr); tree ffecom_save_tree (tree t); tree ffecom_start_decl (tree decl, bool is_init); void ffecom_sym_commit (ffesymbol s); #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ --- 327,344 ---- void ffecom_notify_primary_entry (ffesymbol fn); FILE *ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c); #if FFECOM_targetCURRENT == FFECOM_targetGCC ! void ffecom_prepare_arg_ptr_to_expr (ffebld expr); ! bool ffecom_prepare_end (void); ! void ffecom_prepare_expr_ (ffebld expr, ffebld dest); ! void ffecom_prepare_expr_rw (tree type, ffebld expr); ! void ffecom_prepare_expr_w (tree type, ffebld expr); ! void ffecom_prepare_ptr_to_expr (ffebld expr); ! void ffecom_prepare_return_expr (ffebld expr); ! tree ffecom_ptr_to_const_expr (ffebld expr); tree ffecom_ptr_to_expr (ffebld expr); tree ffecom_return_expr (ffebld expr); tree ffecom_save_tree (tree t); + void ffecom_start_compstmt (void); tree ffecom_start_decl (tree decl, bool is_init); void ffecom_sym_commit (ffesymbol s); #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ *************** void ffecom_sym_retract (ffesymbol s); *** 335,340 **** --- 350,356 ---- tree ffecom_temp_label (void); 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); /* These need to be in the front end with exactly these interfaces, *************** int mark_addressable (tree expr); *** 360,365 **** --- 376,382 ---- #define ffecom_f2c_typecode(bt,kt) ffecom_f2c_typecode_[(bt)][(kt)] #define ffecom_label_kind() ffecom_label_kind_ #define ffecom_pointer_kind() ffecom_pointer_kind_ + #define ffecom_prepare_expr(e) ffecom_prepare_expr_ ((e), NULL) #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ #define ffecom_init_1() diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/config.j gcc-2.95/gcc/f/config.j *** egcs-1.1.2/gcc/f/config.j Tue May 19 03:49:22 1998 --- gcc-2.95/gcc/f/config.j Mon Feb 15 10:16:35 1999 *************** *** 1,6 **** /* config.j -- Wrapper for GCC's config.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* config.j -- Wrapper for GCC's config.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/convert.j gcc-2.95/gcc/f/convert.j *** egcs-1.1.2/gcc/f/convert.j Tue May 19 03:49:23 1998 --- gcc-2.95/gcc/f/convert.j Mon Feb 15 10:16:36 1999 *************** *** 1,6 **** /* convert.j -- Wrapper for GCC's convert.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* convert.j -- Wrapper for GCC's convert.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/data.c gcc-2.95/gcc/f/data.c *** egcs-1.1.2/gcc/f/data.c Tue Jun 30 00:59:33 1998 --- gcc-2.95/gcc/f/data.c Sat Mar 27 02:23:44 1999 *************** *** 1,6 **** /* data.c -- Implementation File (module.c template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* data.c -- Implementation File (module.c template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** tail_recurse: /* :::::::::::::::::::: *** 668,674 **** expression doesn't already exist in the cache) and then puts the result in the cache. */ ! ffebld ffedata_convert_ (ffebld source, ffelexToken source_token, ffelexToken dest_token, ffeinfoBasictype bt, ffeinfoKindtype kt, ffeinfoRank rk, --- 668,674 ---- expression doesn't already exist in the cache) and then puts the result in the cache. */ ! static ffebld ffedata_convert_ (ffebld source, ffelexToken source_token, ffelexToken dest_token, ffeinfoBasictype bt, ffeinfoKindtype kt, ffeinfoRank rk, *************** ffedata_eval_substr_end_ (ffebld expr, f *** 1119,1125 **** If st has any initialization info, transfer that info into mst and clear st's info. */ ! void ffedata_gather_ (ffestorag mst, ffestorag st) { ffesymbol s; --- 1119,1125 ---- If st has any initialization info, transfer that info into mst and clear st's info. */ ! static void ffedata_gather_ (ffestorag mst, ffestorag st) { ffesymbol s; diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/data.h gcc-2.95/gcc/f/data.h *** egcs-1.1.2/gcc/f/data.h Tue May 19 03:49:25 1998 --- gcc-2.95/gcc/f/data.h Mon Feb 15 10:16:38 1999 *************** *** 1,6 **** /* data.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* data.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/equiv.c gcc-2.95/gcc/f/equiv.c *** egcs-1.1.2/gcc/f/equiv.c Sat Jul 11 21:47:16 1998 --- gcc-2.95/gcc/f/equiv.c Mon Feb 15 10:16:39 1999 *************** *** 1,6 **** /* equiv.c -- Implementation File (module.c template V1.0) Copyright (C) 1995-1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* equiv.c -- Implementation File (module.c template V1.0) Copyright (C) 1995-1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/equiv.h gcc-2.95/gcc/f/equiv.h *** egcs-1.1.2/gcc/f/equiv.h Mon Jun 15 19:23:18 1998 --- gcc-2.95/gcc/f/equiv.h Mon Feb 15 10:16:41 1999 *************** *** 1,6 **** /* equiv.h -- Public #include File (module.h template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* equiv.h -- Public #include File (module.h template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/expr.c gcc-2.95/gcc/f/expr.c *** egcs-1.1.2/gcc/f/expr.c Mon Jun 15 19:23:19 1998 --- gcc-2.95/gcc/f/expr.c Sat May 15 08:46:08 1999 *************** *** 1,6 **** /* expr.c -- Implementation File (module.c template V1.0) Copyright (C) 1995-1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* expr.c -- Implementation File (module.c template V1.0) Copyright (C) 1995-1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** static void ffeexpr_update_impdo_sym_ (f *** 268,274 **** static ffeexprContext ffeexpr_context_outer_ (ffeexprStack_ s); static ffeexprExpr_ ffeexpr_expr_new_ (void); static void ffeexpr_fulfill_call_ (ffebld *expr, ffelexToken t); ! static bool ffeexpr_isdigits_ (char *p); static ffelexHandler ffeexpr_token_first_lhs_ (ffelexToken t); static ffelexHandler ffeexpr_token_first_lhs_1_ (ffelexToken t); static ffelexHandler ffeexpr_token_first_rhs_ (ffelexToken t); --- 268,274 ---- static ffeexprContext ffeexpr_context_outer_ (ffeexprStack_ s); static ffeexprExpr_ ffeexpr_expr_new_ (void); static void ffeexpr_fulfill_call_ (ffebld *expr, ffelexToken t); ! static bool ffeexpr_isdigits_ (const char *p); static ffelexHandler ffeexpr_token_first_lhs_ (ffelexToken t); static ffelexHandler ffeexpr_token_first_lhs_1_ (ffelexToken t); static ffelexHandler ffeexpr_token_first_rhs_ (ffelexToken t); *************** ffeexpr_collapse_convert (ffebld expr, f *** 633,638 **** --- 633,642 ---- break; } + /* If conversion operation is not implemented, return original expr. */ + if (error == FFEBAD_NOCANDO) + return expr; + expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val (ffebld_cu_val_integer1 (u)), expr); *************** ffeexpr_collapse_convert (ffebld expr, f *** 822,827 **** --- 826,835 ---- break; } + /* If conversion operation is not implemented, return original expr. */ + if (error == FFEBAD_NOCANDO) + return expr; + expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val (ffebld_cu_val_integer2 (u)), expr); *************** ffeexpr_collapse_convert (ffebld expr, f *** 1011,1016 **** --- 1019,1028 ---- break; } + /* If conversion operation is not implemented, return original expr. */ + if (error == FFEBAD_NOCANDO) + return expr; + expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val (ffebld_cu_val_integer3 (u)), expr); *************** ffeexpr_collapse_convert (ffebld expr, f *** 1200,1205 **** --- 1212,1221 ---- break; } + /* If conversion operation is not implemented, return original expr. */ + if (error == FFEBAD_NOCANDO) + return expr; + expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val (ffebld_cu_val_integer4 (u)), expr); *************** ffeexpr_collapse_convert (ffebld expr, f *** 1317,1322 **** --- 1333,1342 ---- break; } + /* If conversion operation is not implemented, return original expr. */ + if (error == FFEBAD_NOCANDO) + return expr; + expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val (ffebld_cu_val_logical1 (u)), expr); *************** ffeexpr_collapse_convert (ffebld expr, f *** 1424,1429 **** --- 1444,1453 ---- break; } + /* If conversion operation is not implemented, return original expr. */ + if (error == FFEBAD_NOCANDO) + return expr; + expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val (ffebld_cu_val_logical2 (u)), expr); *************** ffeexpr_collapse_convert (ffebld expr, f *** 1531,1536 **** --- 1555,1564 ---- break; } + /* If conversion operation is not implemented, return original expr. */ + if (error == FFEBAD_NOCANDO) + return expr; + expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val (ffebld_cu_val_logical3 (u)), expr); *************** ffeexpr_collapse_convert (ffebld expr, f *** 1638,1643 **** --- 1666,1675 ---- break; } + /* If conversion operation is not implemented, return original expr. */ + if (error == FFEBAD_NOCANDO) + return expr; + expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val (ffebld_cu_val_logical4 (u)), expr); *************** ffeexpr_collapse_convert (ffebld expr, f *** 1796,1801 **** --- 1828,1837 ---- break; } + /* If conversion operation is not implemented, return original expr. */ + if (error == FFEBAD_NOCANDO) + return expr; + expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val (ffebld_cu_val_real1 (u)), expr); *************** ffeexpr_collapse_convert (ffebld expr, f *** 1944,1949 **** --- 1980,1989 ---- break; } + /* If conversion operation is not implemented, return original expr. */ + if (error == FFEBAD_NOCANDO) + return expr; + expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val (ffebld_cu_val_real2 (u)), expr); *************** ffeexpr_collapse_convert (ffebld expr, f *** 2092,2097 **** --- 2132,2141 ---- break; } + /* If conversion operation is not implemented, return original expr. */ + if (error == FFEBAD_NOCANDO) + return expr; + expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val (ffebld_cu_val_real3 (u)), expr); *************** ffeexpr_collapse_convert (ffebld expr, f *** 2240,2245 **** --- 2284,2293 ---- break; } + /* If conversion operation is not implemented, return original expr. */ + if (error == FFEBAD_NOCANDO) + return expr; + expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val (ffebld_cu_val_real4 (u)), expr); *************** ffeexpr_collapse_convert (ffebld expr, f *** 2398,2403 **** --- 2446,2455 ---- break; } + /* If conversion operation is not implemented, return original expr. */ + if (error == FFEBAD_NOCANDO) + return expr; + expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val (ffebld_cu_val_complex1 (u)), expr); *************** ffeexpr_collapse_convert (ffebld expr, f *** 2546,2551 **** --- 2598,2607 ---- break; } + /* If conversion operation is not implemented, return original expr. */ + if (error == FFEBAD_NOCANDO) + return expr; + expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val (ffebld_cu_val_complex2 (u)), expr); *************** ffeexpr_collapse_convert (ffebld expr, f *** 2694,2699 **** --- 2750,2759 ---- break; } + /* If conversion operation is not implemented, return original expr. */ + if (error == FFEBAD_NOCANDO) + return expr; + expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val (ffebld_cu_val_complex3 (u)), expr); *************** ffeexpr_collapse_convert (ffebld expr, f *** 2842,2847 **** --- 2902,2911 ---- break; } + /* If conversion operation is not implemented, return original expr. */ + if (error == FFEBAD_NOCANDO) + return expr; + expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val (ffebld_cu_val_complex4 (u)), expr); *************** ffeexpr_context_outer_ (ffeexprStack_ s) *** 8520,8526 **** static ffeexprPercent_ ffeexpr_percent_ (ffelexToken t) { ! char *p; switch (ffelex_token_length (t)) { --- 8584,8590 ---- static ffeexprPercent_ ffeexpr_percent_ (ffelexToken t) { ! const char *p; switch (ffelex_token_length (t)) { *************** ffeexpr_fulfill_call_ (ffebld *expr, ffe *** 9473,9479 **** /* Check whether rest of string is all decimal digits. */ static bool ! ffeexpr_isdigits_ (char *p) { for (; *p != '\0'; ++p) if (! ISDIGIT (*p)) --- 9537,9543 ---- /* Check whether rest of string is all decimal digits. */ static bool ! ffeexpr_isdigits_ (const char *p) { for (; *p != '\0'; ++p) if (! ISDIGIT (*p)) *************** ffeexpr_reduced_concatenate_ (ffebld red *** 10314,10320 **** if ((lkd != FFEINFO_kindANY) && ffebad_start (FFEBAD_CONCAT_ARG_KIND)) { ! char *what; if (lrk != 0) what = "an array"; --- 10378,10384 ---- if ((lkd != FFEINFO_kindANY) && ffebad_start (FFEBAD_CONCAT_ARG_KIND)) { ! const char *what; if (lrk != 0) what = "an array"; *************** ffeexpr_reduced_concatenate_ (ffebld red *** 10330,10336 **** { if (ffebad_start (FFEBAD_CONCAT_ARG_KIND)) { ! char *what; if (rrk != 0) what = "an array"; --- 10394,10400 ---- { if (ffebad_start (FFEBAD_CONCAT_ARG_KIND)) { ! const char *what; if (rrk != 0) what = "an array"; *************** static ffelexHandler *** 11602,11608 **** ffeexpr_nil_real_ (ffelexToken t) { char d; ! char *p; if (((ffelex_token_type (t) != FFELEX_typeNAME) && (ffelex_token_type (t) != FFELEX_typeNAMES)) --- 11666,11672 ---- ffeexpr_nil_real_ (ffelexToken t) { char d; ! const char *p; if (((ffelex_token_type (t) != FFELEX_typeNAME) && (ffelex_token_type (t) != FFELEX_typeNAMES)) *************** static ffelexHandler *** 11640,11646 **** ffeexpr_nil_number_ (ffelexToken t) { char d; ! char *p; if (ffeexpr_hollerith_count_ > 0) ffelex_set_expecting_hollerith (0, '\0', --- 11704,11710 ---- ffeexpr_nil_number_ (ffelexToken t) { char d; ! const char *p; if (ffeexpr_hollerith_count_ > 0) ffelex_set_expecting_hollerith (0, '\0', *************** ffeexpr_nil_number_period_ (ffelexToken *** 11715,11721 **** { ffelexHandler nexthandler; char d; ! char *p; switch (ffelex_token_type (t)) { --- 11779,11785 ---- { ffelexHandler nexthandler; char d; ! const char *p; switch (ffelex_token_type (t)) { *************** static ffelexHandler *** 11772,11778 **** ffeexpr_nil_number_real_ (ffelexToken t) { char d; ! char *p; if (((ffelex_token_type (t) != FFELEX_typeNAME) && (ffelex_token_type (t) != FFELEX_typeNAMES)) --- 11836,11842 ---- ffeexpr_nil_number_real_ (ffelexToken t) { char d; ! const char *p; if (((ffelex_token_type (t) != FFELEX_typeNAME) && (ffelex_token_type (t) != FFELEX_typeNAMES)) *************** again: /* :::::::::::::::::::: */ *** 12203,12209 **** case FFEEXPR_contextINDEX_: case FFEEXPR_contextSFUNCDEFINDEX_: - case FFEEXPR_contextRETURN: if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0))) break; switch ((expr == NULL) ? FFEINFO_basictypeNONE --- 12267,12272 ---- *************** again: /* :::::::::::::::::::: */ *** 12226,12232 **** break; } /* Fall through. */ - case FFEINFO_basictypeINTEGER: case FFEINFO_basictypeHOLLERITH: case FFEINFO_basictypeTYPELESS: error = FALSE; --- 12289,12294 ---- *************** again: /* :::::::::::::::::::: */ *** 12235,12240 **** --- 12297,12307 ---- FFEEXPR_contextLET); break; + case FFEINFO_basictypeINTEGER: + /* Specifically, allow INTEGER(KIND=2), aka INTEGER*8, through + unmolested. Leave it to downstream to handle kinds. */ + break; + default: error = TRUE; break; *************** again: /* :::::::::::::::::::: */ *** 12242,12247 **** --- 12309,12352 ---- break; /* expr==NULL ok for substring; element case caught by callback. */ + case FFEEXPR_contextRETURN: + if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0))) + break; + switch ((expr == NULL) ? FFEINFO_basictypeNONE + : ffeinfo_basictype (info)) + { + case FFEINFO_basictypeNONE: + error = FALSE; + break; + + case FFEINFO_basictypeLOGICAL: + expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL, + FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE, + FFEEXPR_contextLET); + /* Fall through. */ + case FFEINFO_basictypeREAL: + case FFEINFO_basictypeCOMPLEX: + if (ffe_is_pedantic ()) + { + error = TRUE; + break; + } + /* Fall through. */ + case FFEINFO_basictypeINTEGER: + case FFEINFO_basictypeHOLLERITH: + case FFEINFO_basictypeTYPELESS: + error = FALSE; + expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER, + FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE, + FFEEXPR_contextLET); + break; + + default: + error = TRUE; + break; + } + break; + case FFEEXPR_contextDO: if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0))) break; *************** again: /* :::::::::::::::::::: */ *** 12616,12626 **** switch (ffeinfo_basictype (info)) { case FFEINFO_basictypeLOGICAL: ! error = error && !ffe_is_ugly_logint (); ! if (!ffeexpr_stack_->is_rhs) ! break; /* Don't convert lhs variable. */ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER, ! ffeinfo_kindtype (ffebld_info (expr)), 0, FFETARGET_charactersizeNONE, FFEEXPR_contextLET); break; --- 12721,12732 ---- switch (ffeinfo_basictype (info)) { case FFEINFO_basictypeLOGICAL: ! if (! ffe_is_ugly_logint ()) ! error = TRUE; ! if (! ffeexpr_stack_->is_rhs) ! break; expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER, ! ffeinfo_kindtype (info), 0, FFETARGET_charactersizeNONE, FFEEXPR_contextLET); break; *************** again: /* :::::::::::::::::::: */ *** 12664,12681 **** switch (ffeinfo_basictype (info)) { case FFEINFO_basictypeLOGICAL: ! error = error ! && (ffeinfo_kindtype (info) != FFEINFO_kindtypeLOGICALDEFAULT); ! if (!ffeexpr_stack_->is_rhs) ! break; /* Don't convert lhs variable. */ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER, ! FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE, FFEEXPR_contextLET); ! break; ! case FFEINFO_basictypeINTEGER: ! error = error && ! (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT); break; case FFEINFO_basictypeHOLLERITH: --- 12770,12790 ---- switch (ffeinfo_basictype (info)) { case FFEINFO_basictypeLOGICAL: ! if (! ffeexpr_stack_->is_rhs) ! break; expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER, ! ffeinfo_kindtype (info), 0, ! FFETARGET_charactersizeNONE, FFEEXPR_contextLET); ! /* Fall through. */ case FFEINFO_basictypeINTEGER: ! if (ffeexpr_stack_->is_rhs ! && (ffeinfo_kindtype (ffebld_info (expr)) ! != FFEINFO_kindtypeINTEGERDEFAULT)) ! expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER, ! FFEINFO_kindtypeINTEGERDEFAULT, 0, ! FFETARGET_charactersizeNONE, ! FFEEXPR_contextLET); break; case FFEINFO_basictypeHOLLERITH: *************** again: /* :::::::::::::::::::: */ *** 12853,12859 **** : ffeinfo_basictype (info)) { case FFEINFO_basictypeINTEGER: ! error = FALSE; break; default: --- 12962,12972 ---- : ffeinfo_basictype (info)) { case FFEINFO_basictypeINTEGER: ! /* Maybe this should be supported someday, but, right now, ! g77 can't generate a call to libf2c to write to an ! integer other than the default size. */ ! error = ((! ffeexpr_stack_->is_rhs) ! && ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT); break; default: *************** static ffelexHandler *** 13584,13590 **** ffeexpr_token_real_ (ffelexToken t) { char d; ! char *p; if (((ffelex_token_type (t) != FFELEX_typeNAME) && (ffelex_token_type (t) != FFELEX_typeNAMES)) --- 13697,13703 ---- ffeexpr_token_real_ (ffelexToken t) { char d; ! const char *p; if (((ffelex_token_type (t) != FFELEX_typeNAME) && (ffelex_token_type (t) != FFELEX_typeNAMES)) *************** ffeexpr_token_number_ (ffelexToken t) *** 13741,13747 **** ffeexprExpr_ e; ffeinfo ni; char d; ! char *p; if (ffeexpr_hollerith_count_ > 0) ffelex_set_expecting_hollerith (0, '\0', --- 13854,13860 ---- ffeexprExpr_ e; ffeinfo ni; char d; ! const char *p; if (ffeexpr_hollerith_count_ > 0) ffelex_set_expecting_hollerith (0, '\0', *************** ffeexpr_token_number_period_ (ffelexToke *** 13897,13903 **** { ffeexprExpr_ e; ffelexHandler nexthandler; ! char *p; char d; switch (ffelex_token_type (t)) --- 14010,14016 ---- { ffeexprExpr_ e; ffelexHandler nexthandler; ! const char *p; char d; switch (ffelex_token_type (t)) *************** static ffelexHandler *** 14015,14021 **** ffeexpr_token_number_real_ (ffelexToken t) { char d; ! char *p; if (((ffelex_token_type (t) != FFELEX_typeNAME) && (ffelex_token_type (t) != FFELEX_typeNAMES)) --- 14128,14134 ---- ffeexpr_token_number_real_ (ffelexToken t) { char d; ! const char *p; if (((ffelex_token_type (t) != FFELEX_typeNAME) && (ffelex_token_type (t) != FFELEX_typeNAMES)) *************** ffeexpr_token_elements_ (ffelexToken ft, *** 18530,18536 **** ffeexpr_stack_->immediate = FALSE; break; } ! if (ffebld_op (expr) == FFEBLD_opCONTER) { val = ffebld_constant_integerdefault (ffebld_conter (expr)); --- 18643,18650 ---- ffeexpr_stack_->immediate = FALSE; break; } ! if (ffebld_op (expr) == FFEBLD_opCONTER ! && ffebld_kindtype (expr) == FFEINFO_kindtypeINTEGERDEFAULT) { val = ffebld_constant_integerdefault (ffebld_conter (expr)); *************** ffeexpr_token_substring_1_ (ffelexToken *** 18841,18866 **** ffetargetIntegerDefault last_val; ffetargetCharacterSize size; ffetargetCharacterSize strop_size_max; string = ffeexpr_stack_->exprstack; strop = string->u.operand; info = ffebld_info (strop); ! if ((first == NULL) || (ffebld_op (first) == FFEBLD_opCONTER)) { /* The starting point is known. */ first_val = (first == NULL) ? 1 : ffebld_constant_integerdefault (ffebld_conter (first)); } else { /* Assume start of the entity. */ first_val = 1; } ! if ((last != NULL) && (ffebld_op (last) == FFEBLD_opCONTER)) { /* The ending point is known. */ last_val = ffebld_constant_integerdefault (ffebld_conter (last)); ! if ((first == NULL) || (ffebld_op (first) == FFEBLD_opCONTER)) { /* The beginning point is a constant. */ if (first_val <= last_val) size = last_val - first_val + 1; --- 18955,18987 ---- ffetargetIntegerDefault last_val; ffetargetCharacterSize size; ffetargetCharacterSize strop_size_max; + bool first_known; string = ffeexpr_stack_->exprstack; strop = string->u.operand; info = ffebld_info (strop); ! if (first == NULL ! || (ffebld_op (first) == FFEBLD_opCONTER ! && ffebld_kindtype (first) == FFEINFO_kindtypeINTEGERDEFAULT)) { /* The starting point is known. */ first_val = (first == NULL) ? 1 : ffebld_constant_integerdefault (ffebld_conter (first)); + first_known = TRUE; } else { /* Assume start of the entity. */ first_val = 1; + first_known = FALSE; } ! if (last != NULL ! && (ffebld_op (last) == FFEBLD_opCONTER ! && ffebld_kindtype (last) == FFEINFO_kindtypeINTEGERDEFAULT)) { /* The ending point is known. */ last_val = ffebld_constant_integerdefault (ffebld_conter (last)); ! if (first_known) { /* The beginning point is a constant. */ if (first_val <= last_val) size = last_val - first_val + 1; diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/expr.h gcc-2.95/gcc/f/expr.h *** egcs-1.1.2/gcc/f/expr.h Tue May 19 03:49:30 1998 --- gcc-2.95/gcc/f/expr.h Mon Feb 15 10:16:43 1999 *************** *** 1,6 **** /* expr.h -- Public #include File (module.h template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* expr.h -- Public #include File (module.h template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/ffe.texi gcc-2.95/gcc/f/ffe.texi *** egcs-1.1.2/gcc/f/ffe.texi Wed Dec 31 16:00:00 1969 --- gcc-2.95/gcc/f/ffe.texi Fri Jun 4 18:33:37 1999 *************** *** 0 **** --- 1,2024 ---- + @c Copyright (C) 1999 Free Software Foundation, Inc. + @c This is part of the G77 manual. + @c For copying conditions, see the file g77.texi. + + @node Front End + @chapter Front End + @cindex GNU Fortran Front End (FFE) + @cindex FFE + @cindex @code{g77}, front end + @cindex front end, @code{g77} + + This chapter describes some aspects of the design and implementation + of the @code{g77} front end. + Much of the information below applies not to current + releases of @code{g77}, + but to the 0.6 rewrite being designed and implemented + as of late May, 1999. + + To find about things that are ``To Be Determined'' or ``To Be Done'', + search for the string TBD. + If you want to help by working on one or more of these items, + email me at @email{@value{email-burley}}. + If you're planning to do more than just research issues and offer comments, + see @uref{http://egcs.cygnus.com/contribute.html} for steps you might + need to take first. + + @menu + * Overview of Sources:: + * Overview of Translation Process:: + * Philosophy of Code Generation:: + * Two-pass Design:: + * Challenges Posed:: + * Transforming Statements:: + * Transforming Expressions:: + * Internal Naming Conventions:: + @end menu + + @node Overview of Sources + @section Overview of Sources + + The current directory layout includes the following: + + @table @file + @item @value{srcdir}/gcc/ + Non-g77 files in gcc + + @item @value{srcdir}/gcc/f/ + GNU Fortran front end sources + + @item @value{srcdir}/libf2c/ + @code{libg2c} configuration and @code{g2c.h} file generation + + @item @value{srcdir}/libf2c/libF77/ + General support and math portion of @code{libg2c} + + @item @value{srcdir}/libf2c/libI77/ + I/O portion of @code{libg2c} + + @item @value{srcdir}/libf2c/libU77/ + Additional interfaces to Unix @code{libc} for @code{libg2c} + @end table + + Components of note in @code{g77} are described below. + + @file{f/} as a whole contains the source for @code{g77}, + while @file{libf2c/} contains a portion of the separate program + @code{f2c}. + Note that the @code{libf2c} code is not part of the program @code{g77}, + just distributed with it. + + @file{f/} contains text files that document the Fortran compiler, source + files for the GNU Fortran Front End (FFE), and some other stuff. + The @code{g77} compiler code is placed in @file{f/} because it, + along with its contents, + is designed to be a subdirectory of a @code{gcc} source directory, + @file{gcc/}, + which is structured so that language-specific front ends can be ``dropped + in'' as subdirectories. + The C++ front end (@code{g++}), is an example of this---it resides in + the @file{cp/} subdirectory. + Note that the C front end (also referred to as @code{gcc}) + is an exception to this, as its source files reside + in the @file{gcc/} directory itself. + + @file{libf2c/} contains the run-time libraries for the @code{f2c} program, + also used by @code{g77}. + These libraries normally referred to collectively as @code{libf2c}. + When built as part of @code{g77}, + @code{libf2c} is installed under the name @code{libg2c} to avoid + conflict with any existing version of @code{libf2c}, + and thus is often referred to as @code{libg2c} when the + @code{g77} version is specifically being referred to. + + The @code{netlib} version of @code{libf2c/} + contains two distinct libraries, + @code{libF77} and @code{libI77}, + each in their own subdirectories. + In @code{g77}, this distinction is not made, + beyond maintaining the subdirectory structure in the source-code tree. + + @file{libf2c/} is not part of the program @code{g77}, + just distributed with it. + It contains files not present + in the official (@code{netlib}) version of @code{libf2c}, + and also contains some minor changes made from @code{libf2c}, + to fix some bugs, + and to facilitate automatic configuration, building, and installation of + @code{libf2c} (as @code{libg2c}) for use by @code{g77} users. + See @file{libf2c/README} for more information, + including licensing conditions + governing distribution of programs containing code from @code{libg2c}. + + @code{libg2c}, @code{g77}'s version of @code{libf2c}, + adds Dave Love's implementation of @code{libU77}, + in the @file{libf2c/libU77/} directory. + This library is distributed under the + GNU Library General Public License (LGPL)---see the + file @file{libf2c/libU77/COPYING.LIB} + for more information, + as this license + governs distribution conditions for programs containing code + from this portion of the library. + + Files of note in @file{f/} and @file{libf2c/} are described below: + + @table @file + @item f/BUGS + Lists some important bugs known to be in g77. + Or use Info (or GNU Emacs Info mode) to read + the ``Actual Bugs'' node of the @code{g77} documentation: + + @smallexample + info -f f/g77.info -n "Actual Bugs" + @end smallexample + + @item f/ChangeLog + Lists recent changes to @code{g77} internals. + + @item libf2c/ChangeLog + Lists recent changes to @code{libg2c} internals. + + @item f/NEWS + Contains the per-release changes. + These include the user-visible + changes described in the node ``Changes'' + in the @code{g77} documentation, plus internal + changes of import. + Or use: + + @smallexample + info -f f/g77.info -n News + @end smallexample + + @item f/g77.info* + The @code{g77} documentation, in Info format, + produced by building @code{g77}. + + All users of @code{g77} (not just installers) should read this, + using the @code{more} command if neither the @code{info} command, + nor GNU Emacs (with its Info mode), are available, or if users + aren't yet accustomed to using these tools. + All of these files are readable as ``plain text'' files, + though they're easier to navigate using Info readers + such as @code{info} and GNU Emacs Info mode. + @end table + + If you want to explore the FFE code, which lives entirely in @file{f/}, + here are a few clues. + The file @file{g77spec.c} contains the @code{g77}-specific source code + for the @code{g77} command only---this just forms a variant of the + @code{gcc} command, so, + just as the @code{gcc} command itself does not contain the C front end, + the @code{g77} command does not contain the Fortran front end (FFE). + The FFE code ends up in an executable named @file{f771}, + which does the actual compiling, + so it contains the FFE plus the @code{gcc} back end (GBE), + the latter to do most of the optimization, and the code generation. + + The file @file{parse.c} is the source file for @code{yyparse()}, + which is invoked by the GBE to start the compilation process, + for @file{f771}. + + The file @file{top.c} contains the top-level FFE function @code{ffe_file} + and it (along with top.h) define all @samp{ffe_[a-z].*}, @samp{ffe[A-Z].*}, + and @samp{FFE_[A-Za-z].*} symbols. + + The file @file{fini.c} is a @code{main()} program that is used when building + the FFE to generate C header and source files for recognizing keywords. + The files @file{malloc.c} and @file{malloc.h} comprise a memory manager + that defines all @samp{malloc_[a-z].*}, @samp{malloc[A-Z].*}, and + @samp{MALLOC_[A-Za-z].*} symbols. + + All other modules named @var{xyz} + are comprised of all files named @samp{@var{xyz}*.@var{ext}} + and define all @samp{ffe@var{xyz}_[a-z].*}, @samp{ffe@var{xyz}[A-Z].*}, + and @samp{FFE@var{XYZ}_[A-Za-z].*} symbols. + If you understand all this, congratulations---it's easier for me to remember + how it works than to type in these regular expressions. + But it does make it easy to find where a symbol is defined. + For example, the symbol @samp{ffexyz_set_something} would be defined + in @file{xyz.h} and implemented there (if it's a macro) or in @file{xyz.c}. + + The ``porting'' files of note currently are: + + @table @file + @item proj.c + @itemx proj.h + This defines the ``language'' used by all the other source files, + the language being Standard C plus some useful things + like @code{ARRAY_SIZE} and such. + + @item target.c + @itemx target.h + These describe the target machine + in terms of what data types are supported, + how they are denoted + (to what C type does an @code{INTEGER*8} map, for example), + how to convert between them, + and so on. + Over time, versions of @code{g77} rely less on this file + and more on run-time configuration based on GBE info + in @file{com.c}. + + @item com.c + @itemx com.h + These are the primary interface to the GBE. + + @item ste.c + @itemx ste.h + This contains code for implementing recognized executable statements + in the GBE. + + @item src.c + @itemx src.h + These contain information on the format(s) of source files + (such as whether they are never to be processed as case-insensitive + with regard to Fortran keywords). + @end table + + If you want to debug the @file{f771} executable, + for example if it crashes, + note that the global variables @code{lineno} and @code{input_filename} + are usually set to reflect the current line being read by the lexer + during the first-pass analysis of a program unit and to reflect + the current line being processed during the second-pass compilation + of a program unit. + + If an invocation of the function @code{ffestd_exec_end} is on the stack, + the compiler is in the second pass, otherwise it is in the first. + + (This information might help you reduce a test case and/or work around + a bug in @code{g77} until a fix is available.) + + @node Overview of Translation Process + @section Overview of Translation Process + + The order of phases translating source code to the form accepted + by the GBE is: + + @enumerate + @item + Stripping punched-card sources (@file{g77stripcard.c}) + + @item + Lexing (@file{lex.c}) + + @item + Stand-alone statement identification (@file{sta.c}) + + @item + Parsing (@file{stb.c} and @file{expr.c}) + + @item + Constructing (@file{stc.c}) + + @item + Collecting (@file{std.c}) + + @item + Expanding (@file{ste.c}) + @end enumerate + + To get a rough idea of how a particularly twisted Fortran statement + gets treated by the passes, consider: + + @smallexample + FORMAT(I2 4H)=(J/ + & I3) + @end smallexample + + The job of @file{lex.c} is to know enough about Fortran syntax rules + to break the statement up into distinct lexemes without requiring + any feedback from subsequent phases: + + @smallexample + `FORMAT' + `(' + `I24H' + `)' + `=' + `(' + `J' + `/' + `I3' + `)' + @end smallexample + + The job of @file{sta.c} is to figure out the kind of statement, + or, at least, statement form, that sequence of lexemes represent. + + The sooner it can do this (in terms of using the smallest number of + lexemes, starting with the first for each statement), the better, + because that leaves diagnostics for problems beyond the recognition + of the statement form to subsequent phases, + which can usually better describe the nature of the problem. + + In this case, the @samp{=} at ``level zero'' + (not nested within parentheses) + tells @file{sta.c} that this is an @emph{assignment-form}, + not @code{FORMAT}, statement. + + An assignment-form statement might be a statement-function + definition or an executable assignment statement. + + To make that determination, + @file{sta.c} looks at the first two lexemes. + + Since the second lexeme is @samp{(}, + the first must represent an array for this to be an assignment statement, + else it's a statement function. + + Either way, @file{sta.c} hands off the statement to @file{stb.c} + (either its statement-function parser or its assignment-statement parser). + + @file{stb.c} forms a + statement-specific record containing the pertinent information. + That information includes a source expression and, + for an assignment statement, a destination expression. + Expressions are parsed by @file{expr.c}. + + This record is passed to @file{stc.c}, + which copes with the implications of the statement + within the context established by previous statements. + + For example, if it's the first statement in the file + or after an @code{END} statement, + @file{stc.c} recognizes that, first of all, + a main program unit is now being lexed + (and tells that to @file{std.c} + before telling it about the current statement). + + @file{stc.c} attaches whatever information it can, + usually derived from the context established by the preceding statements, + and passes the information to @file{std.c}. + + @file{std.c} saves this information away, + since the GBE cannot cope with information + that might be incomplete at this stage. + + For example, @samp{I3} might later be determined + to be an argument to an alternate @code{ENTRY} point. + + When @file{std.c} is told about the end of an external (top-level) + program unit, + it passes all the information it has saved away + on statements in that program unit + to @file{ste.c}. + + @file{ste.c} ``expands'' each statement, in sequence, by + constructing the appropriate GBE information and calling + the appropriate GBE routines. + + Details on the transformational phases follow. + Keep in mind that Fortran numbering is used, + so the first character on a line is column 1, + decimal numbering is used, and so on. + + @menu + * g77stripcard:: + * lex.c:: + * sta.c:: + * stb.c:: + * expr.c:: + * stc.c:: + * std.c:: + * ste.c:: + + * Gotchas (Transforming):: + * TBD (Transforming):: + @end menu + + @node g77stripcard + @subsection g77stripcard + + The @code{g77stripcard} program handles removing content beyond + column 72 (adjustable via a command-line option), + optionally warning about that content being something other + than trailing whitespace or Fortran commentary. + + This program is needed because @code{lex.c} doesn't pay attention + to maximum line lengths at all, to make it easier to maintain, + as well as faster (for sources that don't depend on the maximum + column length vis-a-vis trailing non-blank non-commentary content). + + Just how this program will be run---whether automatically for + old source (perhaps as the default for @file{.f} files?)---is not + yet determined. + + In the meantime, it might as well be implemented as a typical UNIX pipe. + + It should accept a @samp{-fline-length-@var{n}} option, + with the default line length set to 72. + + When the text it strips off the end of a line is not blank + (not spaces and tabs), + it should insert an additional comment line + (beginning with @samp{!}, + so it works for both fixed-form and free-form files) + containing the text, + following the stripped line. + The inserted comment should have a prefix of some kind, + TBD, that distinguishes the comment as representing stripped text. + Users could use that to @code{sed} out such lines, if they wished---it + seems silly to provide a command-line option to delete information + when it can be so easily filtered out by another program. + + (This inserted comment should be designed to ``fit in'' well + with whatever the Fortran community is using these days for + preprocessor, translator, and other such products, like OpenMP. + What that's all about, and how @code{g77} can elegantly fit its + special comment conventions into it all, is TBD as well. + We don't want to reinvent the wheel here, but if there turn out + to be too many conflicting conventions, we might have to invent + one that looks nothing like the others, but which offers their + host products a better infrastructure in which to fit and coexist + peacefully.) + + @code{g77stripcard} probably shouldn't do any tab expansion or other + fancy stuff. + People can use @code{expand} or other pre-filtering if they like. + The idea here is to keep each stage quite simple, while providing + excellent performance for ``normal'' code. + + (Code with junk beyond column 73 is not really ``normal'', + as it comes from a card-punch heritage, + and will be increasingly hard for tomorrow's Fortran programmers to read.) + + @node lex.c + @subsection lex.c + + To help make the lexer simple, fast, and easy to maintain, + while also having @code{g77} generally encourage Fortran programmers + to write simple, maintainable, portable code by maximizing the + performance of compiling that kind of code: + + @itemize @bullet + @item + There'll be just one lexer, for both fixed-form and free-form source. + + @item + It'll care about the form only when handling the first 7 columns of + text, stuff like spaces between strings of alphanumerics, and + how lines are continued. + + Some other distinctions will be handled by subsequent phases, + so at least one of them will have to know which form is involved. + + For example, @samp{I = 2 . 4} is acceptable in fixed form, + and works in free form as well given the implementation @code{g77} + presently uses. + But the standard requires a diagnostic for it in free form, + so the parser has to be able to recognize that + the lexemes aren't contiguous + (information the lexer @emph{does} have to provide) + and that free-form source is being parsed, + so it can provide the diagnostic. + + The @code{g77} lexer doesn't try to gather @samp{2 . 4} into a single lexeme. + Otherwise, it'd have to know a whole lot more about how to parse Fortran, + or subsequent phases (mainly parsing) would have two paths through + lots of critical code---one to handle the lexeme @samp{2}, @samp{.}, + and @samp{4} in sequence, another to handle the lexeme @samp{2.4}. + + @item + It won't worry about line lengths + (beyond the first 7 columns for fixed-form source). + + That is, once it starts parsing the ``statement'' part of a line + (column 7 for fixed-form, column 1 for free-form), + it'll keep going until it finds a newline, + rather than ignoring everything past a particular column + (72 or 132). + + The implication here is that there shouldn't @emph{be} + anything past that last column, other than whitespace or + commentary, because users using typical editors + (or viewing output as typically printed) + won't necessarily know just where the last column is. + + Code that has ``garbage'' beyond the last column + (almost certainly only fixed-form code with a punched-card legacy, + such as code using columns 73-80 for ``sequence numbers'') + will have to be run through @code{g77stripcard} first. + + Also, keeping track of the maximum column position while also watching out + for the end of a line @emph{and} while reading from a file + just makes things slower. + Since a file must be read, and watching for the end of the line + is necessary (unless the typical input file was preprocessed to + include the necessary number of trailing spaces), + dropping the tracking of the maximum column position + is the only way to reduce the complexity of the pertinent code + while maintaining high performance. + + @item + ASCII encoding is assumed for the input file. + + Code written in other character sets will have to be converted first. + + @item + Tabs (ASCII code 9) + will be converted to spaces via the straightforward + approach. + + Specifically, a tab is converted to between one and eight spaces + as necessary to reach column @var{n}, + where dividing @samp{(@var{n} - 1)} by eight + results in a remainder of zero. + + @item + Linefeeds (ASCII code 10) + mark the ends of lines. + + @item + A carriage return (ASCII code 13) + is accept if it immediately precedes a linefeed, + in which case it is ignored. + + Otherwise, it is rejected (with a diagnostic). + + @item + Any other characters other than the above + that are not part of the GNU Fortran Character Set + (@pxref{Character Set}) + are rejected with a diagnostic. + + This includes backspaces, form feeds, and the like. + + (It might make sense to allow a form feed in column 1 + as long as that's the only character on a line. + It certainly wouldn't seem to cost much in terms of performance.) + + @item + The end of the input stream (EOF) + ends the current line. + + @item + The distinction between uppercase and lowercase letters + will be preserved. + + It will be up to subsequent phases to decide to fold case. + + Current plans are to permit any casing for Fortran (reserved) keywords + while preserving casing for user-defined names. + (This might not be made the default for @file{.f} files, though.) + + Preserving case seems necessary to provide more direct access + to facilities outside of @code{g77}, such as to C or Pascal code. + + Names of intrinsics will probably be matchable in any case, + However, there probably won't be any option to require + a particular mixed-case appearance of intrinsics + (as there was for @code{g77} prior to version 0.6), + because that's painful to maintain, + and probably nobody uses it. + + (How @samp{external SiN; r = sin(x)} would be handled is TBD. + I think old @code{g77} might already handle that pretty elegantly, + but whether we can cope with allowing the same fragment to reference + a @emph{different} procedure, even with the same interface, + via @samp{s = SiN(r)}, needs to be determined. + If it can't, we need to make sure that when code introduces + a user-defined name, any intrinsic matching that name + using a case-insensitive comparison + is ``turned off''.) + + @item + Backslashes in @code{CHARACTER} and Hollerith constants + are not allowed. + + This avoids the confusion introduced by some Fortran compiler vendors + providing C-like interpretation of backslashes, + while others provide straight-through interpretation. + + Some kind of lexical construct (TBD) will be provided to allow + flagging of a @code{CHARACTER} + (but probably not a Hollerith) + constant that permits backslashes. + It'll necessarily be a prefix, such as: + + @smallexample + PRINT *, C'This line has a backspace \b here.' + PRINT *, F'This line has a straight backslash \ here.' + @end smallexample + + Further, command-line options might be provided to specify that + one prefix or the other is to be assumed as the default + for @code{CHARACTER} constants. + + However, it seems more helpful for @code{g77} to provide a program + that converts prefix all constants + (or just those containing backslashes) + with the desired designation, + so printouts of code can be read + without knowing the compile-time options used when compiling it. + + If such a program is provided + (let's name it @code{g77slash} for now), + then a command-line option to @code{g77} should not be provided. + (Though, given that it'll be easy to implement, it might be hard + to resist user requests for it ``to compile faster than if we + have to invoke another filter''.) + + This program would take a command-line option to specify the + default interpretation of slashes, + affecting which prefix it uses for constants. + + @code{g77slash} probably should automatically convert Hollerith + constants that contain slashes + to the appropriate @code{CHARACTER} constants. + Then @code{g77} wouldn't have to define a prefix syntax for Hollerith + constants specifying whether they want C-style or straight-through + backslashes. + @end itemize + + The above implements nearly exactly what is specified by + @ref{Character Set}, + and + @ref{Lines}, + except it also provides automatic conversion of tabs + and ignoring of newline-related carriage returns. + + It also effects the ``pure visual'' model, + by which is meant that a user viewing his code + in a typical text editor + (assuming it's not preprocessed via @code{g77stripcard} or similar) + doesn't need any special knowledge + of whether spaces on the screen are really tabs, + whether lines end immediately after the last visible non-space character + or after a number of spaces and tabs that follow it, + or whether the last line in the file is ended by a newline. + + Most editors don't make these distinctions, + the ANSI FORTRAN 77 standard doesn't require them to, + and it permits a standard-conforming compiler + to define a method for transforming source code to + ``standard form'' however it wants. + + So, GNU Fortran defines it such that users have the best chance + of having the code be interpreted the way it looks on the screen + of the typical editor. + + (Fancy editors should @emph{never} be required to correctly read code + written in classic two-dimensional-plaintext form. + By correct reading I mean ability to read it, book-like, without + mistaking text ignored by the compiler for program code and vice versa, + and without having to count beyond the first several columns. + The vague meaning of ASCII TAB, among other things, complicates + this somewhat, but as long as ``everyone'', including the editor, + other tools, and printer, agrees about the every-eighth-column convention, + the GNU Fortran ``pure visual'' model meets these requirements. + Any language or user-visible source form + requiring special tagging of tabs, + the ends of lines after spaces/tabs, + and so on, is broken by this definition. + Fortunately, Fortran @emph{itself} is not broken, + even if most vendor-supplied defaults for their Fortran compilers @emph{are} + in this regard.) + + Further, this model provides a clean interface + to whatever preprocessors or code-generators are used + to produce input to this phase of @code{g77}. + Mainly, they need not worry about long lines. + + @node sta.c + @subsection sta.c + + @node stb.c + @subsection stb.c + + @node expr.c + @subsection expr.c + + @node stc.c + @subsection stc.c + + @node std.c + @subsection std.c + + @node ste.c + @subsection ste.c + + @node Gotchas (Transforming) + @subsection Gotchas (Transforming) + + This section is not about transforming ``gotchas'' into something else. + It is about the weirder aspects of transforming Fortran, + however that's defined, + into a more modern, canonical form. + + @subsubsection Multi-character Lexemes + + Each lexeme carries with it a pointer to where it appears in the source. + + To provide the ability for diagnostics to point to column numbers, + in addition to line numbers and names, + lexemes that represent more than one (significant) character + in the source code need, generally, + to provide pointers to where each @emph{character} appears in the source. + + This provides the ability to properly identify the precise location + of the problem in code like + + @smallexample + SUBROUTINE X + END + BLOCK DATA X + END + @end smallexample + + which, in fixed-form source, would result in single lexemes + consisting of the strings @samp{SUBROUTINEX} and @samp{BLOCKDATAX}. + (The problem is that @samp{X} is defined twice, + so a pointer to the @samp{X} in the second definition, + as well as a follow-up pointer to the corresponding pointer in the first, + would be preferable to pointing to the beginnings of the statements.) + + This need also arises when parsing (and diagnosing) @code{FORMAT} + statements. + + Further, it arises when diagnosing + @code{FMT=} specifiers that contain constants + (or partial constants, or even propagated constants!) + in I/O statements, as in: + + @smallexample + PRINT '(I2, 3HAB)', J + @end smallexample + + (A pointer to the beginning of the prematurely-terminated Hollerith + constant, and/or to the close parenthese, is preferable to a pointer + to the open-parenthese or the apostrophe that precedes it.) + + Multi-character lexemes, which would seem to naturally include + at least digit strings, alphanumeric strings, @code{CHARACTER} + constants, and Hollerith constants, therefore need to provide + location information on each character. + (Maybe Hollerith constants don't, but it's unnecessary to except them.) + + The question then arises, what about @emph{other} multi-character lexemes, + such as @samp{**} and @samp{//}, + and Fortran 90's @samp{(/}, @samp{/)}, @samp{::}, and so on? + + Turns out there's a need to identify the location of the second character + of these two-character lexemes. + For example, in @samp{I(/J) = K}, the slash needs to be diagnosed + as the problem, not the open parenthese. + Similarly, it is preferable to diagnose the second slash in + @samp{I = J // K} rather than the first, given the implicit typing + rules, which would result in the compiler disallowing the attempted + concatenation of two integers. + (Though, since that's more of a semantic issue, + it's not @emph{that} much preferable.) + + Even sequences that could be parsed as digit strings could use location info, + for example, to diagnose the @samp{9} in the octal constant @samp{O'129'}. + (This probably will be parsed as a character string, + to be consistent with the parsing of @samp{Z'129A'}.) + + To avoid the hassle of recording the location of the second character, + while also preserving the general rule that each significant character + is distinctly pointed to by the lexeme that contains it, + it's best to simply not have any fixed-size lexemes + larger than one character. + + This new design is expected to make checking for two + @samp{*} lexemes in a row much easier than the old design, + so this is not much of a sacrifice. + It probably makes the lexer much easier to implement + than it makes the parser harder. + + @subsubsection Space-padding Lexemes + + Certain lexemes need to be padded with virtual spaces when the + end of the line (or file) is encountered. + + This is necessary in fixed form, to handle lines that don't + extend to column 72, assuming that's the line length in effect. + + @subsubsection Bizarre Free-form Hollerith Constants + + Last I checked, the Fortran 90 standard actually required the compiler + to silently accept something like + + @smallexample + FORMAT ( 1 2 Htwelve chars ) + @end smallexample + + as a valid @code{FORMAT} statement specifying a twelve-character + Hollerith constant. + + The implication here is that, since the new lexer is a zero-feedback one, + it won't know that the special case of a @code{FORMAT} statement being parsed + requires apparently distinct lexemes @samp{1} and @samp{2} to be treated as + a single lexeme. + + (This is a horrible misfeature of the Fortran 90 language. + It's one of many such misfeatures that almost make me want + to not support them, and forge ahead with designing a new + ``GNU Fortran'' language that has the features, + but not the misfeatures, of Fortran 90, + and provide utility programs to do the conversion automatically.) + + So, the lexer must gather distinct chunks of decimal strings into + a single lexeme in contexts where a single decimal lexeme might + start a Hollerith constant. + + (Which probably means it might as well do that all the time + for all multi-character lexemes, even in free-form mode, + leaving it to subsequent phases to pull them apart as they see fit.) + + Compare the treatment of this to how + + @smallexample + CHARACTER * 4 5 HEY + @end smallexample + + and + + @smallexample + CHARACTER * 12 HEY + @end smallexample + + must be treated---the former must be diagnosed, due to the separation + between lexemes, the latter must be accepted as a proper declaration. + + @subsubsection Hollerith Constants + + Recognizing a Hollerith constant---specifically, + that an @samp{H} or @samp{h} after a digit string begins + such a constant---requires some knowledge of context. + + Hollerith constants (such as @samp{2HAB}) can appear after: + + @itemize @bullet + @item + @samp{(} + + @item + @samp{,} + + @item + @samp{=} + + @item + @samp{+}, @samp{-}, @samp{/} + + @item + @samp{*}, except as noted below + @end itemize + + Hollerith constants don't appear after: + + @itemize @bullet + @item + @samp{CHARACTER*}, + which can be treated generally as + any @samp{*} that is the second lexeme of a statement + @end itemize + + @subsubsection Confusing Function Keyword + + While + + @smallexample + REAL FUNCTION FOO () + @end smallexample + + must be a @code{FUNCTION} statement and + + @smallexample + REAL FUNCTION FOO (5) + @end smallexample + + must be a type-definition statement, + + @smallexample + REAL FUNCTION FOO (@var{names}) + @end smallexample + + where @var{names} is a comma-separated list of names, + can be one or the other. + + The only way to disambiguate that statement + (short of mandating free-form source or a short maximum + length for name for external procedures) + is based on the context of the statement. + + In particular, the statement is known to be within an + already-started program unit + (but not at the outer level of the @code{CONTAINS} block), + it is a type-declaration statement. + + Otherwise, the statement is a @code{FUNCTION} statement, + in that it begins a function program unit + (external, or, within @code{CONTAINS}, nested). + + @subsubsection Weird READ + + The statement + + @smallexample + READ (N) + @end smallexample + + is equivalent to either + + @smallexample + READ (UNIT=(N)) + @end smallexample + + or + + @smallexample + READ (FMT=(N)) + @end smallexample + + depending on which would be valid in context. + + Specifically, if @samp{N} is type @code{INTEGER}, + @samp{READ (FMT=(N))} would not be valid, + because parentheses may not be used around @samp{N}, + whereas they may around it in @samp{READ (UNIT=(N))}. + + Further, if @samp{N} is type @code{CHARACTER}, + the opposite is true---@samp{READ (UNIT=(N))} is not valid, + but @samp{READ (FMT=(N))} is. + + Strictly speaking, if anything follows + + @smallexample + READ (N) + @end smallexample + + in the statement, whether the first lexeme after the close + parenthese is a comma could be used to disambiguate the two cases, + without looking at the type of @samp{N}, + because the comma is required for the @samp{READ (FMT=(N))} + interpretation and disallowed for the @samp{READ (UNIT=(N))} + interpretation. + + However, in practice, many Fortran compilers allow + the comma for the @samp{READ (UNIT=(N))} + interpretation anyway + (in that they generally allow a leading comma before + an I/O list in an I/O statement), + and much code takes advantage of this allowance. + + (This is quite a reasonable allowance, since the + juxtaposition of a comma-separated list immediately + after an I/O control-specification list, which is also comma-separated, + without an intervening comma, + looks sufficiently ``wrong'' to programmers + that they can't resist the itch to insert the comma. + @samp{READ (I, J), K, L} simply looks cleaner than + @samp{READ (I, J) K, L}.) + + So, type-based disambiguation is needed unless strict adherence + to the standard is always assumed, and we're not going to assume that. + + @node TBD (Transforming) + @subsection TBD (Transforming) + + Continue researching gotchas, designing the transformational process, + and implementing it. + + Specific issues to resolve: + + @itemize @bullet + @item + Just where should @code{INCLUDE} processing take place? + + Clearly before (or part of) statement identification (@file{sta.c}), + since determining whether @samp{I(J)=K} is a statement-function + definition or an assignment statement requires knowing the context, + which in turn requires having processed @code{INCLUDE} files. + + @item + Just where should (if it was implemented) @code{USE} processing take place? + + This gets into the whole issue of how @code{g77} should handle the concept + of modules. + I think GNAT already takes on this issue, but don't know more than that. + Jim Giles has written extensively on @code{comp.lang.fortran} + about his opinions on module handling, as have others. + Jim's views should be taken into account. + + Actually, Richard M. Stallman (RMS) also has written up + some guidelines for implementing such things, + but I'm not sure where I read them. + Perhaps the old @email{gcc2@@cygnus.com} list. + + If someone could dig references to these up and get them to me, + that would be much appreciated! + Even though modules are not on the short-term list for implementation, + it'd be helpful to know @emph{now} how to avoid making them harder to + implement them @emph{later}. + + @item + Should the @code{g77} command become just a script that invokes + all the various preprocessing that might be needed, + thus making it seem slower than necessary for legacy code + that people are unwilling to convert, + or should we provide a separate script for that, + thus encouraging people to convert their code once and for all? + + At least, a separate script to behave as old @code{g77} did, + perhaps named @code{g77old}, might ease the transition, + as might a corresponding one that converts source codes + named @code{g77oldnew}. + + These scripts would take all the pertinent options @code{g77} used + to take and run the appropriate filters, + passing the results to @code{g77} or just making new sources out of them + (in a subdirectory, leaving the user to do the dirty deed of + moving or copying them over the old sources). + + @item + Do other Fortran compilers provide a prefix syntax + to govern the treatment of backslashes in @code{CHARACTER} + (or Hollerith) constants? + + Knowing what other compilers provide would help. + + @item + Is it okay to drop support for the @samp{-fintrin-case-initcap}, + @samp{-fmatch-case-initcap}, @samp{-fsymbol-case-initcap}, + and @samp{-fcase-initcap} options? + + I've asked @email{info-gnu-fortran@@gnu.org} for input on this. + Not having to support these makes it easier to write the new front end, + and might also avoid complicated its design. + @end itemize + + @node Philosophy of Code Generation + @section Philosophy of Code Generation + + Don't poke the bear. + + The @code{g77} front end generates code + via the @code{gcc} back end. + + @cindex GNU Back End (GBE) + @cindex GBE + @cindex @code{gcc}, back end + @cindex back end, gcc + @cindex code generator + The @code{gcc} back end (GBE) is a large, complex + labyrinth of intricate code + written in a combination of the C language + and specialized languages internal to @code{gcc}. + + While the @emph{code} that implements the GBE + is written in a combination of languages, + the GBE itself is, + to the front end for a language like Fortran, + best viewed as a @emph{compiler} + that compiles its own, unique, language. + + The GBE's ``source'', then, is written in this language, + which consists primarily of + a combination of calls to GBE functions + and @dfn{tree} nodes + (which are, themselves, created + by calling GBE functions). + + So, the @code{g77} generates code by, in effect, + translating the Fortran code it reads + into a form ``written'' in the ``language'' + of the @code{gcc} back end. + + @cindex GBEL + @cindex GNU Back End Language (GBEL) + This language will heretofore be referred to as @dfn{GBEL}, + for GNU Back End Language. + + GBEL is an evolving language, + not fully specified in any published form + as of this writing. + It offers many facilities, + but its ``core'' facilities + are those that corresponding most directly + to those needed to support @code{gcc} + (compiling code written in GNU C). + + The @code{g77} Fortran Front End (FFE) + is designed and implemented + to navigate the currents and eddies + of ongoing GBEL and @code{gcc} development + while also delivering on the potential + of an integrated FFE + (as compared to using a converter like @code{f2c} + and feeding the output into @code{gcc}). + + Goals of the FFE's code-generation strategy include: + + @itemize @bullet + @item + High likelihood of generation of correct code, + or, failing that, producing a fatal diagnostic or crashing. + + @item + Generation of highly optimized code, + as directed by the user + via GBE-specific (versus @code{g77}-specific) constructs, + such as command-line options. + + @item + Fast overall (FFE plus GBE) compilation. + + @item + Preservation of source-level debugging information. + @end itemize + + The strategies historically, and currently, used by the FFE + to achieve these goals include: + + @itemize @bullet + @item + Use of GBEL constructs that most faithfully encapsulate + the semantics of Fortran. + + @item + Avoidance of GBEL constructs that are so rarely used, + or limited to use in specialized situations not related to Fortran, + that their reliability and performance has not yet been established + as sufficient for use by the FFE. + + @item + Flexible design, to readily accommodate changes to specific + code-generation strategies, perhaps governed by command-line options. + @end itemize + + @cindex Bear-poking + @cindex Poking the bear + ``Don't poke the bear'' somewhat summarizes the above strategies. + The GBE is the bear. + The FFE is designed and implemented to avoid poking it + in ways that are likely to just annoy it. + The FFE usually either tackles it head-on, + or avoids treating it in ways dissimilar to how + the @code{gcc} front end treats it. + + For example, the FFE uses the native array facility in the back end + instead of the lower-level pointer-arithmetic facility + used by @code{gcc} when compiling @code{f2c} output). + Theoretically, this presents more opportunities for optimization, + faster compile times, + and the production of more faithful debugging information. + These benefits were not, however, immediately realized, + mainly because @code{gcc} itself makes little or no use + of the native array facility. + + Complex arithmetic is a case study of the evolution of this strategy. + When originally implemented, + the GBEL had just evolved its own native complex-arithmetic facility, + so the FFE took advantage of that. + + When porting @code{g77} to 64-bit systems, + it was discovered that the GBE didn't really + implement its native complex-arithmetic facility properly. + + The short-term solution was to rewrite the FFE + to instead use the lower-level facilities + that'd be used by @code{gcc}-compiled code + (assuming that code, itself, didn't use the native complex type + provided, as an extension, by @code{gcc}), + since these were known to work, + and, in any case, if shown to not work, + would likely be rapidly fixed + (since they'd likely not work for vanilla C code in similar circumstances). + + However, the rewrite accommodated the original, native approach as well + by offering a command-line option to select it over the emulated approach. + This allowed users, and especially GBE maintainers, to try out + fixes to complex-arithmetic support in the GBE + while @code{g77} continued to default to compiling more code correctly, + albeit producing (typically) slower executables. + + As of April 1999, it appeared that the last few bugs + in the GBE's support of its native complex-arithmetic facility + were worked out. + The FFE was changed back to default to using that native facility, + leaving emulation as an option. + + Other Fortran constructs---arrays, character strings, + complex division, @code{COMMON} and @code{EQUIVALENCE} aggregates, + and so on---involve issues similar to those pertaining to complex arithmetic. + + So, it is possible that the history + of how the FFE handled complex arithmetic + will be repeated, probably in modified form + (and hopefully over shorter timeframes), + for some of these other facilities. + + @node Two-pass Design + @section Two-pass Design + + The FFE does not tell the GBE anything about a program unit + until after the last statement in that unit has been parsed. + (A program unit is a Fortran concept that corresponds, in the C world, + mostly closely to functions definitions in ISO C. + That is, a program unit in Fortran is like a top-level function in C. + Nested functions, found among the extensions offered by GNU C, + correspond roughly to Fortran's statement functions.) + + So, while parsing the code in a program unit, + the FFE saves up all the information + on statements, expressions, names, and so on, + until it has seen the last statement. + + At that point, the FFE revisits the saved information + (in what amounts to a second @dfn{pass} over the program unit) + to perform the actual translation of the program unit into GBEL, + ultimating in the generation of assembly code for it. + + Some lookahead is performed during this second pass, + so the FFE could be viewed as a ``two-plus-pass'' design. + + @menu + * Two-pass Code:: + * Why Two Passes:: + @end menu + + @node Two-pass Code + @subsection Two-pass Code + + Most of the code that turns the first pass (parsing) + into a second pass for code generation + is in @file{@value{path-g77}/std.c}. + + It has external functions, + called mainly by siblings in @file{@value{path-g77}/stc.c}, + that record the information on statements and expressions + in the order they are seen in the source code. + These functions save that information. + + It also has an external function that revisits that information, + calling the siblings in @file{@value{path-g77}/ste.c}, + which handles the actual code generation + (by generating GBEL code, + that is, by calling GBE routines + to represent and specify expressions, statements, and so on). + + @node Why Two Passes + @subsection Why Two Passes + + The need for two passes was not immediately evident + during the design and implementation of the code in the FFE + that was to produce GBEL. + Only after a few kludges, + to handle things like incorrectly-guessed @code{ASSIGN} label nature, + had been implemented, + did enough evidence pile up to make it clear + that @file{std.c} had to be introduced to intercept, + save, then revisit as part of a second pass, + the digested contents of a program unit. + + Other such missteps have occurred during the evolution of the FFE, + because of the different goals of the FFE and the GBE. + + Because the GBE's original, and still primary, goal + was to directly support the GNU C language, + the GBEL, and the GBE itself, + requires more complexity + on the part of most front ends + than it requires of @code{gcc}'s. + + For example, + the GBEL offers an interface that permits the @code{gcc} front end + to implement most, or all, of the language features it supports, + without the front end having to + make use of non-user-defined variables. + (It's almost certainly the case that all of K&R C, + and probably ANSI C as well, + is handled by the @code{gcc} front end + without declaring such variables.) + + The FFE, on the other hand, must resort to a variety of ``tricks'' + to achieve its goals. + + Consider the following C code: + + @smallexample + int + foo (int a, int b) + @{ + int c = 0; + + if ((c = bar (c)) == 0) + goto done; + + quux (c << 1); + + done: + return c; + @} + @end smallexample + + Note what kinds of objects are declared, or defined, before their use, + and before any actual code generation involving them + would normally take place: + + @itemize @bullet + @item + Return type of function + + @item + Entry point(s) of function + + @item + Dummy arguments + + @item + Variables + + @item + Initial values for variables + @end itemize + + Whereas, the following items can, and do, + suddenly appear ``out of the blue'' in C: + + @itemize @bullet + @item + Label references + + @item + Function references + @end itemize + + Not surprisingly, the GBE faithfully permits the latter set of items + to be ``discovered'' partway through GBEL ``programs'', + just as they are permitted to in C. + + Yet, the GBE has tended, at least in the past, + to be reticent to fully support similar ``late'' discovery + of items in the former set. + + This makes Fortran a poor fit for the ``safe'' subset of GBEL. + Consider: + + @smallexample + FUNCTION X (A, ARRAY, ID1) + CHARACTER*(*) A + DOUBLE PRECISION X, Y, Z, TMP, EE, PI + REAL ARRAY(ID1*ID2) + COMMON ID2 + EXTERNAL FRED + + ASSIGN 100 TO J + CALL FOO (I) + IF (I .EQ. 0) PRINT *, A(0) + GOTO 200 + + ENTRY Y (Z) + ASSIGN 101 TO J + 200 PRINT *, A(1) + READ *, TMP + GOTO J + 100 X = TMP * EE + RETURN + 101 Y = TMP * PI + CALL FRED + DATA EE, PI /2.71D0, 3.14D0/ + END + @end smallexample + + Here are some observations about the above code, + which, while somewhat contrived, + conforms to the FORTRAN 77 and Fortran 90 standards: + + @itemize @bullet + @item + The return type of function @samp{X} is not known + until the @samp{DOUBLE PRECISION} line has been parsed. + + @item + Whether @samp{A} is a function or a variable + is not known until the @samp{PRINT *, A(0)} statement + has been parsed. + + @item + The bounds of the array of argument @samp{ARRAY} + depend on a computation involving + the subsequent argument @samp{ID1} + and the blank-common member @samp{ID2}. + + @item + Whether @samp{Y} and @samp{Z} are local variables, + additional function entry points, + or dummy arguments to additional entry points + is not known + until the @code{ENTRY} statement is parsed. + + @item + Similarly, whether @samp{TMP} is a local variable is not known + until the @samp{READ *, TMP} statement is parsed. + + @item + The initial values for @samp{EE} and @samp{PI} + are not known until after the @code{DATA} statement is parsed. + + @item + Whether @samp{FRED} is a function returning type @code{REAL} + or a subroutine + (which can be thought of as returning type @code{void} + @emph{or}, to support alternate returns in a simple way, + type @code{int}) + is not known + until the @samp{CALL FRED} statement is parsed. + + @item + Whether @samp{100} is a @code{FORMAT} label + or the label of an executable statement + is not known + until the @samp{X =} statement is parsed. + (These two types of labels get @emph{very} different treatment, + especially when @code{ASSIGN}'ed.) + + @item + That @samp{J} is a local variable is not known + until the first @code{ASSIGN} statement is parsed. + (This happens @emph{after} executable code has been seen.) + @end itemize + + Very few of these ``discoveries'' + can be accommodated by the GBE as it has evolved over the years. + The GBEL doesn't support several of them, + and those it might appear to support + don't always work properly, + especially in combination with other GBEL and GBE features, + as implemented in the GBE. + + (Had the GBE and its GBEL originally evolved to support @code{g77}, + the shoe would be on the other foot, so to speak---most, if not all, + of the above would be directly supported by the GBEL, + and a few C constructs would probably not, as they are in reality, + be supported. + Both this mythical, and today's real, GBE caters to its GBEL + by, sometimes, scrambling around, cleaning up after itself---after + discovering that assumptions it made earlier during code generation + are incorrect.) + + So, the FFE handles these discrepancies---between the order in which + it discovers facts about the code it is compiling, + and the order in which the GBEL and GBE support such discoveries---by + performing what amounts to two + passes over each program unit. + + (A few ambiguities can remain at that point, + such as whether, given @samp{EXTERNAL BAZ} + and no other reference to @samp{BAZ} in the program unit, + it is a subroutine, a function, or a block-data---which, in C-speak, + governs its declared return type. + Fortunately, these distinctions are easily finessed + for the procedure, library, and object-file interfaces + supported by @code{g77}.) + + @node Challenges Posed + @section Challenges Posed + + Consider the following Fortran code, which uses various extensions + (including some to Fortran 90): + + @smallexample + SUBROUTINE X(A) + CHARACTER*(*) A + COMPLEX CFUNC + INTEGER*2 CLOCKS(200) + INTEGER IFUNC + + CALL SYSTEM_CLOCK (CLOCKS (IFUNC (CFUNC ('('//A//')')))) + @end smallexample + + The above poses the following challenges to any Fortran compiler + that uses run-time interfaces, and a run-time library, roughly similar + to those used by @code{g77}: + + @itemize @bullet + @item + Assuming the library routine that supports @code{SYSTEM_CLOCK} + expects to set an @code{INTEGER*4} variable via its @code{COUNT} argument, + the compiler must make available to it a temporary variable of that type. + + @item + Further, after the @code{SYSTEM_CLOCK} library routine returns, + the compiler must ensure that the temporary variable it wrote + is copied into the appropriate element of the @samp{CLOCKS} array. + (This assumes the compiler doesn't just reject the code, + which it should if it is compiling under some kind of a ``strict'' option.) + + @item + To determine the correct index into the @samp{CLOCKS} array, + (putting aside the fact that the index, in this particular case, + need not be computed until after + the @code{SYSTEM_CLOCK} library routine returns), + the compiler must ensure that the @code{IFUNC} function is called. + + That requires evaluating its argument, + which requires, for @code{g77} + (assuming @code{-ff2c} is in force), + reserving a temporary variable of type @code{COMPLEX} + for use as a repository for the return value + being computed by @samp{CFUNC}. + + @item + Before invoking @samp{CFUNC}, + is argument must be evaluated, + which requires allocating, at run time, + a temporary large enough to hold the result of the concatenation, + as well as actually performing the concatenation. + + @item + The large temporary needed during invocation of @code{CFUNC} + should, ideally, be deallocated + (or, at least, left to the GBE to dispose of, as it sees fit) + as soon as @code{CFUNC} returns, + which means before @code{IFUNC} is called + (as it might need a lot of dynamically allocated memory). + @end itemize + + @code{g77} currently doesn't support all of the above, + but, so that it might someday, it has evolved to handle + at least some of the above requirements. + + Meeting the above requirements is made more challenging + by conforming to the requirements of the GBEL/GBE combination. + + @node Transforming Statements + @section Transforming Statements + + Most Fortran statements are given their own block, + and, for temporary variables they might need, their own scope. + (A block is what distinguishes @samp{@{ foo (); @}} + from just @samp{foo ();} in C. + A scope is included with every such block, + providing a distinct name space for local variables.) + + Label definitions for the statement precede this block, + so @samp{10 PRINT *, I} is handled more like + @samp{fl10: @{ @dots{} @}} than @samp{@{ fl10: @dots{} @}} + (where @samp{fl10} is just a notation meaning ``Fortran Label 10'' + for the purposes of this document). + + @menu + * Statements Needing Temporaries:: + * Transforming DO WHILE:: + * Transforming Iterative DO:: + * Transforming Block IF:: + * Transforming SELECT CASE:: + @end menu + + @node Statements Needing Temporaries + @subsection Statements Needing Temporaries + + Any temporaries needed during, but not beyond, + execution of a Fortran statement, + are made local to the scope of that statement's block. + + This allows the GBE to share storage for these temporaries + among the various statements without the FFE + having to manage that itself. + + (The GBE could, of course, decide to optimize + management of these temporaries. + For example, it could, theoretically, + schedule some of the computations involving these temporaries + to occur in parallel. + More practically, it might leave the storage for some temporaries + ``live'' beyond their scopes, to reduce the number of + manipulations of the stack pointer at run time.) + + Temporaries needed across distinct statement boundaries usually + are associated with Fortran blocks (such as @code{DO}/@code{END DO}). + (Also, there might be temporaries not associated with blocks at all---these + would be in the scope of the entire program unit.) + + Each Fortran block @emph{should} get its own block/scope in the GBE. + This is best, because it allows temporaries to be more naturally handled. + However, it might pose problems when handling labels + (in particular, when they're the targets of @code{GOTO}s outside the Fortran + block), and generally just hassling with replicating + parts of the @code{gcc} front end + (because the FFE needs to support + an arbitrary number of nested back-end blocks + if each Fortran block gets one). + + So, there might still be a need for top-level temporaries, whose + ``owning'' scope is that of the containing procedure. + + Also, there seems to be problems declaring new variables after + generating code (within a block) in the back end, leading to, e.g., + @samp{label not defined before binding contour} or similar messages, + when compiling with @samp{-fstack-check} or + when compiling for certain targets. + + Because of that, and because sometimes these temporaries are not + discovered until in the middle of of generating code for an expression + statement (as in the case of the optimization for @samp{X**I}), + it seems best to always + pre-scan all the expressions that'll be expanded for a block + before generating any of the code for that block. + + This pre-scan then handles discovering and declaring, to the back end, + the temporaries needed for that block. + + It's also important to treat distinct items in an I/O list as distinct + statements deserving their own blocks. + That's because there's a requirement + that each I/O item be fully processed before the next one, + which matters in cases like @samp{READ (*,*), I, A(I)}---the + element of @samp{A} read in the second item + @emph{must} be determined from the value + of @samp{I} read in the first item. + + @node Transforming DO WHILE + @subsection Transforming DO WHILE + + @samp{DO WHILE(expr)} @emph{must} be implemented + so that temporaries needed to evaluate @samp{expr} + are generated just for the test, each time. + + Consider how @samp{DO WHILE (A//B .NE. 'END'); @dots{}; END DO} is transformed: + + @smallexample + for (;;) + @{ + int temp0; + + @{ + char temp1[large]; + + libg77_catenate (temp1, a, b); + temp0 = libg77_ne (temp1, 'END'); + @} + + if (! temp0) + break; + + @dots{} + @} + @end smallexample + + In this case, it seems like a time/space tradeoff + between allocating and deallocating @samp{temp1} for each iteration + and allocating it just once for the entire loop. + + However, if @samp{temp1} is allocated just once for the entire loop, + it could be the wrong size for subsequent iterations of that loop + in cases like @samp{DO WHILE (A(I:J)//B .NE. 'END')}, + because the body of the loop might modify @samp{I} or @samp{J}. + + So, the above implementation is used, + though a more optimal one can be used + in specific circumstances. + + @node Transforming Iterative DO + @subsection Transforming Iterative DO + + An iterative @code{DO} loop + (one that specifies an iteration variable) + is required by the Fortran standards + to be implemented as though an iteration count + is computed before entering the loop body, + and that iteration count used to determine + the number of times the loop body is to be performed + (assuming the loop isn't cut short via @code{GOTO} or @code{EXIT}). + + The FFE handles this by allocating a temporary variable + to contain the computed number of iterations. + Since this variable must be in a scope that includes the entire loop, + a GBEL block is created for that loop, + and the variable declared as belonging to the scope of that block. + + @node Transforming Block IF + @subsection Transforming Block IF + + Consider: + + @smallexample + SUBROUTINE X(A,B,C) + CHARACTER*(*) A, B, C + LOGICAL LFUNC + + IF (LFUNC (A//B)) THEN + CALL SUBR1 + ELSE IF (LFUNC (A//C)) THEN + CALL SUBR2 + ELSE + CALL SUBR3 + END + @end smallexample + + The arguments to the two calls to @samp{LFUNC} + require dynamic allocation (at run time), + but are not required during execution of the @code{CALL} statements. + + So, the scopes of those temporaries must be within blocks inside + the block corresponding to the Fortran @code{IF} block. + + This cannot be represented ``naturally'' + in vanilla C, nor in GBEL. + The @code{if}, @code{elseif}, @code{else}, + and @code{endif} constructs + provided by both languages must, + for a given @code{if} block, + share the same C/GBE block. + + Therefore, any temporaries needed during evaluation of @samp{expr} + while executing @samp{ELSE IF(expr)} + must either have been predeclared + at the top of the corresponding @code{IF} block, + or declared within a new block for that @code{ELSE IF}---a block that, + since it cannot contain the @code{else} or @code{else if} itself + (due to the above requirement), + actually implements the rest of the @code{IF} block's + @code{ELSE IF} and @code{ELSE} statements + within an inner block. + + The FFE takes the latter approach. + + @node Transforming SELECT CASE + @subsection Transforming SELECT CASE + + @code{SELECT CASE} poses a few interesting problems for code generation, + if efficiency and frugal stack management are important. + + Consider @samp{SELECT CASE (I('PREFIX'//A))}, + where @samp{A} is @code{CHARACTER*(*)}. + In a case like this---basically, + in any case where largish temporaries are needed + to evaluate the expression---those temporaries should + not be ``live'' during execution of any of the @code{CASE} blocks. + + So, evaluation of the expression is best done within its own block, + which in turn is within the @code{SELECT CASE} block itself + (which contains the code for the CASE blocks as well, + though each within their own block). + + Otherwise, we'd have the rough equivalent of this pseudo-code: + + @smallexample + @{ + char temp[large]; + + libg77_catenate (temp, 'prefix', a); + + switch (i (temp)) + @{ + case 0: + @dots{} + @} + @} + @end smallexample + + And that would leave temp[large] in scope during the CASE blocks + (although a clever back end *could* see that it isn't referenced + in them, and thus free that temp before executing the blocks). + + So this approach is used instead: + + @smallexample + @{ + int temp0; + + @{ + char temp1[large]; + + libg77_catenate (temp1, 'prefix', a); + temp0 = i (temp1); + @} + + switch (temp0) + @{ + case 0: + @dots{} + @} + @} + @end smallexample + + Note how @samp{temp1} goes out of scope before starting the switch, + thus making it easy for a back end to free it. + + The problem @emph{that} solution has, however, + is with @samp{SELECT CASE('prefix'//A)} + (which is currently not supported). + + Unless the GBEL is extended to support arbitrarily long character strings + in its @code{case} facility, + the FFE has to implement @code{SELECT CASE} on @code{CHARACTER} + (probably excepting @code{CHARACTER*1}) + using a cascade of + @code{if}, @code{elseif}, @code{else}, and @code{endif} constructs + in GBEL. + + To prevent the (potentially large) temporary, + needed to hold the selected expression itself (@samp{'prefix'//A}), + from being in scope during execution of the @code{CASE} blocks, + two approaches are available: + + @itemize @bullet + @item + Pre-evaluate all the @code{CASE} tests, + producing an integer ordinal that is used, + a la @samp{temp0} in the earlier example, + as if @samp{SELECT CASE(temp0)} had been written. + + Each corresponding @code{CASE} is replaced with @samp{CASE(@var{i})}, + where @var{i} is the ordinal for that case, + determined while, or before, + generating the cascade of @code{if}-related constructs + to cope with @code{CHARACTER} selection. + + @item + Make @samp{temp0} above just + large enough to hold the longest @code{CASE} string + that'll actually be compared against the expression + (in this case, @samp{'prefix'//A}). + + Since that length must be constant + (because @code{CASE} expressions are all constant), + it won't be so large, + and, further, @samp{temp1} need not be dynamically allocated, + since normal @code{CHARACTER} assignment can be used + into the fixed-length @samp{temp0}. + @end itemize + + Both of these solutions require @code{SELECT CASE} implementation + to be changed so all the corresponding @code{CASE} statements + are seen during the actual code generation for @code{SELECT CASE}. + + @node Transforming Expressions + @section Transforming Expressions + + The interactions between statements, expressions, and subexpressions + at program run time can be viewed as: + + @smallexample + @var{action}(@var{expr}) + @end smallexample + + Here, @var{action} is the series of steps + performed to effect the statement, + and @var{expr} is the expression + whose value is used by @var{action}. + + Expanding the above shows a typical order of events at run time: + + @smallexample + Evaluate @var{expr} + Perform @var{action}, using result of evaluation of @var{expr} + Clean up after evaluating @var{expr} + @end smallexample + + So, if evaluating @var{expr} requires allocating memory, + that memory can be freed before performing @var{action} + only if it is not needed to hold the result of evaluating @var{expr}. + Otherwise, it must be freed no sooner than + after @var{action} has been performed. + + The above are recursive definitions, + in the sense that they apply to subexpressions of @var{expr}. + + That is, evaluating @var{expr} involves + evaluating all of its subexpressions, + performing the @var{action} that computes the + result value of @var{expr}, + then cleaning up after evaluating those subexpressions. + + The recursive nature of this evaluation is implemented + via recursive-descent transformation of the top-level statements, + their expressions, @emph{their} subexpressions, and so on. + + However, that recursive-descent transformation is, + due to the nature of the GBEL, + focused primarily on generating a @emph{single} stream of code + to be executed at run time. + + Yet, from the above, it's clear that multiple streams of code + must effectively be simultaneously generated + during the recursive-descent analysis of statements. + + The primary stream implements the primary @var{action} items, + while at least two other streams implement + the evaluation and clean-up items. + + Requirements imposed by expressions include: + + @itemize @bullet + @item + Whether the caller needs to have a temporary ready + to hold the value of the expression. + + @item + Other stuff??? + @end itemize + + @node Internal Naming Conventions + @section Internal Naming Conventions + + Names exported by FFE modules have the following (regular-expression) forms. + Note that all names beginning @code{ffe@var{mod}} or @code{FFE@var{mod}}, + where @var{mod} is lowercase or uppercase alphanumerics, respectively, + are exported by the module @code{ffe@var{mod}}, + with the source code doing the exporting in @file{@var{mod}.h}. + (Usually, the source code for the implementation is in @file{@var{mod}.c}.) + + Identifiers that don't fit the following forms + are not considered exported, + even if they are according to the C language. + (For example, they might be made available to other modules + solely for use within expansions of exported macros, + not for use within any source code in those other modules.) + + @table @code + @item ffe@var{mod} + The single typedef exported by the module. + + @item FFE@var{umod}_[A-Z][A-Z0-9_]* + (Where @var{umod} is the uppercase for of @var{mod}.) + + A @code{#define} or @code{enum} constant of the type @code{ffe@var{mod}}. + + @item ffe@var{mod}[A-Z][A-Z][a-z0-9]* + A typedef exported by the module. + + The portion of the identifier after @code{ffe@var{mod}} is + referred to as @code{ctype}, a capitalized (mixed-case) form + of @code{type}. + + @item FFE@var{umod}_@var{type}[A-Z][A-Z0-9_]*[A-Z0-9]? + (Where @var{umod} is the uppercase for of @var{mod}.) + + A @code{#define} or @code{enum} constant of the type + @code{ffe@var{mod}@var{type}}, + where @var{type} is the lowercase form of @var{ctype} + in an exported typedef. + + @item ffe@var{mod}_@var{value} + A function that does or returns something, + as described by @var{value} (see below). + + @item ffe@var{mod}_@var{value}_@var{input} + A function that does or returns something based + primarily on the thing described by @var{input} (see below). + @end table + + Below are names used for @var{value} and @var{input}, + along with their definitions. + + @table @code + @item col + A column number within a line (first column is number 1). + + @item file + An encapsulation of a file's name. + + @item find + Looks up an instance of some type that matches specified criteria, + and returns that, even if it has to create a new instance or + crash trying to find it (as appropriate). + + @item initialize + Initializes, usually a module. No type. + + @item int + A generic integer of type @code{int}. + + @item is + A generic integer that contains a true (non-zero) or false (zero) value. + + @item len + A generic integer that contains the length of something. + + @item line + A line number within a source file, + or a global line number. + + @item lookup + Looks up an instance of some type that matches specified criteria, + and returns that, or returns nil. + + @item name + A @code{text} that points to a name of something. + + @item new + Makes a new instance of the indicated type. + Might return an existing one if appropriate---if so, + similar to @code{find} without crashing. + + @item pt + Pointer to a particular character (line, column pairs) + in the input file (source code being compiled). + + @item run + Performs some herculean task. No type. + + @item terminate + Terminates, usually a module. No type. + + @item text + A @code{char *} that points to generic text. + @end table diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/fini.c gcc-2.95/gcc/f/fini.c *** egcs-1.1.2/gcc/f/fini.c Wed Jul 15 02:35:55 1998 --- gcc-2.95/gcc/f/fini.c Sat Mar 27 02:23:47 1999 *************** *** 1,6 **** /* fini.c Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* fini.c Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** along with GNU Fortran; see the file COP *** 19,27 **** --- 19,30 ---- the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ + #define USE_HCONFIG + #include "proj.h" #include "malloc.h" + #undef MAXNAMELEN #define MAXNAMELEN 100 typedef struct _name_ *name; *************** static FILE *out; *** 59,65 **** static char prefix[32]; static char postfix[32]; static char storage[32]; ! static char *spaces[] = { "", /* 0 */ --- 62,68 ---- static char prefix[32]; static char postfix[32]; static char storage[32]; ! static const char *xspaces[] = { "", /* 0 */ *************** testname (bool nested, int indent, name *** 633,639 **** int numhalf; assert (!nested || indent >= 2); ! assert (((size_t) indent) + 4 < ARRAY_SIZE (spaces)); num = 0; numhalf = 0; --- 636,642 ---- int numhalf; assert (!nested || indent >= 2); ! assert (((size_t) indent) + 4 < ARRAY_SIZE (xspaces)); num = 0; numhalf = 0; *************** testname (bool nested, int indent, name *** 651,665 **** "\ %s{\n\ ", ! spaces[indent - 2]); fprintf (out, "\ %sif ((c = ffesrc_strcmp_2c (ffe_case_match (), p, \"%s\", \"%s\", \"%s\")) == 0)\n\ %sreturn %s%s%s;\n\ ", ! spaces[indent], nhalf->name_uc, nhalf->name_lc, nhalf->name_ic, ! spaces[indent + 2], prefix, nhalf->kwname, postfix); if (num != 1) { --- 654,668 ---- "\ %s{\n\ ", ! xspaces[indent - 2]); fprintf (out, "\ %sif ((c = ffesrc_strcmp_2c (ffe_case_match (), p, \"%s\", \"%s\", \"%s\")) == 0)\n\ %sreturn %s%s%s;\n\ ", ! xspaces[indent], nhalf->name_uc, nhalf->name_lc, nhalf->name_ic, ! xspaces[indent + 2], prefix, nhalf->kwname, postfix); if (num != 1) { *************** testname (bool nested, int indent, name *** 667,680 **** "\ %selse if (c < 0)\n\ ", ! spaces[indent]); if (numhalf == 0) fprintf (out, "\ %s;\n\ ", ! spaces[indent + 2]); else testname (TRUE, indent + 4, first, nhalf->previous); --- 670,683 ---- "\ %selse if (c < 0)\n\ ", ! xspaces[indent]); if (numhalf == 0) fprintf (out, "\ %s;\n\ ", ! xspaces[indent + 2]); else testname (TRUE, indent + 4, first, nhalf->previous); *************** testname (bool nested, int indent, name *** 684,690 **** "\ %selse\n\ ", ! spaces[indent]); testname (TRUE, indent + 4, nhalf->next, last); } --- 687,693 ---- "\ %selse\n\ ", ! xspaces[indent]); testname (TRUE, indent + 4, nhalf->next, last); } *************** testname (bool nested, int indent, name *** 695,701 **** "\ %s}\n\ ", ! spaces[indent - 2]); } void --- 698,704 ---- "\ %s}\n\ ", ! xspaces[indent - 2]); } void *************** testnames (bool nested, int indent, int *** 707,713 **** int numhalf; assert (!nested || indent >= 2); ! assert (((size_t) indent) + 4 < ARRAY_SIZE (spaces)); num = 0; numhalf = 0; --- 710,716 ---- int numhalf; assert (!nested || indent >= 2); ! assert (((size_t) indent) + 4 < ARRAY_SIZE (xspaces)); num = 0; numhalf = 0; *************** testnames (bool nested, int indent, int *** 725,739 **** "\ %s{\n\ ", ! spaces[indent - 2]); fprintf (out, "\ %sif ((c = ffesrc_strncmp_2c (ffe_case_match (), p, \"%s\", \"%s\", \"%s\", %d)) == 0)\n\ %sreturn %s%s%s;\n\ ", ! spaces[indent], nhalf->name_uc, nhalf->name_lc, nhalf->name_ic, ! len, spaces[indent + 2], prefix, nhalf->kwname, postfix); if (num != 1) { --- 728,742 ---- "\ %s{\n\ ", ! xspaces[indent - 2]); fprintf (out, "\ %sif ((c = ffesrc_strncmp_2c (ffe_case_match (), p, \"%s\", \"%s\", \"%s\", %d)) == 0)\n\ %sreturn %s%s%s;\n\ ", ! xspaces[indent], nhalf->name_uc, nhalf->name_lc, nhalf->name_ic, ! len, xspaces[indent + 2], prefix, nhalf->kwname, postfix); if (num != 1) { *************** testnames (bool nested, int indent, int *** 741,754 **** "\ %selse if (c < 0)\n\ ", ! spaces[indent]); if (numhalf == 0) fprintf (out, "\ %s;\n\ ", ! spaces[indent + 2]); else testnames (TRUE, indent + 4, len, first, nhalf->previous); --- 744,757 ---- "\ %selse if (c < 0)\n\ ", ! xspaces[indent]); if (numhalf == 0) fprintf (out, "\ %s;\n\ ", ! xspaces[indent + 2]); else testnames (TRUE, indent + 4, len, first, nhalf->previous); *************** testnames (bool nested, int indent, int *** 758,764 **** "\ %selse\n\ ", ! spaces[indent]); testnames (TRUE, indent + 4, len, nhalf->next, last); } --- 761,767 ---- "\ %selse\n\ ", ! xspaces[indent]); testnames (TRUE, indent + 4, len, nhalf->next, last); } *************** testnames (bool nested, int indent, int *** 769,773 **** "\ %s}\n\ ", ! spaces[indent - 2]); } --- 772,776 ---- "\ %s}\n\ ", ! xspaces[indent - 2]); } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/flags.j gcc-2.95/gcc/f/flags.j *** egcs-1.1.2/gcc/f/flags.j Tue May 19 03:49:32 1998 --- gcc-2.95/gcc/f/flags.j Mon Feb 15 10:16:45 1999 *************** *** 1,6 **** /* flags.j -- Wrapper for GCC's flags.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* flags.j -- Wrapper for GCC's flags.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/g77.1 gcc-2.95/gcc/f/g77.1 *** egcs-1.1.2/gcc/f/g77.1 Tue Sep 1 02:03:29 1998 --- gcc-2.95/gcc/f/g77.1 Sun Feb 14 03:42:46 1999 *************** *** 1,7 **** .\" Copyright (c) 1995-1997 Free Software Foundation -*-Text-*- .\" See section COPYING for conditions for redistribution .\" FIXME: no info here on predefines. Should there be? extra for F77... ! .TH G77 1 "1998-09-01" "GNU Tools" "GNU Tools" .de BP .sp .ti \-.2i --- 1,7 ---- .\" Copyright (c) 1995-1997 Free Software Foundation -*-Text-*- .\" See section COPYING for conditions for redistribution .\" FIXME: no info here on predefines. Should there be? extra for F77... ! .TH G77 1 "1999-02-14" "GNU Tools" "GNU Tools" .de BP .sp .ti \-.2i *************** For complete documentation on GNU Fortra *** 88,101 **** F77 source files use the suffix `\|\c .B .f\c ! \&\|' or `\|\c .B .for\c \&\|'; F77 files to be preprocessed by .BR cpp ( 1 ) use the suffix `\|\c .B .F\c ! \&\|' or `\|\c .B .fpp\c \&\|'; Ratfor source files use the suffix `\|\c .B .r\c \&\|' (though --- 88,105 ---- F77 source files use the suffix `\|\c .B .f\c ! \&\|', `\|\c .B .for\c + \&\|', or `\|\c + .B .FOR\c \&\|'; F77 files to be preprocessed by .BR cpp ( 1 ) use the suffix `\|\c .B .F\c ! \&\|', `\|\c .B .fpp\c + \&\|', or `\|\c + .B .FPP\c \&\|'; Ratfor source files use the suffix `\|\c .B .r\c \&\|' (though *************** file.f Fortran source file *** 250,258 **** --- 254,266 ---- .br file.for Fortran source file .br + file.FOR Fortran source file + .br file.F preprocessed Fortran source file .br file.fpp preprocessed Fortran source file + .br + file.FPP preprocessed Fortran source file .br file.r Ratfor source file (ratfor not included) .br diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/g77.texi gcc-2.95/gcc/f/g77.texi *** egcs-1.1.2/gcc/f/g77.texi Thu Mar 11 07:28:50 1999 --- gcc-2.95/gcc/f/g77.texi Mon Jun 21 04:58:54 1999 *************** *** 1,28 **** \input texinfo @c -*-texinfo-*- ! @c fix @set inside @example: ! @tex ! \gdef\set{\begingroup\catcode` =10 \parsearg\setxxx} ! \gdef\setyyy#1 #2\endsetyyy{% ! \def\temp{#2}% ! \ifx\temp\empty \global\expandafter\let\csname SET#1\endcsname = \empty ! \else \setzzz{#1}#2\endsetzzz % Remove the trailing space \setxxx inserted. ! \fi ! \endgroup ! } ! @end tex ! ! @c %**start of header @setfilename g77.info ! @set last-up-date 1999-03-11 ! @set version-g77 0.5.24 ! @set version-egcs 1.1.2 ! @set email-general egcs@@egcs.cygnus.com ! @set email-bugs egcs-bugs@@egcs.cygnus.com ! @set email-burley craig@@jcb-sc.com ! @set path-g77 egcs/gcc/f ! @set path-libf2c egcs/libf2c ! @set which-g77 @code{egcs}-@value{version-egcs} @c @setfilename useg77.info @c @setfilename portg77.info --- 1,15 ---- \input texinfo @c -*-texinfo-*- ! @c %**start of header @setfilename g77.info ! @set last-update 1999-06-06 ! @set copyrights-g77 1995-1999 ! ! @include root.texi ! ! @c This tells @include'd files that they're part of the overall G77 doc ! @c set. (They might be part of a higher-level doc set too.) ! @set DOC-G77 @c @setfilename useg77.info @c @setfilename portg77.info *************** *** 37,45 **** @c and make sure the following does NOT begin with '@c': @c @clear USING ! @c (For FSF printing, turn on smallbook; that is all that is needed.) ! @c smallbook @ifset INTERNALS @ifset USING --- 24,36 ---- @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 @ifset INTERNALS @ifset USING *************** *** 52,58 **** @end ifclear @ifclear USING @settitle Porting GNU Fortran ! @end ifclear @c then again, have some fun @ifclear INTERNALS @ifclear USING --- 43,49 ---- @end ifclear @ifclear USING @settitle Porting GNU Fortran ! @end ifclear @c then again, have some fun @ifclear INTERNALS @ifclear USING *************** *** 63,78 **** @syncodeindex fn cp @syncodeindex vr cp @c %**end of header ! @setchapternewpage odd @ifinfo ! This file explains how to use the GNU Fortran system. Published by the Free Software Foundation 59 Temple Place - Suite 330 Boston, MA 02111-1307 USA ! Copyright (C) 1995-1997 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice --- 54,101 ---- @syncodeindex fn cp @syncodeindex vr cp @c %**end of header ! ! @c Cause even numbered pages to be printed on the left hand side of ! @c the page and odd numbered pages to be printed on the right hand ! @c side of the page. Using this, you can print on both sides of a ! @c sheet of paper and have the text on the same part of the sheet. ! ! @c The text on right hand pages is pushed towards the right hand ! @c margin and the text on left hand pages is pushed toward the left ! @c hand margin. ! @c (To provide the reverse effect, set bindingoffset to -0.75in.) ! ! @c @tex ! @c \global\bindingoffset=0.75in ! @c \global\normaloffset =0.75in ! @c @end tex @ifinfo ! @dircategory Programming ! @direntry ! * g77: (g77). The GNU Fortran compiler. ! @end direntry ! @ifset INTERNALS ! @ifset USING ! This file documents the use and the internals of the GNU Fortran (@code{g77}) ! compiler. ! It corresponds to the @value{which-g77} version of @code{g77}. ! @end ifset ! @end ifset ! @ifclear USING ! This file documents the internals of the GNU Fortran (@code{g77}) compiler. ! It corresponds to the @value{which-g77} version of @code{g77}. ! @end ifclear ! @ifclear INTERNALS ! This file documents the use of the GNU Fortran (@code{g77}) compiler. ! It corresponds to the @value{which-g77} version of @code{g77}. ! @end ifclear 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 make and distribute verbatim copies of this manual provided the copyright notice and this permission notice *************** Contributed by James Craig Burley (@emai *** 106,128 **** 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}). ! @finalout @titlepage ! @comment The title is printed in a large font. ! @center @titlefont{Using GNU Fortran} @sp 2 @center James Craig Burley @sp 3 ! @center Last updated @value{last-up-date} @sp 1 - @c The version number appears some more times in this file. - @center for version @value{version-g77} @page @vskip 0pt plus 1filll ! Copyright @copyright{} 1995-1997 Free Software Foundation, Inc. @sp 2 ! For GNU Fortran Version @value{version-g77}* @sp 1 Published by the Free Software Foundation @* 59 Temple Place - Suite 330@* --- 129,160 ---- 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 ! @center @titlefont{Using and Porting GNU Fortran} ! ! @end ifset ! @end ifset ! @ifclear INTERNALS ! @title Using GNU Fortran ! @end ifclear ! @ifclear USING ! @title Porting GNU Fortran ! @end ifclear @sp 2 @center James Craig Burley @sp 3 ! @center Last updated @value{last-update} @sp 1 @center for version @value{version-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 @* 59 Temple Place - Suite 330@* *************** original English. *** 155,194 **** @ifinfo - @dircategory Programming - @direntry - * g77: (g77). The GNU Fortran compiler. - @end direntry @node Top, Copying,, (DIR) @top Introduction @cindex Introduction @ifset INTERNALS @ifset USING ! This manual documents how to run, install and port the GNU Fortran ! compiler, as well as its new features and incompatibilities, and how to ! report bugs. It corresponds to GNU Fortran version @value{version-g77}. @end ifset @end ifset @ifclear INTERNALS ! This manual documents how to run and install the GNU Fortran compiler, as well as its new features and incompatibilities, and how to report ! bugs. It corresponds to GNU Fortran version @value{version-g77}. @end ifclear @ifclear USING ! This manual documents how to port the GNU Fortran compiler, ! as well as its new features and incompatibilities, and how to report ! bugs. It corresponds to GNU Fortran version @value{version-g77}. @end ifclear - An online, ``live'' version of this document - (derived directly from the up-to-date mainline version - of @code{g77} within @code{egcs}) - is available at - @uref{http://egcs.cygnus.com/onlinedocs/g77_toc.html}. - @end ifinfo @menu * Copying:: GNU General Public License says how you can copy and share GNU Fortran. --- 187,236 ---- @ifinfo @node Top, Copying,, (DIR) @top Introduction @cindex Introduction @ifset INTERNALS @ifset USING ! This manual documents how to run, install and port @code{g77}, ! as well as its new features and incompatibilities, ! and how to report bugs. ! It corresponds to the @value{which-g77} version of @code{g77}. @end ifset @end ifset @ifclear INTERNALS ! This manual documents how to run and install @code{g77}, as well as its new features and incompatibilities, and how to report ! bugs. ! It corresponds to the @value{which-g77} version of @code{g77}. @end ifclear @ifclear USING ! This manual documents how to port @code{g77}, ! as well as its new features and incompatibilities, ! and how to report bugs. ! It corresponds to the @value{which-g77} version of @code{g77}. @end ifclear @end ifinfo + + @ifset DEVELOPMENT + @emph{Warning:} This document is still under development, + and might not accurately reflect the @code{g77} code base + of which it is a part. + Efforts are made to keep it somewhat up-to-date, + but they are particularly concentrated + on any version of this information + that is distributed as part of a @emph{released} @code{g77}. + + In particular, while this document is intended to apply to + the @value{which-g77} version of @code{g77}, + only an official @emph{release} of that version + is expected to contain documentation that is + most consistent with the @code{g77} product in that version. + @end ifset + @menu * Copying:: GNU General Public License says how you can copy and share GNU Fortran. *************** is available at *** 219,224 **** --- 261,267 ---- @ifset INTERNALS * Adding Options:: Guidance on teaching @code{g77} about new options. * Projects:: Projects for @code{g77} internals hackers. + * Front End:: Design and implementation of the @code{g77} front end. @end ifset * M: Diagnostics. Diagnostics produced by @code{g77}. *************** the ``copyright'' line and a pointer to *** 567,575 **** @var{one line to give the program's name and a brief idea of what it does.} Copyright (C) 19@var{yy} @var{name of author} ! This program is free software; you can redistribute it and/or modify ! it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, --- 610,618 ---- @var{one line to give the program's name and a brief idea of what it does.} Copyright (C) 19@var{yy} @var{name of author} ! This program is free software; you can redistribute it and/or modify ! it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, *************** when it starts in an interactive mode: *** 590,597 **** @smallexample Gnomovision version 69, Copyright (C) 19@var{yy} @var{name of author} Gnomovision comes with ABSOLUTELY NO WARRANTY; for details ! type `show w'. ! This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. @end smallexample --- 633,640 ---- @smallexample Gnomovision version 69, Copyright (C) 19@var{yy} @var{name of author} Gnomovision comes with ABSOLUTELY NO WARRANTY; for details ! type `show w'. ! This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. @end smallexample *************** without royalty; alteration is not permi *** 786,791 **** --- 829,836 ---- Work on GNU Fortran is still being done mostly by its author, James Craig Burley (@email{@value{email-burley}}), who is a volunteer for, not an employee of, the Free Software Foundation (FSF). + (He has a web page at @uref{@value{www-burley}}.) + As with other GNU software, funding is important because it can pay for needed equipment, personnel, and so on. *************** continuing operation of the FSF offices, *** 810,816 **** network connections, and so on, which are invaluable to volunteers. (Similarly, hiring Cygnus Support can help a project like GNU Fortran---Cygnus has been a long-time donor of equipment usage to the author ! of GNU Fortran, and this too has been invaluable---@xref{Contributors}.) Currently, the only way to directly fund the author of GNU Fortran in his work on that project is to hire him for the work you want --- 855,861 ---- network connections, and so on, which are invaluable to volunteers. (Similarly, hiring Cygnus Support can help a project like GNU Fortran---Cygnus has been a long-time donor of equipment usage to the author ! of GNU Fortran, and this too has been invaluable---see @ref{Contributors}.) Currently, the only way to directly fund the author of GNU Fortran in his work on that project is to hire him for the work you want *************** Email @email{@value{email-general}} to v *** 838,844 **** @node Look and Feel @chapter Protect Your Freedom---Fight ``Look And Feel'' ! @c the above chapter heading overflows onto the next line. --mew 1/26/93 To preserve the ability to write free software, including replacements for proprietary software, authors must be free to replicate the --- 883,889 ---- @node Look and Feel @chapter Protect Your Freedom---Fight ``Look And Feel'' ! @c the above chapter heading overflows onto the next line. --mew 1/26/93 To preserve the ability to write free software, including replacements for proprietary software, authors must be free to replicate the *************** Everyone except experienced @code{g77} u *** 872,878 **** see @ref{Invoking G77}. If you're acquainted with previous versions of @code{g77}, ! you should see @ref{News}. Further, if you've actually used previous versions of @code{g77}, especially if you've written or modified Fortran code to be compiled by previous versions of @code{g77}, you --- 917,923 ---- see @ref{Invoking G77}. If you're acquainted with previous versions of @code{g77}, ! you should see @ref{News,,News About GNU Fortran}. Further, if you've actually used previous versions of @code{g77}, especially if you've written or modified Fortran code to be compiled by previous versions of @code{g77}, you *************** to make big mistakes. *** 966,973 **** @cindex debugger @cindex bugs, finding ! @cindex gdb command ! @cindex commands, gdb @item They provide information in the generated machine code that can make it easier to find bugs in the program --- 1011,1018 ---- @cindex debugger @cindex bugs, finding ! @cindex @code{gdb}, command ! @cindex commands, @code{gdb} @item They provide information in the generated machine code that can make it easier to find bugs in the program *************** such as @code{gdb}). *** 976,983 **** @cindex libraries @cindex linking ! @cindex ld command ! @cindex commands, ld @item They locate and gather machine code already generated to perform actions requested by statements in --- 1021,1028 ---- @cindex libraries @cindex linking ! @cindex @code{ld} command ! @cindex commands, @code{ld} @item They locate and gather machine code already generated to perform actions requested by statements in *************** of the language), how much time to spend *** 1036,1046 **** the generated machine code run faster, and so on. @cindex components of g77 ! @cindex g77, components of @code{g77} consists of several components: ! @cindex gcc command ! @cindex commands, gcc @itemize @bullet @item A modified version of the @code{gcc} command, which also might be --- 1081,1091 ---- the generated machine code run faster, and so on. @cindex components of g77 ! @cindex @code{g77}, components of @code{g77} consists of several components: ! @cindex @code{gcc}, command ! @cindex commands, @code{gcc} @itemize @bullet @item A modified version of the @code{gcc} command, which also might be *************** might be a non-GNU compiler, or an older *** 1051,1058 **** of @code{gcc} considered more stable or that is used to build the operating system kernel.) ! @cindex g77 command ! @cindex commands, g77 @item The @code{g77} command itself, which also might be installed as the system's @code{f77} command. --- 1096,1103 ---- of @code{gcc} considered more stable or that is used to build the operating system kernel.) ! @cindex @code{g77}, command ! @cindex commands, @code{g77} @item The @code{g77} command itself, which also might be installed as the system's @code{f77} command. *************** system's @code{f77} command. *** 1061,1067 **** @cindex libf2c library @cindex libraries, libf2c @cindex libraries, libg2c ! @cindex run-time library @item The @code{libg2c} run-time library. This library contains the machine code needed to support --- 1106,1112 ---- @cindex libf2c library @cindex libraries, libf2c @cindex libraries, libg2c ! @cindex run-time, library @item The @code{libg2c} run-time library. This library contains the machine code needed to support *************** on the system. *** 1079,1089 **** The maintainer of @code{libf2c} currently is @email{dmg@@bell-labs.com}. ! @cindex f771 program ! @cindex programs, f771 @cindex assembler ! @cindex as command ! @cindex commands, as @cindex assembly code @cindex code, assembly @item --- 1124,1134 ---- The maintainer of @code{libf2c} currently is @email{dmg@@bell-labs.com}. ! @cindex @code{f771}, program ! @cindex programs, @code{f771} @cindex assembler ! @cindex @code{as} command ! @cindex commands, @code{as} @cindex assembly code @cindex code, assembly @item *************** preprocessing, compiling (in a variety o *** 1103,1109 **** and linking. @cindex driver, gcc command as ! @cindex gcc command as driver @cindex executable file @cindex files, executable @cindex cc1 program --- 1148,1154 ---- and linking. @cindex driver, gcc command as ! @cindex @code{gcc}, command as driver @cindex executable file @cindex files, executable @cindex cc1 program *************** As another example, the command @samp{gc *** 1124,1137 **** @samp{gcc foo.c}, but instead of using the C compiler named @code{cc1}, @code{gcc} would use the C++ compiler (named @code{cc1plus}). ! @cindex f771 program ! @cindex programs, f771 In a GNU Fortran installation, @code{gcc} recognizes Fortran source files by name just like it does C and C++ source files. It knows to use the Fortran compiler named @code{f771}, instead of @code{cc1} or @code{cc1plus}, to compile Fortran files. ! @cindex gcc not recognizing Fortran source @cindex unrecognized file format @cindex file format not recognized Non-Fortran-related operation of @code{gcc} is generally --- 1169,1182 ---- @samp{gcc foo.c}, but instead of using the C compiler named @code{cc1}, @code{gcc} would use the C++ compiler (named @code{cc1plus}). ! @cindex @code{f771}, program ! @cindex programs, @code{f771} In a GNU Fortran installation, @code{gcc} recognizes Fortran source files by name just like it does C and C++ source files. It knows to use the Fortran compiler named @code{f771}, instead of @code{cc1} or @code{cc1plus}, to compile Fortran files. ! @cindex @code{gcc}, not recognizing Fortran source @cindex unrecognized file format @cindex file format not recognized Non-Fortran-related operation of @code{gcc} is generally *************** GNU Fortran version, @code{gcc} will not *** 1141,1148 **** and link Fortran programs---and since @code{g77} uses @code{gcc} to do most of the actual work, neither will @code{g77}! ! @cindex g77 command ! @cindex commands, g77 The @code{g77} command is essentially just a front-end for the @code{gcc} command. Fortran users will normally use @code{g77} instead of @code{gcc}, --- 1186,1193 ---- and link Fortran programs---and since @code{g77} uses @code{gcc} to do most of the actual work, neither will @code{g77}! ! @cindex @code{g77}, command ! @cindex commands, @code{g77} The @code{g77} command is essentially just a front-end for the @code{gcc} command. Fortran users will normally use @code{g77} instead of @code{gcc}, *************** large chunks of code. *** 1201,1207 **** @cindex GNU Back End (GBE) @cindex GBE ! @cindex gcc back end @cindex back end, gcc @cindex code generator One chunk is the so-called @dfn{GNU Back End}, or GBE, --- 1246,1252 ---- @cindex GNU Back End (GBE) @cindex GBE ! @cindex @code{gcc}, back end @cindex back end, gcc @cindex code generator One chunk is the so-called @dfn{GNU Back End}, or GBE, *************** whenever the distinction is important. *** 1214,1221 **** @cindex GNU Fortran Front End (FFE) @cindex FFE ! @cindex g77 front end ! @cindex front end, g77 The other chunk of @code{f771} is the majority of what is unique about GNU Fortran---the code that knows how to interpret Fortran programs to determine what they are intending to --- 1259,1266 ---- @cindex GNU Fortran Front End (FFE) @cindex FFE ! @cindex @code{g77}, front end ! @cindex front end, @code{g77} The other chunk of @code{f771} is the majority of what is unique about GNU Fortran---the code that knows how to interpret Fortran programs to determine what they are intending to *************** of generated code (in terms of speed and *** 1245,1252 **** @cindex compiling programs @cindex programs, compiling ! @cindex gcc command ! @cindex commands, gcc A GNU Fortran installation includes a modified version of the @code{gcc} command. --- 1290,1297 ---- @cindex compiling programs @cindex programs, compiling ! @cindex @code{gcc}, command ! @cindex commands, @code{gcc} A GNU Fortran installation includes a modified version of the @code{gcc} command. *************** but apply to other languages as well. *** 1262,1269 **** for information on the way different languages are handled by the GNU CC compiler (@code{gcc}). ! @cindex g77 command ! @cindex commands, g77 Also provided as part of GNU Fortran is the @code{g77} command. The @code{g77} command is designed to make compiling and linking Fortran programs somewhat easier than when using the @code{gcc} command for --- 1307,1314 ---- for information on the way different languages are handled by the GNU CC compiler (@code{gcc}). ! @cindex @code{g77}, command ! @cindex commands, @code{g77} Also provided as part of GNU Fortran is the @code{g77} command. The @code{g77} command is designed to make compiling and linking Fortran programs somewhat easier than when using the @code{gcc} command for *************** It does this by analyzing the command li *** 1272,1278 **** appropriately before submitting it to the @code{gcc} command. @cindex -v option ! @cindex g77 options, -v @cindex options, -v Use the @samp{-v} option with @code{g77} to see what is going on---the first line of output is the invocation --- 1317,1323 ---- appropriately before submitting it to the @code{gcc} command. @cindex -v option ! @cindex @code{g77} options, -v @cindex options, -v Use the @samp{-v} option with @code{g77} to see what is going on---the first line of output is the invocation *************** by type. Explanations are in the follow *** 1343,1349 **** @item Shorthand Options @xref{Shorthand Options}. @smallexample ! -ff66 -fno-f66 -ff77 -fno-f77 -fugly -fno-ugly @end smallexample @item Fortran Language Options --- 1388,1394 ---- @item Shorthand Options @xref{Shorthand Options}. @smallexample ! -ff66 -fno-f66 -ff77 -fno-f77 -fno-ugly @end smallexample @item Fortran Language Options *************** by type. Explanations are in the follow *** 1422,1431 **** -fpcc-struct-return -freg-struct-return -fshort-double -fno-common -fpack-struct -fzeros -fno-second-underscore ! -fdebug-kludge -fno-emulate-complex -falias-check -fargument-alias -fargument-noalias -fno-argument-noalias-global ! -fno-globals @end smallexample @end table --- 1467,1477 ---- -fpcc-struct-return -freg-struct-return -fshort-double -fno-common -fpack-struct -fzeros -fno-second-underscore ! -fdebug-kludge -femulate-complex -falias-check -fargument-alias -fargument-noalias -fno-argument-noalias-global ! -fno-globals -fflatten-arrays ! -fbounds-check -ffortran-bounds-check @end smallexample @end table *************** Suffixes specific to GNU Fortran are lis *** 1473,1487 **** information on suffixes recognized by GNU CC. @table @code @item @var{file}.f @item @var{file}.for Fortran source code that should not be preprocessed. Such source code cannot contain any preprocessor directives, such as @code{#include}, @code{#define}, @code{#if}, and so on. ! You can force @samp{.f} files to be preprocessed by @samp{cpp} by using ! @samp{-x f77-cpp-input}, @ref{LEX}. @cindex preprocessor @cindex C preprocessor --- 1519,1538 ---- information on suffixes recognized by GNU CC. @table @code + @cindex .f filename suffix + @cindex .for filename suffix + @cindex .FOR filename suffix @item @var{file}.f @item @var{file}.for + @item @var{file}.FOR Fortran source code that should not be preprocessed. Such source code cannot contain any preprocessor directives, such as @code{#include}, @code{#define}, @code{#if}, and so on. ! You can force @samp{.f} files to be preprocessed by @code{cpp} by using ! @samp{-x f77-cpp-input}. ! @xref{LEX}. @cindex preprocessor @cindex C preprocessor *************** You can force @samp{.f} files to be prep *** 1491,1498 **** --- 1542,1551 ---- @cindex programs, cpp @cindex .F filename suffix @cindex .fpp filename suffix + @cindex .FPP filename suffix @item @var{file}.F @item @var{file}.fpp + @item @var{file}.FPP Fortran source code that must be preprocessed (by the C preprocessor @code{cpp}, which is part of GNU CC). *************** files included by the @code{INCLUDE} dir *** 1501,1509 **** preprocessor directive must be used instead. @cindex Ratfor preprocessor ! @cindex programs, ratfor ! @cindex .r filename suffix ! @pindex ratfor @item @var{file}.r Ratfor source code, which must be preprocessed by the @code{ratfor} command, which is available separately (as it is not yet part of the GNU --- 1554,1562 ---- preprocessor directive must be used instead. @cindex Ratfor preprocessor ! @cindex programs, @code{ratfor} ! @cindex @samp{.r} filename suffix ! @cindex @code{ratfor} @item @var{file}.r Ratfor source code, which must be preprocessed by the @code{ratfor} command, which is available separately (as it is not yet part of the GNU *************** by the @code{g77} and @code{gcc} command *** 1584,1595 **** @cindex options, -fversion @cindex printing version information @cindex version information, printing @item -fversion Ensure that the @code{g77}-specific version of the compiler phase is reported, ! if run. ! (This is supplied automatically when @samp{-v} or @samp{--verbose} is specified as a command-line option for @code{g77} or @code{gcc} ! and when the resulting commands compile Fortran source files.) @cindex -fset-g77-defaults option @cindex options, -fset-g77-defaults --- 1637,1654 ---- @cindex options, -fversion @cindex printing version information @cindex version information, printing + @cindex consistency checks + @cindex internal consistency checks + @cindex checks, of internal consistency @item -fversion Ensure that the @code{g77}-specific version of the compiler phase is reported, ! if run, ! and, starting in @code{egcs} version 1.1, ! that internal consistency checks in the @file{f771} program are run. ! ! This option is supplied automatically when @samp{-v} or @samp{--verbose} is specified as a command-line option for @code{g77} or @code{gcc} ! and when the resulting commands compile Fortran source files. @cindex -fset-g77-defaults option @cindex options, -fset-g77-defaults *************** and when the resulting commands compile *** 1597,1603 **** @emph{Version info:} This option is obsolete in @code{egcs} as of version 1.1. ! Set up whatever @code{gcc} options are to apply to Fortran compilations, and avoid running internal consistency checks that might take some time. --- 1656,1668 ---- @emph{Version info:} This option is obsolete in @code{egcs} as of version 1.1. ! The effect is instead achieved ! by the @code{lang_init_options} routine ! in @file{egcs/gcc/f/com.c}. ! ! @cindex consistency checks ! @cindex internal consistency checks ! @cindex checks, of internal consistency Set up whatever @code{gcc} options are to apply to Fortran compilations, and avoid running internal consistency checks that might take some time. *************** with a diagnostic if it detects an incon *** 1623,1632 **** @cindex -fno-silent option @cindex options, -fno-silent ! @cindex @code{f2c} compatibility ! @cindex compatibility, @code{f2c} @cindex status, compilation ! @cindex compilation status @cindex reporting compilation status @cindex printing compilation status @item -fno-silent --- 1688,1697 ---- @cindex -fno-silent option @cindex options, -fno-silent ! @cindex f2c compatibility ! @cindex compatibility, f2c @cindex status, compilation ! @cindex compilation, status @cindex reporting compilation status @cindex printing compilation status @item -fno-silent *************** for other options accepted by the compil *** 1656,1661 **** --- 1721,1730 ---- @item -fugly @cindex ugly features @cindex features, ugly + @emph{Note:} This option is no longer supported. + The information, below, is provided to aid + in the conversion of old scripts. + Specify that certain ``ugly'' constructs are to be quietly accepted. Same as: *************** or well-maintained portable Fortran code *** 1670,1683 **** in old code. @xref{Distensions}, for more information. - @emph{Note:} The @samp{-fugly} option is likely to - be removed in a future version. - Implicitly enabling all the @samp{-fugly-*} options - is unlikely to be feasible, or sensible, in the future, - so users should learn to specify only those - @samp{-fugly-*} options they really need for a - particular source file. - @cindex -fno-ugly option @cindex options, -fno-ugly @item -fno-ugly --- 1739,1744 ---- *************** existing and obsolete Fortran implementa *** 1713,1722 **** @cindex options, -ff77 @item -ff77 @cindex UNIX f77 ! @cindex @code{f2c} compatibility ! @cindex compatibility, @code{f2c} ! @cindex @code{f77} compatibility ! @cindex compatibility, @code{f77} Specify that the program is written in idiomatic UNIX FORTRAN 77 and/or the dialect accepted by the @code{f2c} product. Same as @samp{-fbackslash -fno-typeless-boz}. --- 1774,1783 ---- @cindex options, -ff77 @item -ff77 @cindex UNIX f77 ! @cindex f2c compatibility ! @cindex compatibility, f2c ! @cindex f77 compatibility ! @cindex compatibility, f77 Specify that the program is written in idiomatic UNIX FORTRAN 77 and/or the dialect accepted by the @code{f2c} product. Same as @samp{-fbackslash -fno-typeless-boz}. *************** existing and obsolete Fortran implementa *** 1743,1749 **** @node Fortran Dialect Options @section Options Controlling Fortran Dialect @cindex dialect options ! @cindex language dialect options @cindex options, dialect The following options control the dialect of Fortran --- 1804,1810 ---- @node Fortran Dialect Options @section Options Controlling Fortran Dialect @cindex dialect options ! @cindex language, dialect options @cindex options, dialect The following options control the dialect of Fortran *************** that the compiler accepts: *** 1754,1763 **** @cindex options, -ffree-form @cindex -fno-fixed-form option @cindex options, -fno-fixed-form ! @cindex source file form @cindex free form @cindex fixed form ! @cindex Fortran 90 features @item -ffree-form @item -fno-fixed-form Specify that the source file is written in free form --- 1815,1824 ---- @cindex options, -ffree-form @cindex -fno-fixed-form option @cindex options, -fno-fixed-form ! @cindex source file format @cindex free form @cindex fixed form ! @cindex Fortran 90, features @item -ffree-form @item -fno-fixed-form Specify that the source file is written in free form *************** Specify that the source file is written *** 1765,1771 **** @cindex -ff90 option @cindex options, -ff90 ! @cindex Fortran 90 features @item -ff90 Allow certain Fortran-90 constructs. --- 1826,1832 ---- @cindex -ff90 option @cindex options, -ff90 ! @cindex Fortran 90, features @item -ff90 Allow certain Fortran-90 constructs. *************** current level of support for Fortran 90. *** 1781,1788 **** @cindex -fvxt option @cindex options, -fvxt @item -fvxt ! @cindex Fortran 90 features ! @cindex VXT features Specify the treatment of certain constructs that have different meanings depending on whether the code is written in GNU Fortran (based on FORTRAN 77 and akin to Fortran 90) --- 1842,1849 ---- @cindex -fvxt option @cindex options, -fvxt @item -fvxt ! @cindex Fortran 90, features ! @cindex VXT extensions Specify the treatment of certain constructs that have different meanings depending on whether the code is written in GNU Fortran (based on FORTRAN 77 and akin to Fortran 90) *************** For example, automatic conversion betwee *** 1922,1935 **** @cindex options, -fonetrip @item -fonetrip @cindex FORTRAN 66 ! @cindex DO loops, one-trip ! @cindex one-trip DO loops @cindex compatibility, FORTRAN 66 ! Imperative executable @code{DO} loops are to be executed at least once each time they are reached. ANSI FORTRAN 77 and more recent versions of the Fortran standard ! specify that the body of an imperative @code{DO} loop is not executed if the number of iterations calculated from the parameters of the loop is less than 1. (For example, @samp{DO 10 I = 1, 0}.) --- 1983,1998 ---- @cindex options, -fonetrip @item -fonetrip @cindex FORTRAN 66 ! @cindex @code{DO} loops, one-trip ! @cindex one-trip @code{DO} loops ! @cindex @code{DO} loops, zero-trip ! @cindex zero-trip @code{DO} loops @cindex compatibility, FORTRAN 66 ! Executable iterative @code{DO} loops are to be executed at least once each time they are reached. ANSI FORTRAN 77 and more recent versions of the Fortran standard ! specify that the body of an iterative @code{DO} loop is not executed if the number of iterations calculated from the parameters of the loop is less than 1. (For example, @samp{DO 10 I = 1, 0}.) *************** standard did not specify this behavior. *** 1947,1953 **** The @samp{-fonetrip} option specifies that the source file(s) being compiled require one-trip loops. ! This option affects only those loops specified by the (imperative) @code{DO} statement and by implied-@code{DO} lists in I/O statements. Loops specified by implied-@code{DO} lists in @code{DATA} and specification (non-executable) statements are not affected. --- 2010,2016 ---- The @samp{-fonetrip} option specifies that the source file(s) being compiled require one-trip loops. ! This option affects only those loops specified by the (iterative) @code{DO} statement and by implied-@code{DO} lists in I/O statements. Loops specified by implied-@code{DO} lists in @code{DATA} and specification (non-executable) statements are not affected. *************** variables named @samp{i} and @samp{I} to *** 2096,2103 **** @cindex -fbadu77-intrinsics-enable option @cindex options, -fbadu77-intrinsics-enable @item -fbadu77-intrinsics-enable ! @cindex badu77 intrinsics ! @cindex intrinsics, badu77 Specify status of UNIX intrinsics having inappropriate forms. @samp{-fbadu77-intrinsics-enable} is the default. @xref{Intrinsic Groups}. --- 2159,2166 ---- @cindex -fbadu77-intrinsics-enable option @cindex options, -fbadu77-intrinsics-enable @item -fbadu77-intrinsics-enable ! @cindex @code{badu77} intrinsics ! @cindex intrinsics, @code{badu77} Specify status of UNIX intrinsics having inappropriate forms. @samp{-fbadu77-intrinsics-enable} is the default. @xref{Intrinsic Groups}. *************** Specify status of UNIX intrinsics having *** 2114,2121 **** @cindex -ff2c-intrinsics-enable option @cindex options, -ff2c-intrinsics-enable @item -ff2c-intrinsics-enable ! @cindex f2c intrinsics ! @cindex intrinsics, f2c Specify status of f2c-specific intrinsics. @samp{-ff2c-intrinsics-enable} is the default. @xref{Intrinsic Groups}. --- 2177,2184 ---- @cindex -ff2c-intrinsics-enable option @cindex options, -ff2c-intrinsics-enable @item -ff2c-intrinsics-enable ! @cindex @code{f2c} intrinsics ! @cindex intrinsics, @code{f2c} Specify status of f2c-specific intrinsics. @samp{-ff2c-intrinsics-enable} is the default. @xref{Intrinsic Groups}. *************** Specify status of f2c-specific intrinsic *** 2132,2138 **** @cindex -ff90-intrinsics-enable option @cindex options, -ff90-intrinsics-enable @item -ff90-intrinsics-enable ! @cindex Fortran 90 intrinsics @cindex intrinsics, Fortran 90 Specify status of F90-specific intrinsics. @samp{-ff90-intrinsics-enable} is the default. --- 2195,2201 ---- @cindex -ff90-intrinsics-enable option @cindex options, -ff90-intrinsics-enable @item -ff90-intrinsics-enable ! @cindex Fortran 90, intrinsics @cindex intrinsics, Fortran 90 Specify status of F90-specific intrinsics. @samp{-ff90-intrinsics-enable} is the default. *************** Specify status of F90-specific intrinsic *** 2151,2158 **** @cindex options, -fgnu-intrinsics-enable @item -fgnu-intrinsics-enable @cindex Digital Fortran features ! @cindex COMPLEX intrinsics ! @cindex intrinsics, COMPLEX Specify status of Digital's COMPLEX-related intrinsics. @samp{-fgnu-intrinsics-enable} is the default. @xref{Intrinsic Groups}. --- 2214,2221 ---- @cindex options, -fgnu-intrinsics-enable @item -fgnu-intrinsics-enable @cindex Digital Fortran features ! @cindex @code{COMPLEX} intrinsics ! @cindex intrinsics, @code{COMPLEX} Specify status of Digital's COMPLEX-related intrinsics. @samp{-fgnu-intrinsics-enable} is the default. @xref{Intrinsic Groups}. *************** Specify status of VXT intrinsics. *** 2215,2223 **** @cindex options, -ffixed-line-length-@var{n} @item -ffixed-line-length-@var{n} @cindex source file format ! @cindex line length @cindex length of source lines ! @cindex fixed-form line length Set column after which characters are ignored in typical fixed-form lines in the source file, and through which spaces are assumed (as if padded to that length) after the ends of short fixed-form lines. --- 2278,2287 ---- @cindex options, -ffixed-line-length-@var{n} @item -ffixed-line-length-@var{n} @cindex source file format ! @cindex lines, length @cindex length of source lines ! @cindex fixed form ! @cindex limits, lengths of source lines Set column after which characters are ignored in typical fixed-form lines in the source file, and through which spaces are assumed (as if padded to that length) after the ends of short fixed-form lines. *************** to them to fill out the line. *** 2238,2245 **** @node Warning Options @section Options to Request or Suppress Warnings ! @cindex options to control warnings ! @cindex warning messages @cindex messages, warning @cindex suppressing warnings --- 2302,2309 ---- @node Warning Options @section Options to Request or Suppress Warnings ! @cindex options, warnings ! @cindex warnings, suppressing @cindex messages, warning @cindex suppressing warnings *************** use, on occasion, in clean programs. *** 2413,2424 **** @table @code @c @item -W @c Print extra warning messages for these events: ! @c @c @itemize @bullet @c @item @c If @samp{-Wall} or @samp{-Wunused} is also specified, warn about unused @c arguments. ! @c @c @end itemize @c @cindex -Wsurprising option --- 2477,2488 ---- @table @code @c @item -W @c Print extra warning messages for these events: ! @c @c @itemize @bullet @c @item @c If @samp{-Wall} or @samp{-Wunused} is also specified, warn about unused @c arguments. ! @c @c @end itemize @c @cindex -Wsurprising option *************** and data sets. *** 2650,2660 **** this option does not apply, generally speaking, to Fortran code compiled by @code{g77}. ! @emph{Also note:} @samp{-malign-double} applies only to ! statically-allocated data. ! Double-precision data on the stack can still ! cause problems due to misalignment. ! @xref{Aligned Data}. @emph{Also also note:} The negative form of @samp{-malign-double} is @samp{-mno-align-double}, not @samp{-benign-double}. --- 2714,2720 ---- this option does not apply, generally speaking, to Fortran code compiled by @code{g77}. ! @xref{Aligned Data}, for more information on alignment issues. @emph{Also also note:} The negative form of @samp{-malign-double} is @samp{-mno-align-double}, not @samp{-benign-double}. *************** is @samp{-mno-align-double}, not @samp{- *** 2662,2677 **** @cindex -ffloat-store option @cindex options, -ffloat-store @item -ffloat-store ! @cindex IEEE conformance ! @cindex conformance, IEEE ! @cindex floating point precision Might help a Fortran program that depends on exact IEEE conformance on some machines, but might slow down a program that doesn't. ! This option is effective when the floating point unit is set to work in IEEE 854 `extended precision'---as it typically is on x86 and m68k GNU ! systems---rather than IEEE 754 double precision. @code{-ffloat-store} ! tries to remove the extra precision by spilling data from floating point registers into memory and this typically involves a big performance hit. However, it doesn't affect intermediate results, so that it is only partially effective. `Excess precision' is avoided in code like: --- 2722,2737 ---- @cindex -ffloat-store option @cindex options, -ffloat-store @item -ffloat-store ! @cindex IEEE 754 conformance ! @cindex conformance, IEEE 754 ! @cindex floating-point, precision Might help a Fortran program that depends on exact IEEE conformance on some machines, but might slow down a program that doesn't. ! This option is effective when the floating-point unit is set to work in IEEE 854 `extended precision'---as it typically is on x86 and m68k GNU ! systems---rather than IEEE 754 double precision. @samp{-ffloat-store} ! tries to remove the extra precision by spilling data from floating-point registers into memory and this typically involves a big performance hit. However, it doesn't affect intermediate results, so that it is only partially effective. `Excess precision' is avoided in code like: *************** but not in code like: *** 2684,2691 **** d = (b + c) * e @end smallexample ! For another, potentially better, way of controlling the precision ! @ref{Floating point precision}. @cindex -fforce-mem option @cindex options, -fforce-mem --- 2744,2751 ---- d = (b + c) * e @end smallexample ! For another, potentially better, way of controlling the precision, ! see @ref{Floating-point precision}. @cindex -fforce-mem option @cindex options, -fforce-mem *************** For another, potentially better, way of *** 2694,2706 **** @cindex options, -fforce-addr @item -fforce-addr @cindex loops, speeding up ! @cindex speeding up loops Might improve optimization of loops. @cindex -fno-inline option @cindex options, -fno-inline @item -fno-inline ! @cindex in-line compilation @cindex compilation, in-line @c DL: Only relevant for -O3? Don't compile statement functions inline. --- 2754,2766 ---- @cindex options, -fforce-addr @item -fforce-addr @cindex loops, speeding up ! @cindex speed, of loops Might improve optimization of loops. @cindex -fno-inline option @cindex options, -fno-inline @item -fno-inline ! @cindex in-line code @cindex compilation, in-line @c DL: Only relevant for -O3? Don't compile statement functions inline. *************** Note that if you are not optimizing, no *** 2711,2718 **** @cindex -ffast-math option @cindex options, -ffast-math @item -ffast-math ! @cindex IEEE conformance ! @cindex conformance, IEEE Might allow some programs designed to not be too dependent on IEEE behavior for floating-point to run faster, or die trying. --- 2771,2778 ---- @cindex -ffast-math option @cindex options, -ffast-math @item -ffast-math ! @cindex IEEE 754 conformance ! @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. *************** on IEEE behavior for floating-point to r *** 2720,2726 **** @cindex options, -fstrength-reduce @item -fstrength-reduce @cindex loops, speeding up ! @cindex speeding up loops @c DL: normally defaulted? Might make some loops run faster. --- 2780,2786 ---- @cindex options, -fstrength-reduce @item -fstrength-reduce @cindex loops, speeding up ! @cindex speed, of loops @c DL: normally defaulted? Might make some loops run faster. *************** Might improve performance on some code. *** 2750,2763 **** @item -funroll-loops @cindex loops, unrolling @cindex unrolling loops ! @cindex loop optimization @c DL: fixme: Craig doesn't like `indexed' but f95 doesn't seem to @c provide a suitable term ! Typically improves performance on code using indexed @code{DO} loops by unrolling them and is probably generally appropriate for Fortran, though ! it is not turned on at any optimization level. Note that outer loop unrolling isn't done specifically; decisions about ! whether to unroll a loop are made on the basis of its instruction count. @c DL: Fixme: This should obviously go somewhere else... Also, no `loop discovery'@footnote{@dfn{loop discovery} refers to the --- 2810,2828 ---- @item -funroll-loops @cindex loops, unrolling @cindex unrolling loops ! @cindex loops, optimizing ! @cindex indexed (iterative) @code{DO} ! @cindex iterative @code{DO} @c DL: fixme: Craig doesn't like `indexed' but f95 doesn't seem to @c provide a suitable term ! @c CB: I've decided on `iterative', for the time being, and changed ! @c my previous, rather bizarre, use of `imperative' to that ! @c (though `precomputed-trip' would be a more precise adjective) ! Typically improves performance on code using iterative @code{DO} loops by unrolling them and is probably generally appropriate for Fortran, though ! it is not turned on at any optimization level. Note that outer loop unrolling isn't done specifically; decisions about ! whether to unroll a loop are made on the basis of its instruction count. @c DL: Fixme: This should obviously go somewhere else... Also, no `loop discovery'@footnote{@dfn{loop discovery} refers to the *************** constructed out of lower-level construct *** 2773,2790 **** @code{GOTO}) can lead to generation of more optimal code than otherwise.} is done, so only loops written with @code{DO} benefit from loop optimizations, including---but not limited ! to---unrolling. Loops written with @code{IF} and @code{GOTO} will not ! be recognized as such. This option only unrolls indexed @code{DO} ! loops, not @code{DO WHILE} loops. @cindex -funroll-all-loops option @cindex options, -funroll-all-loops ! @cindex @code{DO WHILE} @item -funroll-all-loops @c DL: Check my understanding of -funroll-all-loops v. -funroll-loops is correct. Probably improves performance on code using @code{DO WHILE} loops by ! unrolling them in addition to indexed @code{DO} loops. In the absence ! of @code{DO WHILE}, this option is equivalent to @code{-funroll-loops} but possibly slower. @item -fno-move-all-movables --- 2838,2855 ---- @code{GOTO}) can lead to generation of more optimal code than otherwise.} is done, so only loops written with @code{DO} benefit from loop optimizations, including---but not limited ! to---unrolling. Loops written with @code{IF} and @code{GOTO} are not ! currently recognized as such. This option unrolls only iterative ! @code{DO} loops, not @code{DO WHILE} loops. @cindex -funroll-all-loops option @cindex options, -funroll-all-loops ! @cindex DO WHILE @item -funroll-all-loops @c DL: Check my understanding of -funroll-all-loops v. -funroll-loops is correct. Probably improves performance on code using @code{DO WHILE} loops by ! unrolling them in addition to iterative @code{DO} loops. In the absence ! of @code{DO WHILE}, this option is equivalent to @samp{-funroll-loops} but possibly slower. @item -fno-move-all-movables *************** contains preprocessor directives. *** 2857,2863 **** @node Directory Options @section Options for Directory Search ! @cindex directory options @cindex options, directory search @cindex search path --- 2922,2928 ---- @node Directory Options @section Options for Directory Search ! @cindex directory, options @cindex options, directory search @cindex search path *************** These options are: *** 2881,2889 **** @cindex -Idir option @cindex options, -Idir @item -I@var{dir} ! @cindex directory search paths for inclusion @cindex inclusion, directory search paths for ! @cindex searching for included files These affect interpretation of the @code{INCLUDE} directive (as well as of the @code{#include} directive of the @code{cpp} preprocessor). --- 2946,2955 ---- @cindex -Idir option @cindex options, -Idir @item -I@var{dir} ! @cindex directory, search paths for inclusion @cindex inclusion, directory search paths for ! @cindex search paths, for included files ! @cindex paths, search These affect interpretation of the @code{INCLUDE} directive (as well as of the @code{#include} directive of the @code{cpp} preprocessor). *************** gcc,Using and Porting GNU CC}, for infor *** 2905,2913 **** @node Code Gen Options @section Options for Code Generation Conventions ! @cindex code generation conventions ! @cindex options, code generation ! @cindex run-time options These machine-independent options control the interface conventions used in code generation. --- 2971,2979 ---- @node Code Gen Options @section Options for Code Generation Conventions ! @cindex code generation, conventions ! @cindex options, code generation ! @cindex run-time, options These machine-independent options control the interface conventions used in code generation. *************** the name @samp{-static}.) *** 2935,2941 **** @item -finit-local-zero @cindex DATA statement @cindex statements, DATA ! @cindex initialization of local variables @cindex variables, initialization of @cindex uninitialized variables @cindex variables, uninitialized --- 3001,3007 ---- @item -finit-local-zero @cindex DATA statement @cindex statements, DATA ! @cindex initialization, of local variables @cindex variables, initialization of @cindex uninitialized variables @cindex variables, uninitialized *************** generating code for an incompatible libr *** 3009,3015 **** @cindex -fno-underscoring option @cindex options, -fno-underscoring @item -fno-underscoring ! @cindex underscores @cindex symbol names, underscores @cindex transforming symbol names @cindex symbol names, transforming --- 3075,3081 ---- @cindex -fno-underscoring option @cindex options, -fno-underscoring @item -fno-underscoring ! @cindex underscore @cindex symbol names, underscores @cindex transforming symbol names @cindex symbol names, transforming *************** interfaces. *** 3084,3090 **** @cindex -fno-second-underscore option @cindex options, -fno-second-underscore @item -fno-second-underscore ! @cindex underscores @cindex symbol names, underscores @cindex transforming symbol names @cindex symbol names, transforming --- 3150,3156 ---- @cindex -fno-second-underscore option @cindex options, -fno-second-underscore @item -fno-second-underscore ! @cindex underscore @cindex symbol names, underscores @cindex transforming symbol names @cindex symbol names, transforming *************** $6 = "At (EQUIVALENCE) `__g77_equiv_xx' *** 3184,3190 **** (gdb) p xx $7 = "At (EQUIVALENCE) `__g77_equiv_xx' plus 1 bytes" (gdb) set language fortran ! (gdb) @end smallexample @noindent --- 3250,3256 ---- (gdb) p xx $7 = "At (EQUIVALENCE) `__g77_equiv_xx' plus 1 bytes" (gdb) set language fortran ! (gdb) @end smallexample @noindent *************** Current plans call for this to happen wh *** 3197,3240 **** and @code{gdb} exist that provide proper access to debugging information on @code{COMMON} and @code{EQUIVALENCE} members. ! @cindex -fno-emulate-complex option ! @cindex options, -fno-emulate-complex ! @item -fno-emulate-complex ! Implement @code{COMPLEX} arithmetic using the facilities in the @code{gcc} back end that provide direct support of ! @code{complex} arithmetic, instead of emulating the arithmetic. ! @code{gcc} has some known problems in its back-end support for @code{complex} arithmetic, due primarily to the support not being ! completed as of version 2.7.2.2. ! Other front ends for the @code{gcc} back end avoid this problem ! by emulating @code{complex} arithmetic at a higher level, so the ! back end sees arithmetic on the real and imaginary components. ! To make @code{g77} more portable to systems where @code{complex} ! support in the @code{gcc} back end is particularly troublesome, ! @code{g77} now defaults to performing the same kinds of emulations ! done by these other front ends. ! ! Use @samp{-fno-emulate-complex} to try the @code{complex} support ! in the @code{gcc} back end, in case it works and produces faster ! programs. ! So far, all the known bugs seem to involve compile-time crashes, ! rather than the generation of incorrect code. Use of this option should not affect how Fortran code compiled by @code{g77} works in terms of its interfaces to other code, e.g. that compiled by @code{f2c}. ! @emph{Caution:} Future versions of @code{g77} are likely to change ! the default for this option to ! @samp{-fno-emulate-complex}, and perhaps someday ignore both forms of this option. - Also, it is possible that use of the @samp{-fno-emulate-complex} option - could result in incorrect code being silently produced by @code{g77}. - But, this is generally true of compilers anyway, so, as usual, test - the programs you compile before assuming they are working. - @cindex -falias-check option @cindex options, -falias-check @cindex -fargument-alias option --- 3263,3298 ---- and @code{gdb} exist that provide proper access to debugging information on @code{COMMON} and @code{EQUIVALENCE} members. ! @cindex -femulate-complex option ! @cindex options, -femulate-complex ! @item -femulate-complex ! Implement @code{COMPLEX} arithmetic via emulation, ! instead of using the facilities of the @code{gcc} back end that provide direct support of ! @code{complex} arithmetic. ! (@code{gcc} had some bugs in its back-end support for @code{complex} arithmetic, due primarily to the support not being ! completed as of version 2.8.1 and @code{egcs} 1.1.2.) ! ! Use @samp{-femulate-complex} if you suspect code-generation bugs, ! or experience compiler crashes, ! that might result from @code{g77} using the @code{COMPLEX} support ! in the @code{gcc} back end. ! If using that option fixes the bugs or crashes you are seeing, ! that indicates a likely @code{g77} bugs ! (though, all compiler crashes are considered bugs), ! so, please report it. ! (Note that the known bugs, now believed fixed, produced compiler crashes ! rather than causing the generation of incorrect code.) Use of this option should not affect how Fortran code compiled by @code{g77} works in terms of its interfaces to other code, e.g. that compiled by @code{f2c}. ! @emph{Caution:} Future versions of @code{g77} might ignore both forms of this option. @cindex -falias-check option @cindex options, -falias-check @cindex -fargument-alias option *************** arguments. *** 3275,3280 **** --- 3333,3340 ---- @item -fno-globals @cindex global names, warning @cindex warnings, global names + @cindex in-line code + @cindex compilation, in-line Disable diagnostics about inter-procedural analysis problems, such as disagreements about the type of a function or a procedure's argument, *************** Further, this option disables such inlin *** 3289,4159 **** avoid compiler crashes resulting from incorrect code that would otherwise be diagnosed. ! As such, this option might be quite useful when ! compiling existing, ``working'' code that happens ! to have a few bugs that do not generally show ! themselves, but @code{g77} exposes via a ! diagnostic. ! ! Use of this option therefore has the effect of ! instructing @code{g77} to behave more like it did ! up through version 0.5.19.1, when it paid little or ! no attention to disagreements between program units ! about a procedure's type and argument information, ! and when it performed no inlining of procedures ! (except statement functions). ! ! Without this option, @code{g77} defaults to performing ! the potentially inlining procedures as it started doing ! in version 0.5.20, but as of version 0.5.21, it also ! diagnoses disagreements that might cause such inlining ! to crash the compiler. ! @end table ! ! @xref{Code Gen Options,,Options for Code Generation Conventions, ! gcc,Using and Porting GNU CC}, for information on more options ! offered by the GBE ! shared by @code{g77}, @code{gcc}, and other GNU compilers. ! ! Some of these do @emph{not} work when compiling programs written in Fortran: ! ! @table @code ! @cindex -fpcc-struct-return option ! @cindex options, -fpcc-struct-return ! @item -fpcc-struct-return ! @cindex -freg-struct-return option ! @cindex options, -freg-struct-return ! @item -freg-struct-return ! You should not use these except strictly the same way as you ! used them to build the version of @code{libg2c} with which ! you will be linking all code compiled by @code{g77} with the ! same option. ! ! @cindex -fshort-double option ! @cindex options, -fshort-double ! @item -fshort-double ! This probably either has no effect on Fortran programs, or ! makes them act loopy. ! ! @cindex -fno-common option ! @cindex options, -fno-common ! @item -fno-common ! Do not use this when compiling Fortran programs, ! or there will be Trouble. ! ! @cindex -fpack-struct option ! @cindex options, -fpack-struct ! @item -fpack-struct ! This probably will break any calls to the @code{libg2c} library, ! at the very least, even if it is built with the same option. ! @end table ! ! @node Environment Variables ! @section Environment Variables Affecting GNU Fortran ! @cindex environment variables ! ! GNU Fortran currently does not make use of any environment ! variables to control its operation above and beyond those ! that affect the operation of @code{gcc}. ! ! @xref{Environment Variables,,Environment Variables Affecting GNU CC, ! gcc,Using and Porting GNU CC}, for information on environment ! variables. ! ! @include news.texi ! ! @node Changes ! @chapter User-visible Changes ! @cindex versions, recent ! @cindex recent versions ! @cindex changes, user-visible ! @cindex user-visible changes ! ! This section describes changes to @code{g77} that are visible ! to the programmers who actually write and maintain Fortran ! code they compile with @code{g77}. ! Information on changes to installation procedures, ! changes to the documentation, and bug fixes is ! not provided here, unless it is likely to affect how ! users use @code{g77}. ! @xref{News,,News About GNU Fortran}, for information on ! such changes to @code{g77}. ! ! To find out about existing bugs and ongoing plans for GNU ! Fortran, retrieve @uref{ftp://alpha.gnu.org/g77.plan} ! or, if you cannot do that, email ! @email{fortran@@gnu.org} asking for a recent copy of the ! GNU Fortran @file{.plan} file. ! ! @heading In @code{egcs} 1.1 (versus 0.5.24): ! @itemize @bullet ! @cindex alignment ! @cindex double-precision performance ! @cindex -malign-double ! @item ! Align static double-precision variables and arrays ! on Intel x86 targets ! regardless of whether @samp{-malign-double} is specified. ! ! Generally, this affects only local variables and arrays ! having the @code{SAVE} attribute ! or given initial values via @code{DATA}. ! @end itemize ! ! @heading In @code{egcs} 1.1 (versus @code{egcs} 1.0.3): ! @itemize @bullet ! @item ! Support @samp{FORMAT(I<@var{expr}>)} when @var{expr} is a ! compile-time constant @code{INTEGER} expression. ! ! @item ! Fix @code{g77} @samp{-g} option so procedures that ! use @samp{ENTRY} can be stepped through, line by line, ! in @code{gdb}. ! ! @item ! Allow any @code{REAL} argument to intrinsics ! @code{Second} and @code{CPU_Time}. ! ! @item ! Use @code{tempnam}, if available, to open scratch files ! (as in @samp{OPEN(STATUS='SCRATCH')}) ! so that the @code{TMPDIR} environment variable, ! if present, is used. ! ! @item ! @code{g77}'s version of @code{libf2c} separates out ! the setting of global state ! (such as command-line arguments and signal handling) ! from @file{main.o} into distinct, new library ! archive members. ! ! This should make it easier to write portable applications ! that have their own (non-Fortran) @code{main()} routine ! properly set up the @code{libf2c} environment, even ! when @code{libf2c} (now @code{libg2c}) is a shared library. ! ! @item ! The @code{g77} command now expects the run-time library ! to be named @code{libg2c.a} instead of @code{libf2c.a}, ! to ensure that a version other than the one built and ! installed as part of the same @code{g77} version is picked up. ! ! @item ! Some diagnostics have been changed from warnings to errors, ! to prevent inadvertent use of the resulting, probably buggy, ! programs. ! These mostly include diagnostics about use of unsupported features ! in the @code{OPEN}, @code{INQUIRE}, @code{READ}, and ! @code{WRITE} statements, ! and about truncations of various sorts of constants. ! @end itemize ! ! @heading In 0.5.24 and @code{egcs} 1.1 (versus 0.5.23): ! @itemize @bullet ! @item ! @code{g77} now treats @samp{%LOC(@var{expr})} and ! @samp{LOC(@var{expr})} as ``ordinary'' expressions ! when they are used as arguments in procedure calls. ! This change applies only to global (filewide) analysis, ! making it consistent with ! how @code{g77} actually generates code ! for these cases. ! ! Previously, @code{g77} treated these expressions ! as denoting special ``pointer'' arguments ! for the purposes of filewide analysis. ! ! @item ! The @code{g77} driver now ensures that @samp{-lg2c} ! is specified in the link phase prior to any ! occurrence of @samp{-lm}. ! This prevents accidentally linking to a routine ! in the SunOS4 @samp{-lm} library ! when the generated code wants to link to the one ! in @code{libf2c} (@code{libg2c}). ! ! @item ! @code{g77} emits more debugging information when ! @samp{-g} is used. ! ! This new information allows, for example, ! @kbd{which __g77_length_a} to be used in @code{gdb} ! to determine the type of the phantom length argument ! supplied with @samp{CHARACTER} variables. ! ! This information pertains to internally-generated ! type, variable, and other information, ! not to the longstanding deficiencies vis-a-vis ! @samp{COMMON} and @samp{EQUIVALENCE}. ! ! @item ! The F90 @samp{Date_and_Time} intrinsic now is ! supported. ! ! @item ! The F90 @samp{System_Clock} intrinsic allows ! the optional arguments (except for the @samp{Count} ! argument) to be omitted. ! @end itemize ! ! @heading In 0.5.23: ! @itemize @bullet ! @item ! This release contains several regressions against ! version 0.5.22 of @code{g77}, due to using the ! ``vanilla'' @code{gcc} back end instead of patching ! it to fix a few bugs and improve performance in a ! few cases. ! ! @xref{Actual Bugs,,Actual Bugs We Haven't Fixed Yet}, ! available in plain-text format in @code{gcc/f/BUGS}, ! for information on the known bugs in this version, ! including the regressions. ! ! Features that have been dropped from this version ! of @code{g77} due to their being implemented ! via @code{g77}-specific patches to the @code{gcc} ! back end in previous releases include: ! ! @itemize -- ! @item ! Support for @code{__restrict__} keyword, ! the options @samp{-fargument-alias}, @samp{-fargument-noalias}, ! and @samp{-fargument-noalias-global}, ! and the corresponding alias-analysis code. ! ! (@code{egcs} has the alias-analysis ! code, but not the @code{__restrict__} keyword. ! @code{egcs} @code{g77} users benefit from the alias-analysis ! code despite the lack of the @code{__restrict__} keyword, ! which is a C-language construct.) ! ! @item ! Support for the GNU compiler options ! @samp{-fmove-all-movables}, ! @samp{-freduce-all-givs}, ! and @samp{-frerun-loop-opt}. ! ! (@code{egcs} supports these options. ! @code{g77} users of @code{egcs} benefit from them even if ! they are not explicitly specified, ! because the defaults are optimized for @code{g77} users.) ! ! @item ! Support for the @samp{-W} option warning about ! integer division by zero. ! ! @item ! The Intel x86-specific option @samp{-malign-double} ! applying to stack-allocated data ! as well as statically-allocate data. ! @end itemize ! ! @item ! Support @code{gcc} version 2.8, ! and remove support for prior versions of @code{gcc}. ! ! @cindex -@w{}-driver option ! @cindex g77 options, -@w{}-driver ! @cindex options, -@w{}-driver ! @item ! Remove support for the @samp{--driver} option, ! as @code{g77} now does all the driving, ! just like @code{gcc}. ! ! @item ! The @code{g77} command now expects the run-time library ! to be named @code{libg2c.a} instead of @code{libf2c.a}, ! to ensure that a version other than the one built and ! installed as part of the same @code{g77} version is picked up. ! ! @item ! @code{g77}'s version of @code{libf2c} separates out ! the setting of global state ! (such as command-line arguments and signal handling) ! from @file{main.o} into distinct, new library ! archive members. ! ! This should make it easier to write portable applications ! that have their own (non-Fortran) @code{main()} routine ! properly set up the @code{libf2c} environment, even ! when @code{libf2c} (now @code{libg2c}) is a shared library. ! ! @item ! Some diagnostics have been changed from warnings to errors, ! to prevent inadvertent use of the resulting, probably buggy, ! programs. ! These mostly include diagnostics about use of unsupported features ! in the @code{OPEN}, @code{INQUIRE}, @code{READ}, and ! @code{WRITE} statements, ! and about truncations of various sorts of constants. ! @end itemize ! ! @heading In 0.5.22: ! @itemize @bullet ! @item ! Fix @code{Signal} intrinsic so it offers portable ! support for 64-bit systems (such as Digital Alphas ! running GNU/Linux). ! ! @item ! Support @samp{FORMAT(I<@var{expr}>)} when @var{expr} is a ! compile-time constant @code{INTEGER} expression. ! ! @item ! Fix @code{g77} @samp{-g} option so procedures that ! use @samp{ENTRY} can be stepped through, line by line, ! in @code{gdb}. ! ! @item ! Allow any @code{REAL} argument to intrinsics ! @code{Second} and @code{CPU_Time}. ! ! @item ! Allow any numeric argument to intrinsics ! @code{Int2} and @code{Int8}. ! ! @item ! Use @code{tempnam}, if available, to open scratch files ! (as in @samp{OPEN(STATUS='SCRATCH')}) ! so that the @code{TMPDIR} environment variable, ! if present, is used. ! ! @item ! Rename the @code{gcc} keyword @code{restrict} to ! @code{__restrict__}, to avoid rejecting valid, existing, ! C programs. ! Support for @code{restrict} is now more like support ! for @code{complex}. ! ! @item ! Fix @samp{-fugly-comma} to affect invocations of ! only external procedures. ! Restore rejection of gratuitous trailing omitted ! arguments to intrinsics, as in @samp{I=MAX(3,4,,)}. ! ! @item ! Fix compiler so it accepts @samp{-fgnu-intrinsics-*} and ! @samp{-fbadu77-intrinsics-*} options. ! @end itemize ! ! @heading In @code{egcs} 1.0.2 (versus @code{egcs} 1.0.1): ! @itemize @bullet ! @item ! Fix compiler so it accepts @samp{-fgnu-intrinsics-*} and ! @samp{-fbadu77-intrinsics-*} options. ! @end itemize ! ! @heading In @code{egcs} 1.0 (versus 0.5.21): ! @itemize @bullet ! @item ! Version 1.0 of @code{egcs} ! contains several regressions against ! version 0.5.21 of @code{g77}, ! due to using the ! ``vanilla'' @code{gcc} back end instead of patching ! it to fix a few bugs and improve performance in a ! few cases. ! ! @xref{Actual Bugs,,Actual Bugs We Haven't Fixed Yet}, ! available in plain-text format in @code{gcc/f/BUGS}, ! for information on the known bugs in this version, ! including the regressions. ! ! Features that have been dropped from this version ! of @code{g77} due to their being implemented ! via @code{g77}-specific patches to the @code{gcc} ! back end in previous releases include: ! ! @itemize -- ! @item ! Support for the C-language @code{restrict} keyword. ! ! @item ! Support for the @samp{-W} option warning about ! integer division by zero. ! ! @item ! The Intel x86-specific option @samp{-malign-double} ! applying to stack-allocated data ! as well as statically-allocate data. ! @end itemize ! ! @cindex -@w{}-driver option ! @cindex g77 options, -@w{}-driver ! @cindex options, -@w{}-driver ! @item ! Remove support for the @samp{--driver} option, ! as @code{g77} now does all the driving, ! just like @code{gcc}. ! ! @item ! Allow any numeric argument to intrinsics ! @code{Int2} and @code{Int8}. ! @end itemize ! ! @heading In 0.5.21: ! @itemize @bullet ! @item ! When the @samp{-W} option is specified, @code{gcc}, @code{g77}, ! and other GNU compilers that incorporate the @code{gcc} ! back end as modified by @code{g77}, issue ! a warning about integer division by constant zero. ! ! @item ! New option @samp{-Wno-globals} disables warnings ! about ``suspicious'' use of a name both as a global ! name and as the implicit name of an intrinsic, and ! warnings about disagreements over the number or natures of ! arguments passed to global procedures, or the ! natures of the procedures themselves. ! ! The default is to issue such warnings, which are ! new as of this version of @code{g77}. ! ! @item ! New option @samp{-fno-globals} disables diagnostics ! about potentially fatal disagreements ! analysis problems, such as disagreements over the ! number or natures of arguments passed to global ! procedures, or the natures of those procedures themselves. ! ! The default is to issue such diagnostics and flag ! the compilation as unsuccessful. ! With this option, the diagnostics are issued as ! warnings, or, if @samp{-Wno-globals} is specified, ! are not issued at all. ! ! This option also disables inlining of global procedures, ! to avoid compiler crashes resulting from coding errors ! that these diagnostics normally would identify. ! ! @item ! Fix @code{libU77} routines that accept file and other names ! to strip trailing blanks from them, for consistency ! with other implementations. ! Blanks may be forcibly appended to such names by ! appending a single null character (@samp{CHAR(0)}) ! to the significant trailing blanks. ! ! @item ! Fix @code{CHMOD} intrinsic to work with file names ! that have embedded blanks, commas, and so on. ! ! @item ! Fix @code{SIGNAL} intrinsic so it accepts an ! optional third @samp{Status} argument. ! ! @item ! Make many changes to @code{libU77} intrinsics to ! support existing code more directly. ! ! Such changes include allowing both subroutine and ! function forms of many routines, changing @code{MCLOCK()} ! and @code{TIME()} to return @code{INTEGER(KIND=1)} values, ! introducing @code{MCLOCK8()} and @code{TIME8()} to ! return @code{INTEGER(KIND=2)} values, ! and placing functions that are intended to perform ! side effects in a new intrinsic group, @code{badu77}. ! ! @item ! Add options @samp{-fbadu77-intrinsics-delete}, ! @samp{-fbadu77-intrinsics-hide}, and so on. ! ! @item ! Add @code{INT2} and @code{INT8} intrinsics. ! ! @item ! Add @code{CPU_TIME} intrinsic. ! ! @item ! Add @code{ALARM} intrinsic. ! ! @item ! @code{CTIME} intrinsic now accepts any @code{INTEGER} ! argument, not just @code{INTEGER(KIND=2)}. ! ! @item ! @code{g77} driver now prints version information (such as produced ! by @kbd{g77 -v}) to @code{stderr} instead of @code{stdout}. ! ! @item ! The @samp{.r} suffix now designates a Ratfor source file, ! to be preprocessed via the @code{ratfor} command, available ! separately. ! @end itemize ! ! @heading In 0.5.20: ! @itemize @bullet ! @item ! The @samp{-fno-typeless-boz} option is now the default. ! ! This option specifies that non-decimal-radix ! constants using the prefixed-radix form (such as @samp{Z'1234'}) ! are to be interpreted as @code{INTEGER(KIND=1)} constants. ! Specify @samp{-ftypeless-boz} to cause such ! constants to be interpreted as typeless. ! ! (Version 0.5.19 introduced @samp{-fno-typeless-boz} and ! its inverse.) ! ! @xref{Fortran Dialect Options,,Options Controlling Fortran Dialect}, ! for information on the @samp{-ftypeless-boz} option. ! ! @item ! Options @samp{-ff90-intrinsics-enable} and ! @samp{-fvxt-intrinsics-enable} now are the ! defaults. ! ! Some programs might use names that clash with ! intrinsic names defined (and now enabled) by these ! options or by the new @code{libU77} intrinsics. ! Users of such programs might need to compile them ! differently (using, for example, @samp{-ff90-intrinsics-disable}) ! or, better yet, insert appropriate @code{EXTERNAL} ! statements specifying that these names are not intended ! to be names of intrinsics. ! ! @item ! The @samp{ALWAYS_FLUSH} macro is no longer defined when ! building @code{libf2c}, which should result in improved ! I/O performance, especially over NFS. ! ! @emph{Note:} If you have code that depends on the behavior ! of @code{libf2c} when built with @samp{ALWAYS_FLUSH} defined, ! you will have to modify @code{libf2c} accordingly before ! building it from this and future versions of @code{g77}. ! ! @xref{Output Assumed To Flush}, for more information. ! ! @item ! Dave Love's implementation of @code{libU77} has been ! added to the version of @code{libf2c} distributed with ! and built as part of @code{g77}. ! @code{g77} now knows about the routines in this library ! as intrinsics. ! ! @item ! New option @samp{-fvxt} specifies that the ! source file is written in VXT Fortran, instead of GNU Fortran. ! ! @xref{VXT Fortran}, for more information on the constructs ! recognized when the @samp{-fvxt} option is specified. ! ! @item ! The @samp{-fvxt-not-f90} option has been deleted, ! along with its inverse, @samp{-ff90-not-vxt}. ! ! If you used one of these deleted options, you should ! re-read the pertinent documentation to determine which ! options, if any, are appropriate for compiling your ! code with this version of @code{g77}. ! ! @xref{Other Dialects}, for more information. ! ! @item ! The @samp{-fugly} option now issues a warning, as it ! likely will be removed in a future version. ! ! (Enabling all the @samp{-fugly-*} options is unlikely ! to be feasible, or sensible, in the future, ! so users should learn to specify only those ! @samp{-fugly-*} options they really need for a ! particular source file.) ! ! @item ! The @samp{-fugly-assumed} option, introduced in ! version 0.5.19, has been changed to ! better accommodate old and new code. ! @xref{Ugly Assumed-Size Arrays}, for more information. ! ! @item ! Related to supporting Alpha (AXP) machines, the @code{LOC()} ! intrinsic and @code{%LOC()} construct now return ! values of @code{INTEGER(KIND=0)} type, ! as defined by the GNU Fortran language. ! ! This type is wide enough ! (holds the same number of bits) ! as the character-pointer type on the machine. ! ! On most machines, this won't make a difference, ! whereas, on Alphas and other systems with 64-bit pointers, ! the @code{INTEGER(KIND=0)} type is equivalent to @code{INTEGER(KIND=2)} ! (often referred to as @code{INTEGER*8}) ! instead of the more common @code{INTEGER(KIND=1)} ! (often referred to as @code{INTEGER*4}). ! ! @item ! Emulate @code{COMPLEX} arithmetic in the @code{g77} front ! end, to avoid bugs in @code{complex} support in the ! @code{gcc} back end. ! New option @samp{-fno-emulate-complex} ! causes @code{g77} to revert the 0.5.19 behavior. ! ! @item ! Dummy arguments are no longer assumed to potentially alias ! (overlap) ! other dummy arguments or @code{COMMON} areas when any of ! these are defined (assigned to) by Fortran code. ! ! This can result in faster and/or smaller programs when ! compiling with optimization enabled, though on some ! systems this effect is observed only when @samp{-fforce-addr} ! also is specified. ! ! New options @samp{-falias-check}, @samp{-fargument-alias}, ! @samp{-fargument-noalias}, ! and @samp{-fno-argument-noalias-global} control the ! way @code{g77} handles potential aliasing. ! ! @xref{Aliasing Assumed To Work}, for detailed information on why the ! new defaults might result in some programs no longer working the way they ! did when compiled by previous versions of @code{g77}. ! ! @item ! New option @samp{-fugly-assign} specifies that the ! same memory locations are to be used to hold the ! values assigned by both statements @samp{I = 3} and ! @samp{ASSIGN 10 TO I}, for example. ! (Normally, @code{g77} uses a separate memory location ! to hold assigned statement labels.) ! ! @xref{Ugly Assigned Labels}, for more information. ! ! @item ! @code{FORMAT} and @code{ENTRY} statements now are allowed to ! precede @code{IMPLICIT NONE} statements. ! ! @item ! Enable full support of @code{INTEGER(KIND=2)} ! (often referred to as @code{INTEGER*8}) ! available in ! @code{libf2c} and @file{f2c.h} so that @code{f2c} users ! may make full use of its features via the @code{g77} ! version of @file{f2c.h} and the @code{INTEGER(KIND=2)} ! support routines in the @code{g77} version of @code{libf2c}. ! ! @item ! Improve @code{g77} driver and @code{libf2c} so that @samp{g77 -v} ! yields version information on the library. ! ! @item ! The @code{SNGL} and @code{FLOAT} intrinsics now are ! specific intrinsics, instead of synonyms for the ! generic intrinsic @code{REAL}. ! ! @item ! New intrinsics have been added. ! These are @code{REALPART}, @code{IMAGPART}, ! @code{COMPLEX}, ! @code{LONG}, and @code{SHORT}. ! ! @item ! A new group of intrinsics, @samp{gnu}, has been added ! to contain the new @code{REALPART}, @code{IMAGPART}, ! and @code{COMPLEX} intrinsics. ! An old group, @samp{dcp}, has been removed. ! ! @item ! Complain about industry-wide ambiguous references ! @samp{REAL(@var{expr})} and @samp{AIMAG(@var{expr})}, ! where @var{expr} is @code{DOUBLE COMPLEX} (or any ! complex type other than @code{COMPLEX}), unless ! @samp{-ff90} option specifies Fortran 90 interpretation ! or new @samp{-fugly-complex} option, in conjunction with ! @samp{-fnot-f90}, specifies @code{f2c} interpretation. ! @end itemize ! ! @heading In 0.5.19: ! ! @itemize @bullet ! @item ! A temporary kludge option provides bare-bones information on ! @code{COMMON} and @code{EQUIVALENCE} members at debug time. ! @xref{Code Gen Options,,Options for Code Generation Conventions}, ! for information on the @samp{-fdebug-kludge} option. ! ! @item ! New @samp{-fonetrip} option specifies FORTRAN-66-style ! one-trip @code{DO} loops. ! ! @item ! New @samp{-fno-silent} option causes names of program units ! to be printed as they are compiled, in a fashion similar to ! UNIX @code{f77} and @code{f2c}. ! ! @item ! New @samp{-fugly-assumed} option specifies that arrays ! dimensioned via @samp{DIMENSION X(1)}, for example, are to be ! treated as assumed-size. ! ! @item ! New @samp{-fno-typeless-boz} option specifies that non-decimal-radix ! constants using the prefixed-radix form (such as @samp{Z'1234'}) ! are to be interpreted as @code{INTEGER(KIND=1)} constants. ! ! @item ! New @samp{-ff66} option is a ``shorthand'' option that specifies ! behaviors considered appropriate for FORTRAN 66 programs. ! ! @item ! New @samp{-ff77} option is a ``shorthand'' option that specifies ! behaviors considered appropriate for UNIX @code{f77} programs. ! ! @item ! New @samp{-fugly-comma} and @samp{-fugly-logint} options provided ! to perform some of what @samp{-fugly} used to do. ! @samp{-fugly} and @samp{-fno-ugly} are now ``shorthand'' options, ! in that they do nothing more than enable (or disable) other ! @samp{-fugly-*} options. ! ! @item ! Change code generation for list-directed I/O so it allows ! for new versions of @code{libf2c} that might return non-zero ! status codes for some operations previously assumed to always ! return zero. ! ! This change not only affects how @code{IOSTAT=} variables ! are set by list-directed I/O, it also affects whether ! @code{END=} and @code{ERR=} labels are reached by these ! operations. ! ! @item ! Add intrinsic support for new @code{FTELL} and @code{FSEEK} ! procedures in @code{libf2c}. ! ! @item ! Add options @samp{--help} and @samp{--version} to the ! @code{g77} command, to conform to GNU coding guidelines. ! Also add printing of @code{g77} version number when ! the @samp{--verbose} (@samp{-v}) option is used. ! @end itemize ! ! @heading In 0.5.18: ! ! @itemize @bullet ! @item ! The @code{BYTE} and @code{WORD} statements now are supported, ! to a limited extent. ! ! @item ! @code{INTEGER*1}, @code{INTEGER*2}, @code{INTEGER*8}, ! and their @code{LOGICAL} ! equivalents, now are supported to a limited extent. ! Among the missing elements are complete intrinsic and constant ! support. ! ! @item ! Support automatic arrays in procedures. ! For example, @samp{REAL A(N)}, where @samp{A} is ! not a dummy argument, specifies that @samp{A} is ! an automatic array. ! The size of @samp{A} is calculated from the value ! of @samp{N} each time the procedure is called, ! that amount of space is allocated, and that space ! is freed when the procedure returns to its caller. ! ! @item ! Add @samp{-fno-zeros} option, enabled by default, ! to reduce compile-time CPU and memory usage for ! code that provides initial zero values for variables ! and arrays. ! ! @item ! Introduce three new options that apply to all compilations ! by @code{g77}-aware GNU compilers---@samp{-fmove-all-movables}, ! @samp{-freduce-all-givs}, and @samp{-frerun-loop-opt}---which ! can improve the run-time performance of some programs. ! ! @item ! Replace much of the existing documentation with a single ! Info document. ! ! @item ! New option @samp{-fno-second-underscore}. ! @end itemize ! ! @heading In 0.5.17: ! ! @itemize @bullet ! @item ! The @code{ERF()} and @code{ERFC()} intrinsics now are generic ! intrinsics, mapping to @code{ERF}/@code{DERF} and ! @code{ERFC}/@code{DERFC}, respectively. ! @emph{Note:} Use @samp{INTRINSIC ERF,ERFC} in any code that ! might reference these as generic intrinsics, to ! improve the likelihood of diagnostics (instead of subtle run-time ! bugs) when using compilers that don't support these as intrinsics. ! ! @item ! New option @samp{-Wsurprising}. ! ! @item ! DO loops with non-@code{INTEGER} variables now diagnosed only when ! @samp{-Wsurprising} specified. ! Previously, this was diagnosed @emph{unless} @samp{-fpedantic} or ! @samp{-fugly} was specified. ! @end itemize ! @heading In 0.5.16: ! @itemize @bullet ! @item ! @code{libf2c} changed to output a leading zero (0) digit for floating-point ! values output via list-directed and formatted output (to bring @code{g77} ! more into line with many existing Fortran implementations---the ! ANSI FORTRAN 77 standard leaves this choice to the implementation). ! @item ! @code{libf2c} no longer built with debugging information ! intact, making it much smaller. ! @item ! Automatic installation of the @code{g77} command now works. ! @item ! Diagnostic messages now more informative, a la @code{gcc}, ! including messages like @samp{In function `foo':} and @samp{In file ! included from...:}. ! @item ! New group of intrinsics called @samp{unix}, including @code{ABORT}, ! @code{DERF}, @code{DERFC}, @code{ERF}, @code{ERFC}, @code{EXIT}, ! @code{FLUSH}, @code{GETARG}, @code{GETENV}, @code{SIGNAL}, and ! @code{SYSTEM}. ! @item ! @samp{-funix-intrinsics-@{delete,hide,disable,enable@}} ! options added. ! @item ! @samp{-fno-underscoring} option added. ! @item ! @samp{--driver} option added to the @code{g77} command. ! @item ! Support for the @code{gcc} options @samp{-fident} and @samp{-fno-ident} ! added. ! @item ! @samp{g77 -v} returns much more version info, making the submission ! of better bug reports easily. ! @item ! Many improvements to the @code{g77} command to better fulfill its role as ! a front-end to the @code{gcc} driver. ! For example, @code{g77} now ! recognizes @samp{--verbose} as a verbose way of specifying @samp{-v}. ! @item ! Compiling preprocessed (@file{*.F} and @file{*.fpp}) files now ! results in better diagnostics and debugging information, as the ! source-location info now is passed all the ! way through the compilation process instead of being lost. ! @end itemize @node Language @chapter The GNU Fortran Language --- 3349,3514 ---- avoid compiler crashes resulting from incorrect code that would otherwise be diagnosed. ! As such, this option might be quite useful when ! compiling existing, ``working'' code that happens ! to have a few bugs that do not generally show themselves, ! but which @code{g77} diagnoses. ! Use of this option therefore has the effect of ! instructing @code{g77} to behave more like it did ! up through version 0.5.19.1, when it paid little or ! no attention to disagreements between program units ! about a procedure's type and argument information, ! and when it performed no inlining of procedures ! (except statement functions). ! Without this option, @code{g77} defaults to performing ! the potentially inlining procedures as it started doing ! in version 0.5.20, but as of version 0.5.21, it also ! diagnoses disagreements that might cause such inlining ! to crash the compiler as (fatal) errors, ! and warns about similar disagreements ! that are currently believed to not ! likely to result in the compiler later crashing ! or producing incorrect code. ! ! @cindex -fflatten-arrays option ! @item -fflatten-arrays ! @cindex array performance ! @cindex arrays, flattening ! Use back end's C-like constructs ! (pointer plus offset) ! instead of its @code{ARRAY_REF} construct ! to handle all array references. ! ! @emph{Note:} This option is not supported. ! It is intended for use only by @code{g77} developers, ! to evaluate code-generation issues. ! It might be removed at any time. ! ! @cindex -fbounds-check option ! @cindex -ffortran-bounds-check option ! @item -fbounds-check ! @itemx -ffortran-bounds-check ! @cindex bounds checking ! @cindex range checking ! @cindex array bounds checking ! @cindex subscript checking ! @cindex substring checking ! @cindex checking subscripts ! @cindex checking substrings ! Enable generation of run-time checks for array subscripts ! and substring start and end points ! against the (locally) declared minimum and maximum values. ! ! The current implementation uses the @code{libf2c} ! library routine @code{s_rnge} to print the diagnostic. ! ! However, whereas @code{f2c} generates a single check per ! reference for a multi-dimensional array, of the computed ! offset against the valid offset range (0 through the size of the array), ! @code{g77} generates a single check per @emph{subscript} expression. ! This catches some cases of potential bugs that @code{f2c} does not, ! such as references to below the beginning of an assumed-size array. ! ! @code{g77} also generates checks for @code{CHARACTER} substring references, ! something @code{f2c} currently does not do. ! ! Use the new @samp{-ffortran-bounds-check} option ! to specify bounds-checking for only the Fortran code you are compiling, ! not necessarily for code written in other languages. ! ! @emph{Note:} To provide more detailed information on the offending subscript, ! @code{g77} provides the @code{libg2c} run-time library routine @code{s_rnge} ! with somewhat differently-formatted information. ! Here's a sample diagnostic: ! ! @smallexample ! Subscript out of range on file line 4, procedure rnge.f/bf. ! Attempt to access the -6-th element of variable b[subscript-2-of-2]. ! Aborted ! @end smallexample ! ! The above message indicates that the offending source line is ! line 4 of the file @file{rnge.f}, ! within the program unit (or statement function) named @samp{bf}. ! The offended array is named @samp{b}. ! The offended array dimension is the second for a two-dimensional array, ! and the offending, computed subscript expression was @samp{-6}. ! ! For a @code{CHARACTER} substring reference, the second line has ! this appearance: ! ! @smallexample ! Attempt to access the 11-th element of variable a[start-substring]. ! @end smallexample ! ! This indicates that the offended @code{CHARACTER} variable or array ! is named @samp{a}, ! the offended substring position is the starting (leftmost) position, ! and the offending substring expression is @samp{11}. ! ! (Though the verbage of @code{s_rnge} is not ideal ! for the purpose of the @code{g77} compiler, ! the above information should provide adequate diagnostic abilities ! to it users.) ! @end table ! @xref{Code Gen Options,,Options for Code Generation Conventions, ! gcc,Using and Porting GNU CC}, for information on more options ! offered by the GBE ! shared by @code{g77}, @code{gcc}, and other GNU compilers. ! Some of these do @emph{not} work when compiling programs written in Fortran: ! @table @code ! @cindex -fpcc-struct-return option ! @cindex options, -fpcc-struct-return ! @item -fpcc-struct-return ! @cindex -freg-struct-return option ! @cindex options, -freg-struct-return ! @item -freg-struct-return ! You should not use these except strictly the same way as you ! used them to build the version of @code{libg2c} with which ! you will be linking all code compiled by @code{g77} with the ! same option. ! @cindex -fshort-double option ! @cindex options, -fshort-double ! @item -fshort-double ! This probably either has no effect on Fortran programs, or ! makes them act loopy. ! @cindex -fno-common option ! @cindex options, -fno-common ! @item -fno-common ! Do not use this when compiling Fortran programs, ! or there will be Trouble. ! @cindex -fpack-struct option ! @cindex options, -fpack-struct ! @item -fpack-struct ! This probably will break any calls to the @code{libg2c} library, ! at the very least, even if it is built with the same option. ! @end table ! @node Environment Variables ! @section Environment Variables Affecting GNU Fortran ! @cindex environment variables ! GNU Fortran currently does not make use of any environment ! variables to control its operation above and beyond those ! that affect the operation of @code{gcc}. ! @xref{Environment Variables,,Environment Variables Affecting GNU CC, ! gcc,Using and Porting GNU CC}, for information on environment ! variables. ! @include news.texi ! @set USERVISONLY ! @include news.texi ! @clear USERVISONLY @node Language @chapter The GNU Fortran Language *************** Extensions to the ANSI FORTRAN 77 standa *** 4223,4229 **** @section Direction of Language Development @cindex direction of language development @cindex features, language ! @cindex language features The purpose of the following description of the GNU Fortran language is to promote wide portability of GNU Fortran programs. --- 3578,3584 ---- @section Direction of Language Development @cindex direction of language development @cindex features, language ! @cindex language, features The purpose of the following description of the GNU Fortran language is to promote wide portability of GNU Fortran programs. *************** of @code{g77}). *** 4368,4375 **** @node Standard Support @section ANSI FORTRAN 77 Standard Support @cindex ANSI FORTRAN 77 support ! @cindex standard support ! @cindex support for ANSI FORTRAN 77 @cindex compatibility, FORTRAN 77 @cindex FORTRAN 77 compatibility --- 3723,3730 ---- @node Standard Support @section ANSI FORTRAN 77 Standard Support @cindex ANSI FORTRAN 77 support ! @cindex standard, support for ! @cindex support, FORTRAN 77 @cindex compatibility, FORTRAN 77 @cindex FORTRAN 77 compatibility *************** For example: @samp{PRINT *, 'My name is *** 4600,4606 **** @item A metasyntactic variable---that is, a name used in this document to serve as a placeholder for whatever text is used by the ! user or programmer--appears as shown in the following example: ``The @code{INTEGER @var{ivar}} statement specifies that @var{ivar} is a variable or array of type @code{INTEGER}.'' --- 3955,3961 ---- @item A metasyntactic variable---that is, a name used in this document to serve as a placeholder for whatever text is used by the ! user or programmer---appears as shown in the following example: ``The @code{INTEGER @var{ivar}} statement specifies that @var{ivar} is a variable or array of type @code{INTEGER}.'' *************** for the relevant aspects of GNU Fortran. *** 4644,4649 **** --- 3999,4005 ---- (Corresponds to Section 2.2 of ANSI X3.9-1978 FORTRAN 77.) + @cindex limits, lengths of names In GNU Fortran, a symbolic name is at least one character long, and has no arbitrary upper limit on length. However, names of entities requiring external linkage (such as *************** character (which must be a letter). *** 4660,4667 **** (Corresponds to Section 2.3 of ANSI X3.9-1978 FORTRAN 77.) ! @cindex comments, trailing ! @cindex trailing comments Use of an exclamation point (@samp{!}) to begin a trailing comment (a comment that extends to the end of the same source line) is permitted under the following conditions: --- 4016,4028 ---- (Corresponds to Section 2.3 of ANSI X3.9-1978 FORTRAN 77.) ! @cindex trailing comment ! @cindex comment ! @cindex characters, comment ! @cindex ! ! @cindex exclamation point ! @cindex continuation character ! @cindex characters, continuation Use of an exclamation point (@samp{!}) to begin a trailing comment (a comment that extends to the end of the same source line) is permitted under the following conditions: *************** That is, a trailing comment may contain *** 4685,4691 **** in their commentary text. @end itemize ! @cindex semicolons @cindex statements, separated by semicolon Use of a semicolon (@samp{;}) as a statement separator is permitted under the following conditions: --- 4046,4053 ---- in their commentary text. @end itemize ! @cindex ; ! @cindex semicolon @cindex statements, separated by semicolon Use of a semicolon (@samp{;}) as a statement separator is permitted under the following conditions: *************** Special characters include: *** 4771,4806 **** --- 4133,4197 ---- @itemize @bullet @item + @cindex ; + @cindex semicolon Semicolon (@samp{;}) @item + @cindex ! + @cindex exclamation point Exclamation point (@samp{!}) @item + @cindex " + @cindex double quote Double quote (@samp{"}) @item + @cindex \ + @cindex backslash Backslash (@samp{\}) @item + @cindex ? + @cindex question mark Question mark (@samp{?}) @item + @cindex # + @cindex hash mark + @cindex pound sign Hash mark (@samp{#}) @item + @cindex & + @cindex ampersand Ampersand (@samp{&}) @item + @cindex % + @cindex percent sign Percent sign (@samp{%}) @item + @cindex _ + @cindex underscore Underscore (@samp{_}) @item + @cindex < + @cindex open angle + @cindex left angle + @cindex open bracket + @cindex left bracket Open angle (@samp{<}) @item + @cindex > + @cindex close angle + @cindex right angle + @cindex close bracket + @cindex right bracket Close angle (@samp{>}) @item *************** The FORTRAN 77 special characters (@key{ *** 4810,4816 **** and @samp{:}) @end itemize ! @cindex blanks (spaces) Note that this document refers to @key{SPC} as @dfn{space}, while X3.9-1978 FORTRAN 77 refers to it as @dfn{blank}. --- 4201,4209 ---- and @samp{:}) @end itemize ! @cindex blank ! @cindex space ! @cindex SPC Note that this document refers to @key{SPC} as @dfn{space}, while X3.9-1978 FORTRAN 77 refers to it as @dfn{blank}. *************** while X3.9-1978 FORTRAN 77 refers to it *** 4818,4825 **** @subsection Lines @cindex lines @cindex source file format ! @cindex source form ! @cindex files, source @cindex source code @cindex code, source @cindex fixed form --- 4211,4218 ---- @subsection Lines @cindex lines @cindex source file format ! @cindex source format ! @cindex file, source @cindex source code @cindex code, source @cindex fixed form *************** stream-based text file is translated to *** 4850,4856 **** A newline in the file is the character that represents the end of a line of text to the underlying system. For example, on ASCII-based systems, a newline is the @key{NL} ! character, which has ASCII value 12 (decimal). @item Each newline in the file serves to end the line of text that precedes --- 4243,4249 ---- A newline in the file is the character that represents the end of a line of text to the underlying system. For example, on ASCII-based systems, a newline is the @key{NL} ! character, which has ASCII value 10 (decimal). @item Each newline in the file serves to end the line of text that precedes *************** The end-of-file marker (@code{EOF}) also *** 4861,4867 **** of text that precedes it (and that does not contain a newline). @item ! @cindex blanks (spaces) Any line of text that is shorter than 72 characters is padded to that length with spaces (called ``blanks'' in the standard). --- 4254,4262 ---- of text that precedes it (and that does not contain a newline). @item ! @cindex blank ! @cindex space ! @cindex SPC Any line of text that is shorter than 72 characters is padded to that length with spaces (called ``blanks'' in the standard). *************** line containing 72 spaces. *** 4890,4899 **** @node Continuation Line @subsection Continuation Line ! @cindex continuation lines, number of @cindex lines, continuation @cindex number of continuation lines ! @cindex limits on continuation lines (Corresponds to Section 3.2.3 of ANSI X3.9-1978 FORTRAN 77.) --- 4285,4294 ---- @node Continuation Line @subsection Continuation Line ! @cindex continuation line, number of @cindex lines, continuation @cindex number of continuation lines ! @cindex limits, continuation lines (Corresponds to Section 3.2.3 of ANSI X3.9-1978 FORTRAN 77.) *************** An @code{END BLOCK DATA} statement, if t *** 5007,5013 **** @node INCLUDE @subsection Including Source Text ! @cindex INCLUDE Additional source text may be included in the processing of the source file via the @code{INCLUDE} directive: --- 4402,4408 ---- @node INCLUDE @subsection Including Source Text ! @cindex INCLUDE directive Additional source text may be included in the processing of the source file via the @code{INCLUDE} directive: *************** This permits long names to be used for @ *** 5096,5103 **** @cindex # @cindex preprocessor ! @code{cpp} output-style @code{#} directives @xref{C Preprocessor ! Output,,, cpp, The C Preprocessor}, are recognized by the compiler even when the preprocessor isn't run on the input (as it is when compiling @samp{.F} files). (Note the distinction between these @code{cpp} @code{#} @emph{output} directives and @code{#line} @emph{input} --- 4491,4499 ---- @cindex # @cindex preprocessor ! @code{cpp} output-style @code{#} directives ! (@pxref{C Preprocessor Output,,, cpp, The C Preprocessor}) ! are recognized by the compiler even when the preprocessor isn't run on the input (as it is when compiling @samp{.F} files). (Note the distinction between these @code{cpp} @code{#} @emph{output} directives and @code{#line} @emph{input} *************** as appropriate. *** 5901,5906 **** --- 5297,5306 ---- @node CYCLE and EXIT @subsection The @code{CYCLE} and @code{EXIT} Statements + @cindex CYCLE statement + @cindex EXIT statement + @cindex statements, CYCLE + @cindex statements, EXIT The @code{CYCLE} and @code{EXIT} statements specify that the remaining statements in the current iteration of a particular active (enclosing) @code{DO} loop are to be skipped. *************** are given arguments that do not conform *** 6237,6248 **** @smallexample PROGRAM JCB002 C Version 1: C Modified 1997-05-21 (Burley) to accommodate compilers that implement C INT(I1-I2) as INT(I1)-INT(I2) given INTEGER*2 I1,I2. C C Version 0: C Written by James Craig Burley 1997-02-20. - C Contact via Internet email: burley@@gnu.org C C Purpose: C Determine how compilers handle non-standard IDIM --- 5637,5648 ---- @smallexample PROGRAM JCB002 C Version 1: + C Modified 1999-02-15 (Burley) to delete my email address. C Modified 1997-05-21 (Burley) to accommodate compilers that implement C INT(I1-I2) as INT(I1)-INT(I2) given INTEGER*2 I1,I2. C C Version 0: C Written by James Craig Burley 1997-02-20. C C Purpose: C Determine how compilers handle non-standard IDIM *************** These disagreements strongly suggest tha *** 6345,6351 **** and certainly existing Fortran programs, disagree about the meaning of such invocations. ! The first version of @samp{JCB002} didn't accommodate some compilers' treatment of @samp{INT(I1-I2)} where @samp{I1} and @samp{I2} are @code{INTEGER*2}. In such a case, these compilers apparently convert both --- 5745,5751 ---- and certainly existing Fortran programs, disagree about the meaning of such invocations. ! The first version of @code{JCB002} didn't accommodate some compilers' treatment of @samp{INT(I1-I2)} where @samp{I1} and @samp{I2} are @code{INTEGER*2}. In such a case, these compilers apparently convert both *************** However, the results of the careful anal *** 6357,6363 **** of programs compiled by these various compilers show that they all implement either @samp{Interp 1} or @samp{Interp 2} above. ! Specifically, it is believed that the new version of @samp{JCB002} above will confirm that: @itemize @bullet --- 5757,5763 ---- of programs compiled by these various compilers show that they all implement either @samp{Interp 1} or @samp{Interp 2} above. ! Specifically, it is believed that the new version of @code{JCB002} above will confirm that: @itemize @bullet *************** worth adding to the above list, please l *** 6380,6389 **** @node REAL() and AIMAG() of Complex @subsection @code{REAL()} and @code{AIMAG()} of Complex ! @cindex REAL intrinsic ! @cindex intrinsics, REAL ! @cindex AIMAG intrinsic ! @cindex intrinsics, AIMAG The GNU Fortran language disallows @code{REAL(@var{expr})} and @code{AIMAG(@var{expr})}, --- 5780,5789 ---- @node REAL() and AIMAG() of Complex @subsection @code{REAL()} and @code{AIMAG()} of Complex ! @cindex @code{Real} intrinsic ! @cindex intrinsics, @code{Real} ! @cindex @code{AImag} intrinsic ! @cindex intrinsics, @code{AImag} The GNU Fortran language disallows @code{REAL(@var{expr})} and @code{AIMAG(@var{expr})}, *************** treated as @samp{REAL(REALPART(@var{expr *** 6440,6447 **** @node CMPLX() of DOUBLE PRECISION @subsection @code{CMPLX()} of @code{DOUBLE PRECISION} ! @cindex CMPLX intrinsic ! @cindex intrinsics, CMPLX In accordance with Fortran 90 and at least some (perhaps all) other compilers, the GNU Fortran language defines @code{CMPLX()} --- 5840,5847 ---- @node CMPLX() of DOUBLE PRECISION @subsection @code{CMPLX()} of @code{DOUBLE PRECISION} ! @cindex @code{Cmplx} intrinsic ! @cindex intrinsics, @code{Cmplx} In accordance with Fortran 90 and at least some (perhaps all) other compilers, the GNU Fortran language defines @code{CMPLX()} *************** did not exist, would leave this document *** 6604,6610 **** @node Scope and Classes of Names @section Scope and Classes of Symbolic Names ! @cindex symbolic names @cindex scope (The following information augments or overrides the information in --- 6004,6010 ---- @node Scope and Classes of Names @section Scope and Classes of Symbolic Names ! @cindex symbol names, scope and classes @cindex scope (The following information augments or overrides the information in *************** for the relevant aspects of GNU Fortran. *** 6619,6625 **** @node Underscores in Symbol Names @subsection Underscores in Symbol Names ! @cindex underscores Underscores (@samp{_}) are accepted in symbol names after the first character (which must be a letter). --- 6019,6025 ---- @node Underscores in Symbol Names @subsection Underscores in Symbol Names ! @cindex underscore Underscores (@samp{_}) are accepted in symbol names after the first character (which must be a letter). *************** Edit descriptors in @code{FORMAT} statem *** 6641,6652 **** The @code{OPEN} specifier @code{NAME=} is equivalent to @code{FILE=}. ! These Fortran 90 features are supported: @itemize @bullet @item @cindex Z edit descriptor @cindex edit descriptor, Z ! The @code{Z} edit descriptor is supported. @item The @code{FILE=} specifier may be omitted in an @code{OPEN} statement if @code{STATUS='SCRATCH'} is supplied. The @code{STATUS='REPLACE'} --- 6041,6056 ---- The @code{OPEN} specifier @code{NAME=} is equivalent to @code{FILE=}. ! These Fortran 90 features are supported: @itemize @bullet @item + @cindex FORMAT descriptors @cindex Z edit descriptor @cindex edit descriptor, Z ! @cindex O edit descriptor ! @cindex edit descriptor, O ! The @code{O} and @code{Z} edit descriptors are supported for I/O of ! integers in octal and hexadecimal formats, respectively. @item The @code{FILE=} specifier may be omitted in an @code{OPEN} statement if @code{STATUS='SCRATCH'} is supplied. The @code{STATUS='REPLACE'} *************** specifier is supported. *** 6656,6680 **** @node Fortran 90 Features @section Fortran 90 Features @cindex Fortran 90 For convenience this section collects a list (probably incomplete) of the Fortran 90 features supported by the GNU Fortran language, even if they are documented elsewhere. ! @c makeinfo 1.68 objects to the nested parens ! @ifnotinfo ! @xref{Characters Lines Sequence,,{Characters, Lines, and Execution Sequence}}, ! @end ifnotinfo ! @ifinfo ! @xref{Characters Lines Sequence}, ! @end ifinfo ! for information on additional fixed source form lexical issues. In ! addition, the free source form is supported through the @cindex @samp{-ffree-form} ! @samp{-ffree-form} option. Other Fortran 90 features can be turned on ! by the @cindex @samp{-ff90} ! @samp{-ff90} option, @ref{Fortran 90}. For information on the Fortran ! 90 intrinsics available @ref{Table of Intrinsic Functions}. @table @asis @item Automatic arrays in procedures --- 6060,6080 ---- @node Fortran 90 Features @section Fortran 90 Features @cindex Fortran 90 + @cindex extensions, from Fortran 90 For convenience this section collects a list (probably incomplete) of the Fortran 90 features supported by the GNU Fortran language, even if they are documented elsewhere. ! @xref{Characters Lines Sequence,,@asis{Characters, Lines, and Execution Sequence}}, ! for information on additional fixed source form lexical issues. @cindex @samp{-ffree-form} ! Further, the free source form is supported through the ! @samp{-ffree-form} option. @cindex @samp{-ff90} ! Other Fortran 90 features can be turned on by the @samp{-ff90} option; ! see @ref{Fortran 90}. ! For information on the Fortran 90 intrinsics available, ! see @ref{Table of Intrinsic Functions}. @table @asis @item Automatic arrays in procedures *************** Strings may have zero length and substri *** 6688,6699 **** permitted. Character constants may be enclosed in double quotes (@code{"}) as well as single quotes. @xref{Character Type}. @item Construct names ! (Symbolic tags on blocks.) @xref{Construct Names }. @item @code{CYCLE} and @code{EXIT} @xref{CYCLE and EXIT,,The @code{CYCLE} and @code{EXIT} Statements}. @item @code{DOUBLE COMPLEX} ! @xref{DOUBLE COMPLEX,,@code{DOUBLE COMPLEX} Statement ! }. @item @code{DO WHILE} @xref{DO WHILE}. @item @code{END} decoration --- 6088,6098 ---- permitted. Character constants may be enclosed in double quotes (@code{"}) as well as single quotes. @xref{Character Type}. @item Construct names ! (Symbolic tags on blocks.) @xref{Construct Names}. @item @code{CYCLE} and @code{EXIT} @xref{CYCLE and EXIT,,The @code{CYCLE} and @code{EXIT} Statements}. @item @code{DOUBLE COMPLEX} ! @xref{DOUBLE COMPLEX,,@code{DOUBLE COMPLEX} Statement}. @item @code{DO WHILE} @xref{DO WHILE}. @item @code{END} decoration *************** permitted. Character constants may be e *** 6704,6724 **** @item @code{IMPLICIT NONE} @item @code{INCLUDE} statements @xref{INCLUDE}. ! @item List directed and namelist i/o on internal files @item Binary, octal and hexadecimal constants These are supported more generally than required by Fortran 90. @xref{Integer Type}. @item @code{NAMELIST} @xref{NAMELIST}. @item @code{OPEN} specifiers @code{STATUS='REPLACE'} is supported. @item Relational operators The operators @code{<}, @code{<=}, @code{==}, @code{/=}, @code{>} and @code{>=} may be used instead of @code{.LT.}, @code{.LE.}, @code{.EQ.}, @code{.NE.}, @code{.GT.} and @code{.GE.} respectively. @item @code{SELECT CASE} ! Not fully implemented. @xref{SELECT CASE on CHARACTER Type,, ! @code{SELECT CASE} on @code{CHARACTER} Type}. @item Specification statements A limited subset of the Fortran 90 syntax and semantics for variable declarations is supported, including @code{KIND}. @xref{Kind Notation}. --- 6103,6131 ---- @item @code{IMPLICIT NONE} @item @code{INCLUDE} statements @xref{INCLUDE}. ! @item List-directed and namelist I/O on internal files @item Binary, octal and hexadecimal constants These are supported more generally than required by Fortran 90. @xref{Integer Type}. + @item @samp{O} and @samp{Z} edit descriptors @item @code{NAMELIST} @xref{NAMELIST}. @item @code{OPEN} specifiers @code{STATUS='REPLACE'} is supported. + The @code{FILE=} specifier may be omitted in an @code{OPEN} statement if + @code{STATUS='SCRATCH'} is supplied. + @item @code{FORMAT} edit descriptors + @cindex FORMAT descriptors + @cindex Z edit descriptor + @cindex edit descriptor, Z + The @code{Z} edit descriptor is supported. @item Relational operators The operators @code{<}, @code{<=}, @code{==}, @code{/=}, @code{>} and @code{>=} may be used instead of @code{.LT.}, @code{.LE.}, @code{.EQ.}, @code{.NE.}, @code{.GT.} and @code{.GE.} respectively. @item @code{SELECT CASE} ! Not fully implemented. ! @xref{SELECT CASE on CHARACTER Type,, @code{SELECT CASE} on @code{CHARACTER} Type}. @item Specification statements A limited subset of the Fortran 90 syntax and semantics for variable declarations is supported, including @code{KIND}. @xref{Kind Notation}. *************** of work!} *** 6765,6772 **** @node Source Form @section Source Form @cindex source file format ! @cindex source form ! @cindex files, source @cindex source code @cindex code, source @cindex fixed form --- 6172,6179 ---- @node Source Form @section Source Form @cindex source file format ! @cindex source format ! @cindex file, source @cindex source code @cindex code, source @cindex fixed form *************** inside such constants. *** 6815,6821 **** @node Tabs @subsection Tabs ! @cindex tab characters A source line with a @key{TAB} character anywhere in it is treated as entirely significant---however long it is---instead of ending in --- 6222,6229 ---- @node Tabs @subsection Tabs ! @cindex tab character ! @cindex horizontal tab A source line with a @key{TAB} character anywhere in it is treated as entirely significant---however long it is---instead of ending in *************** the way continued character/Hollerith co *** 6849,6856 **** @node Short Lines @subsection Short Lines @cindex short source lines ! @cindex space-padding ! @cindex spaces @cindex source lines, short @cindex lines, short --- 6257,6263 ---- @node Short Lines @subsection Short Lines @cindex short source lines ! @cindex space, padding with @cindex source lines, short @cindex lines, short *************** like @samp{-ffixed-line-length-none}, fo *** 6876,6882 **** @node Long Lines @subsection Long Lines @cindex long source lines ! @cindex truncation @cindex lines, long @cindex source lines, long --- 6283,6289 ---- @node Long Lines @subsection Long Lines @cindex long source lines ! @cindex truncation, of long lines @cindex lines, long @cindex source lines, long *************** continuation line, imitating the behavio *** 6903,6910 **** @section Trailing Comment @cindex trailing comment ! @cindex comment, trailing @cindex /* @code{g77} supports use of @samp{/*} to start a trailing comment. In the GNU Fortran language, @samp{!} is used for this purpose. --- 6310,6320 ---- @section Trailing Comment @cindex trailing comment ! @cindex comment ! @cindex characters, comment @cindex /* + @cindex ! + @cindex exclamation point @code{g77} supports use of @samp{/*} to start a trailing comment. In the GNU Fortran language, @samp{!} is used for this purpose. *************** but that seems to be overkill for a prod *** 7058,7064 **** Note 2: Rules for InitialCaps names are: ! @itemize -- @item Must be a single uppercase letter, @strong{or} @item --- 6468,6474 ---- Note 2: Rules for InitialCaps names are: ! @itemize @minus @item Must be a single uppercase letter, @strong{or} @item *************** valid InitialCaps names, but @samp{AB}, *** 7071,7077 **** not. Note that most, but not all, built-in names meet these requirements---the exceptions are some of the two-letter format ! specifiers, such as @samp{BN} and @samp{BZ}. Here are the names of the corresponding command-line options: --- 6481,6487 ---- not. Note that most, but not all, built-in names meet these requirements---the exceptions are some of the two-letter format ! specifiers, such as @code{BN} and @code{BZ}. Here are the names of the corresponding command-line options: *************** meaning is to be assumed. *** 7265,7271 **** @code{g77} treats double-quote (@samp{"}) as beginning an octal constant of @code{INTEGER(KIND=1)} type ! when the @code{-fvxt} option is specified. The form of this octal constant is @example --- 6675,6681 ---- @code{g77} treats double-quote (@samp{"}) as beginning an octal constant of @code{INTEGER(KIND=1)} type ! when the @samp{-fvxt} option is specified. The form of this octal constant is @example *************** The form of this octal constant is *** 7276,7282 **** where @var{octal-digits} is a nonempty string of characters in the set @samp{01234567}. ! For example, the @code{-fvxt} option permits this: @example PRINT *, "20 --- 6686,6692 ---- where @var{octal-digits} is a nonempty string of characters in the set @samp{01234567}. ! For example, the @samp{-fvxt} option permits this: @example PRINT *, "20 *************** both constructs in the general case, sin *** 7297,7303 **** @node Exclamation Point @subsection Meaning of Exclamation Point in Column 6 ! @cindex exclamation points @cindex continuation character @cindex characters, continuation @cindex comment character --- 6707,6714 ---- @node Exclamation Point @subsection Meaning of Exclamation Point in Column 6 ! @cindex ! ! @cindex exclamation point @cindex continuation character @cindex characters, continuation @cindex comment character *************** a fixed-form source file *** 7308,7314 **** as a continuation character rather than as the beginning of a comment (as it does in any other column) ! when the @code{-fvxt} option is specified. The following program, when run, prints a message indicating whether it is interpreted according to GNU Fortran (and Fortran 90) --- 6719,6725 ---- as a continuation character rather than as the beginning of a comment (as it does in any other column) ! when the @samp{-fvxt} option is specified. The following program, when run, prints a message indicating whether it is interpreted according to GNU Fortran (and Fortran 90) *************** marks a line as a continuation line when *** 7331,7337 **** @node Fortran 90 @section Fortran 90 @cindex compatibility, Fortran 90 ! @cindex Fortran 90 compatibility The GNU Fortran language includes a number of features that are part of Fortran 90, even when the @samp{-ff90} option is not specified. --- 6742,6748 ---- @node Fortran 90 @section Fortran 90 @cindex compatibility, Fortran 90 ! @cindex Fortran 90, compatibility The GNU Fortran language includes a number of features that are part of Fortran 90, even when the @samp{-ff90} option is not specified. *************** provided for by that standard. *** 7419,7425 **** Automatic conversion of numeric expressions to @code{INTEGER(KIND=1)} in contexts such as: ! @itemize -- @item Array-reference indexes. @item --- 6830,6836 ---- Automatic conversion of numeric expressions to @code{INTEGER(KIND=1)} in contexts such as: ! @itemize @minus @item Array-reference indexes. @item *************** portable constructs, are accepted. *** 7538,7555 **** These are humorously referred to as ``distensions'', extensions that just plain look ugly in the harsh light of day. - @emph{Note:} The @samp{-fugly} option, which currently serves - as shorthand to enable all of the distensions below, is likely to - be removed in a future version of @code{g77}. - That's because it's likely new distensions will be added that - conflict with existing ones in terms of assigning meaning to - a given chunk of code. - (Also, it's pretty clear that users should not use @samp{-fugly} - as shorthand when the next release of @code{g77} might add a - distension to that that causes their existing code, when recompiled, - to behave differently---perhaps even fail to compile or run - correctly.) - @menu * Ugly Implicit Argument Conversion:: Disabled via @samp{-fno-ugly-args}. * Ugly Assumed-Size Arrays:: Enabled via @samp{-fugly-assumed}. --- 6949,6954 ---- *************** without conversion. *** 7684,7691 **** @node Ugly Null Arguments @subsection Ugly Null Arguments ! @cindex trailing commas ! @cindex commas, trailing @cindex null arguments @cindex arguments, null --- 7083,7091 ---- @node Ugly Null Arguments @subsection Ugly Null Arguments ! @cindex trailing comma ! @cindex comma, trailing ! @cindex characters, comma @cindex null arguments @cindex arguments, null *************** ASSIGN 10 TO I *** 7842,7848 **** Normally, for portability and improved diagnostics, @code{g77} reserves distinct storage for a ``sibling'' of @samp{I}, used only for @code{ASSIGN} statements to that variable (along with ! the corresponding assigned-@code{GOTO} and assigned-@samp{FORMAT}-I/O statements that reference the variable). However, some code (that violates the ANSI FORTRAN 77 standard) --- 7242,7248 ---- Normally, for portability and improved diagnostics, @code{g77} reserves distinct storage for a ``sibling'' of @samp{I}, used only for @code{ASSIGN} statements to that variable (along with ! the corresponding assigned-@code{GOTO} and assigned-@code{FORMAT}-I/O statements that reference the variable). However, some code (that violates the ANSI FORTRAN 77 standard) *************** of work!} *** 7899,7904 **** --- 7299,7305 ---- @menu * Compiler Limits:: + * Run-time Environment Limits:: * Compiler Types:: * Compiler Constants:: * Compiler Intrinsics:: *************** symbols in a program, and so on. *** 7917,7922 **** --- 7318,7325 ---- @cindex -Nl option @cindex options, -Nx @cindex -Nx option + @cindex limits, continuation lines + @cindex limits, lengths of names For example, some other Fortran compiler have an option (such as @samp{-Nl@var{x}}) to increase the limit on the number of continuation lines. *************** limits in these areas. *** 7932,7940 **** @cindex maximum rank @cindex number of dimensions, maximum @cindex maximum number of dimensions @code{g77} does currently limit the number of dimensions in an array to the same degree as do the Fortran standards---seven (7). ! This restriction might well be lifted in a future version. @node Compiler Types @section Compiler Types --- 7335,7649 ---- @cindex maximum rank @cindex number of dimensions, maximum @cindex maximum number of dimensions + @cindex limits, rank + @cindex limits, array dimensions @code{g77} does currently limit the number of dimensions in an array to the same degree as do the Fortran standards---seven (7). ! This restriction might be lifted in a future version. ! ! @node Run-time Environment Limits ! @section Run-time Environment Limits ! @cindex limits, run-time library ! @cindex wraparound ! ! As a portable Fortran implementation, ! @code{g77} offers its users direct access to, ! and otherwise depends upon, ! the underlying facilities of the system ! used to build @code{g77}, ! the system on which @code{g77} itself is used to compile programs, ! and the system on which the @code{g77}-compiled program is actually run. ! (For most users, the three systems are of the same ! type---combination of operating environment and hardware---often ! the same physical system.) ! ! The run-time environment for a particular system ! inevitably imposes some limits on a program's use ! of various system facilities. ! These limits vary from system to system. ! ! Even when such limits might be well beyond the ! possibility of being encountered on a particular system, ! the @code{g77} run-time environment ! has certain built-in limits, ! usually, but not always, stemming from intrinsics ! with inherently limited interfaces. ! ! Currently, the @code{g77} run-time environment ! does not generally offer a less-limiting environment ! by augmenting the underlying system's own environment. ! ! Therefore, code written in the GNU Fortran language, ! while syntactically and semantically portable, ! might nevertheless make non-portable assumptions ! about the run-time environment---assumptions that ! prove to be false for some particular environments. ! ! The GNU Fortran language, ! the @code{g77} compiler and run-time environment, ! and the @code{g77} documentation ! do not yet offer comprehensive portable work-arounds for such limits, ! though programmers should be able to ! find their own in specific instances. ! ! Not all of the limitations are described in this document. ! Some of the known limitations include: ! ! @menu ! * Timer Wraparounds:: ! * Year 2000 (Y2K) Problems:: ! * Array Size:: ! * Character-variable Length:: ! * Year 10000 (Y10K) Problems:: ! @end menu ! ! @node Timer Wraparounds ! @subsection Timer Wraparounds ! ! Intrinsics that return values computed from system timers, ! whether elapsed (wall-clock) timers, ! process CPU timers, ! or other kinds of timers, ! are prone to experiencing wrap-around errors ! (or returning wrapped-around values from successive calls) ! due to insufficient ranges ! offered by the underlying system's timers. ! ! @cindex negative time ! @cindex short time ! @cindex long time ! Some of the symptoms of such behaviors include ! apparently negative time being computed for a duration, ! an extremely short amount of time being computed for a long duration, ! and an extremely long amount of time being computed for a short duration. ! ! See the following for intrinsics ! known to have potential problems in these areas ! on at least some systems: ! @ref{CPU_Time Intrinsic}, ! @ref{DTime Intrinsic (function)}, @ref{DTime Intrinsic (subroutine)}, ! @ref{ETime Intrinsic (function)}, @ref{ETime Intrinsic (subroutine)}, ! @ref{MClock Intrinsic}, @ref{MClock8 Intrinsic}, ! @ref{Secnds Intrinsic}, ! @ref{Second Intrinsic (function)}, @ref{Second Intrinsic (subroutine)}, ! @ref{System_Clock Intrinsic}, ! @ref{Time Intrinsic (UNIX)}, @ref{Time Intrinsic (VXT)}, ! @ref{Time8 Intrinsic}. ! ! @node Year 2000 (Y2K) Problems ! @subsection Year 2000 (Y2K) Problems ! @cindex Y2K compliance ! @cindex Year 2000 compliance ! ! While the @code{g77} compiler itself is believed to ! be Year-2000 (Y2K) compliant, ! some intrinsics are not, ! and, potentially, some underlying systems are not, ! perhaps rendering some Y2K-compliant intrinsics ! non-compliant when used on those particular systems. ! ! Fortran code that uses non-Y2K-compliant intrinsics ! (listed below) ! is, itself, almost certainly not compliant, ! and should be modified to use Y2K-compliant intrinsics instead. ! ! Fortran code that uses no non-Y2K-compliant intrinsics, ! but which currently is running on a non-Y2K-compliant system, ! can be made more Y2K compliant by compiling and ! linking it for use on a new Y2K-compliant system, ! such as a new version of an old, non-Y2K-compliant, system. ! ! Currently, information on Y2K and related issues ! is being maintained at ! @uref{http://www.gnu.org/software/year2000-list.html}. ! ! See the following for intrinsics ! known to have potential problems in these areas ! on at least some systems: ! @ref{Date Intrinsic}, ! @ref{IDate Intrinsic (VXT)}. ! ! @cindex y2kbuggy ! @cindex date_y2kbuggy_0 ! @cindex vxtidate_y2kbuggy_0 ! @cindex G77_date_y2kbuggy_0 ! @cindex G77_vxtidate_y2kbuggy_0 ! The @code{libg2c} library ! shipped with any @code{g77} that warns ! about invocation of a non-Y2K-compliant intrinsic ! has renamed the @code{EXTERNAL} procedure names ! of those intrinsics. ! This is done so that ! the @code{libg2c} implementations of these intrinsics ! cannot be directly linked to ! as @code{EXTERNAL} names ! (which normally would avoid the non-Y2K-intrinsic warning). ! ! The renamed forms of the @code{EXTERNAL} names ! of these renamed procedures ! may be linked to ! by appending the string @samp{_y2kbug} ! to the name of the procedure ! in the source code. ! For example: ! ! @smallexample ! CHARACTER*20 STR ! INTEGER YY, MM, DD ! EXTERNAL DATE_Y2KBUG, VXTIDATE_Y2KBUG ! CALL DATE_Y2KBUG (STR) ! CALL VXTIDATE_Y2KBUG (MM, DD, YY) ! @end smallexample ! ! (Note that the @code{EXTERNAL} statement ! is not actually required, ! since the modified names are not recognized as intrinsics ! by the current version of @code{g77}. ! But it is shown in this specific case, ! for purposes of illustration.) ! ! The renaming of @code{EXTERNAL} procedure names of these intrinsics ! causes unresolved references at link time. ! For example, @samp{EXTERNAL DATE; CALL DATE(STR)} ! is normally compiled by @code{g77} ! as, in C, @samp{date_(&str, 20);}. ! This, in turn, links to the @code{date_} procedure ! in the @code{libE77} portion of @code{libg2c}, ! which purposely calls a nonexistent procedure ! named @code{G77_date_y2kbuggy_0}. ! The resulting link-time error is designed, via this name, ! to encourage the programmer to look up the ! index entries to this portion of the @code{g77} documentation. ! ! Generally, we recommend that the @code{EXTERNAL} method ! of invoking procedures in @code{libg2c} ! @emph{not} be used. ! When used, some of the correctness checking ! normally performed by @code{g77} ! is skipped. ! ! In particular, it is probably better to use the ! @code{INTRINSIC} method of invoking ! non-Y2K-compliant procedures, ! so anyone compiling the code ! can quickly notice the potential Y2K problems ! (via the warnings printing by @code{g77}) ! without having to even look at the code itself. ! ! If there are problems linking @code{libg2c} ! to code compiled by @code{g77} ! that involve the string @samp{y2kbug}, ! and these are not explained above, ! that probably indicates ! that a version of @code{libg2c} ! older than @code{g77} ! is being linked to, ! or that the new library is being linked ! to code compiled by an older version of @code{g77}. ! ! That's because, as of the version that warns about ! non-Y2K-compliant intrinsic invocation, ! @code{g77} references the @code{libg2c} implementations ! of those intrinsics ! using new names, containing the string @samp{y2kbug}. ! ! So, linking newly-compiled code ! (invoking one of the intrinsics in question) ! to an old library ! might yield an unresolved reference ! to @code{G77_date_y2kbug_0}. ! (The old library calls it @code{G77_date_0}.) ! ! Similarly, linking previously-compiled code ! to a new library ! might yield an unresolved reference ! to @code{G77_vxtidate_0}. ! (The new library calls it @code{G77_vxtidate_y2kbug_0}.) ! ! The proper fix for the above problems ! is to obtain the latest release of @code{g77} ! and related products ! (including @code{libg2c}) ! and install them on all systems, ! then recompile, relink, and install ! (as appropriate) ! all existing Fortran programs. ! ! (Normally, this sort of renaming is steadfastly avoided. ! In this case, however, it seems more important to highlight ! potential Y2K problems ! than to ease the transition ! of potentially non-Y2K-compliant code ! to new versions of @code{g77} and @code{libg2c}.) ! ! @node Array Size ! @subsection Array Size ! @cindex limits, array size ! @cindex array size ! ! Currently, @code{g77} uses the default @code{INTEGER} type ! for array indexes, ! which limits the sizes of single-dimension arrays ! on systems offering a larger address space ! than can be addressed by that type. ! (That @code{g77} puts all arrays in memory ! could be considered another limitation---it ! could use large temporary files---but that decision ! is left to the programmer as an implementation choice ! by most Fortran implementations.) ! ! @c ??? Investigate this, to offer a more clear statement ! @c than the following paragraphs do. -- burley 1999-02-17 ! It is not yet clear whether this limitation ! never, sometimes, or always applies to the ! sizes of multiple-dimension arrays as a whole. ! ! For example, on a system with 64-bit addresses ! and 32-bit default @code{INTEGER}, ! an array with a size greater than can be addressed ! by a 32-bit offset ! can be declared using multiple dimensions. ! Such an array is therefore larger ! than a single-dimension array can be, ! on the same system. ! ! @cindex limits, multi-dimension arrays ! @cindex multi-dimension arrays ! @cindex arrays, dimensioning ! Whether large multiple-dimension arrays are reliably supported ! depends mostly on the @code{gcc} back end (code generator) ! used by @code{g77}, and has not yet been fully investigated. ! ! @node Character-variable Length ! @subsection Character-variable Length ! @cindex limits, on character-variable length ! @cindex character-variable length ! ! Currently, @code{g77} uses the default @code{INTEGER} type ! for the lengths of @code{CHARACTER} variables ! and array elements. ! ! This means that, for example, ! a system with a 64-bit address space ! and a 32-bit default @code{INTEGER} type ! does not, under @code{g77}, ! support a @code{CHARACTER*@var{n}} declaration ! where @var{n} is greater than 2147483647. ! ! @node Year 10000 (Y10K) Problems ! @subsection Year 10000 (Y10K) Problems ! @cindex Y10K compliance ! @cindex Year 10000 compliance ! ! Most intrinsics returning, or computing values based on, ! date information are prone to Year-10000 (Y10K) problems, ! due to supporting only 4 digits for the year. ! ! See the following for examples: ! @ref{FDate Intrinsic (function)}, @ref{FDate Intrinsic (subroutine)}, ! @ref{IDate Intrinsic (UNIX)}, ! @ref{Time Intrinsic (VXT)}, ! @ref{Date_and_Time Intrinsic}. @node Compiler Types @section Compiler Types *************** command. *** 8470,8476 **** of work!} @menu ! * Interoperating with C and C++:: @end menu @node Interoperating with C and C++ --- 8179,8185 ---- of work!} @menu ! * Interoperating with C and C++:: @end menu @node Interoperating with C and C++ *************** options @code{g77} passes by running @sa *** 8511,8517 **** @pindex f2c @cindex cfortran.h @cindex Netlib ! Even if you don't actually use it as a compiler, @samp{f2c} from @uref{ftp://ftp.netlib.org/f2c/src}, can be a useful tool when you're interfacing (linking) Fortran and C@. @xref{f2c Skeletons and Prototypes,,Generating Skeletons and Prototypes with @code{f2c}}. --- 8220,8226 ---- @pindex f2c @cindex cfortran.h @cindex Netlib ! Even if you don't actually use it as a compiler, @code{f2c} from @uref{ftp://ftp.netlib.org/f2c/src}, can be a useful tool when you're interfacing (linking) Fortran and C@. @xref{f2c Skeletons and Prototypes,,Generating Skeletons and Prototypes with @code{f2c}}. *************** Generally, C code written to link with *** 8538,8544 **** called from Fortran---should @samp{#include } to define the C versions of the Fortran types. Don't assume Fortran @code{INTEGER} types ! correspond to C @samp{int}s, for instance; instead, declare them as @code{integer}, a type defined by @file{g2c.h}. @file{g2c.h} is installed where @code{gcc} will find it by default, assuming you use a copy of @code{gcc} compatible with --- 8247,8253 ---- called from Fortran---should @samp{#include } to define the C versions of the Fortran types. Don't assume Fortran @code{INTEGER} types ! correspond to C @code{int}s, for instance; instead, declare them as @code{integer}, a type defined by @file{g2c.h}. @file{g2c.h} is installed where @code{gcc} will find it by default, assuming you use a copy of @code{gcc} compatible with *************** A simple and foolproof way to write @cod *** 8553,8559 **** interface with an existing library---is to write a file (named, for example, @file{fred.f}) of dummy Fortran skeletons comprising just the declaration of the routine(s) and dummy ! arguments plus @samp{END} statements. Then run @code{f2c} on file @file{fred.f} to produce @file{fred.c} into which you can edit useful code, confident the calling sequence is correct, at least. --- 8262,8268 ---- interface with an existing library---is to write a file (named, for example, @file{fred.f}) of dummy Fortran skeletons comprising just the declaration of the routine(s) and dummy ! arguments plus @code{END} statements. Then run @code{f2c} on file @file{fred.f} to produce @file{fred.c} into which you can edit useful code, confident the calling sequence is correct, at least. *************** as the return type of a @code{REAL} @cod *** 8567,8573 **** @samp{-P} option to generate C prototypes appropriate for calling the Fortran.@footnote{The files generated like this can also be used for inter-unit consistency checking of dummy and actual arguments, although ! the @samp{ftnchek} tool from @uref{ftp://ftp.netlib.org/fortran} or @uref{ftp://ftp.dsm.fordham.edu} is probably better for this purpose.} If the Fortran code containing any --- 8276,8282 ---- @samp{-P} option to generate C prototypes appropriate for calling the Fortran.@footnote{The files generated like this can also be used for inter-unit consistency checking of dummy and actual arguments, although ! the @code{ftnchek} tool from @uref{ftp://ftp.netlib.org/fortran} or @uref{ftp://ftp.dsm.fordham.edu} is probably better for this purpose.} If the Fortran code containing any *************** avoid clashes with C++ reserved words in *** 8599,8606 **** @subsection Startup Code @cindex startup code ! @cindex runtime initialization ! @cindex initialization, runtime Unlike with some runtime systems, it shouldn't be necessary (unless there are bugs) --- 8308,8315 ---- @subsection Startup Code @cindex startup code ! @cindex run-time, initialization ! @cindex initialization, run-time Unlike with some runtime systems, it shouldn't be necessary (unless there are bugs) *************** described in this section. *** 8813,8823 **** @cindex statements, PROGRAM When @code{g77} compiles a main program unit, it gives it the public ! procedure name @samp{MAIN__}. The @code{libg2c} library has the actual @code{main()} procedure as is typical of C-based environments, and it is this procedure that performs some initial start-up ! activity and then calls @samp{MAIN__}. Generally, @code{g77} and @code{libg2c} are designed so that you need not include a main program unit written in Fortran in your program---it --- 8522,8532 ---- @cindex statements, PROGRAM When @code{g77} compiles a main program unit, it gives it the public ! procedure name @code{MAIN__}. The @code{libg2c} library has the actual @code{main()} procedure as is typical of C-based environments, and it is this procedure that performs some initial start-up ! activity and then calls @code{MAIN__}. Generally, @code{g77} and @code{libg2c} are designed so that you need not include a main program unit written in Fortran in your program---it *************** file @file{@value{path-libf2c}/libF77/ma *** 8835,8844 **** might need to be done by your @code{main()} in order to provide the Fortran environment your Fortran code is expecting. ! @cindex IARGC() intrinsic ! @cindex intrinsics, IARGC() ! @cindex GETARG() intrinsic ! @cindex intrinsics, GETARG() For example, @code{libg2c}'s @code{main()} sets up the information used by the @code{IARGC} and @code{GETARG} intrinsics. Bypassing @code{libg2c}'s @code{main()} --- 8544,8553 ---- might need to be done by your @code{main()} in order to provide the Fortran environment your Fortran code is expecting. ! @cindex @code{IArgC} intrinsic ! @cindex intrinsics, @code{IArgC} ! @cindex @code{GetArg} intrinsic ! @cindex intrinsics, @code{GetArg} For example, @code{libg2c}'s @code{main()} sets up the information used by the @code{IARGC} and @code{GETARG} intrinsics. Bypassing @code{libg2c}'s @code{main()} *************** Fortran code. *** 8859,8865 **** The standard way to get around this problem is to set a break point (a one-time, or temporary, break point will do) at ! the entrance to @samp{MAIN__}, and then run the program. A convenient way to do so is to add the @code{gdb} command @example --- 8568,8574 ---- The standard way to get around this problem is to set a break point (a one-time, or temporary, break point will do) at ! the entrance to @code{MAIN__}, and then run the program. A convenient way to do so is to add the @code{gdb} command @example *************** unit of your program. *** 8876,8882 **** Of course, if you really want to set a break point at some other place in your program and just start the program ! running, without first breaking at @samp{MAIN__}, that should work fine. @node Procedures --- 8585,8591 ---- Of course, if you really want to set a break point at some other place in your program and just start the program ! running, without first breaking at @code{MAIN__}, that should work fine. @node Procedures *************** functions return @code{float}. *** 9009,9015 **** @node Names @section Names @cindex symbol names ! @cindex transformation of symbol names Fortran permits each implementation to decide how to represent names as far as how they're seen in other contexts, such as debuggers --- 8718,8724 ---- @node Names @section Names @cindex symbol names ! @cindex transforming symbol names Fortran permits each implementation to decide how to represent names as far as how they're seen in other contexts, such as debuggers *************** could be used to inhibit the appending o *** 9109,9116 **** @node Common Blocks @section Common Blocks (COMMON) @cindex common blocks ! @cindex COMMON statement ! @cindex statements, COMMON @code{g77} names and lays out @code{COMMON} areas the same way @code{f2c} does, --- 8818,8825 ---- @node Common Blocks @section Common Blocks (COMMON) @cindex common blocks ! @cindex @code{COMMON} statement ! @cindex statements, @code{COMMON} @code{g77} names and lays out @code{COMMON} areas the same way @code{f2c} does, *************** previous method in the documentation.) *** 9224,9230 **** @node Complex Variables @section Complex Variables (COMPLEX) @cindex complex variables ! @cindex imaginary part of complex @cindex COMPLEX statement @cindex statements, COMPLEX --- 8933,8939 ---- @node Complex Variables @section Complex Variables (COMPLEX) @cindex complex variables ! @cindex imaginary part @cindex COMPLEX statement @cindex statements, COMPLEX *************** mode afterward. *** 9252,9262 **** (In @code{gdb}, this is accomplished via @samp{set lang c} and either @samp{set lang fortran} or @samp{set lang auto}.) - @emph{Note:} Compiling with the @samp{-fno-emulate-complex} option - avoids the debugging problem, but is known to cause other problems - like compiler crashes and generation of incorrect code, so it is - not recommended. - @node Arrays @section Arrays (DIMENSION) @cindex DIMENSION statement --- 8961,8966 ---- *************** Instead, make a separate @code{INCLUDE} *** 9678,9684 **** so you can more easily change the actual numbers in the future. The information below is culled from the definition ! of @samp{F_err} in @file{f/runtime/libI77/err.c} in the @code{g77} source tree. @smallexample --- 9382,9388 ---- so you can more easily change the actual numbers in the future. The information below is culled from the definition ! of @code{F_err} in @file{f/runtime/libI77/err.c} in the @code{g77} source tree. @smallexample *************** is not intended to be comprehensive. *** 9772,9778 **** @menu * Language Extensions:: Features used by Fortran code. ! * Compiler Options:: Features helpful during development. * Compiler Speed:: Speed of the compilation process. * Program Speed:: Speed of the generated, optimized code. * Ease of Debugging:: Debugging ease-of-use at the source level. --- 9476,9483 ---- @menu * Language Extensions:: Features used by Fortran code. ! * Diagnostic Abilities:: Abilities to spot problems early. ! * Compiler Options:: Features helpful to accommodate legacy code, etc. * Compiler Speed:: Speed of the compilation process. * Program Speed:: Speed of the generated, optimized code. * Ease of Debugging:: Debugging ease-of-use at the source level. *************** is not intended to be comprehensive. *** 9782,9806 **** @node Language Extensions @subsection Language Extensions ! @code{g77} offers several extensions to the Fortran language that @code{f2c} ! doesn't. - However, @code{f2c} offers a few that @code{g77} doesn't, like - fairly complete support for @code{INTEGER*2}. It is expected that @code{g77} will offer some or all of these missing features at some time in the future. ! (Version 0.5.18 of @code{g77} offers some rudimentary support for some ! of these features.) @node Compiler Options @subsection Compiler Options ! @code{g77} offers a whole bunch of compiler options that @code{f2c} doesn't. ! However, @code{f2c} offers a few that @code{g77} doesn't, like an ! option to generate code to check array subscripts at run time. ! It is expected that @code{g77} will offer some or all of these ! missing options at some time in the future. @node Compiler Speed @subsection Compiler Speed --- 9487,9600 ---- @node Language Extensions @subsection Language Extensions ! @code{g77} offers several extensions to FORTRAN 77 language that @code{f2c} ! doesn't: ! ! @itemize @bullet ! @item ! Automatic arrays ! ! @item ! @code{CYCLE} and @code{EXIT} ! ! @item ! Construct names ! ! @item ! @code{SELECT CASE} ! ! @item ! @code{KIND=} and @code{LEN=} notation ! ! @item ! Semicolon as statement separator ! ! @item ! Constant expressions in @code{FORMAT} statements ! (such as @samp{FORMAT(I)}, ! where @samp{J} is a @code{PARAMETER} named constant) ! ! @item ! @code{MvBits} intrinsic ! ! @item ! @code{libU77} (Unix-compatibility) library, ! with routines known to compiler as intrinsics ! (so they work even when compiler options are used ! to change the interfaces used by Fortran routines) ! @end itemize ! ! @code{g77} also implements iterative @code{DO} loops ! so that they work even in the presence of certain ``extreme'' inputs, ! unlike @code{f2c}. ! @xref{Loops}. ! ! However, @code{f2c} offers a few that @code{g77} doesn't, such as: ! ! @itemize @bullet ! @item ! Intrinsics in @code{PARAMETER} statements ! ! @item ! Array bounds expressions (such as @samp{REAL M(N(2))}) ! ! @item ! @code{AUTOMATIC} statement ! @end itemize It is expected that @code{g77} will offer some or all of these missing features at some time in the future. ! ! @node Diagnostic Abilities ! @subsection Diagnostic Abilities ! ! @code{g77} offers better diagnosis of problems in @code{FORMAT} statements. ! @code{f2c} doesn't, for example, emit any diagnostic for ! @samp{FORMAT(XZFAJG10324)}, ! leaving that to be diagnosed, at run time, by ! the @code{libf2c} run-time library. @node Compiler Options @subsection Compiler Options ! @code{g77} offers compiler options that @code{f2c} doesn't, ! most of which are designed to more easily accommodate ! legacy code: ! ! @itemize @bullet ! @item ! Two that control the automatic appending of extra ! underscores to external names ! ! @item ! One that allows dollar signs (@samp{$}) in symbol names ! ! @item ! A variety that control acceptance of various ! ``ugly'' constructs ! ! @item ! Several that specify acceptable use of upper and lower case ! in the source code ! ! @item ! Many that enable, disable, delete, or hide ! groups of intrinsics ! ! @item ! One to specify the length of fixed-form source lines ! (normally 72) ! ! @item ! One to specify the the source code is written in ! Fortran-90-style free-form ! @end itemize ! However, @code{f2c} offers a few that @code{g77} doesn't, ! like an option to have @code{REAL} default to @code{REAL*8}. ! It is expected that @code{g77} will offer all of the ! missing options pertinent to being a Fortran compiler ! at some time in the future. @node Compiler Speed @subsection Compiler Speed *************** Microsoft's rumored patent on the digits *** 9948,9955 **** @cindex BLOCK DATA statement @cindex statements, BLOCK DATA @cindex libraries, containing BLOCK DATA ! @cindex @code{f2c} compatibility ! @cindex compatibility, @code{f2c} To ensure that block data program units are linked, especially a concern when they are put into libraries, give each one a name (as in --- 9742,9749 ---- @cindex BLOCK DATA statement @cindex statements, BLOCK DATA @cindex libraries, containing BLOCK DATA ! @cindex f2c compatibility ! @cindex compatibility, f2c To ensure that block data program units are linked, especially a concern when they are put into libraries, give each one a name (as in *************** The meaning of a @code{DO} loop in Fortr *** 10049,10055 **** in the Fortran standard@dots{}and is quite different from what many programmers might expect. ! In particular, Fortran indexed @code{DO} loops are implemented as if the number of trips through the loop is calculated @emph{before} the loop is entered. --- 9843,9849 ---- in the Fortran standard@dots{}and is quite different from what many programmers might expect. ! In particular, Fortran iterative @code{DO} loops are implemented as if the number of trips through the loop is calculated @emph{before} the loop is entered. *************** tracking down bugs in such programs. *** 10233,10239 **** * Aliasing Assumed To Work:: * Output Assumed To Flush:: * Large File Unit Numbers:: ! * Floating point precision:: * Inconsistent Calling Sequences:: @end menu --- 10027,10033 ---- * Aliasing Assumed To Work:: * Output Assumed To Flush:: * Large File Unit Numbers:: ! * Floating-point precision:: * Inconsistent Calling Sequences:: @end menu *************** are given types and then evaluated. *** 10292,10298 **** @node Variables Assumed To Be Zero @subsection Variables Assumed To Be Zero @cindex zero-initialized variables ! @cindex variables assumed to be zero @cindex uninitialized variables Many Fortran programs were developed on systems that provided --- 10086,10092 ---- @node Variables Assumed To Be Zero @subsection Variables Assumed To Be Zero @cindex zero-initialized variables ! @cindex variables, assumed to be zero @cindex uninitialized variables Many Fortran programs were developed on systems that provided *************** options using @code{g77}. *** 10317,10323 **** @node Variables Assumed To Be Saved @subsection Variables Assumed To Be Saved ! @cindex variables retaining values across calls @cindex saved variables @cindex static variables --- 10111,10117 ---- @node Variables Assumed To Be Saved @subsection Variables Assumed To Be Saved ! @cindex variables, retaining values across calls @cindex saved variables @cindex static variables *************** it provides either form of detection are *** 10590,10596 **** For several versions prior to 0.5.20, @code{g77} configured its version of the @code{libf2c} run-time library so that one of ! its configuration macros, @samp{ALWAYS_FLUSH}, was defined. This was done as a result of a belief that many programs expected output to be flushed to the operating system (under UNIX, via --- 10384,10390 ---- For several versions prior to 0.5.20, @code{g77} configured its version of the @code{libf2c} run-time library so that one of ! its configuration macros, @code{ALWAYS_FLUSH}, was defined. This was done as a result of a belief that many programs expected output to be flushed to the operating system (under UNIX, via *************** non-flushing library routines.) *** 10615,10621 **** @xref{Always Flush Output}, for information on how to modify the @code{g77} source tree so that a version of @code{libg2c} ! can be built and installed with the @samp{ALWAYS_FLUSH} macro defined. @node Large File Unit Numbers @subsection Large File Unit Numbers --- 10409,10415 ---- @xref{Always Flush Output}, for information on how to modify the @code{g77} source tree so that a version of @code{libg2c} ! can be built and installed with the @code{ALWAYS_FLUSH} macro defined. @node Large File Unit Numbers @subsection Large File Unit Numbers *************** file unit number that is out of the rang *** 10634,10646 **** @code{libg2c}. Normally, this range is 0 through 99, and the high end of the range is controlled by a @code{libg2c} source-file ! macro named @samp{MXUNIT}. If you can easily change your program to use unit numbers in the range 0 through 99, you should do so. Otherwise, see @ref{Larger File Unit Numbers}, for information on how ! to change @samp{MXUNIT} in @code{libg2c} so you can build and install a new version of @code{libg2c} that supports the larger unit numbers you need. --- 10428,10440 ---- @code{libg2c}. Normally, this range is 0 through 99, and the high end of the range is controlled by a @code{libg2c} source-file ! macro named @code{MXUNIT}. If you can easily change your program to use unit numbers in the range 0 through 99, you should do so. Otherwise, see @ref{Larger File Unit Numbers}, for information on how ! to change @code{MXUNIT} in @code{libg2c} so you can build and install a new version of @code{libg2c} that supports the larger unit numbers you need. *************** open by a running program. *** 10652,10674 **** Information on how to increase these limits should be found in your system's documentation. ! @node Floating point precision ! @subsection Floating point precision ! @cindex IEEE 754 ! @cindex IEEE conformance ! @cindex conformance, IEEE ! @cindex floating point precision ! If your program depends on exact IEEE 754 floating point handling it may help on some systems---specifically x86 or m68k hardware---to use ! the @code{-ffloat-store} option or to reset the precision flag on the ! floating point unit @xref{Optimize Options}. However, it might be better simply to put the FPU into double precision ! mode and not take the performance hit of @code{-ffloat-store}. On x86 and m68k GNU systems you can do this with a technique similar to that ! for turning on floating point exceptions @xref{Floating-point Exception ! Handling}. The control word could be set to double precision by replacing the @code{__setfpucw} call with one like this: @smallexample __setfpucw ((_FPU_DEFAULT & ~_FPU_EXTENDED) | _FPU_DOUBLE); --- 10446,10471 ---- Information on how to increase these limits should be found in your system's documentation. ! @node Floating-point precision ! @subsection Floating-point precision ! @cindex IEEE 754 conformance ! @cindex conformance, IEEE 754 ! @cindex floating-point, precision ! @cindex ix86 floating-point ! @cindex x86 floating-point ! If your program depends on exact IEEE 754 floating-point handling it may help on some systems---specifically x86 or m68k hardware---to use ! the @samp{-ffloat-store} option or to reset the precision flag on the ! floating-point unit. ! @xref{Optimize Options}. However, it might be better simply to put the FPU into double precision ! mode and not take the performance hit of @samp{-ffloat-store}. On x86 and m68k GNU systems you can do this with a technique similar to that ! for turning on floating-point exceptions ! (@pxref{Floating-point Exception Handling}). ! The control word could be set to double precision by replacing the @code{__setfpucw} call with one like this: @smallexample __setfpucw ((_FPU_DEFAULT & ~_FPU_EXTENDED) | _FPU_DOUBLE); *************** replacing the @code{__setfpucw} call wit *** 10677,10710 **** maths library, but we have no evidence of it causing trouble.) Some targets (such as the Alpha) may need special options for full IEEE ! conformance @xref{Submodel Options,,Hardware Models and ! Configurations,gcc,Using and Porting GNU CC}. @node Inconsistent Calling Sequences @subsection Inconsistent Calling Sequences @pindex ftnchek ! @cindex floating point errors @cindex x86 FPU stack Code containing inconsistent calling sequences in the same file is ! normally rejected @xref{GLOBALS}. (Use, say, @code{ftnchek} to ensure ! consistency across source files ! @c makeinfo 1.68 objects to the nested parens ! @ifinfo ! @xref{f2c Skeletons and Prototypes}.) ! @end ifinfo ! @ifnotinfo @xref{f2c Skeletons and Prototypes,, ! {Generating Skeletons and Prototypes with @code{f2c}}}.) ! @end ifnotinfo Mysterious errors, which may appear to be code generation problems, can appear specifically on the x86 architecture with some such ! inconsistencies. On x86 hardware, floating point return values of ! functions are placed on the floating point unit's register stack, not the normal stack. Thus calling a @code{REAL} or @code{DOUBLE PRECISION} @code{FUNCTION} as some other sort of procedure, or vice versa, ! scrambles the floating point stack. This may break unrelated code executed later. Similarly if, say, external C routines are written incorrectly. --- 10474,10503 ---- maths library, but we have no evidence of it causing trouble.) Some targets (such as the Alpha) may need special options for full IEEE ! conformance. ! @xref{Submodel Options,,Hardware Models and Configurations,gcc,Using and Porting GNU CC}. @node Inconsistent Calling Sequences @subsection Inconsistent Calling Sequences @pindex ftnchek ! @cindex floating-point, errors ! @cindex ix86 FPU stack @cindex x86 FPU stack Code containing inconsistent calling sequences in the same file is ! normally rejected---see @ref{GLOBALS}. ! (Use, say, @code{ftnchek} to ensure ! consistency across source files. @xref{f2c Skeletons and Prototypes,, ! Generating Skeletons and Prototypes with @code{f2c}}.) Mysterious errors, which may appear to be code generation problems, can appear specifically on the x86 architecture with some such ! inconsistencies. On x86 hardware, floating-point return values of ! functions are placed on the floating-point unit's register stack, not the normal stack. Thus calling a @code{REAL} or @code{DOUBLE PRECISION} @code{FUNCTION} as some other sort of procedure, or vice versa, ! scrambles the floating-point stack. This may break unrelated code executed later. Similarly if, say, external C routines are written incorrectly. *************** Currently, @code{g77} supports only auto *** 10784,10798 **** @code{RECURSIVE} procedures or other means of explicitly specifying that variables or arrays are automatic. - @cindex -fugly option - @cindex options, -fugly - @item -fugly - Fix the source code so that @samp{-fno-ugly} will work. - Note that, for many programs, it is difficult to practically - avoid using the features enabled via @samp{-fugly-init}, and these - features pose the lowest risk of writing nonportable code, among the - various ``ugly'' features. - @cindex -f@var{group}-intrinsics-hide option @cindex options, -f@var{group}-intrinsics-hide @item -f@var{group}-intrinsics-hide --- 10577,10582 ---- *************** It is easy to find these using @samp{-f@ *** 10803,10809 **** @node Faster Programs @section Faster Programs ! @cindex speeding up programs @cindex programs, speeding up Aside from the usual @code{gcc} options, such as @samp{-O}, --- 10587,10593 ---- @node Faster Programs @section Faster Programs ! @cindex speed, of programs @cindex programs, speeding up Aside from the usual @code{gcc} options, such as @samp{-O}, *************** it working). *** 10820,10831 **** @node Aligned Data @subsection Aligned Data @cindex data, aligned @cindex stack, aligned @cindex aligned data @cindex aligned stack @cindex Pentium optimizations ! @cindex optimizations, Pentium On some systems, such as those with Pentium Pro CPUs, programs that make heavy use of @code{REAL(KIND=2)} (@code{DOUBLE PRECISION}) --- 10604,10616 ---- @node Aligned Data @subsection Aligned Data + @cindex alignment @cindex data, aligned @cindex stack, aligned @cindex aligned data @cindex aligned stack @cindex Pentium optimizations ! @cindex optimization, for Pentium On some systems, such as those with Pentium Pro CPUs, programs that make heavy use of @code{REAL(KIND=2)} (@code{DOUBLE PRECISION}) *************** There are a variety of approaches to use *** 10847,10854 **** @itemize @bullet @item ! @cindex COMMON, layout ! @cindex layout of common blocks Order your @code{COMMON} and @code{EQUIVALENCE} areas such that the variables and arrays with the widest alignment guidelines come first. --- 10632,10639 ---- @itemize @bullet @item ! @cindex @code{COMMON} layout ! @cindex layout of @code{COMMON} blocks Order your @code{COMMON} and @code{EQUIVALENCE} areas such that the variables and arrays with the widest alignment guidelines come first. *************** avoid having to carefully count the numb *** 10878,10884 **** occupied by each entity to determine whether the actual alignment of each subsequent entity meets the alignment guidelines for the type of that entity. ! If you don't ensure correct alignment of @code{COMMON} elements, the compiler may be forced by some systems to violate the Fortran semantics by adding padding to get @code{DOUBLE PRECISION} data properly aligned. --- 10663,10669 ---- occupied by each entity to determine whether the actual alignment of each subsequent entity meets the alignment guidelines for the type of that entity. ! If you don't ensure correct alignment of @code{COMMON} elements, the compiler may be forced by some systems to violate the Fortran semantics by adding padding to get @code{DOUBLE PRECISION} data properly aligned. *************** of the FORTRAN 77 standard, *** 10921,10932 **** or uses @code{EQUIVALENCE} or different layouts in ways that assume no padding is ever inserted by the compiler. - @emph{Note:} @samp{-malign-double} applies only to - statically-allocated data. - Double-precision data on the stack can still - cause problems due to misalignment. - @xref{Aligned Data}. - @item Ensure that @file{crt0.o} or @file{crt1.o} on your system guarantees a 64-bit --- 10706,10711 ---- *************** Progress is being made on making this wo *** 10943,10948 **** --- 10722,10734 ---- @code{gcc}, and some of the relevant operating systems (such as GNU/Linux). + @cindex alignment testing + @cindex testing alignment + A package that tests the degree to which a Fortran compiler + (such as @code{g77}) + aligns 64-bit floating-point variables and arrays + is available at @uref{ftp://alpha.gnu.org/gnu/g77/align/}. + @node Prefer Automatic Uninitialized Variables @subsection Prefer Automatic Uninitialized Variables *************** compiler, typically @code{gcc}.) *** 10988,11017 **** @node Use Submodel Options @subsection Use Submodel Options - @cindex Pentium optimizations - @cindex optimizations, Pentium - @cindex 586/686 CPUs @cindex submodels Using an appropriate @samp{-m} option to generate specific code for your CPU may be worthwhile, though it may mean the executable won't run on other versions of the CPU that don't support the same instruction set. @xref{Submodel Options,,Hardware Models and Configurations,gcc,Using and ! Porting GNU CC}. ! ! For recent CPUs that don't have explicit support in ! the released version of @code{gcc}, it may still be possible to get ! improvements. ! For instance, the flags recommended for 586/686 ! (Pentium(Pro)) chips for building the Linux kernel are: ! ! @smallexample ! -m486 -malign-loops=2 -malign-jumps=2 -malign-functions=2 ! -fomit-frame-pointer ! @end smallexample ! ! @noindent @samp{-fomit-frame-pointer} will, however, inhibit debugging ! on x86 systems. @node Trouble @chapter Known Causes of Trouble with GNU Fortran --- 10774,10798 ---- @node Use Submodel Options @subsection Use Submodel Options @cindex submodels Using an appropriate @samp{-m} option to generate specific code for your CPU may be worthwhile, though it may mean the executable won't run on other versions of the CPU that don't support the same instruction set. @xref{Submodel Options,,Hardware Models and Configurations,gcc,Using and ! Porting GNU CC}. For instance on an x86 system the compiler might have ! been built---as shown by @samp{g77 -v}---for the target ! @samp{i386-pc-linux-gnu}, i.e.@: an @samp{i386} CPU@. In that case to ! generate code best optimized for a Pentium you could use the option ! @samp{-march=pentium}. ! ! For recent CPUs that don't have explicit support in the released version ! of @code{gcc}, it @emph{might} still be possible to get improvements ! with certain @samp{-m} options. ! ! @samp{-fomit-frame-pointer} can help performance on x86 systems and ! others. It will, however, inhibit debugging on the systems on which it ! is not turned on anyway by @samp{-O}. @node Trouble @chapter Known Causes of Trouble with GNU Fortran *************** or installing @code{g77} is not provided *** 11033,11052 **** @xref{Problems Installing}. To find out about major bugs discovered in the current release and ! possible workarounds for them, retrieve @uref{ftp://alpha.gnu.org/g77.plan}. (Note that some of this portion of the manual is lifted directly from the @code{gcc} manual, with minor modifications to tailor it to users of @code{g77}. Anytime a bug seems to have more to do with the @code{gcc} ! portion of @code{g77}, ! @xref{Trouble,,Known Causes of Trouble with GNU CC, gcc,Using and Porting GNU CC}.) @menu * But-bugs:: Bugs really in other programs or elsewhere. ! * Actual Bugs:: Bugs and misfeatures we will fix later. * Missing Features:: Features we already know we want to add later. * Disappointments:: Regrettable things we can't change. * Non-bugs:: Things we think are right, but some others disagree. --- 10814,10833 ---- @xref{Problems Installing}. To find out about major bugs discovered in the current release and ! possible workarounds for them, see @uref{ftp://alpha.gnu.org/g77.plan}. (Note that some of this portion of the manual is lifted directly from the @code{gcc} manual, with minor modifications to tailor it to users of @code{g77}. Anytime a bug seems to have more to do with the @code{gcc} ! portion of @code{g77}, see ! @ref{Trouble,,Known Causes of Trouble with GNU CC, gcc,Using and Porting GNU CC}.) @menu * But-bugs:: Bugs really in other programs or elsewhere. ! * Known Bugs:: Bugs known to be in this version of @code{g77}. * Missing Features:: Features we already know we want to add later. * Disappointments:: Regrettable things we can't change. * Non-bugs:: Things we think are right, but some others disagree. *************** How to cope with such problems is well b *** 11140,11146 **** of this manual. However, users of Linux-based systems (such as GNU/Linux) ! should review @uref{http://www.bitwizard.nl/sig11}, a source of detailed information on diagnosing hardware problems, by recognizing their common symptoms. --- 10921,10927 ---- of this manual. However, users of Linux-based systems (such as GNU/Linux) ! should review @uref{http://www.bitwizard.nl/sig11/}, a source of detailed information on diagnosing hardware problems, by recognizing their common symptoms. *************** a reference to it in future versions of *** 11155,11162 **** @cindex unresolved reference (various) @cindex linking error for user code @cindex code, user ! @cindex ld error for user code ! @cindex ld can't find strange names On some systems, perhaps just those with out-of-date (shared?) libraries, unresolved-reference errors happen when linking @code{g77}-compiled programs (which should be done using @code{g77}). --- 10936,10943 ---- @cindex unresolved reference (various) @cindex linking error for user code @cindex code, user ! @cindex @code{ld}, error linking user code ! @cindex @code{ld}, can't find strange names On some systems, perhaps just those with out-of-date (shared?) libraries, unresolved-reference errors happen when linking @code{g77}-compiled programs (which should be done using @code{g77}). *************** systems where @samp{-lg2c -lm} is insuff *** 11172,11181 **** by @code{g77}. @cindex undefined reference (_main) ! @cindex linking error for user code ! @cindex ld error for user code @cindex code, user ! @cindex ld can't find _main If your program doesn't link due to unresolved references to names like @samp{_main}, make sure you're using the @code{g77} command to do the link, since this command ensures that the necessary libraries are --- 10953,10962 ---- by @code{g77}. @cindex undefined reference (_main) ! @cindex linking error, user code ! @cindex @code{ld}, error linking user code @cindex code, user ! @cindex @code{ld}, can't find @samp{_main} If your program doesn't link due to unresolved references to names like @samp{_main}, make sure you're using the @code{g77} command to do the link, since this command ensures that the necessary libraries are *************** command line, in case that helps. *** 11192,11199 **** @subsection Large Common Blocks @cindex common blocks, large @cindex large common blocks ! @cindex linker errors ! @cindex ld errors @cindex errors, linker On some older GNU/Linux systems, programs with common blocks larger than 16MB cannot be linked without some kind of error --- 10973,10980 ---- @subsection Large Common Blocks @cindex common blocks, large @cindex large common blocks ! @cindex linking, errors ! @cindex @code{ld}, errors @cindex errors, linker On some older GNU/Linux systems, programs with common blocks larger than 16MB cannot be linked without some kind of error *************** more recent versions of @code{binutils}, *** 11204,11210 **** @node Debugger Problems @subsection Debugger Problems ! @cindex @code{gdb} support @cindex support, @code{gdb} There are some known problems when using @code{gdb} on code compiled by @code{g77}. --- 10985,10991 ---- @node Debugger Problems @subsection Debugger Problems ! @cindex @code{gdb}, support @cindex support, @code{gdb} There are some known problems when using @code{gdb} on code compiled by @code{g77}. *************** not enough.) *** 11274,11280 **** @node Stack Overflow @subsection Stack Overflow ! @cindex stack overflow @cindex segmentation violation @code{g77} code might fail at runtime (probably with a ``segmentation violation'') due to overflowing the stack. --- 11055,11061 ---- @node Stack Overflow @subsection Stack Overflow ! @cindex stack, overflow @cindex segmentation violation @code{g77} code might fail at runtime (probably with a ``segmentation violation'') due to overflowing the stack. *************** simply too large for the system, or bugg *** 11326,11334 **** @node Nothing Happens @subsection Nothing Happens @cindex nothing happens ! @cindex naming programs @samp{test} ! @cindex @samp{test} programs ! @cindex programs named @samp{test} It is occasionally reported that a ``simple'' program, such as a ``Hello, World!'' program, does nothing when it is run, even though the compiler reported no errors, --- 11107,11115 ---- @node Nothing Happens @subsection Nothing Happens @cindex nothing happens ! @cindex naming programs ! @cindex @code{test} programs ! @cindex programs, @code{test} It is occasionally reported that a ``simple'' program, such as a ``Hello, World!'' program, does nothing when it is run, even though the compiler reported no errors, *************** despite the program containing nothing o *** 11336,11342 **** simple @code{PRINT} statement. This most often happens because the program has been ! compiled and linked on a UNIX system and named @samp{test}, though other names can lead to similarly unexpected run-time behavior on various systems. --- 11117,11123 ---- simple @code{PRINT} statement. This most often happens because the program has been ! compiled and linked on a UNIX system and named @code{test}, though other names can lead to similarly unexpected run-time behavior on various systems. *************** themselves as @emph{visible} problems so *** 11392,11397 **** --- 11173,11180 ---- Overflowing the bounds of an array---usually by writing beyond the end of it---is one of two kinds of bug that often occurs in Fortran code. + (Compile your code with the @samp{-fbounds-check} option + to catch many of these kinds of errors at program run time.) The other kind of bug is a mismatch between the actual arguments passed to a procedure and the dummy arguments as declared by that *************** That is, these bugs can be quite sensiti *** 11405,11422 **** data representing the placement of other data in memory (that is, pointers, such as the placement of stack frames in memory). ! Plans call for improving @code{g77} so that it can offer the ability to catch and report some of these problems at compile, link, or run time, such as by generating code to detect references to ! beyond the bounds of an array, or checking for agreement between ! calling and called procedures. In the meantime, finding and fixing the programming bugs that lead to these behaviors is, ultimately, the user's responsibility, as difficult as that task can sometimes be. ! @cindex ``infinite spaces'' printed ! @cindex spaces, endless printing of @cindex libc, non-ANSI or non-default @cindex C library @cindex linking against non-standard library --- 11188,11207 ---- data representing the placement of other data in memory (that is, pointers, such as the placement of stack frames in memory). ! @code{g77} now offers the ability to catch and report some of these problems at compile, link, or run time, such as by generating code to detect references to ! beyond the bounds of most arrays (except assumed-size arrays), ! and checking for agreement between calling and called procedures. ! Future improvements are likely to be made in the procedure-mismatch area, ! at least. In the meantime, finding and fixing the programming bugs that lead to these behaviors is, ultimately, the user's responsibility, as difficult as that task can sometimes be. ! @cindex infinite spaces printed ! @cindex space, endless printing of @cindex libc, non-ANSI or non-default @cindex C library @cindex linking against non-standard library *************** used by @code{g77}, handles only double- *** 11503,11509 **** Since @samp{0.2} in the program is a single-precision value, it is converted to double precision (still in binary notation) before being converted back to decimal. ! The conversion to binary appends _binary_ zero digits to the original value---which, again, is an inexact approximation of 0.2---resulting in an approximation that is much less exact than is connoted by the use of double precision. --- 11288,11294 ---- Since @samp{0.2} in the program is a single-precision value, it is converted to double precision (still in binary notation) before being converted back to decimal. ! The conversion to binary appends @emph{binary} zero digits to the original value---which, again, is an inexact approximation of 0.2---resulting in an approximation that is much less exact than is connoted by the use of double precision. *************** with that produced by some other Fortran *** 11548,11562 **** A useful source of information on floating-point computation is David Goldberg, `What Every Computer Scientist Should Know About Floating-Point Arithmetic', Computing Surveys, 23, March 1991, pp.@: ! 5--48. An online version is available at ! @uref{http://docs.sun.com}, and there is a supplemented version, in PostScript form, at @uref{http://www.validgh.com/goldberg/paper.ps}. Information related to the IEEE 754 floating-point standard by a leading light can be found at ! @uref{http://http.cs.berkeley.edu/%7Ewkahan/ieee754status}; see also slides from the short course referenced from @uref{http://http.cs.berkeley.edu/%7Efateman/}. @uref{http://www.linuxsupportline.com/%7Ebillm/} has a brief --- 11333,11347 ---- A useful source of information on floating-point computation is David Goldberg, `What Every Computer Scientist Should Know About Floating-Point Arithmetic', Computing Surveys, 23, March 1991, pp.@: ! 5-48. An online version is available at ! @uref{http://docs.sun.com/}, and there is a supplemented version, in PostScript form, at @uref{http://www.validgh.com/goldberg/paper.ps}. Information related to the IEEE 754 floating-point standard by a leading light can be found at ! @uref{http://http.cs.berkeley.edu/%7Ewkahan/ieee754status/}; see also slides from the short course referenced from @uref{http://http.cs.berkeley.edu/%7Efateman/}. @uref{http://www.linuxsupportline.com/%7Ebillm/} has a brief *************** as an option, or perhaps even as the def *** 11588,11594 **** The GNU C library provides routines for controlling the FPU, and other documentation about this. ! @xref{Floating point precision}, regarding IEEE 754 conformance. @include bugs.texi --- 11373,11379 ---- The GNU C library provides routines for controlling the FPU, and other documentation about this. ! @xref{Floating-point precision}, regarding IEEE 754 conformance. @include bugs.texi *************** GNU Fortran language: *** 11604,11609 **** --- 11389,11395 ---- * Better Source Model:: * Fortran 90 Support:: * Intrinsics in PARAMETER Statements:: + * Arbitrary Concatenation:: * SELECT CASE on CHARACTER Type:: * RECURSIVE Keyword:: * Popular Non-standard Types:: *************** GNU Fortran language: *** 11611,11616 **** --- 11397,11403 ---- * Array Bounds Expressions:: * POINTER Statements:: * Sensible Non-standard Constructs:: + * READONLY Keyword:: * FLUSH Statement:: * Expressions in FORMAT Statements:: * Explicit Assembler Code:: *************** GNU Fortran dialects: *** 11622,11630 **** --- 11409,11419 ---- * STRUCTURE UNION RECORD MAP:: * OPEN CLOSE and INQUIRE Keywords:: * ENCODE and DECODE:: + * AUTOMATIC Statement:: * Suppressing Space Padding:: * Fortran Preprocessor:: * Bit Operations on Floating-point Data:: + * Really Ugly Character Assignments:: New facilities: * POSIX Standard:: *************** New facilities: *** 11633,11640 **** --- 11422,11431 ---- * Large Automatic Arrays:: * Support for Threads:: * Increasing Precision/Range:: + * Enabling Debug Lines:: Better diagnostics: + * Better Warnings:: * Gracefully Handle Sensible Bad Code:: * Non-standard Conversions:: * Non-standard Intrinsics:: *************** Better diagnostics: *** 11650,11657 **** Run-time facilities: * Uninitialized Variables at Run Time:: - * Bounds Checking at Run Time:: * Portable Unformatted Files:: Debugging: * Labels Visible to Debugger:: --- 11441,11449 ---- Run-time facilities: * Uninitialized Variables at Run Time:: * Portable Unformatted Files:: + * Better List-directed I/O:: + * Default to Console I/O:: Debugging: * Labels Visible to Debugger:: *************** but one of the most frequent bugs encoun *** 11695,11705 **** accidentally writing fixed-form source code into and beyond column 73. So, maybe the users of old code would be able to more easily handle ! having to specify, say, a @code{-Wno-col73to80} option. @node Fortran 90 Support @subsection Fortran 90 Support ! @cindex Fortran 90 support @cindex support, Fortran 90 @code{g77} does not support many of the features that --- 11487,11497 ---- accidentally writing fixed-form source code into and beyond column 73. So, maybe the users of old code would be able to more easily handle ! having to specify, say, a @samp{-Wno-col73to80} option. @node Fortran 90 Support @subsection Fortran 90 Support ! @cindex Fortran 90, support @cindex support, Fortran 90 @code{g77} does not support many of the features that *************** But, if the @code{gcc} back end is enhan *** 11743,11748 **** --- 11535,11556 ---- such a facility, @code{g77} will likely use that facility in implementing this feature soon afterwards. + @node Arbitrary Concatenation + @subsection Arbitrary Concatenation + @cindex concatenation + @cindex CHARACTER*(*) + @cindex run-time, dynamic allocation + + @code{g77} doesn't support arbitrary operands for concatenation + in contexts where run-time allocation is required. + For example: + + @smallexample + SUBROUTINE X(A) + CHARACTER*(*) A + CALL FOO(A // 'suffix') + @end smallexample + @node SELECT CASE on CHARACTER Type @subsection @code{SELECT CASE} on @code{CHARACTER} Type *************** but the result is not pretty. *** 11767,11772 **** --- 11575,11581 ---- @node Increasing Precision/Range @subsection Increasing Precision/Range @cindex -r8 + @cindex -qrealsize=8 @cindex -i8 @cindex f2c @cindex increasing precision *************** but the result is not pretty. *** 11776,11782 **** @cindex Toolpack @cindex Netlib ! Some compilers, such as @code{f2c}, have an option (@samp{-r8} or similar) that provides automatic treatment of @code{REAL} entities such that they have twice the storage size, and a corresponding increase in the range and precision, of what --- 11585,11592 ---- @cindex Toolpack @cindex Netlib ! Some compilers, such as @code{f2c}, have an option (@samp{-r8}, ! @samp{-qrealsize=8} or similar) that provides automatic treatment of @code{REAL} entities such that they have twice the storage size, and a corresponding increase in the range and precision, of what *************** alleviate this problem). *** 11809,11816 **** @node Popular Non-standard Types @subsection Popular Non-standard Types ! @cindex INTEGER*2 support ! @cindex LOGICAL*1 support @code{g77} doesn't fully support @code{INTEGER*2}, @code{LOGICAL*1}, and similar. --- 11619,11628 ---- @node Popular Non-standard Types @subsection Popular Non-standard Types ! @cindex @code{INTEGER*2} support ! @cindex types, @code{INTEGER*2} ! @cindex @code{LOGICAL*1} support ! @cindex types, @code{LOGICAL*1} @code{g77} doesn't fully support @code{INTEGER*2}, @code{LOGICAL*1}, and similar. *************** for them. *** 11822,11828 **** @node Full Support for Compiler Types @subsection Full Support for Compiler Types ! @cindex REAL*16 support @code{g77} doesn't support @code{INTEGER}, @code{REAL}, and @code{COMPLEX} equivalents for @emph{all} applicable back-end-supported types (@code{char}, @code{short int}, @code{int}, @code{long int}, @code{long long int}, and @code{long double}). --- 11634,11643 ---- @node Full Support for Compiler Types @subsection Full Support for Compiler Types ! @cindex @code{REAL*16} support ! @cindex types, @code{REAL*16} ! @cindex @code{INTEGER*8} support ! @cindex types, @code{INTEGER*8} @code{g77} doesn't support @code{INTEGER}, @code{REAL}, and @code{COMPLEX} equivalents for @emph{all} applicable back-end-supported types (@code{char}, @code{short int}, @code{int}, @code{long int}, @code{long long int}, and @code{long double}). *************** This is scheduled for version 0.6. *** 11838,11845 **** @cindex array elements, in adjustable array bounds @cindex function references, in adjustable array bounds @cindex array bounds, adjustable ! @cindex DIMENSION statement ! @cindex statements, DIMENSION @code{g77} doesn't support more general expressions to dimension arrays, such as array element references, function --- 11653,11660 ---- @cindex array elements, in adjustable array bounds @cindex function references, in adjustable array bounds @cindex array bounds, adjustable ! @cindex @code{DIMENSION} statement ! @cindex statements, @code{DIMENSION} @code{g77} doesn't support more general expressions to dimension arrays, such as array element references, function *************** specification of an attribute), please s *** 11931,11936 **** --- 11746,11779 ---- bug report with an explanation, so we can consider fixing @code{g77} just for cases like yours. + @node READONLY Keyword + @subsection @code{READONLY} Keyword + @cindex READONLY + + Support for @code{READONLY}, in @code{OPEN} statements, + requires @code{libg2c} support, + to make sure that @samp{CLOSE(@dots{},STATUS='DELETE')} + does not delete a file opened on a unit + with the @code{READONLY} keyword, + and perhaps to trigger a fatal diagnostic + if a @code{WRITE} or @code{PRINT} + to such a unit is attempted. + + @emph{Note:} It is not sufficient for @code{g77} and @code{libg2c} + (its version of @code{libf2c}) + to assume that @code{READONLY} does not need some kind of explicit support + at run time, + due to UNIX systems not (generally) needing it. + @code{g77} is not just a UNIX-based compiler! + + Further, mounting of non-UNIX filesystems on UNIX systems + (such as via NFS) + might require proper @code{READONLY} support. + + @cindex SHARED + (Similar issues might be involved with supporting the @code{SHARED} + keyword.) + @node FLUSH Statement @subsection @code{FLUSH} Statement *************** require much more work on @code{libg2c}. *** 12073,12079 **** @cindex FORM='PRINT' @cindex ANS carriage control ! @cindex carraige control @pindex asa @pindex fpr @code{g77} doesn't support @code{FORM='PRINT'} or an equivalent to --- 11916,11922 ---- @cindex FORM='PRINT' @cindex ANS carriage control ! @cindex carriage control @pindex asa @pindex fpr @code{g77} doesn't support @code{FORM='PRINT'} or an equivalent to *************** with: *** 12148,12153 **** --- 11991,12034 ---- It is entirely possible that @code{ENCODE} and @code{DECODE} will be supported by a future version of @code{g77}. + @node AUTOMATIC Statement + @subsection @code{AUTOMATIC} Statement + @cindex @code{AUTOMATIC} statement + @cindex statements, @code{AUTOMATIC} + @cindex automatic variables + @cindex variables, automatic + + @code{g77} doesn't support the @code{AUTOMATIC} statement that + @code{f2c} does. + + @code{AUTOMATIC} would identify a variable or array + as not being @code{SAVE}'d, which is normally the default, + but which would be especially useful for code that, @emph{generally}, + needed to be compiled with the @samp{-fno-automatic} option. + + @code{AUTOMATIC} also would serve as a hint to the compiler that placing + the variable or array---even a very large array--on the stack is acceptable. + + @code{AUTOMATIC} would not, by itself, designate the containing procedure + as recursive. + + @code{AUTOMATIC} should work syntactically like @code{SAVE}, + in that @code{AUTOMATIC} with no variables listed should apply to + all pertinent variables and arrays + (which would not include common blocks or their members). + + Variables and arrays denoted as @code{AUTOMATIC} + would not be permitted to be initialized via @code{DATA} + or other specification of any initial values, + requiring explicit initialization, + such as via assignment statements. + + @cindex UNSAVE + @cindex STATIC + Perhaps @code{UNSAVE} and @code{STATIC}, + as strict semantic opposites to @code{SAVE} and @code{AUTOMATIC}, + should be provided as well. + @node Suppressing Space Padding @subsection Suppressing Space Padding of Source Lines *************** files included via the @code{INCLUDE} di *** 12194,12211 **** @node Bit Operations on Floating-point Data @subsection Bit Operations on Floating-point Data ! @cindex AND intrinsic ! @cindex intrinsics, AND ! @cindex OR intrinsic ! @cindex intrinsics, OR ! @cindex SHIFT intrinsic ! @cindex intrinsics, SHIFT @code{g77} does not allow @code{REAL} and other non-integral types for ! arguments to intrinsics like @code{AND}, @code{OR}, and @code{SHIFT}. For example, this program is rejected by @code{g77}, because ! the intrinsic @code{IAND} does not accept @code{REAL} arguments: @smallexample DATA A/7.54/, B/9.112/ --- 12075,12092 ---- @node Bit Operations on Floating-point Data @subsection Bit Operations on Floating-point Data ! @cindex @code{And} intrinsic ! @cindex intrinsics, @code{And} ! @cindex @code{Or} intrinsic ! @cindex intrinsics, @code{Or} ! @cindex @code{Shift} intrinsic ! @cindex intrinsics, @code{Shift} @code{g77} does not allow @code{REAL} and other non-integral types for ! arguments to intrinsics like @code{And}, @code{Or}, and @code{Shift}. For example, this program is rejected by @code{g77}, because ! the intrinsic @code{Iand} does not accept @code{REAL} arguments: @smallexample DATA A/7.54/, B/9.112/ *************** PRINT *, IAND(A, B) *** 12213,12218 **** --- 12094,12117 ---- END @end smallexample + @node Really Ugly Character Assignments + @subsection Really Ugly Character Assignments + + An option such as @samp{-fugly-char} should be provided + to allow + + @smallexample + REAL*8 A1 + DATA A1 / '12345678' / + @end smallexample + + and: + + @smallexample + REAL*8 A1 + A1 = 'ABCDEFGH' + @end smallexample + @node POSIX Standard @subsection @code{POSIX} Standard *************** END *** 12220,12227 **** @node Floating-point Exception Handling @subsection Floating-point Exception Handling ! @cindex floating point exceptions ! @cindex exceptions, floating point @cindex FPE handling @cindex NaN values --- 12119,12126 ---- @node Floating-point Exception Handling @subsection Floating-point Exception Handling ! @cindex floating-point, exceptions ! @cindex exceptions, floating-point @cindex FPE handling @cindex NaN values *************** A convenient trick is to compile this so *** 12254,12260 **** @smallexample gcc -o libtrapfpe.a trapfpe.c @end smallexample ! and then use it by adding @code{-trapfpe} to the @code{g77} command line when linking. @node Nonportable Conversions --- 12153,12159 ---- @smallexample gcc -o libtrapfpe.a trapfpe.c @end smallexample ! and then use it by adding @samp{-trapfpe} to the @code{g77} command line when linking. @node Nonportable Conversions *************** is type @code{REAL}), that other compile *** 12269,12275 **** quietly accept. Some of these conversions are accepted by @code{g77} ! when the @samp{-fugly} option is specified. Perhaps it should accept more or all of them. @node Large Automatic Arrays --- 12168,12174 ---- quietly accept. Some of these conversions are accepted by @code{g77} ! when the @samp{-fugly-logint} option is specified. Perhaps it should accept more or all of them. @node Large Automatic Arrays *************** are thread-safe, nor does @code{g77} hav *** 12293,12298 **** --- 12192,12264 ---- processors). A package such as PVM might help here. + @node Enabling Debug Lines + @subsection Enabling Debug Lines + @cindex debug line + @cindex comment line, debug + + An option such as @samp{-fdebug-lines} should be provided + to turn fixed-form lines beginning with @samp{D} + to be treated as if they began with a space, + instead of as if they began with a @samp{C} + (as comment lines). + + @node Better Warnings + @subsection Better Warnings + + Because of how @code{g77} generates code via the back end, + it doesn't always provide warnings the user wants. + Consider: + + @smallexample + PROGRAM X + PRINT *, A + END + @end smallexample + + Currently, the above is not flagged as a case of + using an uninitialized variable, + because @code{g77} generates a run-time library call that looks, + to the GBE, like it might actually @emph{modify} @samp{A} at run time. + (And, in fact, depending on the previous run-time library call, + it would!) + + Fixing this requires one of the following: + + @itemize @bullet + @item + Switch to new library, @code{libg77}, that provides + a more ``clean'' interface, + vis-a-vis input, output, and modified arguments, + so the GBE can tell what's going on. + + This would provide a pretty big performance improvement, + at least theoretically, and, ultimately, in practice, + for some types of code. + + @item + Have @code{g77} pass a pointer to a temporary + containing a copy of @samp{A}, + instead of to @samp{A} itself. + The GBE would then complain about the copy operation + involving a potentially uninitialized variable. + + This might also provide a performance boost for some code, + because @samp{A} might then end up living in a register, + which could help with inner loops. + + @item + Have @code{g77} use a GBE construct similar to @code{ADDR_EXPR} + but with extra information on the fact that the + item pointed to won't be modified + (a la @code{const} in C). + + Probably the best solution for now, but not quite trivial + to implement in the general case. + Worth considering after @code{g77} 0.6 is considered + pretty solid. + @end itemize + @node Gracefully Handle Sensible Bad Code @subsection Gracefully Handle Sensible Bad Code *************** some kinds of uninitialized variables at *** 12461,12475 **** Note that use of the options @samp{-O -Wuninitialized} can catch many such bugs at compile time. - @node Bounds Checking at Run Time - @subsection Bounds Checking at Run Time - - @code{g77} should offer run-time bounds-checking of array/subscript references - in a fashion similar to @code{f2c}. - - Note that @code{g77} already warns about references to out-of-bounds - elements of arrays when it detects these at compile time. - @node Portable Unformatted Files @subsection Portable Unformatted Files --- 12427,12432 ---- *************** A number giving the length of the record *** 12500,12505 **** --- 12457,12463 ---- @item the length of record contents again (for backspace). @end enumerate + The record length is of C type @code{long}; this means that it is 8 bytes on 64-bit systems such as Alpha GNU/Linux and 4 bytes on other systems, such as x86 GNU/Linux. *************** written. *** 12519,12525 **** Thus for exchanging a sequential or direct access unformatted file between big- and little-endian 32-bit systems using IEEE 754 floating point it would be sufficient to reverse the bytes in consecutive words ! in the file @emph{iff} only @code{REAL*4}, @code{COMPLEX}, @code{INTEGER*4} and/or @code{LOGICAL*4} data have been written to it by @code{g77}. --- 12477,12483 ---- Thus for exchanging a sequential or direct access unformatted file between big- and little-endian 32-bit systems using IEEE 754 floating point it would be sufficient to reverse the bytes in consecutive words ! in the file if, and @emph{only} if, only @code{REAL*4}, @code{COMPLEX}, @code{INTEGER*4} and/or @code{LOGICAL*4} data have been written to it by @code{g77}. *************** only incur overhead when they are read o *** 12540,12545 **** --- 12498,12546 ---- format.) A future @code{g77} runtime library should use such techniques. + @node Better List-directed I/O + @subsection Better List-directed I/O + + Values output using list-directed I/O + (@samp{PRINT *, R, D}) + should be written with a field width, precision, and so on + appropriate for the type (precision) of each value. + + (Currently, no distinction is made between single-precision + and double-precision values + by @code{libf2c}.) + + It is likely this item will require the @code{libg77} project + to be undertaken. + + In the meantime, use of formatted I/O is recommended. + While it might be of little consolation, + @code{g77} does support @samp{FORMAT(F.4)}, for example, + as long as @samp{WIDTH} is defined as a named constant + (via @code{PARAMETER}). + That at least allows some compile-time specification + of the precision of a data type, + perhaps controlled by preprocessing directives. + + @node Default to Console I/O + @subsection Default to Console I/O + + The default I/O units, + specified by @samp{READ @var{fmt}}, + @samp{READ (UNIT=*)}, + @samp{WRITE (UNIT=*)}, and + @samp{PRINT @var{fmt}}, + should not be units 5 (input) and 6 (output), + but, rather, unit numbers not normally available + for use in statements such as @code{OPEN} and @code{CLOSE}. + + Changing this would allow a program to connect units 5 and 6 + to files via @code{OPEN}, + but still use @samp{READ (UNIT=*)} and @samp{PRINT} + to do I/O to the ``console''. + + This change probably requires the @code{libg77} project. + @node Labels Visible to Debugger @subsection Labels Visible to Debugger *************** way around them for now. *** 12568,12574 **** @cindex external names @cindex common blocks @cindex name space ! @cindex underscores The current external-interface design, which includes naming of external procedures, COMMON blocks, and the library interface, --- 12569,12575 ---- @cindex external names @cindex common blocks @cindex name space ! @cindex underscore The current external-interface design, which includes naming of external procedures, COMMON blocks, and the library interface, *************** with popular existing compilers. *** 12588,12595 **** @cindex block data @cindex BLOCK DATA statement @cindex statements, BLOCK DATA ! @cindex COMMON statement ! @cindex statements, COMMON @cindex naming conflicts @code{g77} doesn't allow a common block and an external procedure or --- 12589,12596 ---- @cindex block data @cindex BLOCK DATA statement @cindex statements, BLOCK DATA ! @cindex @code{COMMON} statement ! @cindex statements, @code{COMMON} @cindex naming conflicts @code{g77} doesn't allow a common block and an external procedure or *************** we do not make because we think GNU Fort *** 12651,12658 **** @node Backslash in Constants @subsection Backslash in Constants @cindex backslash ! @cindex f77 support ! @cindex support, f77 In the opinion of many experienced Fortran users, @samp{-fno-backslash} should be the default, not @samp{-fbackslash}, --- 12652,12659 ---- @node Backslash in Constants @subsection Backslash in Constants @cindex backslash ! @cindex @code{f77} support ! @cindex support, @code{f77} In the opinion of many experienced Fortran users, @samp{-fno-backslash} should be the default, not @samp{-fbackslash}, *************** could be very helpful. *** 12944,12950 **** @cindex logical expressions, comparing Use of @code{.EQ.} and @code{.NE.} on @code{LOGICAL} operands ! is not supported, except via @samp{-fugly}, which is not recommended except for legacy code (where the behavior expected by the @emph{code} is assumed). --- 12945,12951 ---- @cindex logical expressions, comparing Use of @code{.EQ.} and @code{.NE.} on @code{LOGICAL} operands ! is not supported, except via @samp{-fugly-logint}, which is not recommended except for legacy code (where the behavior expected by the @emph{code} is assumed). *************** that were well-designed in the first pla *** 13002,13007 **** --- 13003,13022 ---- you, without knowing more context, whether the @samp{&} and @samp{-} operators are infix (binary) or unary!) + Most dangerous of all is the fact that, + even assuming consensus on its meaning, + an expression like @samp{L.AND.M.EQ.N}, + if it is the result of a typographical error, + doesn't @emph{look} like it has such a typo. + Even experienced Fortran programmers would not likely notice that + @samp{L.AND.M.EQV.N} was, in fact, intended. + + So, this is a prime example of a circumstance in which + a quality compiler diagnoses the code, + instead of leaving it up to someone debugging it + to know to turn on special compiler options + that might diagnose it. + @node Order of Side Effects @subsection Order of Side Effects @cindex side effects, order of evaluation *************** warnings. *** 13067,13073 **** Each kind has a different purpose: @itemize @w{} ! @item @emph{Errors} report problems that make it impossible to compile your program. GNU Fortran reports errors with the source file name, line --- 13082,13088 ---- Each kind has a different purpose: @itemize @w{} ! @item @emph{Errors} report problems that make it impossible to compile your program. GNU Fortran reports errors with the source file name, line *************** Bug reports are your contribution to the *** 13152,13158 **** 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. --- 13167,13173 ---- 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. *************** the bug in the current version of GNU Fo *** 13463,13485 **** @cindex programs, cpp @pindex cpp A complete input file that will reproduce the bug. ! If the bug is in the compiler proper (@file{f771}) and ! you are using the C preprocessor, run your ! source file through the C preprocessor by doing @samp{g77 -E ! @var{sourcefile} > @var{outfile}}, then include the contents of ! @var{outfile} in the bug report. (When you do this, use the same ! @samp{-I}, @samp{-D} or @samp{-U} options 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; and 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 ! frequently depend on every little detail of the function they happen in. @item @cindex included files --- 13478,13507 ---- @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 ! @samp{-I}, @samp{-D}, and @samp{-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 *************** when compiling most any kind of program. *** 13851,13863 **** which is used during the build of @code{gcc} to build a list of all options that are accepted by at least one language's compiler. ! This list goes into the @samp{lang_options} array in @file{gcc/toplev.c}, which uses this array to determine whether a particular option should be offered to the linked-in front end for processing ! by calling @samp{lang_option_decode}, which, for @code{g77}, is in @file{@value{path-g77}/com.c} and just ! calls @samp{ffe_decode_option}. If the linked-in front end ``rejects'' a particular option passed to it, @file{toplev.c} --- 13873,13885 ---- which is used during the build of @code{gcc} to build a list of all options that are accepted by at least one language's compiler. ! This list goes into the @code{lang_options} array in @file{gcc/toplev.c}, which uses this array to determine whether a particular option should be offered to the linked-in front end for processing ! by calling @code{lang_option_decode}, which, for @code{g77}, is in @file{@value{path-g77}/com.c} and just ! calls @code{ffe_decode_option}. If the linked-in front end ``rejects'' a particular option passed to it, @file{toplev.c} *************** language's compiler is willing to accept *** 13867,13873 **** This allows commands like @samp{gcc -fno-asm foo.c bar.f} to work, even though Fortran compilation does not currently support the @samp{-fno-asm} option; ! even though the @code{f771} version of @samp{lang_decode_option} rejects @samp{-fno-asm}, @file{toplev.c} doesn't produce a diagnostic because some other language (C) does accept it. --- 13889,13895 ---- This allows commands like @samp{gcc -fno-asm foo.c bar.f} to work, even though Fortran compilation does not currently support the @samp{-fno-asm} option; ! even though the @code{f771} version of @code{lang_decode_option} rejects @samp{-fno-asm}, @file{toplev.c} doesn't produce a diagnostic because some other language (C) does accept it. *************** a warning about this would be helpful if *** 13880,13886 **** possible. Code that processes Fortran options is found in ! @file{@value{path-g77}/top.c}, function @samp{ffe_decode_option}. This code needs to check positive and negative forms of each option. --- 13902,13908 ---- possible. Code that processes Fortran options is found in ! @file{@value{path-g77}/top.c}, function @code{ffe_decode_option}. This code needs to check positive and negative forms of each option. *************** Accessor macros for Fortran options, use *** 13900,13908 **** in the @code{g77} FFE, are defined in @file{@value{path-g77}/top.h}. @emph{Compiler options} are listed in @file{gcc/toplev.c} ! in the array @samp{f_options}. ! An option not listed in @samp{lang_options} is ! looked up in @samp{f_options} and handled from there. The defaults for compiler options are set in the global definitions for the corresponding variables, --- 13922,13930 ---- in the @code{g77} FFE, are defined in @file{@value{path-g77}/top.h}. @emph{Compiler options} are listed in @file{gcc/toplev.c} ! in the array @code{f_options}. ! An option not listed in @code{lang_options} is ! looked up in @code{f_options} and handled from there. The defaults for compiler options are set in the global definitions for the corresponding variables, *************** some of which are in @file{gcc/toplev.c} *** 13910,13920 **** You can set different defaults for @emph{Fortran-oriented} or @emph{Fortran-reticent} compiler options by changing ! the way @code{f771} handles the @samp{-fset-g77-defaults} option, which is always provided as the first option when called by @code{g77} or @code{gcc}. ! This code is in @samp{ffe_decode_options} in @file{@value{path-g77}/top.c}. Have it change just the variables that you want to default to a different setting for Fortran compiles compared to compiles of other languages. --- 13932,13956 ---- You can set different defaults for @emph{Fortran-oriented} or @emph{Fortran-reticent} compiler options by changing ! the source code of @code{g77} and rebuilding. ! How to do this depends on the version of @code{g77}: ! ! @table @code ! @item G77 0.5.24 (EGCS 1.1) ! @itemx G77 0.5.25 (EGCS 1.2) ! Change the @code{lang_init_options} routine in @file{egcs/gcc/f/com.c}. ! ! (Note that these versions of @code{g77} ! perform internal consistency checking automatically ! when the @samp{-fversion} option is specified.) ! ! @item G77 0.5.23 ! @itemx G77 0.5.24 (EGCS 1.0) ! Change the way @code{f771} handles the @samp{-fset-g77-defaults} option, which is always provided as the first option when called by @code{g77} or @code{gcc}. ! This code is in @code{ffe_decode_options} in @file{@value{path-g77}/top.c}. Have it change just the variables that you want to default to a different setting for Fortran compiles compared to compiles of other languages. *************** It is in @file{@value{path-g77}/lang-spe *** 13933,13938 **** --- 13969,13975 ---- even when the user has not explicitly specified them. Other ``internal'' options such as @samp{-quiet} also are passed via this mechanism. + @end table @node Projects @chapter Projects *************** them show up only given certain kinds of *** 13967,13973 **** @itemize @bullet @item ! Improve @samp{malloc} package and its uses to specify more info about memory pools and, where feasible, use obstacks to implement them. @item --- 14004,14010 ---- @itemize @bullet @item ! Improve @code{malloc} package and its uses to specify more info about memory pools and, where feasible, use obstacks to implement them. @item *************** unimplemented-statement catch-all. *** 13994,14004 **** @item Throughout @code{g77}, don't pass line/column pairs where ! a simple @samp{ffewhere} type, which points to the error as much as is ! desired by the configuration, will do, and don't pass @samp{ffelexToken} types ! where a simple @samp{ffewhere} type will do. Then, allow new default ! configuration of @samp{ffewhere} such that the source line text is not preserved, and leave it to things like Emacs' next-error function to point to them (now that @samp{next-error} supports column, or, perhaps, character-offset, numbers). --- 14031,14041 ---- @item Throughout @code{g77}, don't pass line/column pairs where ! a simple @code{ffewhere} type, which points to the error as much as is ! desired by the configuration, will do, and don't pass @code{ffelexToken} types ! where a simple @code{ffewhere} type will do. Then, allow new default ! configuration of @code{ffewhere} such that the source line text is not preserved, and leave it to things like Emacs' next-error function to point to them (now that @samp{next-error} supports column, or, perhaps, character-offset, numbers). *************** that are at all worth inlining. *** 14048,14054 **** @item When doing @samp{CHAR_VAR = CHAR_FUNC(@dots{})}, and it's clear that types line up ! and @samp{CHAR_VAR} is addressable or not a @samp{VAR_DECL}, make @samp{CHAR_VAR}, not a temporary, be the receiver for @samp{CHAR_FUNC}. (This is now done for @code{COMPLEX} variables.) --- 14085,14091 ---- @item When doing @samp{CHAR_VAR = CHAR_FUNC(@dots{})}, and it's clear that types line up ! and @samp{CHAR_VAR} is addressable or not a @code{VAR_DECL}, make @samp{CHAR_VAR}, not a temporary, be the receiver for @samp{CHAR_FUNC}. (This is now done for @code{COMPLEX} variables.) *************** external names for @code{COMPLEX} functi *** 14096,14102 **** @code{gcc} rather than @code{f2c} calling conventions.) @item ! Do something useful with @samp{doiter} references where possible. For example, @samp{CALL FOO(I)} cannot modify @samp{I} if within a @code{DO} loop that uses @samp{I} as the iteration variable, and the back end might find that info useful --- 14133,14139 ---- @code{gcc} rather than @code{f2c} calling conventions.) @item ! Do something useful with @code{doiter} references where possible. For example, @samp{CALL FOO(I)} cannot modify @samp{I} if within a @code{DO} loop that uses @samp{I} as the iteration variable, and the back end might find that info useful *************** sprinkled throughout. *** 14171,14182 **** It is not worth repeating them here. @item - @cindex concatenation - @cindex CHARACTER*(*) - Support arbitrary operands for concatenation, even in contexts where - run-time allocation is required. - - @item Consider adding a @code{NUMERIC} type to designate typeless numeric constants, named and unnamed. The idea is to provide a forward-looking, effective --- 14208,14213 ---- *************** provides it via its configuration. *** 14252,14258 **** @itemize @bullet @item ! Switch to using @samp{REAL_VALUE_TYPE} to represent floating-point constants exclusively so the target float format need not be required. This means changing the way @code{g77} handles initialization of aggregate areas --- 14283,14289 ---- @itemize @bullet @item ! Switch to using @code{REAL_VALUE_TYPE} to represent floating-point constants exclusively so the target float format need not be required. This means changing the way @code{g77} handles initialization of aggregate areas *************** Better info on how @code{g77} works and *** 14281,14286 **** --- 14312,14320 ---- Much of this should be done only after the redesign planned for 0.6 is complete. + @xref{Front End}, which contains some information + on @code{g77} internals. + @node Internals Improvements @section Internals Improvements *************** Come up with better naming conventions f *** 14305,14317 **** to achieve desired implementation dialect via @file{proj.h}. @item ! Clean up used tokens and @samp{ffewhere}s in @samp{ffeglobal_terminate_1}. @item ! Replace @file{sta.c} @samp{outpooldisp} mechanism with @samp{malloc_pool_use}. @item ! Check for @samp{opANY} in more places in @file{com.c}, @file{std.c}, and @file{ste.c}, and get rid of the @samp{opCONVERT(opANY)} kludge (after determining if there is indeed no real need for it). --- 14339,14351 ---- to achieve desired implementation dialect via @file{proj.h}. @item ! Clean up used tokens and @code{ffewhere}s in @code{ffeglobal_terminate_1}. @item ! Replace @file{sta.c} @code{outpooldisp} mechanism with @code{malloc_pool_use}. @item ! Check for @code{opANY} in more places in @file{com.c}, @file{std.c}, and @file{ste.c}, and get rid of the @samp{opCONVERT(opANY)} kludge (after determining if there is indeed no real need for it). *************** to the official standard, or put documen *** 14353,14374 **** in the code@dots{}uh@dots{}in the code. @item ! Some @samp{ffebld_new} calls (those outside of @file{ffeexpr.c} or ! inside but invoked via paths not involving @samp{ffeexpr_lhs} or ! @samp{ffeexpr_rhs}) might be creating things in improper pools, leading to such things staying around too long or (doubtful, but possible and dangerous) not long enough. @item ! Some @samp{ffebld_list_new} (or whatever) calls might not be matched by ! @samp{ffebld_list_bottom} (or whatever) calls, which might someday matter. (It definitely is not a problem just yet.) @item Probably not doing clean things when we fail to @code{EQUIVALENCE} something due to alignment/mismatch or other problems---they end up without ! @samp{ffestorag} objects, so maybe the backend (and other parts of the front ! end) can notice that and handle like an @samp{opANY} (do what it wants, just don't complain or crash). Most of this seems to have been addressed by now, but a code review wouldn't hurt. --- 14387,14408 ---- in the code@dots{}uh@dots{}in the code. @item ! Some @code{ffebld_new} calls (those outside of @file{ffeexpr.c} or ! inside but invoked via paths not involving @code{ffeexpr_lhs} or ! @code{ffeexpr_rhs}) might be creating things in improper pools, leading to such things staying around too long or (doubtful, but possible and dangerous) not long enough. @item ! Some @code{ffebld_list_new} (or whatever) calls might not be matched by ! @code{ffebld_list_bottom} (or whatever) calls, which might someday matter. (It definitely is not a problem just yet.) @item Probably not doing clean things when we fail to @code{EQUIVALENCE} something due to alignment/mismatch or other problems---they end up without ! @code{ffestorag} objects, so maybe the backend (and other parts of the front ! end) can notice that and handle like an @code{opANY} (do what it wants, just don't complain or crash). Most of this seems to have been addressed by now, but a code review wouldn't hurt. *************** clutter. *** 14386,14392 **** @item When @code{FUNCTION} and @code{ENTRY} point types disagree (@code{CHARACTER} lengths, type classes, and so on), ! @samp{ANY}-ize the offending @code{ENTRY} point and any @emph{new} dummies it specifies. @item --- 14420,14426 ---- @item When @code{FUNCTION} and @code{ENTRY} point types disagree (@code{CHARACTER} lengths, type classes, and so on), ! @code{ANY}-ize the offending @code{ENTRY} point and any @emph{new} dummies it specifies. @item *************** END *** 14407,14412 **** --- 14441,14449 ---- is processed in the context of executable, not specification, statements.) @end itemize + + @include ffe.texi + @end ifset @ifset USING *************** as the above is just a sample, no such s *** 14452,14458 **** * INTGLOB:: Intrinsic also used as name of global. * LEX:: Various lexer messages * GLOBALS:: Disagreements about globals. ! * LINKFAIL:: When linking @samp{f771} fails. @end menu @node CMPAMBIG --- 14489,14496 ---- * INTGLOB:: Intrinsic also used as name of global. * LEX:: Various lexer messages * GLOBALS:: Disagreements about globals. ! * LINKFAIL:: When linking @code{f771} fails. ! * Y2KBAD:: Use of non-Y2K-compliant intrinsic. @end menu @node CMPAMBIG *************** expects the Fortran 90 interpretation, y *** 14570,14577 **** @itemize @bullet @item Change it to @samp{DBLE(@var{expr})} (if @var{intrinsic} is ! @samp{REAL}) or @samp{DIMAG(@var{expr})} (if @var{intrinsic} ! is @samp{AIMAG}) if it expected the Fortran 90 interpretation. This assumes @var{expr} is @code{COMPLEX(KIND=2)}---if it is --- 14608,14615 ---- @itemize @bullet @item Change it to @samp{DBLE(@var{expr})} (if @var{intrinsic} is ! @code{REAL}) or @samp{DIMAG(@var{expr})} (if @var{intrinsic} ! is @code{AIMAG}) if it expected the Fortran 90 interpretation. This assumes @var{expr} is @code{COMPLEX(KIND=2)}---if it is *************** The following sample program might help: *** 14624,14630 **** PROGRAM JCB003 C C Written by James Craig Burley 1997-02-23. - C Contact via Internet email: burley@@gnu.org C C Determine how compilers handle non-standard REAL C and AIMAG on DOUBLE COMPLEX operands. --- 14662,14667 ---- *************** was not specified on the command line to *** 14800,14805 **** --- 14837,14844 ---- Free form is a newer form for Fortran code. The older, classic form is called fixed form. + @cindex continuation character + @cindex characters, continuation Fixed-form code is visually fairly distinctive, because numerical labels and comments are all that appear in the first five columns of a line, the sixth column is *************** and actual statements start at or beyond *** 14808,14815 **** --- 14847,14861 ---- Spaces generally are not significant, so if you see statements such as @samp{REALX,Y} and @samp{DO10I=1,100}, you are looking at fixed-form code. + @cindex * + @cindex asterisk Comment lines are indicated by the letter @samp{C} or the symbol @samp{*} in column 1. + @cindex trailing comment + @cindex comment + @cindex characters, comment + @cindex ! + @cindex exclamation point (Some code uses @samp{!} or @samp{/*} to begin in-line comments, which many compilers support.) *************** C On XYZZY systems, remove "C" on next l *** 14851,14863 **** CALL XYZZY_RESET @end smallexample ! However, that leaves the first @samp{C} in the @samp{CALL} statement in column 6, making it a comment line, which is not really what the author intended, and which is likely to result in one of the above-listed diagnostics. @emph{Replacing} the @samp{C} in column 1 with a space ! is the proper change to make, to ensure the @samp{CALL} keyword starts in or after column 7. Another common mistake like this is to forget that fixed-form --- 14897,14909 ---- CALL XYZZY_RESET @end smallexample ! However, that leaves the first @samp{C} in the @code{CALL} statement in column 6, making it a comment line, which is not really what the author intended, and which is likely to result in one of the above-listed diagnostics. @emph{Replacing} the @samp{C} in column 1 with a space ! is the proper change to make, to ensure the @code{CALL} keyword starts in or after column 7. Another common mistake like this is to forget that fixed-form *************** A source file containing lines beginning *** 14875,14886 **** @code{#include}, @code{#if}, and so on is likely one that requires preprocessing. ! If the file's suffix is @samp{.f} or @samp{.for}, the file ! will normally be compiled @emph{without} preprocessing by @code{g77}. ! Change the file's suffix from @samp{.f} to @samp{.F} (or, on ! systems with case-insensitive file names, to @samp{.fpp}) or ! from @samp{.for} to @samp{.fpp}. @code{g77} compiles files with such names @emph{with} preprocessing. --- 14921,14935 ---- @code{#include}, @code{#if}, and so on is likely one that requires preprocessing. ! If the file's suffix is @samp{.f}, @samp{.for}, or @samp{.FOR}, ! the file normally will be compiled @emph{without} preprocessing ! by @code{g77}. ! Change the file's suffix from @samp{.f} to @samp{.F} ! (or, on systems with case-insensitive file names, ! to @samp{.fpp} or @samp{.FPP}), ! from @samp{.for} to @samp{.fpp}, ! or from @samp{.FOR} to @samp{.FPP}. @code{g77} compiles files with such names @emph{with} preprocessing. *************** Argument #@var{n} of @var{name} is @dots *** 14924,14952 **** @end smallexample These messages all identify disagreements about the ! global procedure named @var{name} among different program ! units (usually including @var{name} itself). ! These disagreements, if not diagnosed, could result in a ! compiler crash if the compiler attempted to inline a reference ! to @var{name} within a calling program unit that disagreed ! with the @var{name} program unit regarding whether the ! procedure is a subroutine or function, the type of the ! return value of the procedure (if it is a function), the ! number of arguments the procedure accepts, or the type ! of each argument. ! ! Such disagreements @emph{should} be fixed in the Fortran ! code itself. ! However, if that is not immediately practical, and the code ! has been working for some time, it is possible it will work ! when compiled by @code{g77} with the @samp{-fno-globals} option. ! ! The @samp{-fno-globals} option disables these diagnostics, and ! also disables all inlining of references to global procedures ! to avoid compiler crashes. ! The diagnostics are actually produced, but as warnings, unless ! the @samp{-Wno-globals} option also is specified. After using @samp{-fno-globals} to work around these problems, it is wise to stop using that option and address them by fixing --- 14973,15026 ---- @end smallexample These messages all identify disagreements about the ! global procedure named @var{name} among different program units ! (usually including @var{name} itself). ! ! Whether a particular disagreement is reported ! as a warning or an error ! can depend on the relative order ! of the disagreeing portions of the source file. ! ! Disagreements between a procedure invocation ! and the @emph{subsequent} procedure itself ! are, usually, diagnosed as errors ! when the procedure itself @emph{precedes} the invocation. ! Other disagreements are diagnosed via warnings. ! @cindex forward references ! @cindex in-line code ! @cindex compilation, in-line ! This distinction, between warnings and errors, ! is due primarily to the present tendency of the @code{gcc} back end ! to inline only those procedure invocations that are ! @emph{preceded} by the corresponding procedure definitions. ! If the @code{gcc} back end is changed ! to inline ``forward references'', ! in which invocations precede definitions, ! the @code{g77} front end will be changed ! to treat both orderings as errors, accordingly. ! ! The sorts of disagreements that are diagnosed by @code{g77} include ! whether a procedure is a subroutine or function; ! if it is a function, the type of the return value of the procedure; ! the number of arguments the procedure accepts; ! and the type of each argument. ! ! Disagreements regarding global names among program units ! in a Fortran program @emph{should} be fixed in the code itself. ! However, if that is not immediately practical, ! and the code has been working for some time, ! it is possible it will work ! when compiled with the @samp{-fno-globals} option. ! ! The @samp{-fno-globals} option ! causes these diagnostics to all be warnings ! and disables all inlining of references to global procedures ! (to avoid subsequent compiler crashes and bad-code generation). ! Use of the @samp{-Wno-globals} option as well as @samp{-fno-globals} ! suppresses all of these diagnostics. ! (@samp{-Wno-globals} by itself disables only the warnings, ! not the errors.) After using @samp{-fno-globals} to work around these problems, it is wise to stop using that option and address them by fixing *************** might solve this problem, e.g.@: by addi *** 14988,14993 **** --- 15062,15085 ---- BOOT_CFLAGS='-mminimal-toc -O2 -g' @end smallexample to the @code{make bootstrap} command line. + + @node Y2KBAD + @section @code{Y2KBAD} + @cindex Y2K compliance + @cindex Year 2000 compliance + + @noindent + @smallexample + Intrinsic `@var{name}', invoked at (^), known to be non-Y2K-compliant@dots{} + @end smallexample + + This diagnostic indicates that + the specific intrinsic invoked by the name @var{name} + is known to have an interface + that is not Year-2000 (Y2K) compliant. + + @xref{Year 2000 (Y2K) Problems}. + @end ifset @node Index diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/g77install.texi gcc-2.95/gcc/f/g77install.texi *** egcs-1.1.2/gcc/f/g77install.texi Sat Aug 8 20:51:31 1998 --- gcc-2.95/gcc/f/g77install.texi Sat Jul 17 08:37:45 1999 *************** *** 1,14 **** ! @c Copyright (C) 1995-1997 Free Software Foundation, Inc. @c This is part of the G77 manual. @c For copying conditions, see the file g77.texi. @c The text of this file appears in the file INSTALL @c in the G77 distribution, as well as in the G77 manual. ! @c 1998-07-13 - @set version-g77 0.5.24 - @set version-gcc 2.8.1 @set version-autoconf 2.12 @set version-bison 1.25 @set version-gperf 2.5 --- 1,35 ---- ! @c Copyright (C) 1995-1999 Free Software Foundation, Inc. @c This is part of the G77 manual. @c For copying conditions, see the file g77.texi. @c The text of this file appears in the file INSTALL @c in the G77 distribution, as well as in the G77 manual. ! @c Keep this the same as the dates above, since it's used ! @c in the standalone derivations of this file (e.g. INSTALL). ! @set copyrights 1995-1999 ! ! @set last-update-install 1999-07-17 ! ! @include root.texi ! ! @ifset DOC-INSTALL ! @c The immediately following lines apply to the INSTALL file ! @c which is generated using this file. ! @emph{Note:} This file is automatically generated from the files ! @file{install0.texi} and @file{g77install.texi}. ! @file{INSTALL} is @emph{not} a source file, ! although it is normally included within source distributions. ! ! This file contains installation information for the GNU Fortran compiler. ! Copyright (C) @value{copyrights-install} Free Software Foundation, Inc. ! You may copy, distribute, and modify it freely as long as you preserve ! this copyright notice and permission notice. ! ! @node Top,,, (dir) ! @chapter Installing GNU Fortran ! @end ifset @set version-autoconf 2.12 @set version-bison 1.25 @set version-gperf 2.5 *************** *** 20,39 **** @set version-tar 1.12 @set version-texinfo 3.12 ! @ifclear INSTALLONLY @node Installation @chapter Installing GNU Fortran ! @end ifclear ! @cindex installing GNU Fortran The following information describes how to install @code{g77}. ! Note that, for @code{egcs} users, ! much of this information is obsolete, and is superceded by the ! @code{egcs} installation procedures. ! Such information is explicitly flagged as such. The information in this file generally pertains to dealing with @emph{source} distributions of @code{g77} and @code{gcc}. It is possible that some of this information will be applicable --- 41,73 ---- @set version-tar 1.12 @set version-texinfo 3.12 ! @ifset DOC-G77 @node Installation @chapter Installing GNU Fortran ! @cindex installing, GNU Fortran ! @end ifset The following information describes how to install @code{g77}. ! @clear OMIT-FSF-G77 ! ! @ifset EGCS-G77 ! @set OMIT-FSF-G77 ! @end ifset ! ! @ifset GCC-G77 ! @set OMIT-FSF-G77 ! @end ifset ! ! @ifset OMIT-FSF-G77 ! Note that, for users of the @value{which-g77} version of @code{g77}, ! much of the information is obsolete, and is superceded by the ! @value{which-gcc} installation procedures. ! Such information is accordingly omitted and flagged as such. ! @end ifset + @ifclear OMIT-FSF-G77 The information in this file generally pertains to dealing with @emph{source} distributions of @code{g77} and @code{gcc}. It is possible that some of this information will be applicable *************** whoever built and first distributed them *** 45,50 **** --- 79,103 ---- Nevertheless, efforts to make @code{g77} easier to both build and install from source and package up as a binary distribution are ongoing. + @end ifclear + + @ifset DEVELOPMENT + @emph{Warning:} The information below is still under development, + and might not accurately reflect the @code{g77} code base + of which it is a part. + Efforts are made to keep it somewhat up-to-date, + but they are particularly concentrated + on any version of this information + that is distributed as part of a @emph{released} @code{g77}. + + In particular, while this information is intended to apply to + the @value{which-g77} version of @code{g77}, + only an official @emph{release} of that version + is expected to contain documentation that is + most consistent with the @code{g77} product in that version. + @end ifset + + The following information was last updated on @value{last-update-install}: @menu * Prerequisites:: Make sure your system is ready for @code{g77}. *************** are ongoing. *** 59,68 **** @section Prerequisites @cindex prerequisites ! @emph{Version info:} ! For @code{egcs} users, the following information is ! superceded by the @code{egcs} installation instructions. The procedures described to unpack, configure, build, and install @code{g77} assume your system has certain programs already installed. --- 112,124 ---- @section Prerequisites @cindex prerequisites ! @ifset OMIT-FSF-G77 ! For users of the @value{which-g77} version of @code{g77}, ! this information is superceded by the ! @value{which-gcc} installation instructions. ! @end ifset + @ifclear OMIT-FSF-G77 The procedures described to unpack, configure, build, and install @code{g77} assume your system has certain programs already installed. *************** instead of the entire @file{.tar.gz} dis *** 338,343 **** --- 394,401 ---- to rebuild derived files, such as @code{makeinfo}). @end table + @end ifclear + @node Problems Installing @section Problems Installing @cindex problems installing *************** These problems can occur on most or all *** 366,374 **** * GNU C Required:: Why even ANSI C is not enough. * Patching GNU CC:: Why @code{gcc} needn't be patched. * Building GNU CC Necessary:: Why you can't build @emph{just} Fortran. ! * Missing strtoul or bsearch:: When linking @samp{f771} fails. * Cleanup Kills Stage Directories:: For @code{g77} developers. ! * LANGUAGES Macro Ignored:: Sometimes @samp{LANGUAGES} is ignored. @end menu @node GNU C Required --- 424,432 ---- * GNU C Required:: Why even ANSI C is not enough. * Patching GNU CC:: Why @code{gcc} needn't be patched. * Building GNU CC Necessary:: Why you can't build @emph{just} Fortran. ! * Missing strtoul or bsearch:: When linking @code{f771} fails. * Cleanup Kills Stage Directories:: For @code{g77} developers. ! * LANGUAGES Macro Ignored:: Sometimes @code{LANGUAGES} is ignored. @end menu @node GNU C Required *************** so there are no plans for an interim fix *** 385,391 **** This requirement does not mean you must already have @code{gcc} installed to build @code{g77}. As long as you have a working C compiler, you can use a ! bootstrap build to automate the process of first building @code{gcc} using the working C compiler you have, then building @code{g77} and rebuilding @code{gcc} using that just-built @code{gcc}, and so on. --- 443,449 ---- This requirement does not mean you must already have @code{gcc} installed to build @code{g77}. As long as you have a working C compiler, you can use a ! ``bootstrap'' build to automate the process of first building @code{gcc} using the working C compiler you have, then building @code{g77} and rebuilding @code{gcc} using that just-built @code{gcc}, and so on. *************** and @code{egcs} version 1.0. *** 403,409 **** @node Building GNU CC Necessary @subsubsection Building GNU CC Necessary ! @cindex gcc, building @cindex building gcc It should be possible to build the runtime without building @code{cc1} --- 461,467 ---- @node Building GNU CC Necessary @subsubsection Building GNU CC Necessary ! @cindex @code{gcc}, building @cindex building gcc It should be possible to build the runtime without building @code{cc1} *************** is not yet established. *** 420,441 **** @cindex undefined reference (_strtoul) @cindex f771, linking error for @cindex linking error for f771 ! @cindex ld error for f771 ! @cindex ld can't find _bsearch ! @cindex ld can't find _strtoul @cindex SunOS4 ! @emph{Version info:} ! The following information does not apply to the ! @code{egcs} version of @code{g77}. On SunOS4 systems, linking the @code{f771} program used to produce an error message concerning an undefined symbol named ! @samp{_strtoul}, because the @samp{strtoul} library function is not provided on that system. Other systems have, in the past, been reported to not provide ! their own @samp{strtoul} or @samp{bsearch} function. Some versions @code{g77} tried to default to providing bare-bones versions of @code{bsearch} and @code{strtoul} automatically, --- 478,501 ---- @cindex undefined reference (_strtoul) @cindex f771, linking error for @cindex linking error for f771 ! @cindex @code{ld}, error linking f771 ! @cindex @code{ld}, can't find _bsearch ! @cindex @code{ld}, can't find _strtoul @cindex SunOS4 ! @ifset OMIT-FSF-G77 ! This information does not apply to ! the @value{which-g77} version of @code{g77}, ! @end ifset + @ifclear OMIT-FSF-G77 On SunOS4 systems, linking the @code{f771} program used to produce an error message concerning an undefined symbol named ! @samp{_strtoul}, because the @code{strtoul} library function is not provided on that system. Other systems have, in the past, been reported to not provide ! their own @code{strtoul} or @code{bsearch} function. Some versions @code{g77} tried to default to providing bare-bones versions of @code{bsearch} and @code{strtoul} automatically, *************** but every attempt at this has failed for *** 443,457 **** To limit the failures to those few systems actually missing the required routines, the bare-bones versions are still provided, ! in @file{gcc/f/proj.c}, if the appropriate macros are defined. ! These are @code{NEED_BSEARCH} for @samp{bsearch} and ! @code{NEED_STRTOUL} for @samp{NEED_STRTOUL}. Therefore, if you are sure your system is missing @code{bsearch} or @code{strtoul} in its library, define the relevant macro(s) before building @code{g77}. ! This can be done by editing @file{gcc/f/proj.c} and inserting either or both of the following @samp{#define} statements before the comment shown: --- 503,517 ---- To limit the failures to those few systems actually missing the required routines, the bare-bones versions are still provided, ! in @file{@value{path-g77}/proj.c}, if the appropriate macros are defined. ! These are @code{NEED_BSEARCH} for @code{bsearch} and ! @code{NEED_STRTOUL} for @code{NEED_STRTOUL}. Therefore, if you are sure your system is missing @code{bsearch} or @code{strtoul} in its library, define the relevant macro(s) before building @code{g77}. ! This can be done by editing @file{@value{path-g77}/proj.c} and inserting either or both of the following @samp{#define} statements before the comment shown: *************** To build with the bundled @code{cc} on S *** 470,484 **** make bootstrap BOOT_CFLAGS='-O2 -g -DNEED_STRTOUL' @end smallexample ! If you then encounter problems compiling @file{gcc/f/proj.c}, ! it might be due to a discrepancy between how @samp{bsearch} ! or @samp{strtoul} are defined by that file and how they're declared by your system's header files. In that case, you'll have to use some basic knowledge of C ! to work around the problem, perhaps by editing @file{gcc/f/proj.c} somewhat. @node Cleanup Kills Stage Directories @subsubsection Cleanup Kills Stage Directories @cindex stage directories --- 530,546 ---- make bootstrap BOOT_CFLAGS='-O2 -g -DNEED_STRTOUL' @end smallexample ! If you then encounter problems compiling @file{@value{path-g77}/proj.c}, ! it might be due to a discrepancy between how @code{bsearch} ! or @code{strtoul} are defined by that file and how they're declared by your system's header files. In that case, you'll have to use some basic knowledge of C ! to work around the problem, perhaps by editing @file{@value{path-g77}/proj.c} somewhat. + @end ifclear + @node Cleanup Kills Stage Directories @subsubsection Cleanup Kills Stage Directories @cindex stage directories *************** that, on demand. *** 498,511 **** @node LANGUAGES Macro Ignored @subsubsection LANGUAGES Macro Ignored ! @cindex @samp{LANGUAGES} macro ignored ! @cindex ignoring @samp{LANGUAGES} macro Prior to version 0.5.23 of @code{g77} and version 1.1 of @code{egcs}, @code{g77} would sometimes ignore ! the absence of @samp{f77} and @samp{F77} in the ! @samp{LANGUAGES} macro definition used for the @code{make} command being processed. As of @code{g77} version 0.5.23 --- 560,573 ---- @node LANGUAGES Macro Ignored @subsubsection LANGUAGES Macro Ignored ! @cindex @code{LANGUAGES} macro ignored ! @cindex ignoring @code{LANGUAGES} macro Prior to version 0.5.23 of @code{g77} and version 1.1 of @code{egcs}, @code{g77} would sometimes ignore ! the absence of @code{f77} and @code{F77} in the ! @code{LANGUAGES} macro definition used for the @code{make} command being processed. As of @code{g77} version 0.5.23 *************** such as @code{g++}, *** 519,525 **** are known to go ahead and perform various language-specific activities when their respective language strings do not appear ! in the @samp{LANGUAGES} macro in effect during that invocation of @code{make}. It is expected that these remaining problems will --- 581,587 ---- are known to go ahead and perform various language-specific activities when their respective language strings do not appear ! in the @code{LANGUAGES} macro in effect during that invocation of @code{make}. It is expected that these remaining problems will *************** be fixed in a future version of @code{gc *** 532,538 **** --- 594,602 ---- A linker bug on some versions of AIX 4.1 might prevent building when @code{g77} is built within @code{gcc}. It might also occur when building within @code{egcs}. + @ifset DOC-G77 @xref{LINKFAIL}. + @end ifset @node Cross-compiler Problems @subsection Cross-compiler Problems *************** system, depending on the systems involve *** 597,603 **** @section Changing Settings Before Building Here are some internal @code{g77} settings that can be changed ! by editing source files in @file{gcc/f/} before building. This information, and perhaps even these settings, represent stop-gap solutions to problems people doing various ports --- 661,667 ---- @section Changing Settings Before Building Here are some internal @code{g77} settings that can be changed ! by editing source files in @file{@value{path-g77}/} before building. This information, and perhaps even these settings, represent stop-gap solutions to problems people doing various ports *************** As such, none of the following informati *** 606,612 **** be pertinent in future versions of @code{g77}. @menu ! * Larger File Unit Numbers:: Raising @samp{MXUNIT}. * Always Flush Output:: Synchronizing write errors. * Maximum Stackable Size:: Large arrays forced off the stack. * Floating-point Bit Patterns:: Possible programs building @code{g77} --- 670,676 ---- be pertinent in future versions of @code{g77}. @menu ! * Larger File Unit Numbers:: Raising @code{MXUNIT}. * Always Flush Output:: Synchronizing write errors. * Maximum Stackable Size:: Large arrays forced off the stack. * Floating-point Bit Patterns:: Possible programs building @code{g77} *************** a run-time crash in @code{libf2c}, becau *** 634,655 **** If you know that Fortran programs at your installation require the use of unit numbers higher than 99, you can change the ! value of the @samp{MXUNIT} macro, which represents the maximum unit number, to an appropriately higher value. ! To do this, edit the file @file{f/runtime/libI77/fio.h} in your @code{g77} source tree, changing the following line: @example #define MXUNIT 100 @end example ! Change the line so that the value of @samp{MXUNIT} is defined to be at least one @emph{greater} than the maximum unit number used by the Fortran programs on your system. (For example, a program that does @samp{WRITE (UNIT=255)} would require ! @samp{MXUNIT} set to at least 256 to avoid crashing.) Then build or rebuild @code{g77} as appropriate. --- 698,719 ---- If you know that Fortran programs at your installation require the use of unit numbers higher than 99, you can change the ! value of the @code{MXUNIT} macro, which represents the maximum unit number, to an appropriately higher value. ! To do this, edit the file @file{@value{path-libf2c}/libI77/fio.h} in your @code{g77} source tree, changing the following line: @example #define MXUNIT 100 @end example ! Change the line so that the value of @code{MXUNIT} is defined to be at least one @emph{greater} than the maximum unit number used by the Fortran programs on your system. (For example, a program that does @samp{WRITE (UNIT=255)} would require ! @code{MXUNIT} set to at least 256 to avoid crashing.) Then build or rebuild @code{g77} as appropriate. *************** asynchronous, or, more precisely, buffer *** 690,696 **** (detection of errors might be delayed). @code{libg2c} supports flagging write errors immediately when ! it is built with the @samp{ALWAYS_FLUSH} macro defined. This results in a @code{libg2c} that runs slower, sometimes quite a bit slower, under certain circumstances---for example, accessing files via the networked file system NFS---but the --- 754,760 ---- (detection of errors might be delayed). @code{libg2c} supports flagging write errors immediately when ! it is built with the @code{ALWAYS_FLUSH} macro defined. This results in a @code{libg2c} that runs slower, sometimes quite a bit slower, under certain circumstances---for example, accessing files via the networked file system NFS---but the *************** If you know that Fortran programs requir *** 700,709 **** of error reporting are to be compiled using the version of @code{g77} you are building, you might wish to modify the @code{g77} source tree so that the version of ! @code{libg2c} is built with the @samp{ALWAYS_FLUSH} macro defined, enabling this behavior. ! To do this, find this line in @file{f/runtime/f2c.h} in your @code{g77} source tree: @example --- 764,773 ---- of error reporting are to be compiled using the version of @code{g77} you are building, you might wish to modify the @code{g77} source tree so that the version of ! @code{libg2c} is built with the @code{ALWAYS_FLUSH} macro defined, enabling this behavior. ! To do this, find this line in @file{@value{path-libf2c}/f2c.h} in your @code{g77} source tree: @example *************** Then build or rebuild @code{g77} as appr *** 721,731 **** @vindex FFECOM_sizeMAXSTACKITEM @cindex code, stack variables @cindex maximum stackable size ! @cindex stack allocation @cindex segmentation violation @code{g77}, on most machines, puts many variables and arrays on the stack where possible, and can be configured (by changing ! @samp{FFECOM_sizeMAXSTACKITEM} in @file{gcc/f/com.c}) to force smaller-sized entities into static storage (saving on stack space) or permit larger-sized entities to be put on the stack (which can improve run-time performance, as it presents --- 785,795 ---- @vindex FFECOM_sizeMAXSTACKITEM @cindex code, stack variables @cindex maximum stackable size ! @cindex stack, allocation @cindex segmentation violation @code{g77}, on most machines, puts many variables and arrays on the stack where possible, and can be configured (by changing ! @code{FFECOM_sizeMAXSTACKITEM} in @file{@value{path-g77}/com.c}) to force smaller-sized entities into static storage (saving on stack space) or permit larger-sized entities to be put on the stack (which can improve run-time performance, as it presents *************** more opportunities for the GBE to optimi *** 733,739 **** @emph{Note:} Putting more variables and arrays on the stack might cause problems due to system-dependent limits on stack size. ! Also, the value of @samp{FFECOM_sizeMAXSTACKITEM} has no effect on automatic variables and arrays. @xref{But-bugs}, for more information. --- 797,803 ---- @emph{Note:} Putting more variables and arrays on the stack might cause problems due to system-dependent limits on stack size. ! Also, the value of @code{FFECOM_sizeMAXSTACKITEM} has no effect on automatic variables and arrays. @xref{But-bugs}, for more information. *************** something like @samp{EQUIVALENCE (I,R)} *** 758,764 **** @node Large Initialization @subsection Initialization of Large Aggregate Areas ! @cindex speed, compiler @cindex slow compiler @cindex memory utilization @cindex large initialization --- 822,828 ---- @node Large Initialization @subsection Initialization of Large Aggregate Areas ! @cindex speed, of compiler @cindex slow compiler @cindex memory utilization @cindex large initialization *************** a factor of 10. *** 773,780 **** This size currently is quite small, since @code{g77} currently has a known bug requiring too much memory and time to handle such cases. ! In @file{gcc/f/data.c}, the macro ! @samp{FFEDATA_sizeTOO_BIG_INIT_} is defined to the minimum size for the warning to appear. The size is specified in storage units, which can be bytes, words, or whatever, on a case-by-case basis. --- 837,844 ---- This size currently is quite small, since @code{g77} currently has a known bug requiring too much memory and time to handle such cases. ! In @file{@value{path-g77}/data.c}, the macro ! @code{FFEDATA_sizeTOO_BIG_INIT_} is defined to the minimum size for the warning to appear. The size is specified in storage units, which can be bytes, words, or whatever, on a case-by-case basis. *************** systems. *** 827,836 **** @section Quick Start @cindex quick start ! @emph{Version info:} ! For @code{egcs} users, the following information is ! superceded by the @code{egcs} installation instructions. This procedure configures, builds, and installs @code{g77} ``out of the box'' and works on most UNIX systems. Each command is identified by a unique number, --- 891,903 ---- @section Quick Start @cindex quick start ! @ifset OMIT-FSF-G77 ! For users of the @value{which-g77} version of @code{g77}, ! this information is superceded by the ! @value{which-gcc} installation instructions. ! @end ifset + @ifclear OMIT-FSF-G77 This procedure configures, builds, and installs @code{g77} ``out of the box'' and works on most UNIX systems. Each command is identified by a unique number, *************** around anymore. *** 1108,1120 **** Removing them can free up a lot of disk space. @end table @node Complete Installation @section Complete Installation ! @emph{Version info:} ! For @code{egcs} users, the following information is ! mostly superceded by the @code{egcs} installation instructions. Here is the complete @code{g77}-specific information on how to configure, build, and install @code{g77}. --- 1175,1192 ---- Removing them can free up a lot of disk space. @end table + @end ifclear + @node Complete Installation @section Complete Installation ! @ifset OMIT-FSF-G77 ! For users of the @value{which-g77} version of @code{g77}, ! this information is superceded by the ! @value{which-gcc} installation instructions. ! @end ifset + @ifclear OMIT-FSF-G77 Here is the complete @code{g77}-specific information on how to configure, build, and install @code{g77}. *************** tree for the first time. *** 1209,1215 **** @cindex modifying @code{g77} @cindex code, modifying @cindex Pentium optimizations ! @cindex optimizations, Pentium @emph{Note:} Please use @strong{only} @code{gcc} and @code{g77} source trees as distributed by the FSF. Use of modified versions is likely to result in problems that appear to be --- 1281,1287 ---- @cindex modifying @code{g77} @cindex code, modifying @cindex Pentium optimizations ! @cindex optimization, for Pentium @emph{Note:} Please use @strong{only} @code{gcc} and @code{g77} source trees as distributed by the FSF. Use of modified versions is likely to result in problems that appear to be *************** and @code{gcc} can coexist as they do in *** 1223,1238 **** @node Merging Distributions @subsection Merging Distributions @cindex merging distributions ! @cindex @code{gcc} versions supported by @code{g77} ! @cindex versions of @code{gcc} ! @cindex support for @code{gcc} versions After merging the @code{g77} source tree into the @code{gcc} source tree, you have put together a complete @code{g77} source tree. ! @cindex gcc version numbering ! @cindex version numbering ! @cindex g77 version number @cindex GNU version numbering As of version 0.5.23, @code{g77} no longer modifies the version number of @code{gcc}, --- 1295,1310 ---- @node Merging Distributions @subsection Merging Distributions @cindex merging distributions ! @cindex @code{gcc}, versions supported by @code{g77} ! @cindex versions, of @code{gcc} ! @cindex support, @code{gcc} versions After merging the @code{g77} source tree into the @code{gcc} source tree, you have put together a complete @code{g77} source tree. ! @cindex @code{gcc}, version number ! @cindex version number ! @cindex @code{g77}, version number @cindex GNU version numbering As of version 0.5.23, @code{g77} no longer modifies the version number of @code{gcc}, *************** the directories they create.) *** 1266,1272 **** If your version of @code{gcc} is older than the oldest version supported by @code{g77} ! (as casually determined by listing the contents of @file{gcc/f/INSTALL/}, which contains these installation instructions in plain-text format), you should obtain a newer, supported version of @code{gcc}. (You could instead obtain an older version of @code{g77}, --- 1338,1344 ---- If your version of @code{gcc} is older than the oldest version supported by @code{g77} ! (as casually determined by listing the contents of @file{@value{path-g77}/INSTALL/}, which contains these installation instructions in plain-text format), you should obtain a newer, supported version of @code{gcc}. (You could instead obtain an older version of @code{g77}, *************** it is likely that @file{gcc-2.8.2} would *** 1291,1299 **** However, @file{gcc-2.9.0} would almost certainly not work with that version of @code{g77} without appropriate modifications, ! so a new version of @code{g77} would be needed (and you should ! wait for it rather than bothering the maintainers---@pxref{Changes,, ! User-Visible Changes}). @cindex distributions, why separate @cindex separate distributions --- 1363,1369 ---- However, @file{gcc-2.9.0} would almost certainly not work with that version of @code{g77} without appropriate modifications, ! so a new version of @code{g77} would be needed. @cindex distributions, why separate @cindex separate distributions *************** and such changes require corresponding c *** 1310,1316 **** the @code{g77} front end (FFE). @c @pindex config-lang.in ! @c @emph{Note:} @code{g77}'s configuration file @file{gcc/f/config-lang.in} @c sometimes ensures that the source code for the version of @code{gcc} @c being configured has at least one indication of being an appropriate @c version as required specifically by @code{g77}. --- 1380,1386 ---- the @code{g77} front end (FFE). @c @pindex config-lang.in ! @c @emph{Note:} @code{g77}'s configuration file @file{@value{path-g77}/config-lang.in} @c sometimes ensures that the source code for the version of @code{gcc} @c being configured has at least one indication of being an appropriate @c version as required specifically by @code{g77}. *************** the @code{g77} front end (FFE). *** 1325,1331 **** @node Where to Install @subsection Where in the World Does Fortran (and GNU CC) Go? @cindex language f77 not recognized ! @cindex gcc will not compile Fortran programs Before configuring, you should make sure you know where you want the @code{g77} and @code{gcc} --- 1395,1401 ---- @node Where to Install @subsection Where in the World Does Fortran (and GNU CC) Go? @cindex language f77 not recognized ! @cindex @code{gcc}, will not compile Fortran programs Before configuring, you should make sure you know where you want the @code{g77} and @code{gcc} *************** issuing an explanatory diagnostic. *** 1470,1485 **** @cindex building @code{gcc} @cindex building @code{g77} ! @vindex LANGUAGES Building @code{g77} requires building enough of @code{gcc} that these instructions assume you're going to build all of @code{gcc}, including @code{g++}, @code{protoize}, and so on. You can save a little time and disk space by changes the ! @samp{LANGUAGES} macro definition in @code{gcc/Makefile.in} or @code{gcc/Makefile}, but if you do that, you're on your own. One change is almost @emph{certainly} going to cause failures: ! removing @samp{c} or @samp{f77} from the definition of the ! @samp{LANGUAGES} macro. After configuring @code{gcc}, which configures @code{g77} and @code{libg2c} automatically, you're ready to start the actual --- 1540,1555 ---- @cindex building @code{gcc} @cindex building @code{g77} ! @cindex @code{LANGUAGES} macro Building @code{g77} requires building enough of @code{gcc} that these instructions assume you're going to build all of @code{gcc}, including @code{g++}, @code{protoize}, and so on. You can save a little time and disk space by changes the ! @code{LANGUAGES} macro definition in @code{gcc/Makefile.in} or @code{gcc/Makefile}, but if you do that, you're on your own. One change is almost @emph{certainly} going to cause failures: ! removing @code{c} or @code{f77} from the definition of the ! @code{LANGUAGES} macro. After configuring @code{gcc}, which configures @code{g77} and @code{libg2c} automatically, you're ready to start the actual *************** To save some disk space during installat *** 1557,1563 **** is built, you can type @samp{rm -fr stage1} to remove the binaries built during Stage 1. ! Also, @xref{Installation,,Installing GNU CC,gcc,Using and Porting GNU CC}, for important information on building @code{gcc} that is not described in this @code{g77} manual. For example, explanations of diagnostic messages --- 1627,1633 ---- is built, you can type @samp{rm -fr stage1} to remove the binaries built during Stage 1. ! Also, see @ref{Installation,,Installing GNU CC,gcc,Using and Porting GNU CC}, for important information on building @code{gcc} that is not described in this @code{g77} manual. For example, explanations of diagnostic messages *************** make -k CC=gcc install *** 1718,1724 **** As described in @ref{Installation,,Installing GNU CC, gcc,Using and Porting GNU CC}, the values for ! the @samp{CC} and @samp{LANGUAGES} macros should be the same as those you supplied for the build itself. --- 1788,1794 ---- As described in @ref{Installation,,Installing GNU CC, gcc,Using and Porting GNU CC}, the values for ! the @code{CC} and @code{LANGUAGES} macros should be the same as those you supplied for the build itself. *************** make -k @dots{} install install-libf77 *** 1738,1744 **** We don't know why some non-GNU versions of @code{make} sometimes require this alternate command, but they do. ! (Remember to supply the appropriate definition for @samp{CC} where you see @samp{@dots{}} in the above command.) Note that using the @samp{-k} option tells @code{make} to --- 1808,1814 ---- We don't know why some non-GNU versions of @code{make} sometimes require this alternate command, but they do. ! (Remember to supply the appropriate definition for @code{CC} where you see @samp{@dots{}} in the above command.) Note that using the @samp{-k} option tells @code{make} to *************** information for the derived files to wor *** 1872,1881 **** problem of not having the appropriate tools installed. On UNIX systems, the simplest way to update the date-time-modified ! information of a file is to use the use the @samp{touch} command. ! How to use @samp{touch} to update the derived files updated by each of the tools is described below. @emph{Note:} New versions of @code{g77} might change the set of files it generates by invoking each of these tools. --- 1942,1951 ---- problem of not having the appropriate tools installed. On UNIX systems, the simplest way to update the date-time-modified ! information of a file is to use the use the @code{touch} command. ! How to use @code{touch} to update the derived files updated by each of the tools is described below. @emph{Note:} New versions of @code{g77} might change the set of files it generates by invoking each of these tools. *************** do @emph{not} do @samp{make maintainer-c *** 1903,1909 **** type these commands: @example ! sh# @kbd{cd gcc/f/runtime} sh# @kbd{touch configure libU77/configure} sh# @kbd{cd ../../..} sh# --- 1973,1979 ---- type these commands: @example ! sh# @kbd{cd @value{path-libf2c}} sh# @kbd{touch configure libU77/configure} sh# @kbd{cd ../../..} sh# *************** sh# @kbd{cd ..} *** 1974,1984 **** --- 2044,2063 ---- sh# @end example + @end ifclear + @node Distributing Binaries @section Distributing Binaries @cindex binaries, distributing @cindex code, distributing + @ifset OMIT-FSF-G77 + For users of the @value{which-g77} version of @code{g77}, + this information is superceded by the + @value{which-gcc} installation instructions. + @end ifset + + @ifclear OMIT-FSF-G77 If you are building @code{g77} for distribution to others in binary form, first make sure you are aware of your legal responsibilities (read the file @file{gcc/COPYING} thoroughly). *************** If it is not included, users will have t *** 2097,2103 **** diagnostics messages and other such things, and will send you a lot of email asking questions. ! Please edit this documentation (by editing @file{gcc/f/*.texi} and doing @samp{make doc} from the @file{/usr/src/gcc} directory) to reflect any changes you've made to @code{g77}, or at least to encourage users of your binary distribution to --- 2176,2182 ---- diagnostics messages and other such things, and will send you a lot of email asking questions. ! Please edit this documentation (by editing @file{@value{path-g77}/*.texi} and doing @samp{make doc} from the @file{/usr/src/gcc} directory) to reflect any changes you've made to @code{g77}, or at least to encourage users of your binary distribution to *************** and distributions, about which nothing c *** 2168,2170 **** --- 2247,2251 ---- user. Once you are quite certain a bug report does not involve your efforts, you can forward it to us. + + @end ifclear diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/g77spec.c gcc-2.95/gcc/f/g77spec.c *** egcs-1.1.2/gcc/f/g77spec.c Tue Jul 21 15:34:38 1998 --- gcc-2.95/gcc/f/g77spec.c Sat Jul 17 20:50:49 1999 *************** *** 1,5 **** /* Specific flags and argument handling of the Fortran front-end. ! Copyright (C) 1997 Free Software Foundation, Inc. This file is part of GNU CC. --- 1,5 ---- /* Specific flags and argument handling of the Fortran front-end. ! Copyright (C) 1997, 1999 Free Software Foundation, Inc. This file is part of GNU CC. *************** Boston, MA 02111-1307, USA. */ *** 46,52 **** #include "config.h" #include "system.h" - #include "gansidecl.h" #include #ifndef MATH_LIBRARY --- 46,51 ---- *************** static void (*g77_fn)(); *** 93,100 **** static int g77_newargc; static char **g77_newargv; - extern char *xmalloc PROTO((size_t)); - extern char *version_string; /* --- This comes from gcc.c (2.8.1) verbatim: */ --- 92,97 ---- *************** lang_specific_driver (fn, in_argc, in_ar *** 289,294 **** --- 286,294 ---- 2 => last two args were -l -lm. */ int saw_library = 0; + /* By default, we throw on the math library if we have one. */ + int need_math = (MATH_LIBRARY[0] != '\0'); + /* The number of input and output files in the incoming arg list. */ int n_infiles = 0; int n_outfiles = 0; *************** code-generation methodology, and so on.\ *** 427,433 **** For more information on g77 and gcc, type the commands `info -f g77'\n\ and `info -f gcc' to read the Info documentation.\n\ \n\ ! Report bugs to .\n"); exit (0); break; #endif --- 427,434 ---- For more information on g77 and gcc, type the commands `info -f g77'\n\ and `info -f gcc' to read the Info documentation.\n\ \n\ ! For bug reporting instructions, please see:\n\ ! .\n"); exit (0); break; #endif *************** Report bugs to .\n *** 469,475 **** { /* Not a filename or library. */ ! if (saw_library == 1) /* -l. */ append_arg (MATH_LIBRARY); saw_library = 0; --- 470,476 ---- { /* Not a filename or library. */ ! if (saw_library == 1 && need_math) /* -l. */ append_arg (MATH_LIBRARY); saw_library = 0; *************** Report bugs to .\n *** 524,530 **** saw_library = 1; /* -l. */ else { /* Other library, or filename. */ ! if (saw_library == 1) append_arg (MATH_LIBRARY); saw_library = 0; } --- 525,531 ---- saw_library = 1; /* -l. */ else { /* Other library, or filename. */ ! if (saw_library == 1 && need_math) append_arg (MATH_LIBRARY); saw_library = 0; } *************** Report bugs to .\n *** 544,550 **** case 0: append_arg (library); case 1: ! append_arg (MATH_LIBRARY); default: break; } --- 545,552 ---- case 0: append_arg (library); case 1: ! if (need_math) ! append_arg (MATH_LIBRARY); default: break; } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/glimits.j gcc-2.95/gcc/f/glimits.j *** egcs-1.1.2/gcc/f/glimits.j Tue May 19 03:49:33 1998 --- gcc-2.95/gcc/f/glimits.j Mon Feb 15 10:16:48 1999 *************** *** 1,6 **** /* glimits.j -- Wrapper for GCC's glimits.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* glimits.j -- Wrapper for GCC's glimits.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/global.c gcc-2.95/gcc/f/global.c *** egcs-1.1.2/gcc/f/global.c Tue Jun 30 00:59:35 1998 --- gcc-2.95/gcc/f/global.c Sat Mar 27 02:23:48 1999 *************** *** 1,6 **** /* global.c -- Implementation File (module.c template V1.0) Copyright (C) 1995, 1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* global.c -- Implementation File (module.c template V1.0) Copyright (C) 1995, 1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** the Free Software Foundation, 59 Temple *** 60,66 **** #if FFEGLOBAL_ENABLED static ffenameSpace ffeglobal_filewide_ = NULL; ! static char *ffeglobal_type_string_[] = { [FFEGLOBAL_typeNONE] "??", [FFEGLOBAL_typeMAIN] "main program", --- 60,66 ---- #if FFEGLOBAL_ENABLED static ffenameSpace ffeglobal_filewide_ = NULL; ! static const char *ffeglobal_type_string_[] = { [FFEGLOBAL_typeNONE] "??", [FFEGLOBAL_typeMAIN] "main program", *************** static char *ffeglobal_type_string_[] = *** 86,92 **** #if FFEGLOBAL_ENABLED void ! ffeglobal_drive (ffeglobal (*fn) ()) { if (ffeglobal_filewide_ != NULL) ffename_space_drive_global (ffeglobal_filewide_, fn); --- 86,92 ---- #if FFEGLOBAL_ENABLED void ! ffeglobal_drive (ffeglobal (*fn) (ffeglobal)) { if (ffeglobal_filewide_ != NULL) ffename_space_drive_global (ffeglobal_filewide_, fn); *************** ffeglobal_init_common (ffesymbol s, ffel *** 181,186 **** --- 181,187 ---- { if (g->u.common.blank) { + /* Not supposed to initialize blank common, though it works. */ ffebad_start (FFEBAD_COMMON_BLANK_INIT); ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); ffebad_finish (); *************** ffeglobal_new_common (ffesymbol s, ffele *** 229,238 **** --- 230,242 ---- { if (g->type == FFEGLOBAL_typeCOMMON) { + /* The names match, so the "blankness" should match too! */ assert (g->u.common.blank == blank); } else { + /* This global name has already been established, + but as something other than a common block. */ if (ffe_is_globals () || ffe_is_warn_globals ()) { ffebad_start (ffe_is_globals () *************** ffeglobal_new_common (ffesymbol s, ffele *** 258,263 **** --- 262,271 ---- && !g->explicit_intrinsic && ffe_is_warn_globals ()) { + /* Common name previously used as intrinsic. Though it works, + warn, because the intrinsic reference might have been intended + as a ref to an external procedure, but g77's vast list of + intrinsics happened to snarf the name. */ ffebad_start (FFEBAD_INTRINSIC_GLOBAL); ffebad_string (ffelex_token_text (t)); ffebad_string ("common block"); *************** ffeglobal_new_progunit_ (ffesymbol s, ff *** 308,313 **** --- 316,322 ---- || (g->type == FFEGLOBAL_typeBDATA)) && g->u.proc.defined) { + /* This program unit has already been defined. */ if (ffe_is_globals () || ffe_is_warn_globals ()) { ffebad_start (ffe_is_globals () *************** ffeglobal_new_progunit_ (ffesymbol s, ff *** 327,332 **** --- 336,348 ---- && (g->type != FFEGLOBAL_typeEXT) && (g->type != type)) { + /* A reference to this program unit has been seen, but its + context disagrees about the new definition regarding + what kind of program unit it is. (E.g. `call foo' followed + by `function foo'.) But `external foo' alone doesn't mean + disagreement with either a function or subroutine, though + g77 normally interprets it as a request to force-load + a block data program unit by that name (to cope with libs). */ if (ffe_is_globals () || ffe_is_warn_globals ()) { ffebad_start (ffe_is_globals () *************** ffeglobal_new_progunit_ (ffesymbol s, ff *** 353,363 **** --- 369,384 ---- g->u.proc.other_t = NULL; } else if ((ffesymbol_basictype (s) != FFEINFO_basictypeNONE) + && (g->type == FFEGLOBAL_typeFUNC) && ((ffesymbol_basictype (s) != g->u.proc.bt) || (ffesymbol_kindtype (s) != g->u.proc.kt) || ((ffesymbol_size (s) != FFETARGET_charactersizeNONE) && (ffesymbol_size (s) != g->u.proc.sz)))) { + /* The previous reference and this new function definition + disagree about the type of the function. I (Burley) think + this rarely occurs, because when this code is reached, + the type info doesn't appear to be filled in yet. */ if (ffe_is_globals () || ffe_is_warn_globals ()) { ffebad_start (ffe_is_globals () *************** ffeglobal_new_progunit_ (ffesymbol s, ff *** 377,382 **** --- 398,407 ---- && !g->explicit_intrinsic && ffe_is_warn_globals ()) { + /* This name, previously used as an intrinsic, now is known + to also be a global procedure name. Warn, since the previous + use as an intrinsic might have been intended to refer to + this procedure. */ ffebad_start (FFEBAD_INTRINSIC_GLOBAL); ffebad_string (ffelex_token_text (t)); ffebad_string ("global"); *************** ffeglobal_new_progunit_ (ffesymbol s, ff *** 395,404 **** g->u.proc.kt = ffesymbol_kindtype (s); g->u.proc.sz = ffesymbol_size (s); } ! g->tick = ffe_count_2; if ((g->tick != 0) && (g->type != type)) g->u.proc.n_args = -1; g->type = type; g->u.proc.defined = TRUE; } --- 420,431 ---- g->u.proc.kt = ffesymbol_kindtype (s); g->u.proc.sz = ffesymbol_size (s); } ! /* If there's a known disagreement about the kind of program ! unit, then don't even bother tracking arglist argreement. */ if ((g->tick != 0) && (g->type != type)) g->u.proc.n_args = -1; + g->tick = ffe_count_2; g->type = type; g->u.proc.defined = TRUE; } *************** ffeglobal_pad_common (ffesymbol s, ffeta *** 487,493 **** /* Collect info for a global's argument. */ void ! ffeglobal_proc_def_arg (ffesymbol s, int argno, char *name, ffeglobalArgSummary as, ffeinfoBasictype bt, ffeinfoKindtype kt, bool array) { --- 514,520 ---- /* Collect info for a global's argument. */ void ! ffeglobal_proc_def_arg (ffesymbol s, int argno, const char *name, ffeglobalArgSummary as, ffeinfoBasictype bt, ffeinfoKindtype kt, bool array) { *************** ffeglobal_proc_def_arg (ffesymbol s, int *** 511,518 **** if ((ai->t != NULL) && ffe_is_warn_globals ()) { ! char *refwhy = NULL; ! char *defwhy = NULL; bool warn = FALSE; switch (as) --- 538,545 ---- if ((ai->t != NULL) && ffe_is_warn_globals ()) { ! const char *refwhy = NULL; ! const char *defwhy = NULL; bool warn = FALSE; switch (as) *************** ffeglobal_proc_ref_arg (ffesymbol s, int *** 789,796 **** if (ai->t != NULL) { ! char *refwhy = NULL; ! char *defwhy = NULL; bool fail = FALSE; bool warn = FALSE; --- 816,823 ---- if (ai->t != NULL) { ! const char *refwhy = NULL; ! const char *defwhy = NULL; bool fail = FALSE; bool warn = FALSE; *************** ffeglobal_ref_intrinsic (ffesymbol s, ff *** 1160,1165 **** --- 1187,1196 ---- && ! g->intrinsic && ffe_is_warn_globals ()) { + /* This name, previously used as a global, now is used + for an intrinsic. Warn, since this new use as an + intrinsic might have been intended to refer to + the global procedure. */ ffebad_start (FFEBAD_INTRINSIC_GLOBAL); ffebad_string (ffelex_token_text (t)); ffebad_string ("intrinsic"); *************** ffeglobal_ref_intrinsic (ffesymbol s, ff *** 1186,1191 **** --- 1217,1227 ---- && (g->tick != ffe_count_2) && ffe_is_warn_globals ()) { + /* An earlier reference to this intrinsic disagrees with + this reference vis-a-vis explicit `intrinsic foo', + which suggests that the one relying on implicit + intrinsicacity might have actually intended to refer + to a global of the same name. */ ffebad_start (FFEBAD_INTRINSIC_EXPIMP); ffebad_string (ffelex_token_text (t)); ffebad_string (explicit ? "explicit" : "implicit"); *************** ffeglobal_ref_progunit_ (ffesymbol s, ff *** 1235,1244 **** if ((g != NULL) && (g->type != FFEGLOBAL_typeNONE) - && (g->type != type) && (g->type != FFEGLOBAL_typeEXT) && (type != FFEGLOBAL_typeEXT)) { if ((((type == FFEGLOBAL_typeBDATA) && (g->type != FFEGLOBAL_typeCOMMON)) || ((g->type == FFEGLOBAL_typeBDATA) --- 1271,1283 ---- if ((g != NULL) && (g->type != FFEGLOBAL_typeNONE) && (g->type != FFEGLOBAL_typeEXT) + && (g->type != type) && (type != FFEGLOBAL_typeEXT)) { + /* Disagreement about (fully refined) class of program unit + (main, subroutine, function, block data). Treat EXTERNAL/ + COMMON disagreements distinctly. */ if ((((type == FFEGLOBAL_typeBDATA) && (g->type != FFEGLOBAL_typeCOMMON)) || ((g->type == FFEGLOBAL_typeBDATA) *************** ffeglobal_ref_progunit_ (ffesymbol s, ff *** 1248,1253 **** --- 1287,1293 ---- #if 0 /* This is likely to just annoy people. */ if (ffe_is_warn_globals ()) { + /* Warn about EXTERNAL of a COMMON name, though it works. */ ffebad_start (FFEBAD_FILEWIDE_TIFF); ffebad_string (ffelex_token_text (t)); ffebad_string (ffeglobal_type_string_[type]); *************** ffeglobal_ref_progunit_ (ffesymbol s, ff *** 1260,1282 **** } #endif } ! else if (ffe_is_globals ()) ! { ! ffebad_start (FFEBAD_FILEWIDE_DISAGREEMENT); ! ffebad_string (ffelex_token_text (t)); ! ffebad_string (ffeglobal_type_string_[type]); ! ffebad_string (ffeglobal_type_string_[g->type]); ! ffebad_here (0, ffelex_token_where_line (t), ! ffelex_token_where_column (t)); ! ffebad_here (1, ffelex_token_where_line (g->t), ! ffelex_token_where_column (g->t)); ! ffebad_finish (); ! g->type = FFEGLOBAL_typeANY; ! return FALSE; ! } ! else if (ffe_is_warn_globals ()) { ! ffebad_start (FFEBAD_FILEWIDE_DISAGREEMENT_W); ffebad_string (ffelex_token_text (t)); ffebad_string (ffeglobal_type_string_[type]); ffebad_string (ffeglobal_type_string_[g->type]); --- 1300,1310 ---- } #endif } ! else if (ffe_is_globals () || ffe_is_warn_globals ()) { ! ffebad_start (ffe_is_globals () ! ? FFEBAD_FILEWIDE_DISAGREEMENT ! : FFEBAD_FILEWIDE_DISAGREEMENT_W); ffebad_string (ffelex_token_text (t)); ffebad_string (ffeglobal_type_string_[type]); ffebad_string (ffeglobal_type_string_[g->type]); *************** ffeglobal_ref_progunit_ (ffesymbol s, ff *** 1286,1292 **** ffelex_token_where_column (g->t)); ffebad_finish (); g->type = FFEGLOBAL_typeANY; ! return TRUE; } } --- 1314,1320 ---- ffelex_token_where_column (g->t)); ffebad_finish (); g->type = FFEGLOBAL_typeANY; ! return (! ffe_is_globals ()); } } *************** ffeglobal_ref_progunit_ (ffesymbol s, ff *** 1302,1340 **** g->u.proc.kt = ffesymbol_kindtype (s); g->u.proc.sz = ffesymbol_size (s); } ! /* Else, make sure there is type agreement. */ ! else if ((g->u.proc.bt != FFEINFO_basictypeNONE) ! && (ffesymbol_basictype (s) != FFEINFO_basictypeNONE) ! && ((ffesymbol_basictype (s) != g->u.proc.bt) ! || (ffesymbol_kindtype (s) != g->u.proc.kt) ! || ((ffesymbol_size (s) != g->u.proc.sz) ! && g->u.proc.defined ! && (g->u.proc.sz != FFETARGET_charactersizeNONE)))) ! { ! if (ffe_is_globals ()) { ! ffebad_start (FFEBAD_FILEWIDE_TYPE_MISMATCH); ffebad_string (ffelex_token_text (t)); ! ffebad_here (0, ffelex_token_where_line (t), ! ffelex_token_where_column (t)); ! ffebad_here (1, ffelex_token_where_line (g->t), ! ffelex_token_where_column (g->t)); ffebad_finish (); ! g->type = FFEGLOBAL_typeANY; return FALSE; } - if (ffe_is_warn_globals ()) - { - ffebad_start (FFEBAD_FILEWIDE_TYPE_MISMATCH_W); - ffebad_string (ffelex_token_text (t)); - ffebad_here (0, ffelex_token_where_line (t), - ffelex_token_where_column (t)); - ffebad_here (1, ffelex_token_where_line (g->t), - ffelex_token_where_column (g->t)); - ffebad_finish (); - } - g->type = FFEGLOBAL_typeANY; - return TRUE; } } --- 1330,1394 ---- g->u.proc.kt = ffesymbol_kindtype (s); g->u.proc.sz = ffesymbol_size (s); } ! /* Make sure there is type agreement. */ ! if (g->type == FFEGLOBAL_typeFUNC ! && g->u.proc.bt != FFEINFO_basictypeNONE ! && ffesymbol_basictype (s) != FFEINFO_basictypeNONE ! && (ffesymbol_basictype (s) != g->u.proc.bt ! || ffesymbol_kindtype (s) != g->u.proc.kt ! /* CHARACTER*n disagreements matter only once a ! definition is involved, since the definition might ! be CHARACTER*(*), which accepts all references. */ ! || (g->u.proc.defined ! && ffesymbol_size (s) != g->u.proc.sz ! && ffesymbol_size (s) != FFETARGET_charactersizeNONE ! && g->u.proc.sz != FFETARGET_charactersizeNONE))) ! { ! int error; ! ! /* Type mismatch between function reference/definition and ! this subsequent reference (which might just be the filling-in ! of type info for the definition, but we can't reach here ! if that's the case and there was a previous definition). ! ! It's an error given a previous definition, since that ! implies inlining can crash the compiler, unless the user ! asked for no such inlining. */ ! error = (g->tick != ffe_count_2 ! && g->u.proc.defined ! && ffe_is_globals ()); ! if (error || ffe_is_warn_globals ()) { ! ffebad_start (error ! ? FFEBAD_FILEWIDE_TYPE_MISMATCH ! : FFEBAD_FILEWIDE_TYPE_MISMATCH_W); ffebad_string (ffelex_token_text (t)); ! if (g->tick == ffe_count_2) ! { ! /* Current reference fills in type info for definition. ! The current token doesn't necessarily point to the actual ! definition of the function, so use the definition pointer ! and the pointer to the pre-definition type info. */ ! ffebad_here (0, ffelex_token_where_line (g->t), ! ffelex_token_where_column (g->t)); ! ffebad_here (1, ffelex_token_where_line (g->u.proc.other_t), ! ffelex_token_where_column (g->u.proc.other_t)); ! } ! else ! { ! /* Current reference is not a filling-in of a current ! definition. The current token is fine, as is ! the previous-mention token. */ ! ffebad_here (0, ffelex_token_where_line (t), ! ffelex_token_where_column (t)); ! ffebad_here (1, ffelex_token_where_line (g->t), ! ffelex_token_where_column (g->t)); ! } ffebad_finish (); ! if (error) ! g->type = FFEGLOBAL_typeANY; return FALSE; } } } *************** ffeglobal_ref_progunit_ (ffesymbol s, ff *** 1357,1362 **** --- 1411,1419 ---- && (g->tick != ffe_count_2) && ffe_is_warn_globals ()) { + /* Now known as a global, this name previously was seen as an + intrinsic. Warn, in case the previous reference was intended + for the same global. */ ffebad_start (FFEBAD_INTRINSIC_GLOBAL); ffebad_string (ffelex_token_text (t)); ffebad_string ("global"); diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/global.h gcc-2.95/gcc/f/global.h *** egcs-1.1.2/gcc/f/global.h Tue Jun 30 00:59:37 1998 --- gcc-2.95/gcc/f/global.h Sat Mar 27 02:23:49 1999 *************** *** 1,6 **** /* global.h -- Public #include File (module.h template V1.0) Copyright (C) 1995, 1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* global.h -- Public #include File (module.h template V1.0) Copyright (C) 1995, 1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** struct _ffeglobal_ *** 128,141 **** /* Declare functions with prototypes. */ ! void ffeglobal_drive (ffeglobal (*fn) ()); void ffeglobal_init_1 (void); void ffeglobal_init_common (ffesymbol s, ffelexToken t); void ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type); void ffeglobal_new_common (ffesymbol s, ffelexToken t, bool blank); void ffeglobal_pad_common (ffesymbol s, ffetargetAlign pad, ffewhereLine wl, ffewhereColumn wc); ! void ffeglobal_proc_def_arg (ffesymbol s, int argno, char *name, ffeglobalArgSummary as, ffeinfoBasictype bt, ffeinfoKindtype kt, bool array); void ffeglobal_proc_def_nargs (ffesymbol s, int n_args); --- 128,141 ---- /* Declare functions with prototypes. */ ! void ffeglobal_drive (ffeglobal (*fn) (ffeglobal)); void ffeglobal_init_1 (void); void ffeglobal_init_common (ffesymbol s, ffelexToken t); void ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type); void ffeglobal_new_common (ffesymbol s, ffelexToken t, bool blank); void ffeglobal_pad_common (ffesymbol s, ffetargetAlign pad, ffewhereLine wl, ffewhereColumn wc); ! void ffeglobal_proc_def_arg (ffesymbol s, int argno, const char *name, ffeglobalArgSummary as, ffeinfoBasictype bt, ffeinfoKindtype kt, bool array); void ffeglobal_proc_def_nargs (ffesymbol s, int n_args); diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/hconfig.j gcc-2.95/gcc/f/hconfig.j *** egcs-1.1.2/gcc/f/hconfig.j Tue May 19 03:49:36 1998 --- gcc-2.95/gcc/f/hconfig.j Mon Feb 15 10:16:52 1999 *************** *** 1,6 **** /* hconfig.j -- Wrapper for GCC's hconfig.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* hconfig.j -- Wrapper for GCC's hconfig.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/implic.c gcc-2.95/gcc/f/implic.c *** egcs-1.1.2/gcc/f/implic.c Mon Jun 15 19:23:23 1998 --- gcc-2.95/gcc/f/implic.c Sat Mar 27 02:23:50 1999 *************** *** 1,6 **** /* implic.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* implic.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** static struct _ffeimplic_ ffeimplic_tabl *** 73,79 **** /* Static functions (internal). */ ! static ffeimplic_ ffeimplic_lookup_ (char c); /* Internal macros. */ --- 73,79 ---- /* Static functions (internal). */ ! static ffeimplic_ ffeimplic_lookup_ (unsigned char c); /* Internal macros. */ *************** static ffeimplic_ ffeimplic_lookup_ (cha *** 89,95 **** data type. */ static ffeimplic_ ! ffeimplic_lookup_ (char c) { /* NOTE: This is definitely ASCII-specific!! */ if (ISALPHA (c) || (c == '_')) --- 89,95 ---- data type. */ static ffeimplic_ ! ffeimplic_lookup_ (unsigned char c) { /* NOTE: This is definitely ASCII-specific!! */ if (ISALPHA (c) || (c == '_')) *************** ffeimplic_none () *** 331,337 **** /* ffeimplic_peek_symbol_type -- Determine implicit type of a symbol ffesymbol s; ! char *name; // name for s in case it is NULL, or NULL if s never NULL if (ffeimplic_peek_symbol_type(s,name) == FFEINFO_basictypeCHARACTER) // is or will be a CHARACTER-typed name --- 331,337 ---- /* ffeimplic_peek_symbol_type -- Determine implicit type of a symbol ffesymbol s; ! const char *name; // name for s in case it is NULL, or NULL if s never NULL if (ffeimplic_peek_symbol_type(s,name) == FFEINFO_basictypeCHARACTER) // is or will be a CHARACTER-typed name *************** ffeimplic_none () *** 348,354 **** needed anyway (as when ffecom calls it). */ ffeinfoBasictype ! ffeimplic_peek_symbol_type (ffesymbol s, char *name) { char c; ffeimplic_ imp; --- 348,354 ---- needed anyway (as when ffecom calls it). */ ffeinfoBasictype ! ffeimplic_peek_symbol_type (ffesymbol s, const char *name) { char c; ffeimplic_ imp; diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/implic.h gcc-2.95/gcc/f/implic.h *** egcs-1.1.2/gcc/f/implic.h Tue May 19 03:49:38 1998 --- gcc-2.95/gcc/f/implic.h Sat Mar 27 02:23:51 1999 *************** *** 1,6 **** /* implic.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* implic.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** bool ffeimplic_establish_initial (char c *** 55,61 **** bool ffeimplic_establish_symbol (ffesymbol s); void ffeimplic_init_2 (void); void ffeimplic_none (void); ! ffeinfoBasictype ffeimplic_peek_symbol_type (ffesymbol s, char *name); void ffeimplic_terminate_2 (void); /* Define macros. */ --- 55,61 ---- bool ffeimplic_establish_symbol (ffesymbol s); void ffeimplic_init_2 (void); void ffeimplic_none (void); ! ffeinfoBasictype ffeimplic_peek_symbol_type (ffesymbol s, const char *name); void ffeimplic_terminate_2 (void); /* Define macros. */ diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/info-b.def gcc-2.95/gcc/f/info-b.def *** egcs-1.1.2/gcc/f/info-b.def Tue May 19 03:49:39 1998 --- gcc-2.95/gcc/f/info-b.def Mon Feb 15 10:16:55 1999 *************** *** 1,6 **** /* info-b.def -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* info-b.def -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/info-k.def gcc-2.95/gcc/f/info-k.def *** egcs-1.1.2/gcc/f/info-k.def Tue May 19 03:49:40 1998 --- gcc-2.95/gcc/f/info-k.def Mon Feb 15 10:16:56 1999 *************** *** 1,6 **** /* info-k.def -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* info-k.def -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/info-w.def gcc-2.95/gcc/f/info-w.def *** egcs-1.1.2/gcc/f/info-w.def Tue May 19 03:49:41 1998 --- gcc-2.95/gcc/f/info-w.def Mon Feb 15 10:16:57 1999 *************** *** 1,6 **** /* info-w.def -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* info-w.def -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/info.c gcc-2.95/gcc/f/info.c *** egcs-1.1.2/gcc/f/info.c Thu Jun 4 03:41:22 1998 --- gcc-2.95/gcc/f/info.c Sat Mar 27 02:23:52 1999 *************** *** 1,6 **** /* info.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* info.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** the Free Software Foundation, 59 Temple *** 55,75 **** /* Static objects accessed by functions in this module. */ ! static char *ffeinfo_basictype_string_[] = { #define FFEINFO_BASICTYPE(KWD,LNAM,SNAM) SNAM, #include "info-b.def" #undef FFEINFO_BASICTYPE }; ! static char *ffeinfo_kind_message_[] = { #define FFEINFO_KIND(KWD,LNAM,SNAM) LNAM, #include "info-k.def" #undef FFEINFO_KIND }; ! static char *ffeinfo_kind_string_[] = { #define FFEINFO_KIND(KWD,LNAM,SNAM) SNAM, --- 55,75 ---- /* Static objects accessed by functions in this module. */ ! static const char *ffeinfo_basictype_string_[] = { #define FFEINFO_BASICTYPE(KWD,LNAM,SNAM) SNAM, #include "info-b.def" #undef FFEINFO_BASICTYPE }; ! static const char *ffeinfo_kind_message_[] = { #define FFEINFO_KIND(KWD,LNAM,SNAM) LNAM, #include "info-k.def" #undef FFEINFO_KIND }; ! static const char *ffeinfo_kind_string_[] = { #define FFEINFO_KIND(KWD,LNAM,SNAM) SNAM, *************** static char *ffeinfo_kind_string_[] *** 77,83 **** #undef FFEINFO_KIND }; static ffeinfoBasictype ffeinfo_combine_[FFEINFO_basictype][FFEINFO_basictype]; ! static char *ffeinfo_kindtype_string_[] = { "", --- 77,83 ---- #undef FFEINFO_KIND }; static ffeinfoBasictype ffeinfo_combine_[FFEINFO_basictype][FFEINFO_basictype]; ! static const char *ffeinfo_kindtype_string_[] = { "", *************** static char *ffeinfo_kindtype_string_[] *** 91,97 **** "8", "*", }; ! static char *ffeinfo_where_string_[] = { #define FFEINFO_WHERE(KWD,LNAM,SNAM) SNAM, --- 91,97 ---- "8", "*", }; ! static const char *ffeinfo_where_string_[] = { #define FFEINFO_WHERE(KWD,LNAM,SNAM) SNAM, *************** ffeinfo_basictype_combine (ffeinfoBasict *** 129,135 **** Returns the string based on the basic type. */ ! char * ffeinfo_basictype_string (ffeinfoBasictype basictype) { if (basictype >= ARRAY_SIZE (ffeinfo_basictype_string_)) --- 129,135 ---- Returns the string based on the basic type. */ ! const char * ffeinfo_basictype_string (ffeinfoBasictype basictype) { if (basictype >= ARRAY_SIZE (ffeinfo_basictype_string_)) *************** ffeinfo_init_0 () *** 186,192 **** Returns the string based on the kind. */ ! char * ffeinfo_kind_message (ffeinfoKind kind) { if (kind >= ARRAY_SIZE (ffeinfo_kind_message_)) --- 186,192 ---- Returns the string based on the kind. */ ! const char * ffeinfo_kind_message (ffeinfoKind kind) { if (kind >= ARRAY_SIZE (ffeinfo_kind_message_)) *************** ffeinfo_kind_message (ffeinfoKind kind) *** 201,207 **** Returns the string based on the kind. */ ! char * ffeinfo_kind_string (ffeinfoKind kind) { if (kind >= ARRAY_SIZE (ffeinfo_kind_string_)) --- 201,207 ---- Returns the string based on the kind. */ ! const char * ffeinfo_kind_string (ffeinfoKind kind) { if (kind >= ARRAY_SIZE (ffeinfo_kind_string_)) *************** ffeinfo_kindtype_max(ffeinfoBasictype bt *** 232,238 **** Returns the string based on the kind type. */ ! char * ffeinfo_kindtype_string (ffeinfoKindtype kind_type) { if (kind_type >= ARRAY_SIZE (ffeinfo_kindtype_string_)) --- 232,238 ---- Returns the string based on the kind type. */ ! const char * ffeinfo_kindtype_string (ffeinfoKindtype kind_type) { if (kind_type >= ARRAY_SIZE (ffeinfo_kindtype_string_)) *************** ffeinfo_type (ffeinfoBasictype basictype *** 267,273 **** Returns the string based on the where. */ ! char * ffeinfo_where_string (ffeinfoWhere where) { if (where >= ARRAY_SIZE (ffeinfo_where_string_)) --- 267,273 ---- Returns the string based on the where. */ ! const char * ffeinfo_where_string (ffeinfoWhere where) { if (where >= ARRAY_SIZE (ffeinfo_where_string_)) diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/info.h gcc-2.95/gcc/f/info.h *** egcs-1.1.2/gcc/f/info.h Tue May 19 03:49:43 1998 --- gcc-2.95/gcc/f/info.h Sat Mar 27 02:23:53 1999 *************** *** 1,6 **** /* info.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* info.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** struct _ffeinfo_ *** 127,141 **** ffeinfoBasictype ffeinfo_basictype_combine (ffeinfoBasictype l, ffeinfoBasictype r); ! char *ffeinfo_basictype_string (ffeinfoBasictype basictype); void ffeinfo_init_0 (void); ! char *ffeinfo_kind_message (ffeinfoKind kind); ! char *ffeinfo_kind_string (ffeinfoKind kind); ffeinfoKindtype ffeinfo_kindtype_max(ffeinfoBasictype bt, ffeinfoKindtype k1, ffeinfoKindtype k2); ! char *ffeinfo_kindtype_string (ffeinfoKindtype kind_type); ! char *ffeinfo_where_string (ffeinfoWhere where); ffeinfo ffeinfo_new (ffeinfoBasictype basictype, ffeinfoKindtype kindtype, ffeinfoRank rank, ffeinfoKind kind, ffeinfoWhere where, ffetargetCharacterSize size); --- 127,141 ---- ffeinfoBasictype ffeinfo_basictype_combine (ffeinfoBasictype l, ffeinfoBasictype r); ! const char *ffeinfo_basictype_string (ffeinfoBasictype basictype); void ffeinfo_init_0 (void); ! const char *ffeinfo_kind_message (ffeinfoKind kind); ! const char *ffeinfo_kind_string (ffeinfoKind kind); ffeinfoKindtype ffeinfo_kindtype_max(ffeinfoBasictype bt, ffeinfoKindtype k1, ffeinfoKindtype k2); ! const char *ffeinfo_kindtype_string (ffeinfoKindtype kind_type); ! const char *ffeinfo_where_string (ffeinfoWhere where); ffeinfo ffeinfo_new (ffeinfoBasictype basictype, ffeinfoKindtype kindtype, ffeinfoRank rank, ffeinfoKind kind, ffeinfoWhere where, ffetargetCharacterSize size); diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/input.j gcc-2.95/gcc/f/input.j *** egcs-1.1.2/gcc/f/input.j Tue May 19 03:49:44 1998 --- gcc-2.95/gcc/f/input.j Mon Feb 15 10:17:00 1999 *************** *** 1,6 **** /* input.j -- Wrapper for GCC's input.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* input.j -- Wrapper for GCC's input.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/install0.texi gcc-2.95/gcc/f/install0.texi *** egcs-1.1.2/gcc/f/install0.texi Mon Sep 22 23:38:19 1997 --- gcc-2.95/gcc/f/install0.texi Sat Mar 13 04:04:00 1999 *************** *** 1,14 **** @setfilename INSTALL ! @set INSTALLONLY ! @c The immediately following lines apply to the INSTALL file ! @c which is generated using this file. ! This file contains installation information for the GNU Fortran compiler. ! Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! You may copy, distribute, and modify it freely as long as you preserve ! this copyright notice and permission notice. ! ! @node Top,,, (dir) ! @chapter Installing GNU Fortran @include g77install.texi @bye --- 1,9 ---- + \input texinfo @c -*-texinfo-*- + @c %**start of header @setfilename INSTALL ! @c %**end of header ! @c This tells g77install.texi that it's generating just the INSTALL file. ! @set DOC-INSTALL @include g77install.texi @bye diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/intdoc.c gcc-2.95/gcc/f/intdoc.c *** egcs-1.1.2/gcc/f/intdoc.c Wed Jul 15 02:35:57 1998 --- gcc-2.95/gcc/f/intdoc.c Tue Apr 6 23:48:36 1999 *************** *** 1,6 **** /* intdoc.c Copyright (C) 1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* intdoc.c Copyright (C) 1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** typedef enum *** 46,75 **** #define FFEINTRIN_DOC 1 #include "intrin.h" ! char *family_name (ffeintrinFamily family); static void dumpif (ffeintrinFamily fam); static void dumpendif (void); static void dumpclearif (void); static void dumpem (void); ! static void dumpgen (int menu, char *name, char *name_uc, ffeintrinGen gen); ! static void dumpspec (int menu, char *name, char *name_uc, ffeintrinSpec spec); ! static void dumpimp (int menu, char *name, char *name_uc, size_t genno, ffeintrinFamily family, ffeintrinImp imp, ffeintrinSpec spec); ! static char *argument_info_ptr (ffeintrinImp imp, int argno); ! static char *argument_info_string (ffeintrinImp imp, int argno); ! static char *argument_name_ptr (ffeintrinImp imp, int argno); ! static char *argument_name_string (ffeintrinImp imp, int argno); #if 0 ! static char *elaborate_if_complex (ffeintrinImp imp, int argno); ! static char *elaborate_if_maybe_complex (ffeintrinImp imp, int argno); ! static char *elaborate_if_real (ffeintrinImp imp, int argno); #endif ! static void print_type_string (char *c); int ! main (int argc, char **argv) { if (argc != 1) { --- 46,75 ---- #define FFEINTRIN_DOC 1 #include "intrin.h" ! const char *family_name (ffeintrinFamily family); static void dumpif (ffeintrinFamily fam); static void dumpendif (void); static void dumpclearif (void); static void dumpem (void); ! static void dumpgen (int menu, const char *name, const char *name_uc, ffeintrinGen gen); ! static void dumpspec (int menu, const char *name, const char *name_uc, ffeintrinSpec spec); ! static void dumpimp (int menu, const char *name, const char *name_uc, size_t genno, ffeintrinFamily family, ffeintrinImp imp, ffeintrinSpec spec); ! static const char *argument_info_ptr (ffeintrinImp imp, int argno); ! static const char *argument_info_string (ffeintrinImp imp, int argno); ! static const char *argument_name_ptr (ffeintrinImp imp, int argno); ! static const char *argument_name_string (ffeintrinImp imp, int argno); #if 0 ! static const char *elaborate_if_complex (ffeintrinImp imp, int argno); ! static const char *elaborate_if_maybe_complex (ffeintrinImp imp, int argno); ! static const char *elaborate_if_real (ffeintrinImp imp, int argno); #endif ! static void print_type_string (const char *c); int ! main (int argc, char **argv ATTRIBUTE_UNUSED) { if (argc != 1) { *************** Usage: intdoc > intdoc.texi\n\ *** 86,107 **** struct _ffeintrin_name_ { ! char *name_uc; ! char *name_lc; ! char *name_ic; ffeintrinGen generic; ffeintrinSpec specific; }; struct _ffeintrin_gen_ { ! char *name; /* Name as seen in program. */ ffeintrinSpec specs[2]; }; struct _ffeintrin_spec_ { ! char *name; /* Uppercase name as seen in source code, lowercase if no source name, "none" if no name at all (NONE case). */ bool is_actualarg; /* Ok to pass as actual arg if -pedantic. */ --- 86,107 ---- struct _ffeintrin_name_ { ! const char *name_uc; ! const char *name_lc; ! const char *name_ic; ffeintrinGen generic; ffeintrinSpec specific; }; struct _ffeintrin_gen_ { ! const char *name; /* Name as seen in program. */ ffeintrinSpec specs[2]; }; struct _ffeintrin_spec_ { ! const char *name; /* Uppercase name as seen in source code, lowercase if no source name, "none" if no name at all (NONE case). */ bool is_actualarg; /* Ok to pass as actual arg if -pedantic. */ *************** struct _ffeintrin_spec_ *** 111,121 **** struct _ffeintrin_imp_ { ! char *name; /* Name of implementation. */ #if 0 /* FFECOM_targetCURRENT == FFECOM_targetGCC */ ffecomGfrt gfrt; /* gfrt index in library. */ #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ ! char *control; }; static struct _ffeintrin_name_ names[] = { --- 111,121 ---- struct _ffeintrin_imp_ { ! const char *name; /* Name of implementation. */ #if 0 /* FFECOM_targetCURRENT == FFECOM_targetGCC */ ffecomGfrt gfrt; /* gfrt index in library. */ #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ ! const char *control; }; static struct _ffeintrin_name_ names[] = { *************** static struct _ffeintrin_name_ names[] = *** 124,134 **** --- 124,136 ---- #define DEFGEN(CODE,NAME,SPEC1,SPEC2) #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) + #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) #include "intrin.def" #undef DEFNAME #undef DEFGEN #undef DEFSPEC #undef DEFIMP + #undef DEFIMPY }; static struct _ffeintrin_gen_ gens[] = { *************** static struct _ffeintrin_gen_ gens[] = { *** 137,147 **** --- 139,151 ---- { NAME, { SPEC1, SPEC2, }, }, #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) + #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) #include "intrin.def" #undef DEFNAME #undef DEFGEN #undef DEFSPEC #undef DEFIMP + #undef DEFIMPY }; static struct _ffeintrin_imp_ imps[] = { *************** static struct _ffeintrin_imp_ imps[] = { *** 151,159 **** --- 155,167 ---- #if 0 /* FFECOM_targetCURRENT == FFECOM_targetGCC */ #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \ { NAME, FFECOM_gfrt ## GFRT, CONTROL }, + #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \ + { NAME, FFECOM_gfrt ## GFRT, CONTROL }, #elif 1 /* FFECOM_targetCURRENT == FFECOM_targetFFE */ #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \ { NAME, CONTROL }, + #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \ + { NAME, CONTROL }, #else #error #endif *************** static struct _ffeintrin_imp_ imps[] = { *** 162,167 **** --- 170,176 ---- #undef DEFGEN #undef DEFSPEC #undef DEFIMP + #undef DEFIMPY }; static struct _ffeintrin_spec_ specs[] = { *************** static struct _ffeintrin_spec_ specs[] = *** 170,198 **** #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) \ { NAME, CALLABLE, FAMILY, IMP, }, #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) #include "intrin.def" #undef DEFGEN #undef DEFSPEC #undef DEFIMP }; ! struct cc_pair { ffeintrinImp imp; char *text; }; ! static char *descriptions[FFEINTRIN_imp] = { 0 }; static struct cc_pair cc_descriptions[] = { #define DEFDOC(IMP,SUMMARY,DESCRIPTION) { FFEINTRIN_imp ## IMP, DESCRIPTION }, #include "intdoc.h0" #undef DEFDOC }; ! static char *summaries[FFEINTRIN_imp] = { 0 }; static struct cc_pair cc_summaries[] = { #define DEFDOC(IMP,SUMMARY,DESCRIPTION) { FFEINTRIN_imp ## IMP, SUMMARY }, #include "intdoc.h0" #undef DEFDOC }; ! char * family_name (ffeintrinFamily family) { switch (family) --- 179,209 ---- #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) \ { NAME, CALLABLE, FAMILY, IMP, }, #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) + #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) #include "intrin.def" #undef DEFGEN #undef DEFSPEC #undef DEFIMP + #undef DEFIMPY }; ! struct cc_pair { ffeintrinImp imp; const char *text; }; ! static const char *descriptions[FFEINTRIN_imp] = { 0 }; static struct cc_pair cc_descriptions[] = { #define DEFDOC(IMP,SUMMARY,DESCRIPTION) { FFEINTRIN_imp ## IMP, DESCRIPTION }, #include "intdoc.h0" #undef DEFDOC }; ! static const char *summaries[FFEINTRIN_imp] = { 0 }; static struct cc_pair cc_summaries[] = { #define DEFDOC(IMP,SUMMARY,DESCRIPTION) { FFEINTRIN_imp ## IMP, SUMMARY }, #include "intdoc.h0" #undef DEFDOC }; ! const char * family_name (ffeintrinFamily family) { switch (family) *************** dumpem () *** 313,319 **** } static void ! dumpgen (int menu, char *name, char *name_uc, ffeintrinGen gen) { size_t i; int total = 0; --- 324,330 ---- } static void ! dumpgen (int menu, const char *name, const char *name_uc, ffeintrinGen gen) { size_t i; int total = 0; *************** For information on other intrinsics with *** 366,372 **** } static void ! dumpspec (int menu, char *name, char *name_uc, ffeintrinSpec spec) { dumpif (specs[spec].family); dumpimp (menu, name, name_uc, 0, specs[spec].family, specs[spec].implementation, --- 377,383 ---- } static void ! dumpspec (int menu, const char *name, const char *name_uc, ffeintrinSpec spec) { dumpif (specs[spec].family); dumpimp (menu, name, name_uc, 0, specs[spec].family, specs[spec].implementation, *************** dumpspec (int menu, char *name, char *na *** 375,387 **** } static void ! dumpimp (int menu, char *name, char *name_uc, size_t genno, ffeintrinFamily family, ffeintrinImp imp, ! ffeintrinSpec spec) { ! char *c; bool subr; ! char *argc; ! char *argi; int colon; int argno; --- 386,398 ---- } static void ! dumpimp (int menu, const char *name, const char *name_uc, size_t genno, ! ffeintrinFamily family, ffeintrinImp imp, ffeintrinSpec spec) { ! const char *c; bool subr; ! const char *argc; ! const char *argi; int colon; int argno; *************** dumpimp (int menu, char *name, char *nam *** 399,405 **** || (summaries[imp] != NULL)) { int spaces = INDENT_SUMMARY - 14 - strlen (name); ! char *c; if (spec != FFEINTRIN_specNONE) spaces -= (3 + strlen (specs[spec].name)); /* See XYZZY1 above */ --- 410,416 ---- || (summaries[imp] != NULL)) { int spaces = INDENT_SUMMARY - 14 - strlen (name); ! const char *c; if (spec != FFEINTRIN_specNONE) spaces -= (3 + strlen (specs[spec].name)); /* See XYZZY1 above */ *************** external procedure.\n\ *** 509,516 **** if (!subr) { int other_arg; ! char *arg_string; ! char *arg_info; if ((c[colon + 1] >= '0') && (c[colon + 1] <= '9')) --- 520,527 ---- if (!subr) { int other_arg; ! const char *arg_string; ! const char *arg_info; if ((c[colon + 1] >= '0') && (c[colon + 1] <= '9')) *************** Intrinsic groups: "); *** 1019,1025 **** if (descriptions[imp] != NULL) { ! char *c = descriptions[imp]; printf ("\ @noindent\n\ --- 1030,1036 ---- if (descriptions[imp] != NULL) { ! const char *c = descriptions[imp]; printf ("\ @noindent\n\ *************** Description:\n\ *** 1056,1065 **** } } ! static char * argument_info_ptr (ffeintrinImp imp, int argno) { ! char *c = imps[imp].control; static char arginfos[8][32]; static int argx = 0; int i; --- 1067,1076 ---- } } ! static const char * argument_info_ptr (ffeintrinImp imp, int argno) { ! const char *c = imps[imp].control; static char arginfos[8][32]; static int argx = 0; int i; *************** argument_info_ptr (ffeintrinImp imp, int *** 1099,1118 **** return c; } ! static char * argument_info_string (ffeintrinImp imp, int argno) { ! char *p; p = argument_info_ptr (imp, argno); assert (p != NULL); return p; } ! static char * argument_name_ptr (ffeintrinImp imp, int argno) { ! char *c = imps[imp].control; static char argnames[8][32]; static int argx = 0; int i; --- 1110,1129 ---- return c; } ! static const char * argument_info_string (ffeintrinImp imp, int argno) { ! const char *p; p = argument_info_ptr (imp, argno); assert (p != NULL); return p; } ! static const char * argument_name_ptr (ffeintrinImp imp, int argno) { ! const char *c = imps[imp].control; static char argnames[8][32]; static int argx = 0; int i; *************** argument_name_ptr (ffeintrinImp imp, int *** 1148,1157 **** return c; } ! static char * argument_name_string (ffeintrinImp imp, int argno) { ! char *p; p = argument_name_ptr (imp, argno); assert (p != NULL); --- 1159,1168 ---- return c; } ! static const char * argument_name_string (ffeintrinImp imp, int argno) { ! const char *p; p = argument_name_ptr (imp, argno); assert (p != NULL); *************** argument_name_string (ffeintrinImp imp, *** 1159,1165 **** } static void ! print_type_string (char *c) { char basic = c[0]; char kind = c[1]; --- 1170,1176 ---- } static void ! print_type_string (const char *c) { char basic = c[0]; char kind = c[1]; diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/intdoc.in gcc-2.95/gcc/f/intdoc.in *** egcs-1.1.2/gcc/f/intdoc.in Fri Feb 26 05:05:50 1999 --- gcc-2.95/gcc/f/intdoc.in Mon May 3 09:07:20 1999 *************** and returns that string as the function *** 1043,1051 **** ") DEFDOC (CTIME_subr, "Convert time to Day Mon dd hh:mm:ss yyyy.", "\ ! Converts @var{@2@}, a system time value, such as returned by @code{TIME8()}, to a string of the form @samp{Sat Aug 19 18:13:14 1995}, ! and returns that string in @var{@1@}. @xref{Time8 Intrinsic}. --- 1043,1051 ---- ") DEFDOC (CTIME_subr, "Convert time to Day Mon dd hh:mm:ss yyyy.", "\ ! Converts @var{@1@}, a system time value, such as returned by @code{TIME8()}, to a string of the form @samp{Sat Aug 19 18:13:14 1995}, ! and returns that string in @var{@2@}. @xref{Time8 Intrinsic}. *************** representing the numeric day of the mont *** 1059,1065 **** --- 1059,1069 ---- abbreviation of the month name @var{mmm} and the last two digits of the year @var{yy}, e.g.@: @samp{25-Nov-96}. + @cindex Y2K compliance + @cindex Year 2000 compliance 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. @xref{CTime Intrinsic (subroutine)}, for information on obtaining more digits for the current (or any) date. ") *************** The functions' value is equal to @samp{@ *** 1075,1080 **** --- 1079,1094 ---- Subsequent invocations of @samp{@0@()} return values accumulated since the previous invocation. + @cindex wraparound, timings + @cindex limits, timings + On some systems, the underlying timings are represented + using types with sufficiently small limits that overflows + (wraparounds) are possible, such as 32-bit types. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. + Due to the side effects performed by this intrinsic, the function form is not recommended. ") *************** form is not recommended. *** 1082,1095 **** DEFDOC (DTIME_subr, "Get elapsed time since last time.", "\ Initially, return the number of seconds of runtime since the start of the process's execution ! in @var{@1@}, ! and the user and system components of this in @samp{@var{@2@}(1)} ! and @samp{@var{@2@}(2)} respectively. ! The value of @var{@1@} is equal to @samp{@var{@2@}(1) + @var{@2@}(2)}. Subsequent invocations of @samp{@0@()} set values based on accumulations since the previous invocation. Some non-GNU implementations of Fortran provide this intrinsic as only a function, not as a subroutine. ") --- 1096,1119 ---- DEFDOC (DTIME_subr, "Get elapsed time since last time.", "\ Initially, return the number of seconds of runtime since the start of the process's execution ! in @var{@2@}, ! and the user and system components of this in @samp{@var{@1@}(1)} ! and @samp{@var{@1@}(2)} respectively. ! The value of @var{@2@} is equal to @samp{@var{@1@}(1) + @var{@1@}(2)}. Subsequent invocations of @samp{@0@()} set values based on accumulations since the previous invocation. + @cindex wraparound, timings + @cindex limits, timings + On some systems, the underlying timings are represented + using types with sufficiently small limits that overflows + (wraparounds) are possible, such as 32-bit types. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. + Some non-GNU implementations of Fortran provide this intrinsic as only a function, not as a subroutine. ") *************** as the function value, *** 1101,1115 **** and the user and system components of this in @samp{@var{@1@}(1)} and @samp{@var{@1@}(2)} respectively. The functions' value is equal to @samp{@var{@1@}(1) + @var{@1@}(2)}. ") DEFDOC (ETIME_subr, "Get elapsed time for process.", "\ Return the number of seconds of runtime since the start of the process's execution ! in @var{@1@}, ! and the user and system components of this in @samp{@var{@2@}(1)} ! and @samp{@var{@2@}(2)} respectively. ! The value of @var{@1@} is equal to @samp{@var{@2@}(1) + @var{@2@}(2)}. Some non-GNU implementations of Fortran provide this intrinsic as only a function, not as a subroutine. --- 1125,1159 ---- and the user and system components of this in @samp{@var{@1@}(1)} and @samp{@var{@1@}(2)} respectively. The functions' value is equal to @samp{@var{@1@}(1) + @var{@1@}(2)}. + + @cindex wraparound, timings + @cindex limits, timings + On some systems, the underlying timings are represented + using types with sufficiently small limits that overflows + (wraparounds) are possible, such as 32-bit types. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. ") DEFDOC (ETIME_subr, "Get elapsed time for process.", "\ Return the number of seconds of runtime since the start of the process's execution ! in @var{@2@}, ! and the user and system components of this in @samp{@var{@1@}(1)} ! and @samp{@var{@1@}(2)} respectively. ! The value of @var{@2@} is equal to @samp{@var{@1@}(1) + @var{@1@}(2)}. ! ! @cindex wraparound, timings ! @cindex limits, timings ! On some systems, the underlying timings are represented ! using types with sufficiently small limits that overflows ! (wraparounds) are possible, such as 32-bit types. ! Therefore, the values returned by this intrinsic ! might be, or become, negative, ! or numerically less than previous values, ! during a single run of the compiled program. Some non-GNU implementations of Fortran provide this intrinsic as only a function, not as a subroutine. *************** Equivalent to: *** 1124,1129 **** --- 1168,1184 ---- CTIME(TIME8()) @end example + @cindex Y10K compliance + @cindex Year 10000 compliance + @cindex wraparound, Y10K + @cindex limits, Y10K + Programs making use of this intrinsic + might not be Year 10000 (Y10K) 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 10000. + @xref{CTime Intrinsic (function)}. ") *************** Equivalent to: *** 1137,1142 **** --- 1192,1208 ---- CALL CTIME(@var{@1@}, TIME8()) @end example + @cindex Y10K compliance + @cindex Year 10000 compliance + @cindex wraparound, Y10K + @cindex limits, Y10K + Programs making use of this intrinsic + might not be Year 10000 (Y10K) 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 10000. + @xref{CTime Intrinsic (subroutine)}. Some non-GNU implementations of Fortran provide this intrinsic as *************** Fills @var{@1@} with the numerical value *** 1226,1231 **** --- 1292,1308 ---- of day, month (in the range 1--12), and year in elements 1, 2, and 3, respectively. The year has four significant digits. + + @cindex Y10K compliance + @cindex Year 10000 compliance + @cindex wraparound, Y10K + @cindex limits, Y10K + Programs making use of this intrinsic + might not be Year 10000 (Y10K) 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 10000. ") DEFDOC (IDATE_vxt, "Get local time info (VAX/VMS).", "\ *************** The month (in the range 1--12) is return *** 1234,1240 **** --- 1311,1330 ---- the day (in the range 1--7) 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. + 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 + for the current date. ") DEFDOC (ITIME, "Get local time of day.", "\ *************** DEFDOC (MCLOCK, "Get number of clock tic *** 1246,1254 **** --- 1336,1351 ---- Returns the number of clock ticks since the start of the process. Supported on systems with @code{clock(3)} (q.v.). + @cindex wraparound, timings + @cindex limits, timings This intrinsic is not fully portable, such as to systems with 32-bit @code{INTEGER} types but supporting times wider than 32 bits. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. + @xref{MClock8 Intrinsic}, for information on a similar intrinsic that might be portable to more GNU Fortran implementations, though to fewer *************** DEFDOC (MCLOCK8, "Get number of clock ti *** 1262,1273 **** --- 1359,1376 ---- Returns the number of clock ticks since the start of the process. Supported on systems with @code{clock(3)} (q.v.). + @cindex wraparound, timings + @cindex limits, timings @emph{Warning:} this intrinsic does not increase the range of the timing values over that returned by @code{clock(3)}. On a system with a 32-bit @code{clock(3)}, @code{@0@} will return a 32-bit value, even though converted to an @samp{INTEGER(KIND=2)} value. That means overflows of the 32-bit value can still occur. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. No Fortran implementations other than GNU Fortran are known to support this intrinsic at the time of this *************** If the system does not support @code{clo *** 1283,1299 **** --- 1386,1430 ---- DEFDOC (SECNDS, "Get local time offset since midnight.", "\ Returns the local time in seconds since midnight minus the value @var{@1@}. + + @cindex wraparound, timings + @cindex limits, timings + This values returned by this intrinsic + become numerically less than previous values + (they wrap around) during a single run of the + compiler program, under normal circumstances + (such as running through the midnight hour). ") DEFDOC (SECOND_func, "Get CPU time for process in seconds.", "\ Returns the process's runtime in seconds---the same value as the UNIX function @code{etime} returns. + + @cindex wraparound, timings + @cindex limits, timings + On some systems, the underlying timings are represented + using types with sufficiently small limits that overflows + (wraparounds) are possible, such as 32-bit types. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. ") DEFDOC (SECOND_subr, "Get CPU time for process@99@in seconds.", "\ Returns the process's runtime in seconds in @var{@1@}---the same value as the UNIX function @code{etime} returns. + @cindex wraparound, timings + @cindex limits, timings + On some systems, the underlying timings are represented + using types with sufficiently small limits that overflows + (wraparounds) are possible, such as 32-bit types. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. + This routine is known from Cray Fortran. @xref{CPU_Time Intrinsic}, for a standard equivalent. ") *************** isn't in general. *** 1307,1318 **** --- 1438,1469 ---- @var{@3@} is the maximum value this can take, which isn't very useful in this implementation since it's just the maximum C @code{unsigned int} value. + + @cindex wraparound, timings + @cindex limits, timings + On some systems, the underlying timings are represented + using types with sufficiently small limits that overflows + (wraparounds) are possible, such as 32-bit types. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. ") DEFDOC (CPU_TIME, "Get current CPU time.", "\ Returns in @var{@1@} the current value of the system time. This implementation of the Fortran 95 intrinsic is just an alias for @code{second} @xref{Second Intrinsic (subroutine)}. + + @cindex wraparound, timings + @cindex limits, timings + On some systems, the underlying timings are represented + using types with sufficiently small limits that overflows + (wraparounds) are possible, such as 32-bit types. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. ") DEFDOC (TIME8, "Get current time as time value.", "\ *************** Returns the current time encoded as a lo *** 1321,1332 **** --- 1472,1489 ---- This value is suitable for passing to @code{CTIME}, @code{GMTIME}, and @code{LTIME}. + @cindex wraparound, timings + @cindex limits, timings @emph{Warning:} this intrinsic does not increase the range of the timing values over that returned by @code{time(3)}. On a system with a 32-bit @code{time(3)}, @code{@0@} will return a 32-bit value, even though converted to an @samp{INTEGER(KIND=2)} value. That means overflows of the 32-bit value can still occur. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. No Fortran implementations other than GNU Fortran are known to support this intrinsic at the time of this *************** Returns the current time encoded as an i *** 1342,1350 **** --- 1499,1514 ---- This value is suitable for passing to @code{CTIME}, @code{GMTIME}, and @code{LTIME}. + @cindex wraparound, timings + @cindex limits, timings This intrinsic is not fully portable, such as to systems with 32-bit @code{INTEGER} types but supporting times wider than 32 bits. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. + @xref{Time8 Intrinsic}, for information on a similar intrinsic that might be portable to more GNU Fortran implementations, though to fewer *************** See @code{erf(3m)}, which provides the i *** 1378,1384 **** DEFDOC (ERFC, "Complementary error function.", "\ Returns the complementary error function of @var{@1@}: ! @samp{ERFC(R) = 1 - ERF(R)} (except that the result may be more accurate than explicitly evaluating that formulae would give). See @code{erfc(3m)}, which provides the implementation. ") --- 1542,1548 ---- DEFDOC (ERFC, "Complementary error function.", "\ Returns the complementary error function of @var{@1@}: ! @samp{ERFC(R) = 1 - ERF(R)} (except that the result might be more accurate than explicitly evaluating that formulae would give). See @code{erfc(3m)}, which provides the implementation. ") *************** See @code{chdir(3)}. *** 1458,1464 **** @emph{Caution:} Using this routine during I/O to a unit connected with a non-absolute file name can cause subsequent I/O on such a unit to fail ! because the I/O library may reopen files by name. Some non-GNU implementations of Fortran provide this intrinsic as only a function, not as a subroutine, or do not support the --- 1622,1628 ---- @emph{Caution:} Using this routine during I/O to a unit connected with a non-absolute file name can cause subsequent I/O on such a unit to fail ! because the I/O library might reopen files by name. Some non-GNU implementations of Fortran provide this intrinsic as only a function, not as a subroutine, or do not support the *************** See @code{chdir(3)}. *** 1472,1478 **** @emph{Caution:} Using this routine during I/O to a unit connected with a non-absolute file name can cause subsequent I/O on such a unit to fail ! because the I/O library may reopen files by name. Due to the side effects performed by this intrinsic, the function form is not recommended. --- 1636,1642 ---- @emph{Caution:} Using this routine during I/O to a unit connected with a non-absolute file name can cause subsequent I/O on such a unit to fail ! because the I/O library might reopen files by name. Due to the side effects performed by this intrinsic, the function form is not recommended. *************** Returns 0 on success or a non-zero error *** 1492,1498 **** Note that this currently works by actually invoking @code{/bin/chmod} (or the @code{chmod} found when ! the library was configured) and so may fail in some circumstances and will, anyway, be slow. Due to the side effects performed by this intrinsic, the function --- 1656,1662 ---- Note that this currently works by actually invoking @code{/bin/chmod} (or the @code{chmod} found when ! the library was configured) and so might fail in some circumstances and will, anyway, be slow. Due to the side effects performed by this intrinsic, the function *************** If the @var{@3@} argument is supplied, i *** 1514,1520 **** Note that this currently works by actually invoking @code{/bin/chmod} (or the @code{chmod} found when ! the library was configured) and so may fail in some circumstances and will, anyway, be slow. Some non-GNU implementations of Fortran provide this intrinsic as --- 1678,1684 ---- Note that this currently works by actually invoking @code{/bin/chmod} (or the @code{chmod} found when ! the library was configured) and so might fail in some circumstances and will, anyway, be slow. Some non-GNU implementations of Fortran provide this intrinsic as *************** Fills @var{@1@} with the system's host n *** 2077,2083 **** @code{gethostname(2)}, returning 0 on success or a non-zero error code (@code{ENOSYS} if the system does not provide @code{gethostname(2)}). ! On some systems (specifically SCO) it may be necessary to link the ``socket'' library if you call this routine. Typically this means adding @samp{-lg2c -lsocket -lm} to the @code{g77} command line when linking the program. --- 2241,2247 ---- @code{gethostname(2)}, returning 0 on success or a non-zero 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 ``socket'' library if you call this routine. Typically this means adding @samp{-lg2c -lsocket -lm} to the @code{g77} command line when linking the program. *************** Some non-GNU implementations of Fortran *** 2094,2100 **** only a function, not as a subroutine, or do not support the (optional) @var{@2@} argument. ! On some systems (specifically SCO) it may be necessary to link the ``socket'' library if you call this routine. Typically this means adding @samp{-lg2c -lsocket -lm} to the @code{g77} command line when linking the program. --- 2258,2264 ---- only a function, not as a subroutine, or do not support the (optional) @var{@2@} argument. ! On some systems (specifically SCO) it might be necessary to link the ``socket'' library if you call this routine. Typically this means adding @samp{-lg2c -lsocket -lm} to the @code{g77} command line when linking the program. *************** terminal. *** 2217,2224 **** ") DEFDOC (TTYNAM_subr, "Get name of terminal device for unit.", "\ ! Sets @var{@1@} to the name of the terminal device open on logical unit ! @var{@2@} or a blank string if @var{@2@} is not connected to a terminal. Some non-GNU implementations of Fortran provide this intrinsic as --- 2381,2388 ---- ") DEFDOC (TTYNAM_subr, "Get name of terminal device for unit.", "\ ! Sets @var{@2@} to the name of the terminal device open on logical unit ! @var{@1@} or to a blank string if @var{@1@} is not connected to a terminal. Some non-GNU implementations of Fortran provide this intrinsic as *************** DEFDOC (TIME_vxt, "Get the time as a cha *** 2415,2421 **** Returns in @var{@1@} a character representation of the current time as obtained from @code{ctime(3)}. ! @xref{Fdate Intrinsic (subroutine)}, for an equivalent routine. ") DEFDOC (IBCLR, "Clear a bit.", "\ --- 2579,2596 ---- Returns in @var{@1@} a character representation of the current time as obtained from @code{ctime(3)}. ! @cindex Y10K compliance ! @cindex Year 10000 compliance ! @cindex wraparound, Y10K ! @cindex limits, Y10K ! Programs making use of this intrinsic ! might not be Year 10000 (Y10K) 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 10000. ! ! @xref{FDate Intrinsic (subroutine)}, for an equivalent routine. ") DEFDOC (IBCLR, "Clear a bit.", "\ *************** All bits representing @var{@1@} are shif *** 2445,2452 **** indicates no shift and @samp{@var{@2@}.LT.0} indicates a right shift. If the absolute value of the shift count is greater than @samp{BIT_SIZE(@var{@1@})}, the result is undefined. ! Bits shifted out from the left end or the right end, as the case may be, ! are lost. Zeros are shifted in from the opposite end. @xref{IShftC Intrinsic}, for the circular-shift equivalent. --- 2620,2626 ---- indicates no shift and @samp{@var{@2@}.LT.0} indicates a right shift. If the absolute value of the shift count is greater than @samp{BIT_SIZE(@var{@1@})}, the result is undefined. ! Bits shifted out from the left end or the right end are lost. Zeros are shifted in from the opposite end. @xref{IShftC Intrinsic}, for the circular-shift equivalent. *************** minutes from UTC, hour of the day, minut *** 2513,2518 **** --- 2687,2703 ---- of the minute, and milliseconds of the second in successive values of the array. @end table + + @cindex Y10K compliance + @cindex Year 10000 compliance + @cindex wraparound, Y10K + @cindex limits, Y10K + Programs making use of this intrinsic + might not be Year 10000 (Y10K) 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 10000. On systems where a millisecond timer isn't available, the millisecond value is returned as zero. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/intdoc.texi gcc-2.95/gcc/f/intdoc.texi *** egcs-1.1.2/gcc/f/intdoc.texi Fri Feb 26 05:14:36 1999 --- gcc-2.95/gcc/f/intdoc.texi Wed May 12 13:56:21 1999 *************** *** 274,283 **** * DTanH Intrinsic:: Hyperbolic tangent (archaic). @end ifset @ifset familyF2U ! * Dtime Intrinsic (subroutine):: Get elapsed time since last time. @end ifset @ifset familyBADU77 ! * Dtime Intrinsic (function):: Get elapsed time since last time. @end ifset @ifset familyF90 * EOShift Intrinsic:: (Reserved for future use.) --- 274,283 ---- * DTanH Intrinsic:: Hyperbolic tangent (archaic). @end ifset @ifset familyF2U ! * DTime Intrinsic (subroutine):: Get elapsed time since last time. @end ifset @ifset familyBADU77 ! * DTime Intrinsic (function):: Get elapsed time since last time. @end ifset @ifset familyF90 * EOShift Intrinsic:: (Reserved for future use.) *************** *** 297,304 **** * Exponent Intrinsic:: (Reserved for future use.) @end ifset @ifset familyF2U ! * Fdate Intrinsic (subroutine):: Get current time as Day Mon dd hh:mm:ss yyyy. ! * Fdate Intrinsic (function):: Get current time as Day Mon dd hh:mm:ss yyyy. * FGet Intrinsic (subroutine):: Read a character from unit 5 stream-wise. @end ifset @ifset familyBADU77 --- 297,304 ---- * Exponent Intrinsic:: (Reserved for future use.) @end ifset @ifset familyF2U ! * FDate Intrinsic (subroutine):: Get current time as Day Mon dd hh:mm:ss yyyy. ! * FDate Intrinsic (function):: Get current time as Day Mon dd hh:mm:ss yyyy. * FGet Intrinsic (subroutine):: Read a character from unit 5 stream-wise. @end ifset @ifset familyBADU77 *************** See @code{chdir(3)}. *** 2231,2237 **** @emph{Caution:} Using this routine during I/O to a unit connected with a non-absolute file name can cause subsequent I/O on such a unit to fail ! because the I/O library may reopen files by name. Some non-GNU implementations of Fortran provide this intrinsic as only a function, not as a subroutine, or do not support the --- 2231,2237 ---- @emph{Caution:} Using this routine during I/O to a unit connected with a non-absolute file name can cause subsequent I/O on such a unit to fail ! because the I/O library might reopen files by name. Some non-GNU implementations of Fortran provide this intrinsic as only a function, not as a subroutine, or do not support the *************** See @code{chdir(3)}. *** 2270,2276 **** @emph{Caution:} Using this routine during I/O to a unit connected with a non-absolute file name can cause subsequent I/O on such a unit to fail ! because the I/O library may reopen files by name. Due to the side effects performed by this intrinsic, the function form is not recommended. --- 2270,2276 ---- @emph{Caution:} Using this routine during I/O to a unit connected with a non-absolute file name can cause subsequent I/O on such a unit to fail ! because the I/O library might reopen files by name. Due to the side effects performed by this intrinsic, the function form is not recommended. *************** If the @var{Status} argument is supplied *** 2319,2325 **** Note that this currently works by actually invoking @code{/bin/chmod} (or the @code{chmod} found when ! the library was configured) and so may fail in some circumstances and will, anyway, be slow. Some non-GNU implementations of Fortran provide this intrinsic as --- 2319,2325 ---- Note that this currently works by actually invoking @code{/bin/chmod} (or the @code{chmod} found when ! the library was configured) and so might fail in some circumstances and will, anyway, be slow. Some non-GNU implementations of Fortran provide this intrinsic as *************** Returns 0 on success or a non-zero error *** 2369,2375 **** Note that this currently works by actually invoking @code{/bin/chmod} (or the @code{chmod} found when ! the library was configured) and so may fail in some circumstances and will, anyway, be slow. Due to the side effects performed by this intrinsic, the function --- 2369,2375 ---- Note that this currently works by actually invoking @code{/bin/chmod} (or the @code{chmod} found when ! the library was configured) and so might fail in some circumstances and will, anyway, be slow. Due to the side effects performed by this intrinsic, the function *************** Returns in @var{Seconds} the current val *** 2626,2631 **** --- 2626,2641 ---- This implementation of the Fortran 95 intrinsic is just an alias for @code{second} @xref{Second Intrinsic (subroutine)}. + @cindex wraparound, timings + @cindex limits, timings + On some systems, the underlying timings are represented + using types with sufficiently small limits that overflows + (wraparounds) are possible, such as 32-bit types. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. + @node CShift Intrinsic @subsubsection CShift Intrinsic @cindex CShift intrinsic *************** to one type for @var{X}. *** 2699,2712 **** @noindent @example ! CALL CTime(@var{Result}, @var{STime}) @end example @noindent ! @var{Result}: @code{CHARACTER}; scalar; INTENT(OUT). @noindent ! @var{STime}: @code{INTEGER}; scalar; INTENT(IN). @noindent Intrinsic groups: @code{unix}. --- 2709,2722 ---- @noindent @example ! CALL CTime(@var{STime}, @var{Result}) @end example @noindent ! @var{STime}: @code{INTEGER}; scalar; INTENT(IN). @noindent ! @var{Result}: @code{CHARACTER}; scalar; INTENT(OUT). @noindent Intrinsic groups: @code{unix}. *************** representing the numeric day of the mont *** 2966,2972 **** --- 2976,2986 ---- abbreviation of the month name @var{mmm} and the last two digits of the year @var{yy}, e.g.@: @samp{25-Nov-96}. + @cindex Y2K compliance + @cindex Year 2000 compliance 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. @xref{CTime Intrinsic (subroutine)}, for information on obtaining more digits for the current (or any) date. *************** of the minute, and milliseconds *** 3017,3022 **** --- 3031,3047 ---- of the second in successive values of the array. @end table + @cindex Y10K compliance + @cindex Year 10000 compliance + @cindex wraparound, Y10K + @cindex limits, Y10K + Programs making use of this intrinsic + might not be Year 10000 (Y10K) 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 10000. + On systems where a millisecond timer isn't available, the millisecond value is returned as zero. *************** to one type for @var{X}. *** 4088,4108 **** @end ifset @ifset familyF2U ! @node Dtime Intrinsic (subroutine) ! @subsubsection Dtime Intrinsic (subroutine) ! @cindex Dtime intrinsic ! @cindex intrinsics, Dtime @noindent @example ! CALL Dtime(@var{Result}, @var{TArray}) @end example @noindent ! @var{Result}: @code{REAL(KIND=1)}; scalar; INTENT(OUT). @noindent ! @var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); INTENT(OUT). @noindent Intrinsic groups: @code{unix}. --- 4113,4133 ---- @end ifset @ifset familyF2U ! @node DTime Intrinsic (subroutine) ! @subsubsection DTime Intrinsic (subroutine) ! @cindex DTime intrinsic ! @cindex intrinsics, DTime @noindent @example ! CALL DTime(@var{TArray}, @var{Result}) @end example @noindent ! @var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); INTENT(OUT). @noindent ! @var{Result}: @code{REAL(KIND=1)}; scalar; INTENT(OUT). @noindent Intrinsic groups: @code{unix}. *************** The value of @var{Result} is equal to @s *** 4120,4145 **** Subsequent invocations of @samp{DTIME()} set values based on accumulations since the previous invocation. Some non-GNU implementations of Fortran provide this intrinsic as only a function, not as a subroutine. For information on other intrinsics with the same name: ! @xref{Dtime Intrinsic (function)}. @end ifset @ifset familyBADU77 ! @node Dtime Intrinsic (function) ! @subsubsection Dtime Intrinsic (function) ! @cindex Dtime intrinsic ! @cindex intrinsics, Dtime @noindent @example ! Dtime(@var{TArray}) @end example @noindent ! Dtime: @code{REAL(KIND=1)} function. @noindent @var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); INTENT(OUT). --- 4145,4180 ---- Subsequent invocations of @samp{DTIME()} set values based on accumulations since the previous invocation. + @cindex wraparound, timings + @cindex limits, timings + On some systems, the underlying timings are represented + using types with sufficiently small limits that overflows + (wraparounds) are possible, such as 32-bit types. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. + Some non-GNU implementations of Fortran provide this intrinsic as only a function, not as a subroutine. For information on other intrinsics with the same name: ! @xref{DTime Intrinsic (function)}. @end ifset @ifset familyBADU77 ! @node DTime Intrinsic (function) ! @subsubsection DTime Intrinsic (function) ! @cindex DTime intrinsic ! @cindex intrinsics, DTime @noindent @example ! DTime(@var{TArray}) @end example @noindent ! DTime: @code{REAL(KIND=1)} function. @noindent @var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); INTENT(OUT). *************** The functions' value is equal to @samp{@ *** 4160,4170 **** Subsequent invocations of @samp{DTIME()} return values accumulated since the previous invocation. Due to the side effects performed by this intrinsic, the function form is not recommended. For information on other intrinsics with the same name: ! @xref{Dtime Intrinsic (subroutine)}. @end ifset @ifset familyF90 --- 4195,4215 ---- Subsequent invocations of @samp{DTIME()} return values accumulated since the previous invocation. + @cindex wraparound, timings + @cindex limits, timings + On some systems, the underlying timings are represented + using types with sufficiently small limits that overflows + (wraparounds) are possible, such as 32-bit types. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. + Due to the side effects performed by this intrinsic, the function form is not recommended. For information on other intrinsics with the same name: ! @xref{DTime Intrinsic (subroutine)}. @end ifset @ifset familyF90 *************** Intrinsic groups: @code{unix}. *** 4238,4244 **** Description: Returns the complementary error function of @var{X}: ! @samp{ERFC(R) = 1 - ERF(R)} (except that the result may be more accurate than explicitly evaluating that formulae would give). See @code{erfc(3m)}, which provides the implementation. --- 4283,4289 ---- Description: Returns the complementary error function of @var{X}: ! @samp{ERFC(R) = 1 - ERF(R)} (except that the result might be more accurate than explicitly evaluating that formulae would give). See @code{erfc(3m)}, which provides the implementation. *************** See @code{erfc(3m)}, which provides the *** 4249,4262 **** @noindent @example ! CALL ETime(@var{Result}, @var{TArray}) @end example @noindent ! @var{Result}: @code{REAL(KIND=1)}; scalar; INTENT(OUT). @noindent ! @var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); INTENT(OUT). @noindent Intrinsic groups: @code{unix}. --- 4294,4307 ---- @noindent @example ! CALL ETime(@var{TArray}, @var{Result}) @end example @noindent ! @var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); INTENT(OUT). @noindent ! @var{Result}: @code{REAL(KIND=1)}; scalar; INTENT(OUT). @noindent Intrinsic groups: @code{unix}. *************** and the user and system components of th *** 4271,4276 **** --- 4316,4331 ---- and @samp{@var{TArray}(2)} respectively. The value of @var{Result} is equal to @samp{@var{TArray}(1) + @var{TArray}(2)}. + @cindex wraparound, timings + @cindex limits, timings + On some systems, the underlying timings are represented + using types with sufficiently small limits that overflows + (wraparounds) are possible, such as 32-bit types. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. + Some non-GNU implementations of Fortran provide this intrinsic as only a function, not as a subroutine. *************** and the user and system components of th *** 4306,4311 **** --- 4361,4376 ---- and @samp{@var{TArray}(2)} respectively. The functions' value is equal to @samp{@var{TArray}(1) + @var{TArray}(2)}. + @cindex wraparound, timings + @cindex limits, timings + On some systems, the underlying timings are represented + using types with sufficiently small limits that overflows + (wraparounds) are possible, such as 32-bit types. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. + For information on other intrinsics with the same name: @xref{ETime Intrinsic (subroutine)}. *************** external procedure. *** 4376,4389 **** @end ifset @ifset familyF2U ! @node Fdate Intrinsic (subroutine) ! @subsubsection Fdate Intrinsic (subroutine) ! @cindex Fdate intrinsic ! @cindex intrinsics, Fdate @noindent @example ! CALL Fdate(@var{Date}) @end example @noindent --- 4441,4454 ---- @end ifset @ifset familyF2U ! @node FDate Intrinsic (subroutine) ! @subsubsection FDate Intrinsic (subroutine) ! @cindex FDate intrinsic ! @cindex intrinsics, FDate @noindent @example ! CALL FDate(@var{Date}) @end example @noindent *************** Equivalent to: *** 4404,4429 **** CALL CTIME(@var{Date}, TIME8()) @end example @xref{CTime Intrinsic (subroutine)}. Some non-GNU implementations of Fortran provide this intrinsic as only a function, not as a subroutine. For information on other intrinsics with the same name: ! @xref{Fdate Intrinsic (function)}. ! @node Fdate Intrinsic (function) ! @subsubsection Fdate Intrinsic (function) ! @cindex Fdate intrinsic ! @cindex intrinsics, Fdate @noindent @example ! Fdate() @end example @noindent ! Fdate: @code{CHARACTER*(*)} function. @noindent Intrinsic groups: @code{unix}. --- 4469,4505 ---- CALL CTIME(@var{Date}, TIME8()) @end example + @cindex Y10K compliance + @cindex Year 10000 compliance + @cindex wraparound, Y10K + @cindex limits, Y10K + Programs making use of this intrinsic + might not be Year 10000 (Y10K) 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 10000. + @xref{CTime Intrinsic (subroutine)}. Some non-GNU implementations of Fortran provide this intrinsic as only a function, not as a subroutine. For information on other intrinsics with the same name: ! @xref{FDate Intrinsic (function)}. ! @node FDate Intrinsic (function) ! @subsubsection FDate Intrinsic (function) ! @cindex FDate intrinsic ! @cindex intrinsics, FDate @noindent @example ! FDate() @end example @noindent ! FDate: @code{CHARACTER*(*)} function. @noindent Intrinsic groups: @code{unix}. *************** Equivalent to: *** 4439,4448 **** CTIME(TIME8()) @end example @xref{CTime Intrinsic (function)}. For information on other intrinsics with the same name: ! @xref{Fdate Intrinsic (subroutine)}. @node FGet Intrinsic (subroutine) @subsubsection FGet Intrinsic (subroutine) --- 4515,4535 ---- CTIME(TIME8()) @end example + @cindex Y10K compliance + @cindex Year 10000 compliance + @cindex wraparound, Y10K + @cindex limits, Y10K + Programs making use of this intrinsic + might not be Year 10000 (Y10K) 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 10000. + @xref{CTime Intrinsic (function)}. For information on other intrinsics with the same name: ! @xref{FDate Intrinsic (subroutine)}. @node FGet Intrinsic (subroutine) @subsubsection FGet Intrinsic (subroutine) *************** Some non-GNU implementations of Fortran *** 5457,5463 **** only a function, not as a subroutine, or do not support the (optional) @var{Status} argument. ! On some systems (specifically SCO) it may be necessary to link the ``socket'' library if you call this routine. Typically this means adding @samp{-lg2c -lsocket -lm} to the @code{g77} command line when linking the program. --- 5544,5550 ---- only a function, not as a subroutine, or do not support the (optional) @var{Status} argument. ! On some systems (specifically SCO) it might be necessary to link the ``socket'' library if you call this routine. Typically this means adding @samp{-lg2c -lsocket -lm} to the @code{g77} command line when linking the program. *************** Fills @var{Name} with the system's host *** 5491,5497 **** @code{gethostname(2)}, returning 0 on success or a non-zero error code (@code{ENOSYS} if the system does not provide @code{gethostname(2)}). ! On some systems (specifically SCO) it may be necessary to link the ``socket'' library if you call this routine. Typically this means adding @samp{-lg2c -lsocket -lm} to the @code{g77} command line when linking the program. --- 5578,5584 ---- @code{gethostname(2)}, returning 0 on success or a non-zero 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 ``socket'' library if you call this routine. Typically this means adding @samp{-lg2c -lsocket -lm} to the @code{g77} command line when linking the program. *************** of day, month (in the range 1--12), and *** 5811,5816 **** --- 5898,5914 ---- respectively. The year has four significant digits. + @cindex Y10K compliance + @cindex Year 10000 compliance + @cindex wraparound, Y10K + @cindex limits, Y10K + Programs making use of this intrinsic + might not be Year 10000 (Y10K) 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 10000. + For information on other intrinsics with the same name: @xref{IDate Intrinsic (VXT)}. *************** The month (in the range 1--12) is return *** 5846,5852 **** --- 5944,5963 ---- the day (in the range 1--7) 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. + 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 + for the current date. For information on other intrinsics with the same name: @xref{IDate Intrinsic (UNIX)}. *************** All bits representing @var{I} are shifte *** 6603,6610 **** indicates no shift and @samp{@var{Shift}.LT.0} indicates a right shift. If the absolute value of the shift count is greater than @samp{BIT_SIZE(@var{I})}, the result is undefined. ! Bits shifted out from the left end or the right end, as the case may be, ! are lost. Zeros are shifted in from the opposite end. @xref{IShftC Intrinsic}, for the circular-shift equivalent. --- 6714,6720 ---- indicates no shift and @samp{@var{Shift}.LT.0} indicates a right shift. If the absolute value of the shift count is greater than @samp{BIT_SIZE(@var{I})}, the result is undefined. ! Bits shifted out from the left end or the right end are lost. Zeros are shifted in from the opposite end. @xref{IShftC Intrinsic}, for the circular-shift equivalent. *************** Description: *** 7997,8005 **** --- 8107,8122 ---- Returns the number of clock ticks since the start of the process. Supported on systems with @code{clock(3)} (q.v.). + @cindex wraparound, timings + @cindex limits, timings This intrinsic is not fully portable, such as to systems with 32-bit @code{INTEGER} types but supporting times wider than 32 bits. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. + @xref{MClock8 Intrinsic}, for information on a similar intrinsic that might be portable to more GNU Fortran implementations, though to fewer *************** Description: *** 8030,8041 **** --- 8147,8164 ---- Returns the number of clock ticks since the start of the process. Supported on systems with @code{clock(3)} (q.v.). + @cindex wraparound, timings + @cindex limits, timings @emph{Warning:} this intrinsic does not increase the range of the timing values over that returned by @code{clock(3)}. On a system with a 32-bit @code{clock(3)}, @code{MCLOCK8} will return a 32-bit value, even though converted to an @samp{INTEGER(KIND=2)} value. That means overflows of the 32-bit value can still occur. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. No Fortran implementations other than GNU Fortran are known to support this intrinsic at the time of this *************** Description: *** 9141,9146 **** --- 9264,9277 ---- Returns the local time in seconds since midnight minus the value @var{T}. + @cindex wraparound, timings + @cindex limits, timings + This values returned by this intrinsic + become numerically less than previous values + (they wrap around) during a single run of the + compiler program, under normal circumstances + (such as running through the midnight hour). + @end ifset @ifset familyF2U @node Second Intrinsic (function) *************** Description: *** 9165,9170 **** --- 9296,9311 ---- Returns the process's runtime in seconds---the same value as the UNIX function @code{etime} returns. + @cindex wraparound, timings + @cindex limits, timings + On some systems, the underlying timings are represented + using types with sufficiently small limits that overflows + (wraparounds) are possible, such as 32-bit types. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. + For information on other intrinsics with the same name: @xref{Second Intrinsic (subroutine)}. *************** Description: *** 9190,9195 **** --- 9331,9346 ---- Returns the process's runtime in seconds in @var{Seconds}---the same value as the UNIX function @code{etime} returns. + @cindex wraparound, timings + @cindex limits, timings + On some systems, the underlying timings are represented + using types with sufficiently small limits that overflows + (wraparounds) are possible, such as 32-bit types. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. + This routine is known from Cray Fortran. @xref{CPU_Time Intrinsic}, for a standard equivalent. *************** isn't in general. *** 10086,10091 **** --- 10237,10252 ---- in this implementation since it's just the maximum C @code{unsigned int} value. + @cindex wraparound, timings + @cindex limits, timings + On some systems, the underlying timings are represented + using types with sufficiently small limits that overflows + (wraparounds) are possible, such as 32-bit types. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. + @end ifset @ifset familyF77 @node Tan Intrinsic *************** Returns the current time encoded as an i *** 10179,10187 **** --- 10340,10355 ---- This value is suitable for passing to @code{CTIME}, @code{GMTIME}, and @code{LTIME}. + @cindex wraparound, timings + @cindex limits, timings This intrinsic is not fully portable, such as to systems with 32-bit @code{INTEGER} types but supporting times wider than 32 bits. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. + @xref{Time8 Intrinsic}, for information on a similar intrinsic that might be portable to more GNU Fortran implementations, though to fewer *************** Description: *** 10214,10220 **** Returns in @var{Time} a character representation of the current time as obtained from @code{ctime(3)}. ! @xref{Fdate Intrinsic (subroutine)}, for an equivalent routine. For information on other intrinsics with the same name: @xref{Time Intrinsic (UNIX)}. --- 10382,10399 ---- Returns in @var{Time} a character representation of the current time as obtained from @code{ctime(3)}. ! @cindex Y10K compliance ! @cindex Year 10000 compliance ! @cindex wraparound, Y10K ! @cindex limits, Y10K ! Programs making use of this intrinsic ! might not be Year 10000 (Y10K) 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 10000. ! ! @xref{FDate Intrinsic (subroutine)}, for an equivalent routine. For information on other intrinsics with the same name: @xref{Time Intrinsic (UNIX)}. *************** Returns the current time encoded as a lo *** 10245,10256 **** --- 10424,10441 ---- This value is suitable for passing to @code{CTIME}, @code{GMTIME}, and @code{LTIME}. + @cindex wraparound, timings + @cindex limits, timings @emph{Warning:} this intrinsic does not increase the range of the timing values over that returned by @code{time(3)}. On a system with a 32-bit @code{time(3)}, @code{TIME8} will return a 32-bit value, even though converted to an @samp{INTEGER(KIND=2)} value. That means overflows of the 32-bit value can still occur. + Therefore, the values returned by this intrinsic + might be, or become, negative, + or numerically less than previous values, + during a single run of the compiled program. No Fortran implementations other than GNU Fortran are known to support this intrinsic at the time of this *************** external procedure. *** 10310,10323 **** @noindent @example ! CALL TtyNam(@var{Name}, @var{Unit}) @end example @noindent ! @var{Name}: @code{CHARACTER}; scalar; INTENT(OUT). @noindent ! @var{Unit}: @code{INTEGER}; scalar; INTENT(IN). @noindent Intrinsic groups: @code{unix}. --- 10495,10508 ---- @noindent @example ! CALL TtyNam(@var{Unit}, @var{Name}) @end example @noindent ! @var{Unit}: @code{INTEGER}; scalar; INTENT(IN). @noindent ! @var{Name}: @code{CHARACTER}; scalar; INTENT(OUT). @noindent Intrinsic groups: @code{unix}. *************** Intrinsic groups: @code{unix}. *** 10326,10332 **** Description: Sets @var{Name} to the name of the terminal device open on logical unit ! @var{Unit} or a blank string if @var{Unit} is not connected to a terminal. Some non-GNU implementations of Fortran provide this intrinsic as --- 10511,10517 ---- Description: Sets @var{Name} to the name of the terminal device open on logical unit ! @var{Unit} or to a blank string if @var{Unit} is not connected to a terminal. Some non-GNU implementations of Fortran provide this intrinsic as diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/intrin.c gcc-2.95/gcc/f/intrin.c *** egcs-1.1.2/gcc/f/intrin.c Mon Jun 15 19:23:25 1998 --- gcc-2.95/gcc/f/intrin.c Sat Mar 27 02:23:54 1999 *************** *** 1,6 **** /* intrin.c -- Recognize references to intrinsics Copyright (C) 1995-1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* intrin.c -- Recognize references to intrinsics Copyright (C) 1995-1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** the Free Software Foundation, 59 Temple *** 32,53 **** struct _ffeintrin_name_ { ! char *name_uc; ! char *name_lc; ! char *name_ic; ffeintrinGen generic; ffeintrinSpec specific; }; struct _ffeintrin_gen_ { ! char *name; /* Name as seen in program. */ ffeintrinSpec specs[2]; }; struct _ffeintrin_spec_ { ! char *name; /* Uppercase name as seen in source code, lowercase if no source name, "none" if no name at all (NONE case). */ bool is_actualarg; /* Ok to pass as actual arg if -pedantic. */ --- 32,53 ---- struct _ffeintrin_name_ { ! const char *name_uc; ! const char *name_lc; ! const char *name_ic; ffeintrinGen generic; ffeintrinSpec specific; }; struct _ffeintrin_gen_ { ! const char *name; /* Name as seen in program. */ ffeintrinSpec specs[2]; }; struct _ffeintrin_spec_ { ! const char *name; /* Uppercase name as seen in source code, lowercase if no source name, "none" if no name at all (NONE case). */ bool is_actualarg; /* Ok to pass as actual arg if -pedantic. */ *************** struct _ffeintrin_spec_ *** 57,69 **** struct _ffeintrin_imp_ { ! char *name; /* Name of implementation. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ffecomGfrt gfrt_direct; /* library routine, direct-callable form. */ ffecomGfrt gfrt_f2c; /* library routine, f2c-callable form. */ ffecomGfrt gfrt_gnu; /* library routine, gnu-callable form. */ #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ ! char *control; }; static ffebad ffeintrin_check_ (ffeintrinImp imp, ffebldOp op, --- 57,70 ---- struct _ffeintrin_imp_ { ! const char *name; /* Name of implementation. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ffecomGfrt gfrt_direct; /* library routine, direct-callable form. */ ffecomGfrt gfrt_f2c; /* library routine, f2c-callable form. */ ffecomGfrt gfrt_gnu; /* library routine, gnu-callable form. */ #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ ! const char *control; ! char y2kbad; }; static ffebad ffeintrin_check_ (ffeintrinImp imp, ffebldOp op, *************** static struct _ffeintrin_name_ ffeintrin *** 84,94 **** --- 85,97 ---- #define DEFGEN(CODE,NAME,SPEC1,SPEC2) #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) + #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) #include "intrin.def" #undef DEFNAME #undef DEFGEN #undef DEFSPEC #undef DEFIMP + #undef DEFIMPY }; static struct _ffeintrin_gen_ ffeintrin_gens_[] *************** static struct _ffeintrin_gen_ ffeintrin_ *** 99,109 **** --- 102,114 ---- { NAME, { SPEC1, SPEC2, }, }, #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) + #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) #include "intrin.def" #undef DEFNAME #undef DEFGEN #undef DEFSPEC #undef DEFIMP + #undef DEFIMPY }; static struct _ffeintrin_imp_ ffeintrin_imps_[] *************** static struct _ffeintrin_imp_ ffeintrin_ *** 115,124 **** #if FFECOM_targetCURRENT == FFECOM_targetGCC #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \ { NAME, FFECOM_gfrt ## GFRTDIRECT, FFECOM_gfrt ## GFRTF2C, \ ! FFECOM_gfrt ## GFRTGNU, CONTROL }, #elif FFECOM_targetCURRENT == FFECOM_targetFFE #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \ ! { NAME, CONTROL }, #else #error #endif --- 120,134 ---- #if FFECOM_targetCURRENT == FFECOM_targetGCC #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \ { NAME, FFECOM_gfrt ## GFRTDIRECT, FFECOM_gfrt ## GFRTF2C, \ ! FFECOM_gfrt ## GFRTGNU, CONTROL, FALSE }, ! #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \ ! { NAME, FFECOM_gfrt ## GFRTDIRECT, FFECOM_gfrt ## GFRTF2C, \ ! FFECOM_gfrt ## GFRTGNU, CONTROL, Y2KBAD }, #elif FFECOM_targetCURRENT == FFECOM_targetFFE #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \ ! { NAME, CONTROL, FALSE }, ! #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \ ! { NAME, CONTROL, Y2KBAD }, #else #error #endif *************** static struct _ffeintrin_imp_ ffeintrin_ *** 127,132 **** --- 137,143 ---- #undef DEFGEN #undef DEFSPEC #undef DEFIMP + #undef DEFIMPY }; static struct _ffeintrin_spec_ ffeintrin_specs_[] *************** static struct _ffeintrin_spec_ ffeintrin *** 137,146 **** --- 148,159 ---- #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) \ { NAME, CALLABLE, FAMILY, IMP, }, #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) + #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) #include "intrin.def" #undef DEFGEN #undef DEFSPEC #undef DEFIMP + #undef DEFIMPY }; *************** ffeintrin_check_ (ffeintrinImp imp, ffeb *** 153,161 **** ffelexToken t, bool commit) { ! char *c = ffeintrin_imps_[imp].control; bool subr = (c[0] == '-'); ! char *argc; ffebld arg; ffeinfoBasictype bt; ffeinfoKindtype kt; --- 166,174 ---- ffelexToken t, bool commit) { ! const char *c = ffeintrin_imps_[imp].control; bool subr = (c[0] == '-'); ! const char *argc; ffebld arg; ffeinfoBasictype bt; ffeinfoKindtype kt; *************** ffeintrin_check_any_ (ffebld arglist) *** 1152,1160 **** static int ffeintrin_cmp_name_ (const void *name, const void *intrinsic) { ! char *uc = (char *) ((struct _ffeintrin_name_ *) intrinsic)->name_uc; ! char *lc = (char *) ((struct _ffeintrin_name_ *) intrinsic)->name_lc; ! char *ic = (char *) ((struct _ffeintrin_name_ *) intrinsic)->name_ic; return ffesrc_strcmp_2c (ffe_case_intrin (), name, uc, lc, ic); } --- 1165,1173 ---- static int ffeintrin_cmp_name_ (const void *name, const void *intrinsic) { ! const char *uc = ((struct _ffeintrin_name_ *) intrinsic)->name_uc; ! const char *lc = ((struct _ffeintrin_name_ *) intrinsic)->name_lc; ! const char *ic = ((struct _ffeintrin_name_ *) intrinsic)->name_ic; return ffesrc_strcmp_2c (ffe_case_intrin (), name, uc, lc, ic); } *************** ffeintrin_fulfill_generic (ffebld *expr, *** 1374,1379 **** --- 1387,1400 ---- ffebad_string (ffeintrin_gens_[gen].name); ffebad_finish (); } + if (ffeintrin_imps_[imp].y2kbad) + { + ffebad_start (FFEBAD_INTRINSIC_Y2KBAD); + ffebad_here (0, ffelex_token_where_line (t), + ffelex_token_where_column (t)); + ffebad_string (ffeintrin_gens_[gen].name); + ffebad_finish (); + } } } *************** ffeintrin_fulfill_specific (ffebld *expr *** 1408,1414 **** ffeIntrinsicState state; ffebad error; bool any = FALSE; ! char *name; op = ffebld_op (*expr); assert ((op == FFEBLD_opFUNCREF) || (op == FFEBLD_opSUBRREF)); --- 1429,1435 ---- ffeIntrinsicState state; ffebad error; bool any = FALSE; ! const char *name; op = ffebld_op (*expr); assert ((op == FFEBLD_opFUNCREF) || (op == FFEBLD_opSUBRREF)); *************** ffeintrin_fulfill_specific (ffebld *expr *** 1489,1494 **** --- 1510,1523 ---- ffebad_string (name); ffebad_finish (); } + if (ffeintrin_imps_[imp].y2kbad) + { + ffebad_start (FFEBAD_INTRINSIC_Y2KBAD); + ffebad_here (0, ffelex_token_where_line (t), + ffelex_token_where_column (t)); + ffebad_string (name); + ffebad_finish (); + } } } *************** void *** 1522,1530 **** ffeintrin_init_0 () { int i; ! char *p1; ! char *p2; ! char *p3; int colon; if (!ffe_is_do_internal_checks ()) --- 1551,1559 ---- ffeintrin_init_0 () { int i; ! const char *p1; ! const char *p2; ! const char *p3; int colon; if (!ffe_is_do_internal_checks ()) *************** ffeintrin_init_0 () *** 1558,1565 **** break; if ((ISDIGIT (*p1) || (*p1 == '_')) && (*p1 == *p2) && (*p1 == *p3)) continue; ! if (! ISUPPER (*p1) || ! ISLOWER (*p2) ! || (*p1 != toupper (*p2)) || ((*p3 != *p1) && (*p3 != *p2))) break; } assert ((*p1 == *p2) && (*p1 == *p3) && (*p1 == '\0')); --- 1587,1595 ---- break; if ((ISDIGIT (*p1) || (*p1 == '_')) && (*p1 == *p2) && (*p1 == *p3)) continue; ! if (! ISUPPER ((unsigned char)*p1) || ! ISLOWER ((unsigned char)*p2) ! || (*p1 != toupper ((unsigned char)*p2)) ! || ((*p3 != *p1) && (*p3 != *p2))) break; } assert ((*p1 == *p2) && (*p1 == *p3) && (*p1 == '\0')); *************** ffeintrin_init_0 () *** 1567,1573 **** for (i = 0; ((size_t) i) < ARRAY_SIZE (ffeintrin_imps_); ++i) { ! char *c = ffeintrin_imps_[i].control; if (c[0] == '\0') continue; --- 1597,1603 ---- for (i = 0; ((size_t) i) < ARRAY_SIZE (ffeintrin_imps_); ++i) { ! const char *c = ffeintrin_imps_[i].control; if (c[0] == '\0') continue; *************** ffeintrin_is_actualarg (ffeintrinSpec sp *** 1745,1751 **** /* Determine if name is intrinsic, return info. ! char *name; // C-string name of possible intrinsic. ffelexToken t; // NULL if no diagnostic to be given. bool explicit; // TRUE if INTRINSIC name. ffeintrinGen gen; // (TRUE only) Generic id of intrinsic. --- 1775,1781 ---- /* Determine if name is intrinsic, return info. ! const char *name; // C-string name of possible intrinsic. ffelexToken t; // NULL if no diagnostic to be given. bool explicit; // TRUE if INTRINSIC name. ffeintrinGen gen; // (TRUE only) Generic id of intrinsic. *************** ffeintrin_is_actualarg (ffeintrinSpec sp *** 1757,1763 **** // kind accordingly. */ bool ! ffeintrin_is_intrinsic (char *name, ffelexToken t, bool explicit, ffeintrinGen *xgen, ffeintrinSpec *xspec, ffeintrinImp *ximp) { --- 1787,1793 ---- // kind accordingly. */ bool ! ffeintrin_is_intrinsic (const char *name, ffelexToken t, bool explicit, ffeintrinGen *xgen, ffeintrinSpec *xspec, ffeintrinImp *ximp) { *************** ffeintrin_kindtype (ffeintrinSpec spec) *** 1968,1974 **** /* Return name of generic intrinsic. */ ! char * ffeintrin_name_generic (ffeintrinGen gen) { assert (gen < FFEINTRIN_gen); --- 1998,2004 ---- /* Return name of generic intrinsic. */ ! const char * ffeintrin_name_generic (ffeintrinGen gen) { assert (gen < FFEINTRIN_gen); *************** ffeintrin_name_generic (ffeintrinGen gen *** 1977,1983 **** /* Return name of intrinsic implementation. */ ! char * ffeintrin_name_implementation (ffeintrinImp imp) { assert (imp < FFEINTRIN_imp); --- 2007,2013 ---- /* Return name of intrinsic implementation. */ ! const char * ffeintrin_name_implementation (ffeintrinImp imp) { assert (imp < FFEINTRIN_imp); *************** ffeintrin_name_implementation (ffeintrin *** 1986,1992 **** /* Return external/internal name of specific intrinsic. */ ! char * ffeintrin_name_specific (ffeintrinSpec spec) { assert (spec < FFEINTRIN_spec); --- 2016,2022 ---- /* Return external/internal name of specific intrinsic. */ ! const char * ffeintrin_name_specific (ffeintrinSpec spec) { assert (spec < FFEINTRIN_spec); diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/intrin.def gcc-2.95/gcc/f/intrin.def *** egcs-1.1.2/gcc/f/intrin.def Mon Jul 6 01:29:31 1998 --- gcc-2.95/gcc/f/intrin.def Mon May 3 09:07:22 1999 *************** DEFNAME ("DSQRT", "dsqrt", "DSqRt", genN *** 133,139 **** DEFNAME ("DTAN", "dtan", "DTan", genNONE, specDTAN) DEFNAME ("DTAND", "dtand", "DTanD", genNONE, specDTAND) /* VXT */ DEFNAME ("DTANH", "dtanh", "DTanH", genNONE, specDTANH) ! DEFNAME ("DTIME", "dtime", "Dtime", genDTIME, specNONE) /* UNIX */ DEFNAME ("EOSHIFT", "eoshift", "EOShift", genNONE, specEOSHIFT) /* F90 */ DEFNAME ("EPSILON", "epsilon", "Epsilon", genNONE, specEPSILON) /* F90 */ DEFNAME ("ERF", "erf", "ErF", genNONE, specERF) /* UNIX */ --- 133,139 ---- DEFNAME ("DTAN", "dtan", "DTan", genNONE, specDTAN) DEFNAME ("DTAND", "dtand", "DTanD", genNONE, specDTAND) /* VXT */ DEFNAME ("DTANH", "dtanh", "DTanH", genNONE, specDTANH) ! DEFNAME ("DTIME", "dtime", "DTime", genDTIME, specNONE) /* UNIX */ DEFNAME ("EOSHIFT", "eoshift", "EOShift", genNONE, specEOSHIFT) /* F90 */ DEFNAME ("EPSILON", "epsilon", "Epsilon", genNONE, specEPSILON) /* F90 */ DEFNAME ("ERF", "erf", "ErF", genNONE, specERF) /* UNIX */ *************** DEFNAME ("ETIME", "etime", "ETime", genE *** 142,148 **** DEFNAME ("EXIT", "exit", "Exit", genNONE, specEXIT) /* UNIX */ DEFNAME ("EXP", "exp", "Exp", genNONE, specEXP) DEFNAME ("EXPONENT", "exponent", "Exponent", genNONE, specEXPONENT) /* F90 */ ! DEFNAME ("FDATE", "fdate", "Fdate", genFDATE, specNONE) /* UNIX */ DEFNAME ("FGET", "fget", "FGet", genFGET, specNONE) /* UNIX */ DEFNAME ("FGETC", "fgetc", "FGetC", genFGETC, specNONE) /* UNIX */ DEFNAME ("FLOAT", "float", "Float", genNONE, specFLOAT) --- 142,148 ---- DEFNAME ("EXIT", "exit", "Exit", genNONE, specEXIT) /* UNIX */ DEFNAME ("EXP", "exp", "Exp", genNONE, specEXP) DEFNAME ("EXPONENT", "exponent", "Exponent", genNONE, specEXPONENT) /* F90 */ ! DEFNAME ("FDATE", "fdate", "FDate", genFDATE, specNONE) /* UNIX */ DEFNAME ("FGET", "fget", "FGet", genFGET, specNONE) /* UNIX */ DEFNAME ("FGETC", "fgetc", "FGetC", genFGETC, specNONE) /* UNIX */ DEFNAME ("FLOAT", "float", "Float", genNONE, specFLOAT) *************** DEFSPEC (NONE, *** 3006,3011 **** --- 3006,3017 ---- CONTROL -- A control string, described below. + The DEFIMPY macro specifies the above, plus: + + Y2KBAD -- TRUE if the intrinsic is known to be non-Y2K-compliant, + FALSE if it is known to be Y2K-compliant. (In terms of + interface and libg2c implementation.) + */ /* The control string has the following format: *************** DEFIMP (CHMOD_subr, "CHMOD_subr", CHMOD, *** 3231,3238 **** DEFIMP (COMPLEX, "COMPLEX", ,,, "C=:*:Real=S*,Imag=S*") DEFIMP (CPU_TIME, "CPU_TIME", SECOND,,, "--:-:Seconds=R*w") DEFIMP (CTIME_func, "CTIME_func", CTIME,,, "A1*:-:STime=I*") ! DEFIMP (CTIME_subr, "CTIME_subr", CTIME,,, "--:-:Result=A1w,STime=I*") ! DEFIMP (DATE, "DATE", DATE,,, "--:-:Date=A1w") DEFIMP (DATE_AND_TIME, "DATE_AND_TIME", DATE_AND_TIME,,, "--:-:Date=A1w,Time=?A1w,Zone=?A1w,Values=?I1(8)w") DEFIMP (DBESJ0, "DBESJ0", L_BESJ0,,, "R2:-:X=R2") DEFIMP (DBESJ1, "DBESJ1", L_BESJ1,,, "R2:-:X=R2") --- 3237,3244 ---- DEFIMP (COMPLEX, "COMPLEX", ,,, "C=:*:Real=S*,Imag=S*") DEFIMP (CPU_TIME, "CPU_TIME", SECOND,,, "--:-:Seconds=R*w") DEFIMP (CTIME_func, "CTIME_func", CTIME,,, "A1*:-:STime=I*") ! DEFIMP (CTIME_subr, "CTIME_subr", CTIME,,, "--:-:STime=I*,Result=A1w") ! DEFIMPY (DATE, "DATE", DATE,,, "--:-:Date=A1w", TRUE) DEFIMP (DATE_AND_TIME, "DATE_AND_TIME", DATE_AND_TIME,,, "--:-:Date=A1w,Time=?A1w,Zone=?A1w,Values=?I1(8)w") DEFIMP (DBESJ0, "DBESJ0", L_BESJ0,,, "R2:-:X=R2") DEFIMP (DBESJ1, "DBESJ1", L_BESJ1,,, "R2:-:X=R2") *************** DEFIMP (DFLOAT, "DFLOAT", ,,, "R2:-:A=I *** 3247,3257 **** DEFIMP (DIMAG, "DIMAG", ,DIMAG,, "R2:-:Z=C2") DEFIMP (DREAL, "DREAL", ,,, "R2:-:A=N*") DEFIMP (DTIME_func, "DTIME_func", DTIME,,, "R1:-:TArray=R1(2)w") ! DEFIMP (DTIME_subr, "DTIME_subr", DTIME,,, "--:-:Result=R1w,TArray=R1(2)w") DEFIMP (ERF, "ERF", L_ERF,ERF,, "R=:0:X=R*") DEFIMP (ERFC, "ERFC", L_ERFC,ERFC,, "R=:0:X=R*") DEFIMP (ETIME_func, "ETIME_func", ETIME,,, "R1:-:TArray=R1(2)w") ! DEFIMP (ETIME_subr, "ETIME_subr", ETIME,,, "--:-:Result=R1w,TArray=R1(2)w") DEFIMP (EXIT, "EXIT", EXIT,,, "--:-:Status=?I*") DEFIMP (FDATE_func, "FDATE_func", FDATE,,, "A1*:-:") DEFIMP (FDATE_subr, "FDATE_subr", FDATE,,, "--:-:Date=A1w") --- 3253,3263 ---- DEFIMP (DIMAG, "DIMAG", ,DIMAG,, "R2:-:Z=C2") DEFIMP (DREAL, "DREAL", ,,, "R2:-:A=N*") DEFIMP (DTIME_func, "DTIME_func", DTIME,,, "R1:-:TArray=R1(2)w") ! DEFIMP (DTIME_subr, "DTIME_subr", DTIME,,, "--:-:TArray=R1(2)w,Result=R1w") DEFIMP (ERF, "ERF", L_ERF,ERF,, "R=:0:X=R*") DEFIMP (ERFC, "ERFC", L_ERFC,ERFC,, "R=:0:X=R*") DEFIMP (ETIME_func, "ETIME_func", ETIME,,, "R1:-:TArray=R1(2)w") ! DEFIMP (ETIME_subr, "ETIME_subr", ETIME,,, "--:-:TArray=R1(2)w,Result=R1w") DEFIMP (EXIT, "EXIT", EXIT,,, "--:-:Status=?I*") DEFIMP (FDATE_func, "FDATE_func", FDATE,,, "A1*:-:") DEFIMP (FDATE_subr, "FDATE_subr", FDATE,,, "--:-:Date=A1w") *************** DEFIMP (IBCLR, "IBCLR", ,,, "I=:0:I=I* *** 3289,3295 **** DEFIMP (IBITS, "IBITS", ,,, "I=:0:I=I*,Pos=I*,Len=I*") DEFIMP (IBSET, "IBSET", ,,, "I=:0:I=I*,Pos=I*") DEFIMP (IDATE_unix, "IDATE_unix", IDATE,,, "--:-:TArray=I1(3)w") ! DEFIMP (IDATE_vxt, "IDATE_vxt", VXTIDATE,,, "--:-:M=I1w,D=I1w,Y=I1w") DEFIMP (IEOR, "IEOR", ,,, "I=:*:I=I*,J=I*") DEFIMP (IOR, "IOR", ,,, "I=:*:I=I*,J=I*") DEFIMP (IERRNO, "IERRNO", IERRNO,,, "I1:-:") --- 3295,3301 ---- DEFIMP (IBITS, "IBITS", ,,, "I=:0:I=I*,Pos=I*,Len=I*") DEFIMP (IBSET, "IBSET", ,,, "I=:0:I=I*,Pos=I*") DEFIMP (IDATE_unix, "IDATE_unix", IDATE,,, "--:-:TArray=I1(3)w") ! DEFIMPY (IDATE_vxt, "IDATE_vxt", VXTIDATE,,, "--:-:M=I1w,D=I1w,Y=I1w", TRUE) DEFIMP (IEOR, "IEOR", ,,, "I=:*:I=I*,J=I*") DEFIMP (IOR, "IOR", ,,, "I=:*:I=I*,J=I*") DEFIMP (IERRNO, "IERRNO", IERRNO,,, "I1:-:") *************** DEFIMP (TIME8, "TIME8", TIME,,, "I2:-: *** 3342,3348 **** DEFIMP (TIME_unix, "TIME_unix", TIME,,, "I1:-:") DEFIMP (TIME_vxt, "TIME_vxt", VXTTIME,,, "--:-:Time=A1[8]w") DEFIMP (TTYNAM_func, "TTYNAM_func", TTYNAM,,, "A1*:-:Unit=I*") ! DEFIMP (TTYNAM_subr, "TTYNAM_subr", TTYNAM,,, "--:-:Name=A1w,Unit=I*") DEFIMP (UMASK_func, "UMASK_func", UMASK,,, "I1:-:Mask=I*") DEFIMP (UMASK_subr, "UMASK_subr", UMASK,,, "--:-:Mask=I*,Old=?I1w") DEFIMP (UNLINK_func, "UNLINK_func", UNLINK,,, "I1:-:File=A1") --- 3348,3354 ---- DEFIMP (TIME_unix, "TIME_unix", TIME,,, "I1:-:") DEFIMP (TIME_vxt, "TIME_vxt", VXTTIME,,, "--:-:Time=A1[8]w") DEFIMP (TTYNAM_func, "TTYNAM_func", TTYNAM,,, "A1*:-:Unit=I*") ! DEFIMP (TTYNAM_subr, "TTYNAM_subr", TTYNAM,,, "--:-:Unit=I*,Name=A1w") DEFIMP (UMASK_func, "UMASK_func", UMASK,,, "I1:-:Mask=I*") DEFIMP (UMASK_subr, "UMASK_subr", UMASK,,, "--:-:Mask=I*,Old=?I1w") DEFIMP (UNLINK_func, "UNLINK_func", UNLINK,,, "I1:-:File=A1") diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/intrin.h gcc-2.95/gcc/f/intrin.h *** egcs-1.1.2/gcc/f/intrin.h Tue May 19 03:49:46 1998 --- gcc-2.95/gcc/f/intrin.h Sat Mar 27 02:23:55 1999 *************** *** 1,6 **** /* intrin.h -- Public interface for intrin.c Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* intrin.h -- Public interface for intrin.c Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** typedef enum *** 51,61 **** --- 51,63 ---- #define DEFGEN(CODE,NAME,SPEC1,SPEC2) FFEINTRIN_gen ## CODE, #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) + #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) #include "intrin.def" #undef DEFNAME #undef DEFGEN #undef DEFSPEC #undef DEFIMP + #undef DEFIMPY FFEINTRIN_gen } ffeintrinGen; *************** typedef enum *** 65,75 **** --- 67,79 ---- #define DEFGEN(CODE,NAME,SPEC1,SPEC2) #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) FFEINTRIN_spec ## CODE, #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) + #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) #include "intrin.def" #undef DEFNAME #undef DEFGEN #undef DEFSPEC #undef DEFIMP + #undef DEFIMPY FFEINTRIN_spec } ffeintrinSpec; *************** typedef enum *** 80,90 **** --- 84,97 ---- #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \ FFEINTRIN_imp ## CODE, + #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \ + FFEINTRIN_imp ## CODE, #include "intrin.def" #undef DEFNAME #undef DEFGEN #undef DEFSPEC #undef DEFIMP + #undef DEFIMPY FFEINTRIN_imp } ffeintrinImp; *************** void ffeintrin_init_0 (void); *** 108,121 **** #define ffeintrin_init_3() #define ffeintrin_init_4() bool ffeintrin_is_actualarg (ffeintrinSpec spec); ! bool ffeintrin_is_intrinsic (char *name, ffelexToken t, bool explicit, ffeintrinGen *gen, ffeintrinSpec *spec, ffeintrinImp *imp); bool ffeintrin_is_standard (ffeintrinGen gen, ffeintrinSpec spec); ffeinfoKindtype ffeintrin_kindtype (ffeintrinSpec spec); ! char *ffeintrin_name_generic (ffeintrinGen gen); ! char *ffeintrin_name_implementation (ffeintrinImp imp); ! char *ffeintrin_name_specific (ffeintrinSpec spec); ffeIntrinsicState ffeintrin_state_family (ffeintrinFamily family); #define ffeintrin_terminate_0() #define ffeintrin_terminate_1() --- 115,128 ---- #define ffeintrin_init_3() #define ffeintrin_init_4() bool ffeintrin_is_actualarg (ffeintrinSpec spec); ! bool ffeintrin_is_intrinsic (const char *name, ffelexToken t, bool explicit, ffeintrinGen *gen, ffeintrinSpec *spec, ffeintrinImp *imp); bool ffeintrin_is_standard (ffeintrinGen gen, ffeintrinSpec spec); ffeinfoKindtype ffeintrin_kindtype (ffeintrinSpec spec); ! const char *ffeintrin_name_generic (ffeintrinGen gen); ! const char *ffeintrin_name_implementation (ffeintrinImp imp); ! const char *ffeintrin_name_specific (ffeintrinSpec spec); ffeIntrinsicState ffeintrin_state_family (ffeintrinFamily family); #define ffeintrin_terminate_0() #define ffeintrin_terminate_1() diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/lab.c gcc-2.95/gcc/f/lab.c *** egcs-1.1.2/gcc/f/lab.c Tue May 19 03:49:47 1998 --- gcc-2.95/gcc/f/lab.c Mon Feb 15 10:17:04 1999 *************** *** 1,6 **** /* lab.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* lab.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/lab.h gcc-2.95/gcc/f/lab.h *** egcs-1.1.2/gcc/f/lab.h Tue May 19 03:49:48 1998 --- gcc-2.95/gcc/f/lab.h Mon Feb 15 10:17:05 1999 *************** *** 1,6 **** /* lab.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* lab.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/lang-options.h gcc-2.95/gcc/f/lang-options.h *** egcs-1.1.2/gcc/f/lang-options.h Sun Jul 19 16:56:12 1998 --- gcc-2.95/gcc/f/lang-options.h Wed May 26 02:49:09 1999 *************** *** 1,6 **** /* lang-options.h file for Fortran Copyright (C) 1995-1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* lang-options.h file for Fortran Copyright (C) 1995-1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** the Free Software Foundation, 59 Temple *** 28,158 **** overflowing some old compiler's tables, etc. */ DEFINE_LANG_NAME ("Fortran") ! ! { "-fversion", "Print g77-specific compiler version info, run internal tests" }, ! { "-fnull-version", "" }, /*"-fident",*/ /*"-fno-ident",*/ ! { "-ff66", "Program is written in typical FORTRAN 66 dialect" }, ! { "-fno-f66", "" }, ! { "-ff77", "Program is written in typical Unix f77 dialect" }, ! { "-fno-f77", "Program does not use Unix-f77 dialectal features" }, ! { "-ff90", "Program is written in Fortran-90-ish dialect" }, ! { "-fno-f90", "" }, ! { "-fautomatic", "" }, ! { "-fno-automatic", "Treat local vars and COMMON blocks as if they were named in SAVE statements" }, ! { "-fdollar-ok", "Allow $ in symbol names" }, ! { "-fno-dollar-ok", "" }, ! { "-ff2c", "" }, ! { "-fno-f2c", "f2c-compatible code need not be generated" }, ! { "-ff2c-library", "" }, ! { "-fno-f2c-library", "Unsupported; do not generate libf2c-calling code" }, ! { "-ffree-form", "Program is written in Fortran-90-ish free form" }, ! { "-fno-free-form", "" }, ! { "-ffixed-form", "" }, ! { "-fno-fixed-form", "" }, ! { "-fpedantic", "Warn about use of (only a few for now) Fortran extensions" }, ! { "-fno-pedantic", "" }, ! { "-fvxt", "Program is written in VXT (Digital-like) FORTRAN" }, ! { "-fno-vxt", "" }, ! { "-fugly", "Obsolete; allow certain ugly features" }, ! { "-fno-ugly", "" }, ! { "-fugly-args", "" }, ! { "-fno-ugly-args", "Hollerith and typeless constants not passed as arguments" }, ! { "-fugly-assign", "Allow ordinary copying of ASSIGN'ed vars" }, ! { "-fno-ugly-assign", "" }, ! { "-fugly-assumed", "Dummy array dimensioned to (1) is assumed-size" }, ! { "-fno-ugly-assumed", "" }, ! { "-fugly-comma", "Trailing comma in procedure call denotes null argument" }, ! { "-fno-ugly-comma", "" }, ! { "-fugly-complex", "Allow REAL(Z) and AIMAG(Z) given DOUBLE COMPLEX Z" }, ! { "-fno-ugly-complex", "" }, ! { "-fugly-init", "" }, ! { "-fno-ugly-init", "Initialization via DATA and PARAMETER is type-compatible" }, ! { "-fugly-logint", "Allow INTEGER and LOGICAL interchangeability" }, ! { "-fno-ugly-logint", "" }, ! { "-fxyzzy", "Print internal debugging-related info" }, ! { "-fno-xyzzy", "" }, ! { "-finit-local-zero", "Initialize local vars and arrays to zero" }, ! { "-fno-init-local-zero", "" }, ! { "-fbackslash", "" }, ! { "-fno-backslash", "Backslashes in character/hollerith constants not special (C-style)" }, ! { "-femulate-complex", "" }, ! { "-fno-emulate-complex", "Have compiler back end cope with COMPLEX arithmetic" }, ! { "-funderscoring", "" }, ! { "-fno-underscoring", "Disable the appending of underscores to externals" }, ! { "-fsecond-underscore", "" }, ! { "-fno-second-underscore", "Never append a second underscore to externals" }, ! { "-fintrin-case-initcap", "Intrinsics spelled as e.g. SqRt" }, ! { "-fintrin-case-upper", "Intrinsics in uppercase" }, ! { "-fintrin-case-lower", "" }, ! { "-fintrin-case-any", "Intrinsics letters in arbitrary cases" }, ! { "-fmatch-case-initcap", "Language keywords spelled as e.g. IOStat" }, ! { "-fmatch-case-upper", "Language keywords in uppercase" }, ! { "-fmatch-case-lower", "" }, ! { "-fmatch-case-any", "Language keyword letters in arbitrary cases" }, ! { "-fsource-case-upper", "Internally convert most source to uppercase" }, ! { "-fsource-case-lower", "" }, ! { "-fsource-case-preserve", "Internally preserve source case" }, ! { "-fsymbol-case-initcap", "Symbol names spelled in mixed case" }, ! { "-fsymbol-case-upper", "Symbol names in uppercase" }, ! { "-fsymbol-case-lower", "Symbol names in lowercase" }, ! { "-fsymbol-case-any", "" }, ! { "-fcase-strict-upper", "Program written in uppercase" }, ! { "-fcase-strict-lower", "Program written in lowercase" }, ! { "-fcase-initcap", "Program written in strict mixed-case" }, ! { "-fcase-upper", "Compile as if program written in uppercase" }, ! { "-fcase-lower", "Compile as if program written in lowercase" }, ! { "-fcase-preserve", "Preserve all spelling (case) used in program" }, ! { "-fbadu77-intrinsics-delete", "Delete libU77 intrinsics with bad interfaces" }, ! { "-fbadu77-intrinsics-disable", "Disable libU77 intrinsics with bad interfaces" }, ! { "-fbadu77-intrinsics-enable", "" }, ! { "-fbadu77-intrinsics-hide", "Hide libU77 intrinsics with bad interfaces" }, ! { "-ff2c-intrinsics-delete", "Delete non-FORTRAN-77 intrinsics f2c supports" }, ! { "-ff2c-intrinsics-disable", "Disable non-FORTRAN-77 intrinsics f2c supports" }, ! { "-ff2c-intrinsics-enable", "" }, ! { "-ff2c-intrinsics-hide", "Hide non-FORTRAN-77 intrinsics f2c supports" }, ! { "-ff90-intrinsics-delete", "Delete non-FORTRAN-77 intrinsics F90 supports" }, ! { "-ff90-intrinsics-disable", "Disable non-FORTRAN-77 intrinsics F90 supports" }, ! { "-ff90-intrinsics-enable", "" }, ! { "-ff90-intrinsics-hide", "Hide non-FORTRAN-77 intrinsics F90 supports" }, ! { "-fgnu-intrinsics-delete", "Delete non-FORTRAN-77 intrinsics g77 supports" }, ! { "-fgnu-intrinsics-disable", "Disable non-FORTRAN 77 intrinsics F90 supports" }, ! { "-fgnu-intrinsics-enable", "" }, ! { "-fgnu-intrinsics-hide", "Hide non-FORTRAN 77 intrinsics F90 supports" }, ! { "-fmil-intrinsics-delete", "Delete MIL-STD 1753 intrinsics" }, ! { "-fmil-intrinsics-disable", "Disable MIL-STD 1753 intrinsics" }, ! { "-fmil-intrinsics-enable", "" }, ! { "-fmil-intrinsics-hide", "Hide MIL-STD 1753 intrinsics" }, ! { "-funix-intrinsics-delete", "Delete libU77 intrinsics" }, ! { "-funix-intrinsics-disable", "Disable libU77 intrinsics" }, ! { "-funix-intrinsics-enable", "" }, ! { "-funix-intrinsics-hide", "Hide libU77 intrinsics" }, ! { "-fvxt-intrinsics-delete", "Delete non-FORTRAN-77 intrinsics VXT FORTRAN supports" }, ! { "-fvxt-intrinsics-disable", "Disable non-FORTRAN-77 intrinsics VXT FORTRAN supports" }, ! { "-fvxt-intrinsics-enable", "" }, ! { "-fvxt-intrinsics-hide", "Hide non-FORTRAN-77 intrinsics VXT FORTRAN supports" }, ! { "-fzeros", "Treat initial values of 0 like non-zero values" }, ! { "-fno-zeros", "" }, ! { "-fdebug-kludge", "Emit special debugging information for COMMON and EQUIVALENCE" }, ! { "-fno-debug-kludge", "" }, ! { "-fonetrip", "Take at least one trip through each iterative DO loop" }, ! { "-fno-onetrip", "" }, ! { "-fsilent", "" }, ! { "-fno-silent", "Print names of program units as they are compiled" }, ! { "-fglobals", "" }, ! { "-fno-globals", "Disable fatal diagnostics about inter-procedural problems" }, ! { "-ftypeless-boz", "Make prefix-radix non-decimal constants be typeless" }, ! { "-fno-typeless-boz", "" }, ! { "-Wglobals", "" }, ! { "-Wno-globals", "Disable warnings about inter-procedural problems" }, /*"-Wimplicit",*/ /*"-Wno-implicit",*/ ! { "-Wsurprising", "Warn about constructs with surprising meanings" }, ! { "-Wno-surprising", "" }, /*"-Wall",*/ /* Prefix options. */ ! { "-I", "Add a directory for INCLUDE searching" }, ! { "-ffixed-line-length-", "Set the maximum line length" }, #endif --- 28,169 ---- overflowing some old compiler's tables, etc. */ DEFINE_LANG_NAME ("Fortran") ! ! /* Use of FTNOPT makes tracking changes between FSF-g77 and egcs-g77 ! easier, since FSF-gcc doesn't support doc strings. */ ! #define FTNOPT(opt,doc) { opt, doc }, ! ! FTNOPT( "-fversion", "Print g77-specific compiler version info, run internal tests" ) ! FTNOPT( "-fnull-version", "" ) /*"-fident",*/ /*"-fno-ident",*/ ! FTNOPT( "-ff66", "Program is written in typical FORTRAN 66 dialect" ) ! FTNOPT( "-fno-f66", "" ) ! FTNOPT( "-ff77", "Program is written in typical Unix f77 dialect" ) ! FTNOPT( "-fno-f77", "Program does not use Unix-f77 dialectal features" ) ! FTNOPT( "-ff90", "Program is written in Fortran-90-ish dialect" ) ! FTNOPT( "-fno-f90", "" ) ! FTNOPT( "-fautomatic", "" ) ! FTNOPT( "-fno-automatic", "Treat local vars and COMMON blocks as if they were named in SAVE statements" ) ! FTNOPT( "-fdollar-ok", "Allow $ in symbol names" ) ! FTNOPT( "-fno-dollar-ok", "" ) ! FTNOPT( "-ff2c", "" ) ! FTNOPT( "-fno-f2c", "f2c-compatible code need not be generated" ) ! FTNOPT( "-ff2c-library", "" ) ! FTNOPT( "-fno-f2c-library", "Unsupported; do not generate libf2c-calling code" ) ! FTNOPT( "-fflatten-arrays", "Unsupported; affects code-generation of arrays" ) ! FTNOPT( "-fno-flatten-arrays", "" ) ! FTNOPT( "-ffree-form", "Program is written in Fortran-90-ish free form" ) ! FTNOPT( "-fno-free-form", "" ) ! FTNOPT( "-ffixed-form", "" ) ! FTNOPT( "-fno-fixed-form", "" ) ! FTNOPT( "-fpedantic", "Warn about use of (only a few for now) Fortran extensions" ) ! FTNOPT( "-fno-pedantic", "" ) ! FTNOPT( "-fvxt", "Program is written in VXT (Digital-like) FORTRAN" ) ! FTNOPT( "-fno-vxt", "" ) ! FTNOPT( "-fno-ugly", "Disallow all ugly features" ) ! FTNOPT( "-fugly-args", "" ) ! FTNOPT( "-fno-ugly-args", "Hollerith and typeless constants not passed as arguments" ) ! FTNOPT( "-fugly-assign", "Allow ordinary copying of ASSIGN'ed vars" ) ! FTNOPT( "-fno-ugly-assign", "" ) ! FTNOPT( "-fugly-assumed", "Dummy array dimensioned to (1) is assumed-size" ) ! FTNOPT( "-fno-ugly-assumed", "" ) ! FTNOPT( "-fugly-comma", "Trailing comma in procedure call denotes null argument" ) ! FTNOPT( "-fno-ugly-comma", "" ) ! FTNOPT( "-fugly-complex", "Allow REAL(Z) and AIMAG(Z) given DOUBLE COMPLEX Z" ) ! FTNOPT( "-fno-ugly-complex", "" ) ! FTNOPT( "-fugly-init", "" ) ! FTNOPT( "-fno-ugly-init", "Initialization via DATA and PARAMETER is type-compatible" ) ! FTNOPT( "-fugly-logint", "Allow INTEGER and LOGICAL interchangeability" ) ! FTNOPT( "-fno-ugly-logint", "" ) ! FTNOPT( "-fxyzzy", "Print internal debugging-related info" ) ! FTNOPT( "-fno-xyzzy", "" ) ! FTNOPT( "-finit-local-zero", "Initialize local vars and arrays to zero" ) ! FTNOPT( "-fno-init-local-zero", "" ) ! FTNOPT( "-fbackslash", "" ) ! FTNOPT( "-fno-backslash", "Backslashes in character/hollerith constants not special (C-style)" ) ! FTNOPT( "-femulate-complex", "Have front end emulate COMPLEX arithmetic to avoid bugs" ) ! FTNOPT( "-fno-emulate-complex", "" ) ! FTNOPT( "-funderscoring", "" ) ! FTNOPT( "-fno-underscoring", "Disable the appending of underscores to externals" ) ! FTNOPT( "-fsecond-underscore", "" ) ! FTNOPT( "-fno-second-underscore", "Never append a second underscore to externals" ) ! FTNOPT( "-fintrin-case-initcap", "Intrinsics spelled as e.g. SqRt" ) ! FTNOPT( "-fintrin-case-upper", "Intrinsics in uppercase" ) ! FTNOPT( "-fintrin-case-lower", "" ) ! FTNOPT( "-fintrin-case-any", "Intrinsics letters in arbitrary cases" ) ! FTNOPT( "-fmatch-case-initcap", "Language keywords spelled as e.g. IOStat" ) ! FTNOPT( "-fmatch-case-upper", "Language keywords in uppercase" ) ! FTNOPT( "-fmatch-case-lower", "" ) ! FTNOPT( "-fmatch-case-any", "Language keyword letters in arbitrary cases" ) ! FTNOPT( "-fsource-case-upper", "Internally convert most source to uppercase" ) ! FTNOPT( "-fsource-case-lower", "" ) ! FTNOPT( "-fsource-case-preserve", "Internally preserve source case" ) ! FTNOPT( "-fsymbol-case-initcap", "Symbol names spelled in mixed case" ) ! FTNOPT( "-fsymbol-case-upper", "Symbol names in uppercase" ) ! FTNOPT( "-fsymbol-case-lower", "Symbol names in lowercase" ) ! FTNOPT( "-fsymbol-case-any", "" ) ! FTNOPT( "-fcase-strict-upper", "Program written in uppercase" ) ! FTNOPT( "-fcase-strict-lower", "Program written in lowercase" ) ! FTNOPT( "-fcase-initcap", "Program written in strict mixed-case" ) ! FTNOPT( "-fcase-upper", "Compile as if program written in uppercase" ) ! FTNOPT( "-fcase-lower", "Compile as if program written in lowercase" ) ! FTNOPT( "-fcase-preserve", "Preserve all spelling (case) used in program" ) ! FTNOPT( "-fbadu77-intrinsics-delete", "Delete libU77 intrinsics with bad interfaces" ) ! FTNOPT( "-fbadu77-intrinsics-disable", "Disable libU77 intrinsics with bad interfaces" ) ! FTNOPT( "-fbadu77-intrinsics-enable", "" ) ! FTNOPT( "-fbadu77-intrinsics-hide", "Hide libU77 intrinsics with bad interfaces" ) ! FTNOPT( "-ff2c-intrinsics-delete", "Delete non-FORTRAN-77 intrinsics f2c supports" ) ! FTNOPT( "-ff2c-intrinsics-disable", "Disable non-FORTRAN-77 intrinsics f2c supports" ) ! FTNOPT( "-ff2c-intrinsics-enable", "" ) ! FTNOPT( "-ff2c-intrinsics-hide", "Hide non-FORTRAN-77 intrinsics f2c supports" ) ! FTNOPT( "-ff90-intrinsics-delete", "Delete non-FORTRAN-77 intrinsics F90 supports" ) ! FTNOPT( "-ff90-intrinsics-disable", "Disable non-FORTRAN-77 intrinsics F90 supports" ) ! FTNOPT( "-ff90-intrinsics-enable", "" ) ! FTNOPT( "-ff90-intrinsics-hide", "Hide non-FORTRAN-77 intrinsics F90 supports" ) ! FTNOPT( "-fgnu-intrinsics-delete", "Delete non-FORTRAN-77 intrinsics g77 supports" ) ! FTNOPT( "-fgnu-intrinsics-disable", "Disable non-FORTRAN 77 intrinsics F90 supports" ) ! FTNOPT( "-fgnu-intrinsics-enable", "" ) ! FTNOPT( "-fgnu-intrinsics-hide", "Hide non-FORTRAN 77 intrinsics F90 supports" ) ! FTNOPT( "-fmil-intrinsics-delete", "Delete MIL-STD 1753 intrinsics" ) ! FTNOPT( "-fmil-intrinsics-disable", "Disable MIL-STD 1753 intrinsics" ) ! FTNOPT( "-fmil-intrinsics-enable", "" ) ! FTNOPT( "-fmil-intrinsics-hide", "Hide MIL-STD 1753 intrinsics" ) ! FTNOPT( "-funix-intrinsics-delete", "Delete libU77 intrinsics" ) ! FTNOPT( "-funix-intrinsics-disable", "Disable libU77 intrinsics" ) ! FTNOPT( "-funix-intrinsics-enable", "" ) ! FTNOPT( "-funix-intrinsics-hide", "Hide libU77 intrinsics" ) ! FTNOPT( "-fvxt-intrinsics-delete", "Delete non-FORTRAN-77 intrinsics VXT FORTRAN supports" ) ! FTNOPT( "-fvxt-intrinsics-disable", "Disable non-FORTRAN-77 intrinsics VXT FORTRAN supports" ) ! FTNOPT( "-fvxt-intrinsics-enable", "" ) ! FTNOPT( "-fvxt-intrinsics-hide", "Hide non-FORTRAN-77 intrinsics VXT FORTRAN supports" ) ! FTNOPT( "-fzeros", "Treat initial values of 0 like non-zero values" ) ! FTNOPT( "-fno-zeros", "" ) ! FTNOPT( "-fdebug-kludge", "Emit special debugging information for COMMON and EQUIVALENCE" ) ! FTNOPT( "-fno-debug-kludge", "" ) ! FTNOPT( "-fonetrip", "Take at least one trip through each iterative DO loop" ) ! FTNOPT( "-fno-onetrip", "" ) ! FTNOPT( "-fsilent", "" ) ! FTNOPT( "-fno-silent", "Print names of program units as they are compiled" ) ! FTNOPT( "-fglobals", "" ) ! FTNOPT( "-fno-globals", "Disable fatal diagnostics about inter-procedural problems" ) ! FTNOPT( "-ftypeless-boz", "Make prefix-radix non-decimal constants be typeless" ) ! FTNOPT( "-fno-typeless-boz", "" ) ! FTNOPT( "-fbounds-check", "Generate code to check subscript and substring bounds" ) ! FTNOPT( "-fno-bounds-check", "" ) ! FTNOPT( "-ffortran-bounds-check", "Fortran-specific form of -fbounds-check") ! FTNOPT( "-fno-fortran-bounds-check", "" ) ! FTNOPT( "-Wglobals", "" ) ! FTNOPT( "-Wno-globals", "Disable warnings about inter-procedural problems" ) /*"-Wimplicit",*/ /*"-Wno-implicit",*/ ! FTNOPT( "-Wsurprising", "Warn about constructs with surprising meanings" ) ! FTNOPT( "-Wno-surprising", "" ) /*"-Wall",*/ /* Prefix options. */ ! FTNOPT( "-I", "Add a directory for INCLUDE searching" ) ! FTNOPT( "-ffixed-line-length-", "Set the maximum line length" ) ! ! #undef FTNOPT #endif diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/lang-specs.h gcc-2.95/gcc/f/lang-specs.h *** egcs-1.1.2/gcc/f/lang-specs.h Mon Jun 15 00:37:24 1998 --- gcc-2.95/gcc/f/lang-specs.h Mon May 17 16:35:15 1999 *************** *** 1,6 **** /* lang-specs.h file for Fortran ! Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* lang-specs.h file for Fortran ! Copyright (C) 1995-1997, 1999 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** the Free Software Foundation, 59 Temple *** 26,31 **** --- 26,32 ---- {".F", {"@f77-cpp-input"}}, {".fpp", {"@f77-cpp-input"}}, + {".FPP", {"@f77-cpp-input"}}, {"@f77-cpp-input", /* For f77 we want -traditional to avoid errors with, for instance, mismatched '. Also, we avoid unpleasant surprises *************** the Free Software Foundation, 59 Temple *** 34,53 **** Sun f77, at least) so you test `__unix' rather than `unix'. -D_LANGUAGE_FORTRAN is used by some compilers like SGI and might as well be in there. */ ! {"cpp -lang-c %{nostdinc*} %{C} %{v} %{A*} %{I*} %{P} %I\ %{C:%{!E:%eGNU C does not support -C without using -E}}\ %{M} %{MM} %{MD:-MD %b.d} %{MMD:-MMD %b.d} %{MG}\ ! -undef -D__GNUC__=%v1 -D__GNUC_MINOR__=%v2\ %{ansi:-trigraphs -$ -D__STRICT_ANSI__}\ %{!undef:%P} -D_LANGUAGE_FORTRAN %{trigraphs} \ %c %{Os:-D__OPTIMIZE_SIZE__} %{O*:%{!O0:-D__OPTIMIZE__}} -traditional\ %{g*} %{W*} %{w} %{pedantic*} %{H} %{d*} %C %{D*} %{U*} %{i*} %Z\ %i %{!M:%{!MM:%{!E:%{!pipe:%g.i}}}}%{E:%W{o*}}%{M:%W{o*}}%{MM:%W{o*}} |\n", "%{!M:%{!MM:%{!E:f771 %{!pipe:%g.i} %(f771) \ ! %{!Q:-quiet} -dumpbase %b.F %{d*} %{m*} %{a}\ %{g*} %{O*} %{W*} %{w} %{pedantic*} \ %{v:-version -fversion} %{pg:-p} %{p} %{f*} %{I*}\ ! %{aux-info*}\ %{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\ %{S:%W{o*}%{!o*:-o %b.s}}%{!S:-o %{|!pipe:%g.s}} |\n\ %{!S:as %a %Y\ --- 35,55 ---- Sun f77, at least) so you test `__unix' rather than `unix'. -D_LANGUAGE_FORTRAN is used by some compilers like SGI and might as well be in there. */ ! {"cpp -lang-c %{nostdinc*} %{C} %{v} %{A*} %{I*} %{P} %{$} %I\ %{C:%{!E:%eGNU C does not support -C without using -E}}\ %{M} %{MM} %{MD:-MD %b.d} %{MMD:-MMD %b.d} %{MG}\ ! %{!no-gcc:-D__GNUC__=%v1 -D__GNUC_MINOR__=%v2}\ %{ansi:-trigraphs -$ -D__STRICT_ANSI__}\ %{!undef:%P} -D_LANGUAGE_FORTRAN %{trigraphs} \ %c %{Os:-D__OPTIMIZE_SIZE__} %{O*:%{!O0:-D__OPTIMIZE__}} -traditional\ + %{ffast-math:-D__FAST_MATH__}\ %{g*} %{W*} %{w} %{pedantic*} %{H} %{d*} %C %{D*} %{U*} %{i*} %Z\ %i %{!M:%{!MM:%{!E:%{!pipe:%g.i}}}}%{E:%W{o*}}%{M:%W{o*}}%{MM:%W{o*}} |\n", "%{!M:%{!MM:%{!E:f771 %{!pipe:%g.i} %(f771) \ ! %{!Q:-quiet} -dumpbase %b.F %{d*} %{m*} %{a*}\ %{g*} %{O*} %{W*} %{w} %{pedantic*} \ %{v:-version -fversion} %{pg:-p} %{p} %{f*} %{I*}\ ! %{aux-info*} %{Qn:-fno-ident}\ %{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\ %{S:%W{o*}%{!o*:-o %b.s}}%{!S:-o %{|!pipe:%g.s}} |\n\ %{!S:as %a %Y\ *************** the Free Software Foundation, 59 Temple *** 59,68 **** %{C:%{!E:%eGNU C does not support -C without using -E}}\ %{!E:%{!pipe:-o %g.f}}%{E:%W{o*}} %i |\n", "%{!E:f771 %{!pipe:%g.f} %(f771) \ ! %{!Q:-quiet} -dumpbase %b.r %{d*} %{m*} %{a}\ %{g*} %{O*} %{W*} %{w} %{pedantic*} \ %{v:-version -fversion} %{pg:-p} %{p} %{f*} %{I*}\ ! %{aux-info*}\ %{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\ %{S:%W{o*}%{!o*:-o %b.s}}%{!S:-o %{|!pipe:%g.s}} |\n\ %{!S:as %a %Y\ --- 61,70 ---- %{C:%{!E:%eGNU C does not support -C without using -E}}\ %{!E:%{!pipe:-o %g.f}}%{E:%W{o*}} %i |\n", "%{!E:f771 %{!pipe:%g.f} %(f771) \ ! %{!Q:-quiet} -dumpbase %b.r %{d*} %{m*} %{a*}\ %{g*} %{O*} %{W*} %{w} %{pedantic*} \ %{v:-version -fversion} %{pg:-p} %{p} %{f*} %{I*}\ ! %{aux-info*} %{Qn:-fno-ident}\ %{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\ %{S:%W{o*}%{!o*:-o %b.s}}%{!S:-o %{|!pipe:%g.s}} |\n\ %{!S:as %a %Y\ *************** the Free Software Foundation, 59 Temple *** 70,98 **** %{!pipe:%g.s} %A\n }}"}}, {".f", {"@f77"}}, {".for", {"@f77"}}, {"@f77", {"%{!M:%{!MM:%{!E:f771 %i %(f771) \ ! %{!Q:-quiet} -dumpbase %b.f %{d*} %{m*} %{a}\ %{g*} %{O*} %{W*} %{w} %{pedantic*}\ %{v:-version -fversion} %{pg:-p} %{p} %{f*} %{I*}\ ! %{aux-info*}\ %{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\ %{S:%W{o*}%{!o*:-o %b.s}}%{!S:-o %{|!pipe:%g.s}} |\n\ %{!S:as %a %Y\ %{c:%W{o*}%{!o*:-o %w%b%O}}%{!c:-o %d%w%u%O}\ %{!pipe:%g.s} %A\n }}}}"}}, {"@f77-version", ! {"cpp -lang-c %{nostdinc*} %{C} %{v} %{A*} %{I*} %{P} %I \ %{C:%{!E:%eGNU C does not support -C without using -E}} \ %{M} %{MM} %{MD:-MD %b.d} %{MMD:-MMD %b.d} %{MG} \ ! -undef -D__GNUC__=%v1 -D__GNUC_MINOR__=%v2 \ %{ansi:-trigraphs -$ -D__STRICT_ANSI__} \ %{!undef:%P} -D_LANGUAGE_FORTRAN %{trigraphs} \ %c %{Os:-D__OPTIMIZE_SIZE__} %{O*:%{!O0:-D__OPTIMIZE__}} -traditional \ %{g*} %{W*} %{w} %{pedantic*} %{H} %{d*} %C %{D*} %{U*} %{i*} %Z \ /dev/null /dev/null \n\ f771 -fnull-version %(f771) \ ! %{!Q:-quiet} -dumpbase g77-version.f %{d*} %{m*} %{a} \ %{g*} %{O*} %{W*} %{w} %{pedantic*} \ -version -fversion %{f*} %{I*} -o %g.s /dev/null \n\ as %a %Y -o %g%O %g.s %A \n\ --- 72,102 ---- %{!pipe:%g.s} %A\n }}"}}, {".f", {"@f77"}}, {".for", {"@f77"}}, + {".FOR", {"@f77"}}, {"@f77", {"%{!M:%{!MM:%{!E:f771 %i %(f771) \ ! %{!Q:-quiet} -dumpbase %b.f %{d*} %{m*} %{a*}\ %{g*} %{O*} %{W*} %{w} %{pedantic*}\ %{v:-version -fversion} %{pg:-p} %{p} %{f*} %{I*}\ ! %{aux-info*} %{Qn:-fno-ident}\ %{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\ %{S:%W{o*}%{!o*:-o %b.s}}%{!S:-o %{|!pipe:%g.s}} |\n\ %{!S:as %a %Y\ %{c:%W{o*}%{!o*:-o %w%b%O}}%{!c:-o %d%w%u%O}\ %{!pipe:%g.s} %A\n }}}}"}}, {"@f77-version", ! {"cpp -lang-c %{nostdinc*} %{C} %{v} %{A*} %{I*} %{P} %{$} %I \ %{C:%{!E:%eGNU C does not support -C without using -E}} \ %{M} %{MM} %{MD:-MD %b.d} %{MMD:-MMD %b.d} %{MG} \ ! %{!no-gcc:-D__GNUC__=%v1 -D__GNUC_MINOR__=%v2} \ %{ansi:-trigraphs -$ -D__STRICT_ANSI__} \ %{!undef:%P} -D_LANGUAGE_FORTRAN %{trigraphs} \ %c %{Os:-D__OPTIMIZE_SIZE__} %{O*:%{!O0:-D__OPTIMIZE__}} -traditional \ + %{ffast-math:-D__FAST_MATH__}\ %{g*} %{W*} %{w} %{pedantic*} %{H} %{d*} %C %{D*} %{U*} %{i*} %Z \ /dev/null /dev/null \n\ f771 -fnull-version %(f771) \ ! %{!Q:-quiet} -dumpbase g77-version.f %{d*} %{m*} %{a*} \ %{g*} %{O*} %{W*} %{w} %{pedantic*} \ -version -fversion %{f*} %{I*} -o %g.s /dev/null \n\ as %a %Y -o %g%O %g.s %A \n\ diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/lex.c gcc-2.95/gcc/f/lex.c *** egcs-1.1.2/gcc/f/lex.c Mon Jun 15 19:23:26 1998 --- gcc-2.95/gcc/f/lex.c Sat Mar 27 02:23:57 1999 *************** *** 1,6 **** /* Implementation of Fortran lexer ! Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* Implementation of Fortran lexer ! Copyright (C) 1995-1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** ffelex_get_directive_line_ (char **text, *** 1077,1082 **** --- 1077,1099 ---- Returns the next character unhandled, which is always newline or EOF. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC + + #if defined HANDLE_PRAGMA + /* Local versions of these macros, that can be passed as function pointers. */ + static int + pragma_getc () + { + return getc (finput); + } + + static void + pragma_ungetc (arg) + int arg; + { + ungetc (arg, finput); + } + #endif /* HANDLE_PRAGMA */ + static int ffelex_hash_ (FILE *finput) { *************** ffelex_hash_ (FILE *finput) *** 1105,1121 **** && ((c = getc (finput)) == ' ' || c == '\t' || c == '\n' || c == EOF)) { - goto skipline; #if 0 /* g77 doesn't handle pragmas, so ignores them FOR NOW. */ ! #ifdef HANDLE_SYSV_PRAGMA ! return handle_sysv_pragma (finput, c); ! #else /* !HANDLE_SYSV_PRAGMA */ #ifdef HANDLE_PRAGMA ! HANDLE_PRAGMA (finput); #endif /* HANDLE_PRAGMA */ ! goto skipline; ! #endif /* !HANDLE_SYSV_PRAGMA */ #endif /* 0 */ } } --- 1122,1163 ---- && ((c = getc (finput)) == ' ' || c == '\t' || c == '\n' || c == EOF)) { #if 0 /* g77 doesn't handle pragmas, so ignores them FOR NOW. */ ! static char buffer [128]; ! char * buff = buffer; ! ! /* Read the pragma name into a buffer. */ ! while (isspace (c = getc (finput))) ! continue; ! ! do ! { ! * buff ++ = c; ! c = getc (finput); ! } ! while (c != EOF && ! isspace (c) && c != '\n' ! && buff < buffer + 128); ! ! pragma_ungetc (c); ! ! * -- buff = 0; #ifdef HANDLE_PRAGMA ! if (HANDLE_PRAGMA (pragma_getc, pragma_ungetc, buffer)) ! goto skipline; #endif /* HANDLE_PRAGMA */ ! #ifdef HANDLE_GENERIC_PRAGMAS ! if (handle_generic_pragma (buffer)) ! goto skipline; ! #endif /* !HANDLE_GENERIC_PRAGMAS */ ! ! /* Issue a warning message if we have been asked to do so. ! Ignoring unknown pragmas in system header file unless ! an explcit -Wunknown-pragmas has been given. */ ! if (warn_unknown_pragmas > 1 ! || (warn_unknown_pragmas && ! in_system_header)) ! warning ("ignoring pragma: %s", token_buffer); #endif /* 0 */ + goto skipline; } } *************** ffelex_hash_ (FILE *finput) *** 1201,1207 **** goto skipline; } ! if (ffe_is_ident ()) { #ifdef ASM_OUTPUT_IDENT ASM_OUTPUT_IDENT (asm_out_file, --- 1243,1249 ---- goto skipline; } ! if (! flag_no_ident) { #ifdef ASM_OUTPUT_IDENT ASM_OUTPUT_IDENT (asm_out_file, *************** ffelex_token_new_ () *** 1709,1718 **** return t; } ! static char * ffelex_type_string_ (ffelexType type) { ! static char *types[] = { "FFELEX_typeNONE", "FFELEX_typeCOMMENT", "FFELEX_typeEOS", --- 1751,1760 ---- return t; } ! static const char * ffelex_type_string_ (ffelexType type) { ! static const char *types[] = { "FFELEX_typeNONE", "FFELEX_typeCOMMENT", "FFELEX_typeEOS", *************** ffelexHandler *** 4305,4311 **** ffelex_splice_tokens (ffelexHandler first, ffelexToken master, ffeTokenLength start) { ! char *p; ffeTokenLength i; ffelexToken t; --- 4347,4353 ---- ffelex_splice_tokens (ffelexHandler first, ffelexToken master, ffeTokenLength start) { ! unsigned char *p; ffeTokenLength i; ffelexToken t; *************** ffelex_token_name_from_names (ffelexToke *** 4448,4454 **** assert (len > 0); assert ((start + len) <= t->length); } ! assert (ffelex_is_firstnamechar (t->text[start])); nt = ffelex_token_new_ (); nt->type = FFELEX_typeNAME; --- 4490,4496 ---- assert (len > 0); assert ((start + len) <= t->length); } ! assert (ffelex_is_firstnamechar ((unsigned char)(t->text[start]))); nt = ffelex_token_new_ (); nt->type = FFELEX_typeNAME; *************** ffelex_token_names_from_names (ffelexTok *** 4483,4489 **** assert (len > 0); assert ((start + len) <= t->length); } ! assert (ffelex_is_firstnamechar (t->text[start])); nt = ffelex_token_new_ (); nt->type = FFELEX_typeNAMES; --- 4525,4531 ---- assert (len > 0); assert ((start + len) <= t->length); } ! assert (ffelex_is_firstnamechar ((unsigned char)(t->text[start]))); nt = ffelex_token_new_ (); nt->type = FFELEX_typeNAMES; *************** ffelex_token_names_from_names (ffelexTok *** 4504,4510 **** /* Make a new CHARACTER token. */ ffelexToken ! ffelex_token_new_character (char *s, ffewhereLine l, ffewhereColumn c) { ffelexToken t; --- 4546,4552 ---- /* Make a new CHARACTER token. */ ffelexToken ! ffelex_token_new_character (const char *s, ffewhereLine l, ffewhereColumn c) { ffelexToken t; *************** ffelex_token_new_eof () *** 4539,4549 **** /* Make a new NAME token. */ ffelexToken ! ffelex_token_new_name (char *s, ffewhereLine l, ffewhereColumn c) { ffelexToken t; ! assert (ffelex_is_firstnamechar (*s)); t = ffelex_token_new_ (); t->type = FFELEX_typeNAME; --- 4581,4591 ---- /* Make a new NAME token. */ ffelexToken ! ffelex_token_new_name (const char *s, ffewhereLine l, ffewhereColumn c) { ffelexToken t; ! assert (ffelex_is_firstnamechar ((unsigned char)*s)); t = ffelex_token_new_ (); t->type = FFELEX_typeNAME; *************** ffelex_token_new_name (char *s, ffewhere *** 4560,4570 **** /* Make a new NAMES token. */ ffelexToken ! ffelex_token_new_names (char *s, ffewhereLine l, ffewhereColumn c) { ffelexToken t; ! assert (ffelex_is_firstnamechar (*s)); t = ffelex_token_new_ (); t->type = FFELEX_typeNAMES; --- 4602,4612 ---- /* Make a new NAMES token. */ ffelexToken ! ffelex_token_new_names (const char *s, ffewhereLine l, ffewhereColumn c) { ffelexToken t; ! assert (ffelex_is_firstnamechar ((unsigned char)*s)); t = ffelex_token_new_ (); t->type = FFELEX_typeNAMES; *************** ffelex_token_new_names (char *s, ffewher *** 4589,4595 **** in the original string. */ ffelexToken ! ffelex_token_new_number (char *s, ffewhereLine l, ffewhereColumn c) { ffelexToken t; ffeTokenLength len; --- 4631,4637 ---- in the original string. */ ffelexToken ! ffelex_token_new_number (const char *s, ffewhereLine l, ffewhereColumn c) { ffelexToken t; ffeTokenLength len; diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/lex.h gcc-2.95/gcc/f/lex.h *** egcs-1.1.2/gcc/f/lex.h Mon Jun 15 19:23:27 1998 --- gcc-2.95/gcc/f/lex.h Sat Mar 27 02:23:58 1999 *************** *** 1,6 **** /* lex.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* lex.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** ffelexToken ffelex_token_names_from_name *** 148,161 **** ffeTokenLength start, ffeTokenLength len); ffelexToken ffelex_token_new (void); ! ffelexToken ffelex_token_new_character (char *s, ffewhereLine l, ffewhereColumn c); ffelexToken ffelex_token_new_eof (void); ! ffelexToken ffelex_token_new_name (char *s, ffewhereLine l, ffewhereColumn c); ! ffelexToken ffelex_token_new_names (char *s, ffewhereLine l, ffewhereColumn c); ! ffelexToken ffelex_token_new_number (char *s, ffewhereLine l, ffewhereColumn c); ffelexToken ffelex_token_new_simple_ (ffelexType type, ffewhereLine l, ffewhereColumn c); --- 148,161 ---- ffeTokenLength start, ffeTokenLength len); ffelexToken ffelex_token_new (void); ! ffelexToken ffelex_token_new_character (const char *s, ffewhereLine l, ffewhereColumn c); ffelexToken ffelex_token_new_eof (void); ! ffelexToken ffelex_token_new_name (const char *s, ffewhereLine l, ffewhereColumn c); ! ffelexToken ffelex_token_new_names (const char *s, ffewhereLine l, ffewhereColumn c); ! ffelexToken ffelex_token_new_number (const char *s, ffewhereLine l, ffewhereColumn c); ffelexToken ffelex_token_new_simple_ (ffelexType type, ffewhereLine l, ffewhereColumn c); diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/malloc.c gcc-2.95/gcc/f/malloc.c *** egcs-1.1.2/gcc/f/malloc.c Tue May 19 03:49:53 1998 --- gcc-2.95/gcc/f/malloc.c Sat Mar 27 02:23:59 1999 *************** *** 1,6 **** /* malloc.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* malloc.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** the Free Software Foundation, 59 Temple *** 33,42 **** #include "proj.h" #include "malloc.h" - /* Assume gcc/toplev.o is linked in. */ - void *xmalloc (unsigned size); - void *xrealloc (void *ptr, int size); - /* Externals defined here. */ struct _malloc_root_ malloc_root_ --- 33,38 ---- *************** struct _malloc_root_ malloc_root_ *** 52,57 **** --- 48,55 ---- 0, #if MALLOC_DEBUG 0, 0, 0, 0, 0, 0, 0, { '/' } + #else + { 0 } #endif }, }; *************** struct _malloc_root_ malloc_root_ *** 72,78 **** static void *malloc_reserve_ = NULL; /* For crashes. */ #if MALLOC_DEBUG ! static char *malloc_types_[] = {"KS", "KSR", "NF", "NFR", "US", "USR"}; #endif --- 70,76 ---- static void *malloc_reserve_ = NULL; /* For crashes. */ #if MALLOC_DEBUG ! static const char *malloc_types_[] = {"KS", "KSR", "NF", "NFR", "US", "USR"}; #endif *************** malloc_pool_kill (mallocPool p) *** 236,242 **** Makes a new pool with the given name and default new-chunk allocation. */ mallocPool ! malloc_pool_new (char *name, mallocPool parent, unsigned long chunks UNUSED) { mallocPool p; --- 234,240 ---- Makes a new pool with the given name and default new-chunk allocation. */ mallocPool ! malloc_pool_new (const char *name, mallocPool parent, unsigned long chunks UNUSED) { mallocPool p; *************** malloc_new_ (mallocSize s) *** 386,392 **** add it to the list of mallocArea_s for the pool. */ void * ! malloc_new_inpool_ (mallocPool pool, mallocType_ type, char *name, mallocSize s) { void *ptr; mallocArea_ a; --- 384,390 ---- add it to the list of mallocArea_s for the pool. */ void * ! malloc_new_inpool_ (mallocPool pool, mallocType_ type, const char *name, mallocSize s) { void *ptr; mallocArea_ a; *************** malloc_new_inpool_ (mallocPool pool, mal *** 439,445 **** you pass it a 0). */ void * ! malloc_new_zinpool_ (mallocPool pool, mallocType_ type, char *name, mallocSize s, int z) { void *ptr; --- 437,443 ---- you pass it a 0). */ void * ! malloc_new_zinpool_ (mallocPool pool, mallocType_ type, const char *name, mallocSize s, int z) { void *ptr; diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/malloc.h gcc-2.95/gcc/f/malloc.h *** egcs-1.1.2/gcc/f/malloc.h Tue May 19 03:49:54 1998 --- gcc-2.95/gcc/f/malloc.h Sat Mar 27 02:24:00 1999 *************** *** 1,6 **** /* malloc.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* malloc.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** void malloc_init (void); *** 109,122 **** void malloc_kill_inpool_ (mallocPool pool, mallocType_ type, void *ptr, mallocSize size); void *malloc_new_ (mallocSize size); ! void *malloc_new_inpool_ (mallocPool pool, mallocType_ type, char *name, mallocSize size); ! void *malloc_new_zinpool_ (mallocPool pool, mallocType_ type, char *name, mallocSize size, int z); void malloc_pool_display (mallocPool p); char malloc_pool_find_ (mallocPool p, mallocPool parent); void malloc_pool_kill (mallocPool p); ! mallocPool malloc_pool_new (char *name, mallocPool parent, unsigned long chunks); mallocPool malloc_pool_use (mallocPool p); void *malloc_resize_ (void *ptr, mallocSize new_size); void *malloc_resize_inpool_ (mallocPool pool, mallocType_ type, void *ptr, --- 109,122 ---- void malloc_kill_inpool_ (mallocPool pool, mallocType_ type, void *ptr, mallocSize size); void *malloc_new_ (mallocSize size); ! void *malloc_new_inpool_ (mallocPool pool, mallocType_ type, const char *name, mallocSize size); ! void *malloc_new_zinpool_ (mallocPool pool, mallocType_ type, const char *name, mallocSize size, int z); void malloc_pool_display (mallocPool p); char malloc_pool_find_ (mallocPool p, mallocPool parent); void malloc_pool_kill (mallocPool p); ! mallocPool malloc_pool_new (const char *name, mallocPool parent, unsigned long chunks); mallocPool malloc_pool_use (mallocPool p); void *malloc_resize_ (void *ptr, mallocSize new_size); void *malloc_resize_inpool_ (mallocPool pool, mallocType_ type, void *ptr, diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/name.c gcc-2.95/gcc/f/name.c *** egcs-1.1.2/gcc/f/name.c Tue May 19 03:49:55 1998 --- gcc-2.95/gcc/f/name.c Sat Mar 27 02:24:01 1999 *************** *** 1,6 **** /* name.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* name.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** ffename_lookup (ffenameSpace ns, ffelexT *** 167,173 **** ffename_space_drive_global(ns,fn); */ void ! ffename_space_drive_global (ffenameSpace ns, ffeglobal (*fn) ()) { ffename n; --- 167,173 ---- ffename_space_drive_global(ns,fn); */ void ! ffename_space_drive_global (ffenameSpace ns, ffeglobal (*fn) (ffeglobal)) { ffename n; *************** ffename_space_drive_global (ffenameSpace *** 188,194 **** ffename_space_drive_symbol(ns,fn); */ void ! ffename_space_drive_symbol (ffenameSpace ns, ffesymbol (*fn) ()) { ffename n; --- 188,194 ---- ffename_space_drive_symbol(ns,fn); */ void ! ffename_space_drive_symbol (ffenameSpace ns, ffesymbol (*fn) (ffesymbol)) { ffename n; diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/name.h gcc-2.95/gcc/f/name.h *** egcs-1.1.2/gcc/f/name.h Tue May 19 03:49:56 1998 --- gcc-2.95/gcc/f/name.h Sat Mar 27 02:24:02 1999 *************** *** 1,6 **** /* name.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* name.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** struct _ffename_space_ *** 75,82 **** ffename ffename_find (ffenameSpace ns, ffelexToken t); void ffename_kill (ffenameSpace ns, ffename n); ffename ffename_lookup (ffenameSpace ns, ffelexToken t); ! void ffename_space_drive_global (ffenameSpace ns, ffeglobal (*fn) ()); ! void ffename_space_drive_symbol (ffenameSpace ns, ffesymbol (*fn) ()); void ffename_space_kill (ffenameSpace ns); ffenameSpace ffename_space_new (mallocPool pool); --- 75,82 ---- ffename ffename_find (ffenameSpace ns, ffelexToken t); void ffename_kill (ffenameSpace ns, ffename n); ffename ffename_lookup (ffenameSpace ns, ffelexToken t); ! void ffename_space_drive_global (ffenameSpace ns, ffeglobal (*fn) (ffeglobal)); ! void ffename_space_drive_symbol (ffenameSpace ns, ffesymbol (*fn) (ffesymbol)); void ffename_space_kill (ffenameSpace ns); ffenameSpace ffename_space_new (mallocPool pool); diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/news.texi gcc-2.95/gcc/f/news.texi *** egcs-1.1.2/gcc/f/news.texi Thu Mar 11 07:28:52 1999 --- gcc-2.95/gcc/f/news.texi Thu Jul 8 05:40:27 1999 *************** *** 2,19 **** @c This is part of the G77 manual. @c For copying conditions, see the file g77.texi. ! @c The text of this file appears in the file BUGS @c in the G77 distribution, as well as in the G77 manual. ! @c 1999-03-11 ! @ifclear NEWSONLY @node News @chapter News About GNU Fortran - @end ifclear @cindex versions, recent @cindex recent versions Changes made to recent versions of GNU Fortran are listed below, with the most recent version first. --- 2,65 ---- @c This is part of the G77 manual. @c For copying conditions, see the file g77.texi. ! @c The text of this file appears in the file NEWS @c in the G77 distribution, as well as in the G77 manual. ! @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-1999 ! ! @set last-update-news 1999-07-08 ! ! @include root.texi ! ! @ifset DOC-NEWS ! @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 ! @file{news0.texi} and @file{news.texi}. ! @file{NEWS} is @emph{not} a source file, ! although it is normally included within source distributions. ! ! This file lists news about the @value{which-g77} version ! (and some other versions) of the GNU Fortran compiler. ! Copyright (C) @value{copyrights-news} Free Software Foundation, Inc. ! You may copy, distribute, and modify it freely as long as you preserve ! this copyright notice and permission notice. ! @node Top,,, (dir) ! @chapter News About GNU Fortran ! @end ifset ! ! @ifset DOC-G77 ! @ifset USERVISONLY ! @node Changes ! @chapter User-visible Changes ! @cindex versions, recent ! @cindex recent versions ! @cindex changes, user-visible ! @cindex user-visible changes ! ! This chapter describes changes to @code{g77} that are visible ! to the programmers who actually write and maintain Fortran ! code they compile with @code{g77}. ! Information on changes to installation procedures, ! changes to the documentation, and bug fixes is ! not provided here, unless it is likely to affect how ! users use @code{g77}. ! @xref{News,,News About GNU Fortran}, for information on ! such changes to @code{g77}. ! @end ifset ! ! @ifclear USERVISONLY @node News @chapter News About GNU Fortran @cindex versions, recent @cindex recent versions + @end ifclear + @end ifset + @ifclear USERVISONLY Changes made to recent versions of GNU Fortran are listed below, with the most recent version first. *************** Miscellany *** 45,50 **** --- 91,97 ---- This order is not strict---for example, some items involve a combination of these elements. + @end ifclear Note that two variants of @code{g77} are tracked below. The @code{egcs} variant is described vis-a-vis *************** though this can make getting a complete *** 58,92 **** of what a particular @code{egcs} version contains somewhat more difficult. An online, ``live'' version of this document ! (derived directly from the up-to-date mainline version of @code{g77} within @code{egcs}) is available at @uref{http://egcs.cygnus.com/onlinedocs/g77_news.html}. ! @heading In 0.5.24 and @code{egcs} 1.1.2 (versus 0.5.23 and 1.1.1): @itemize @bullet @item ! Fix the @code{IDate} Intrinsic (VXT) so the returned year is in the documented, non-Y2K-compliant range ! of 0--99, instead of being returned as 100 in the year 2000. @item ! Fix the @samp{Date_and_Time} intrinsic (in @code{libg2c}) to return the milliseconds value properly in @var{Values}(8). @item ! Fix the @samp{LStat} intrinsic (in @code{libg2c}) to return device-ID information properly in @var{SArray}(7). @item Improve documentation. @end itemize ! @heading In 0.5.24 and @code{egcs} 1.1.1 (versus 0.5.23 and 1.1): @itemize @bullet @item Fix @code{libg2c} so it performs an implicit @code{ENDFILE} operation --- 105,419 ---- of what a particular @code{egcs} version contains somewhat more difficult. + @ifset DOC-G77 + For information on bugs in the @value{which-g77} version of @code{g77}, + see @ref{Known Bugs,,Known Bugs In GNU Fortran}. + @end ifset + + @ifset DOC-BUGS + For information on bugs in the @value{which-g77} version of @code{g77}, + see @file{@value{path-g77}/BUGS}. + @end ifset + + @ifset DEVELOPMENT + @emph{Warning:} The information below is still under development, + and might not accurately reflect the @code{g77} code base + of which it is a part. + Efforts are made to keep it somewhat up-to-date, + but they are particularly concentrated + on any version of this information + that is distributed as part of a @emph{released} @code{g77}. + + In particular, while this information is intended to apply to + the @value{which-g77} version of @code{g77}, + only an official @emph{release} of that version + is expected to contain documentation that is + most consistent with the @code{g77} product in that version. + + Nevertheless, information on @emph{previous} releases of @code{g77}, below, + is likely to be more up-to-date and accurate + than the equivalent information that accompanied + those releases, + assuming the last-updated date of the information below + is later than the dates of those releases. + + That's due to attempts to keep this development version + of news about previous @code{g77} versions up-to-date. + @end ifset + + @ifclear USERVISONLY An online, ``live'' version of this document ! (derived directly from the mainline, development version of @code{g77} within @code{egcs}) is available at @uref{http://egcs.cygnus.com/onlinedocs/g77_news.html}. + @end ifclear + + The following information was last updated on @value{last-update-news}: + + @heading In 0.5.25, @code{GCC} 2.95 (@code{EGCS} 1.2) versus @code{EGCS} 1.1.2: + @itemize @bullet + @ifclear USERVISONLY + @item + @code{g77} no longer generates bad code for assignments, + or other conversions, + of @code{REAL} or @code{COMPLEX} constant expressions + to type @code{INTEGER(KIND=2)} + (often referred to as @code{INTEGER*8}). + + For example, @samp{INTEGER*8 J; J = 4E10} now works as documented. + @end ifclear + + @ifclear USERVISONLY + @item + @code{g77} no longer truncates @code{INTEGER(KIND=2)} + (usually @code{INTEGER*8}) + subscript expressions when evaluating array references + on systems with pointers widers than @code{INTEGER(KIND=1)} + (such as Alphas). + @end ifclear + + @ifclear USERVISONLY + @item + @code{g77} no longer generates bad code + for an assignment to a @code{COMPLEX} variable or array + that partially overlaps one or more of the sources + of the same assignment + (a very rare construction). + It now assigns through a temporary, + in cases where such partial overlap is deemed possible. + @end ifclear + + @ifclear USERVISONLY + @item + @code{libg2c} (@code{libf2c}) no longer loses track + of the file being worked on + during a @code{BACKSPACE} operation. + @end ifclear + + @ifclear USERVISONLY + @item + @code{libg2c} (@code{libf2c}) fixes a bug whereby + input to a @code{NAMELIST} read involving a repeat count, + such as @samp{K(5)=10*3}, + was not properly handled by @code{libf2c}. + The first item was written to @samp{K(5)}, + but the remaining nine were written elsewhere (still within the array), + not necessarily starting at @samp{K(6)}. + @end ifclear + + @ifclear USERVISONLY + @item + @c Tim Prince reported this, regarding the TEST_FPU benchmark. + Automatic arrays now seem to be working on HP-UX systems. + @end ifclear + + @ifclear USERVISONLY + @item + The @code{Date} intrinsic now returns the correct result + on big-endian systems. + @end ifclear + + @ifclear USERVISONLY + @item + Fix @code{g77} so it no longer crashes when compiling + I/O statements using keywords that define @code{INTEGER} values, + such as @samp{IOSTAT=@var{j}}, + where @var{j} is other than default @code{INTEGER} + (such as @code{INTEGER*2}). + Instead, it issues a diagnostic. + @end ifclear + + @ifclear USERVISONLY + @item + Fix @code{g77} so it properly handles @samp{DATA A/@var{rpt}*@var{val}/}, + where @var{rpt} is not default @code{INTEGER}, such as @code{INTEGER*2}, + instead of producing a spurious diagnostic. + Also fix @samp{DATA (A(I),I=1,N)}, + where @samp{N} is not default @code{INTEGER} + to work instead of crashing @code{g77}. + @end ifclear + + @ifclear USERVISONLY + @item + The @samp{-ax} option is now obeyed when compiling Fortran programs. + (It is passed to the @file{f771} driver.) + @end ifclear + + @item + The new @samp{-fbounds-check} option + causes @code{g77} to compile run-time bounds checks + of array subscripts, as well as of substring start and end points. + + @item + @code{libg2c} now supports building as multilibbed library, + which provides better support for systems + that require options such as @samp{-mieee} + to work properly. + + @item + Source file names with the suffixes @samp{.FOR} and @samp{.FPP} + now are recognized by @code{g77} + as if they ended in @samp{.for} and @samp{.fpp}, respectively. + + @item + The order of arguments to the @emph{subroutine} forms of the + @code{CTime}, @code{DTime}, @code{ETime}, and @code{TtyNam} + intrinsics has been swapped. + The argument serving as the returned value + for the corresponding function forms + now is the @emph{second} argument, + making these consistent with the other subroutine forms + of @code{libU77} intrinsics. + + @item + @code{g77} now warns about a reference to an intrinsic + that has an interface that is not Year 2000 (Y2K) compliant. + Also, @code{libg2c} has been changed to increase the likelihood + of catching references to the implementations of these intrinsics + using the @code{EXTERNAL} mechanism + (which would avoid the new warnings). + + @ifset DOC-G77 + @xref{Year 2000 (Y2K) Problems}, for more information. + @end ifset + + @ifclear USERVISONLY + @item + @code{g77} now warns about a reference to a function + when the corresponding @emph{subsequent} function program unit + disagrees with the reference concerning the type of the function. + @end ifclear + + @item + @samp{-fno-emulate-complex} is now the default option. + This should result in improved performance + of code that uses the @code{COMPLEX} data type. + + @cindex alignment + @cindex double-precision performance + @cindex -malign-double + @item + The @samp{-malign-double} option + now reliably aligns @emph{all} double-precision variables and arrays + on Intel x86 targets. + + @ifclear USERVISONLY + @item + Even without the @samp{-malign-double} option, + @code{g77} reliably aligns local double-precision variables + that are not in @code{EQUIVALENCE} areas + and not @code{SAVE}'d. + @end ifclear + + @ifclear USERVISONLY + @item + @code{g77} now open-codes (``inlines'') division of @code{COMPLEX} operands + instead of generating a run-time call to + the @code{libf2c} routines @code{c_div} or @code{z_div}, + unless the @samp{-Os} option is specified. + @end ifclear + + @item + @code{g77} no longer generates code to maintain @code{errno}, + a C-language concept, + when performing operations such as the @code{SqRt} intrinsic. + + @ifclear USERVISONLY + @item + @code{g77} developers can temporarily use + the @samp{-fflatten-arrays} option + to compare how the compiler handles code generation + using C-like constructs as compared to the + Fortran-like method constructs normally used. + @end ifclear + + @ifclear USERVISONLY + @item + A substantial portion of the @code{g77} front end's code-generation component + was rewritten. + It now generates code using facilities more robustly supported + by the @code{gcc} back end. + One effect of this rewrite is that some codes no longer produce + a spurious ``label @var{lab} used before containing binding contour'' + message. + @end ifclear + + @item + Support for the @samp{-fugly} option has been removed. + + @ifclear USERVISONLY + @item + Improve documentation and indexing, + including information on Year 2000 (Y2K) compliance, + and providing more information on internals of the front end. + @end ifclear + + @ifclear USERVISONLY + @item + Upgrade to @code{libf2c} as of 1999-05-10. + @end ifclear + @end itemize ! @heading In 0.5.24 versus 0.5.23: ! ! There is no @code{g77} version 0.5.24 at this time, ! or planned. ! 0.5.24 is the version number designated for bug fixes and, ! perhaps, some new features added, ! to 0.5.23. ! Version 0.5.23 requires @code{gcc} 2.8.1, ! as 0.5.24 was planned to require. ! ! Due to @code{EGCS} becoming @code{GCC} ! (which is now an acronym for ``GNU Compiler Collection''), ! and @code{EGCS} 1.2 becoming officially designated @code{GCC} 2.95, ! there seems to be no need for an actual 0.5.24 release. ! ! To reduce the confusion already resulting from use of 0.5.24 ! to designate @code{g77} versions within @code{EGCS} versions 1.0 and 1.1, ! as well as in versions of @code{g77} documentation and notices ! during that period, ! ``mainline'' @code{g77} version numbering resumes ! at 0.5.25 with @code{GCC} 2.95 (@code{EGCS} 1.2), ! skipping over 0.5.24 as a placeholder version number. ! ! To repeat, there is no @code{g77} 0.5.24, but there is now a 0.5.25. ! Please remain calm and return to your keypunch units. ! ! @c 1999-03-15: EGCS 1.1.2 released. ! @heading In @code{EGCS} 1.1.2 versus @code{EGCS} 1.1.1: ! @ifclear USERVISONLY @itemize @bullet @item ! Fix the @code{IDate} intrinsic (VXT) (in @code{libg2c}) so the returned year is in the documented, non-Y2K-compliant range ! of 0-99, instead of being returned as 100 in the year 2000. + @ifset DOC-G77 + @xref{IDate Intrinsic (VXT)}, + for more information. + @end ifset + @item ! Fix the @code{Date_and_Time} intrinsic (in @code{libg2c}) to return the milliseconds value properly in @var{Values}(8). @item ! Fix the @code{LStat} intrinsic (in @code{libg2c}) to return device-ID information properly in @var{SArray}(7). @item Improve documentation. @end itemize + @end ifclear ! @c 1998-12-04: EGCS 1.1.1 released. ! @heading In @code{EGCS} 1.1.1 versus @code{EGCS} 1.1: ! @ifclear USERVISONLY @itemize @bullet @item Fix @code{libg2c} so it performs an implicit @code{ENDFILE} operation *************** upon doing any I/O following a direct fo *** 105,171 **** @item Fix @code{g77} so it no longer crashes compiling references ! to the @samp{Rand} intrinsic on some systems. @item Fix @code{g77} portion of installation process so it works better on some systems (those with shells requiring @samp{else true} clauses ! on @samp{if} constructs for the completion code to be set properly). @end itemize ! @heading In @code{egcs} 1.1 (versus 0.5.24): ! @itemize @bullet ! @item ! Fix @code{g77} crash compiling code ! containing the construct @samp{CMPLX(0.)} or similar. ! ! @item ! Fix @code{g77} crash ! (or apparently infinite run-time) ! when compiling certain complicated expressions ! involving @code{COMPLEX} arithmetic ! (especially multiplication). ! ! @cindex DNRM2 ! @cindex stack, 387 coprocessor ! @cindex Intel x86 ! @cindex -O2 ! @item ! Fix a code-generation bug that afflicted ! Intel x86 targets when @samp{-O2} was specified ! compiling, for example, an old version of ! the @samp{DNRM2} routine. ! ! The x87 coprocessor stack was being ! mismanaged in cases involving assigned @code{GOTO} ! and @code{ASSIGN}. ! ! @cindex alignment ! @cindex double-precision performance ! @cindex -malign-double ! @item ! Align static double-precision variables and arrays ! on Intel x86 targets ! regardless of whether @samp{-malign-double} is specified. ! ! Generally, this affects only local variables and arrays ! having the @code{SAVE} attribute ! or given initial values via @code{DATA}. ! @end itemize ! ! @c 1998-09-01: egcs-1.1 released. ! @heading In @code{egcs} 1.1 (versus @code{egcs} 1.0.3): @itemize @bullet @item ! Fix bugs in the @code{libU77} intrinsic @samp{HostNm} ! that wrote one byte beyond the end of its @samp{CHARACTER} argument, and in the @code{libU77} intrinsics ! @samp{GMTime} and @samp{LTime} that overwrote their arguments. @item Assumed arrays with negative bounds (such as @samp{REAL A(-1:*)}) --- 432,462 ---- @item Fix @code{g77} so it no longer crashes compiling references ! to the @code{Rand} intrinsic on some systems. @item Fix @code{g77} portion of installation process so it works better on some systems (those with shells requiring @samp{else true} clauses ! on @code{if} constructs for the completion code to be set properly). @end itemize + @end ifclear ! @c 1998-09-03: EGCS 1.1 released. ! @heading In @code{EGCS} 1.1 versus @code{EGCS} 1.0.3: @itemize @bullet + @ifclear USERVISONLY @item ! Fix bugs in the @code{libU77} intrinsic @code{HostNm} ! that wrote one byte beyond the end of its @code{CHARACTER} argument, and in the @code{libU77} intrinsics ! @code{GMTime} and @code{LTime} that overwrote their arguments. + @end ifclear + @ifclear USERVISONLY @item Assumed arrays with negative bounds (such as @samp{REAL A(-1:*)}) *************** different sizes than integers. *** 176,182 **** --- 467,475 ---- This bug is not known to have existed in any recent version of @code{gcc}. It was introduced in an early release of @code{egcs}. + @end ifclear + @ifclear USERVISONLY @item Valid combinations of @code{EXTERNAL}, passing that external as a dummy argument *************** and, in a subsequent program unit, *** 185,198 **** --- 478,496 ---- referencing that external as an external function with a different type no longer crash @code{g77}. + @end ifclear + @ifclear USERVISONLY @item @code{CASE DEFAULT} no longer crashes @code{g77}. + @end ifclear + @ifclear USERVISONLY @item The @samp{-Wunused} option no longer issues a spurious warning about the ``master'' procedure generated by @code{g77} for procedures containing @code{ENTRY} statements. + @end ifclear @item Support @samp{FORMAT(I<@var{expr}>)} when @var{expr} is a *************** compile-time constant @code{INTEGER} exp *** 200,206 **** @item Fix @code{g77} @samp{-g} option so procedures that ! use @samp{ENTRY} can be stepped through, line by line, in @code{gdb}. @item --- 498,504 ---- @item Fix @code{g77} @samp{-g} option so procedures that ! use @code{ENTRY} can be stepped through, line by line, in @code{gdb}. @item *************** that have their own (non-Fortran) @code{ *** 225,230 **** --- 523,529 ---- properly set up the @code{libf2c} environment, even when @code{libf2c} (now @code{libg2c}) is a shared library. + @ifclear USERVISONLY @item @code{g77} no longer installs the @file{f77} command and @file{f77.1} man page *************** in the @file{/usr} or @file{/usr/local} *** 232,238 **** --- 531,539 ---- even if the @file{f77-install-ok} file exists in the source or build directory. See the installation documentation for more information. + @end ifclear + @ifclear USERVISONLY @item @code{g77} no longer installs the @file{libf2c.a} library and @file{f2c.h} include file *************** in the @file{/usr} or @file{/usr/local} *** 240,246 **** --- 541,549 ---- even if the @file{f2c-install-ok} or @file{f2c-exists-ok} files exist in the source or build directory. See the installation documentation for more information. + @end ifclear + @ifclear USERVISONLY @item The @file{libf2c.a} library produced by @code{g77} has been renamed to @file{libg2c.a}. *************** This allows system administrators and us *** 250,256 **** --- 553,561 ---- version of the @code{libf2c} library from @code{netlib} they wish to use on a case-by-case basis. See the installation documentation for more information. + @end ifclear + @ifclear USERVISONLY @item The @file{f2c.h} include (header) file produced by @code{g77} has been renamed to @file{g2c.h}. *************** This allows system administrators and us *** 260,265 **** --- 565,571 ---- version of the include file from @code{netlib} they wish to use on a case-by-case basis. See the installation documentation for more information. + @end ifclear @item The @code{g77} command now expects the run-time library *************** to be named @code{libg2c.a} instead of @ *** 267,283 **** --- 573,593 ---- to ensure that a version other than the one built and installed as part of the same @code{g77} version is picked up. + @ifclear USERVISONLY @item During the configuration and build process, @code{g77} creates subdirectories it needs only as it needs them. Other cleaning up of the configuration and build process has been performed as well. + @end ifclear + @ifclear USERVISONLY @item @code{install-info} now used to update the directory of Info documentation to contain an entry for @code{g77} (during installation). + @end ifclear @item Some diagnostics have been changed from warnings to errors, *************** in the @code{OPEN}, @code{INQUIRE}, @cod *** 288,328 **** @code{WRITE} statements, and about truncations of various sorts of constants. @item Improve compilation of @code{FORMAT} expressions so that a null byte is appended to the last operand if it is a constant. This provides a cleaner run-time diagnostic as provided by @code{libf2c} for statements like @samp{PRINT '(I1', 42}. @item Improve documentation and indexing. @item The upgrade to @code{libf2c} as of 1998-06-18 should fix a variety of problems, including ! those involving some uses of the @samp{T} format specifier, and perhaps some build (porting) problems as well. @end itemize ! @heading In 0.5.24 and @code{egcs} 1.1 (versus 0.5.23): @itemize @bullet @item @code{g77} no longer produces incorrect code and initial values ! for @samp{EQUIVALENCE} and @samp{COMMON} aggregates that, due to ``unnatural'' ordering of members vis-a-vis their types, require initial padding. @item @code{g77} no longer crashes when compiling code containing specification statements such as @samp{INTEGER(KIND=7) PTR}. @item @code{g77} no longer crashes when compiling code such as @samp{J = SIGNAL(1, 2)}. @item @code{g77} now treats @samp{%LOC(@var{expr})} and --- 598,673 ---- @code{WRITE} statements, and about truncations of various sorts of constants. + @ifclear USERVISONLY @item Improve compilation of @code{FORMAT} expressions so that a null byte is appended to the last operand if it is a constant. This provides a cleaner run-time diagnostic as provided by @code{libf2c} for statements like @samp{PRINT '(I1', 42}. + @end ifclear + @ifclear USERVISONLY @item Improve documentation and indexing. + @end ifclear + @ifclear USERVISONLY @item The upgrade to @code{libf2c} as of 1998-06-18 should fix a variety of problems, including ! those involving some uses of the @code{T} format specifier, and perhaps some build (porting) problems as well. + @end ifclear @end itemize ! @c 1998-09-03: EGCS 1.1 released. ! @heading In @code{EGCS} 1.1 versus @code{g77} 0.5.23: @itemize @bullet + @ifclear USERVISONLY + @cindex DNRM2 + @cindex stack, 387 coprocessor + @cindex Intel x86 + @cindex -O2 + @item + Fix a code-generation bug that afflicted + Intel x86 targets when @samp{-O2} was specified + compiling, for example, an old version of + the @code{DNRM2} routine. + + The x87 coprocessor stack was being + mismanaged in cases involving assigned @code{GOTO} + and @code{ASSIGN}. + @end ifclear + + @ifclear USERVISONLY @item @code{g77} no longer produces incorrect code and initial values ! for @code{EQUIVALENCE} and @code{COMMON} aggregates that, due to ``unnatural'' ordering of members vis-a-vis their types, require initial padding. + @end ifclear + @ifclear USERVISONLY + @item + Fix @code{g77} crash compiling code + containing the construct @samp{CMPLX(0.)} or similar. + @end ifclear + + @ifclear USERVISONLY @item @code{g77} no longer crashes when compiling code containing specification statements such as @samp{INTEGER(KIND=7) PTR}. + @end ifclear + @ifclear USERVISONLY @item @code{g77} no longer crashes when compiling code such as @samp{J = SIGNAL(1, 2)}. + @end ifclear @item @code{g77} now treats @samp{%LOC(@var{expr})} and *************** Previously, @code{g77} treated these exp *** 337,342 **** --- 682,708 ---- as denoting special ``pointer'' arguments for the purposes of filewide analysis. + @ifclear USERVISONLY + @item + Fix @code{g77} crash + (or apparently infinite run-time) + when compiling certain complicated expressions + involving @code{COMPLEX} arithmetic + (especially multiplication). + @end ifclear + + @cindex alignment + @cindex double-precision performance + @cindex -malign-double + @item + Align static double-precision variables and arrays + on Intel x86 targets + regardless of whether @samp{-malign-double} is specified. + + Generally, this affects only local variables and arrays + having the @code{SAVE} attribute + or given initial values via @code{DATA}. + @item The @code{g77} driver now ensures that @samp{-lg2c} is specified in the link phase prior to any *************** in @code{libf2c} (@code{libg2c}). *** 353,383 **** This new information allows, for example, @kbd{which __g77_length_a} to be used in @code{gdb} to determine the type of the phantom length argument ! supplied with @samp{CHARACTER} variables. This information pertains to internally-generated type, variable, and other information, not to the longstanding deficiencies vis-a-vis ! @samp{COMMON} and @samp{EQUIVALENCE}. @item ! The F90 @samp{Date_and_Time} intrinsic now is supported. @item ! The F90 @samp{System_Clock} intrinsic allows ! the optional arguments (except for the @samp{Count} argument) to be omitted. @item Upgrade to @code{libf2c} as of 1998-06-18. @item Improve documentation and indexing. @end itemize @c 1998-05-20: 0.5.23 released. ! @heading In 0.5.23 (versus 0.5.22): @itemize @bullet @item This release contains several regressions against --- 719,766 ---- This new information allows, for example, @kbd{which __g77_length_a} to be used in @code{gdb} to determine the type of the phantom length argument ! supplied with @code{CHARACTER} variables. This information pertains to internally-generated type, variable, and other information, not to the longstanding deficiencies vis-a-vis ! @code{COMMON} and @code{EQUIVALENCE}. @item ! The F90 @code{Date_and_Time} intrinsic now is supported. @item ! The F90 @code{System_Clock} intrinsic allows ! the optional arguments (except for the @code{Count} argument) to be omitted. + @ifclear USERVISONLY @item Upgrade to @code{libf2c} as of 1998-06-18. + @end ifclear + @ifclear USERVISONLY @item Improve documentation and indexing. + @end ifclear @end itemize + @ifset DOC-NEWS + @heading In previous versions: + + Information on previous versions is not provided + in this @file{@value{path-g77}/NEWS} file, + to keep it short. + See @file{@value{path-g77}/news.texi}, + or any of its other derivations + (Info, HTML, dvi forms) + for such information. + @end ifset + + @ifclear DOC-NEWS @c 1998-05-20: 0.5.23 released. ! @heading In 0.5.23 versus 0.5.22: @itemize @bullet @item This release contains several regressions against *************** version 0.5.22 of @code{g77}, due to usi *** 386,409 **** it to fix a few bugs and improve performance in a few cases. - @ifset last-up-date - @xref{Actual Bugs,,Actual Bugs We Haven't Fixed Yet}, - for information on the known bugs in this version, - including the regressions. - @end ifset - - @ifset NEWSONLY - See @file{egcs/gcc/f/BUGS}, - for information on the known bugs in this version, - including the regressions. - @end ifset - Features that have been dropped from this version of @code{g77} due to their being implemented via @code{g77}-specific patches to the @code{gcc} back end in previous releases include: ! @itemize -- @item Support for @code{__restrict__} keyword, the options @samp{-fargument-alias}, @samp{-fargument-noalias}, --- 769,780 ---- it to fix a few bugs and improve performance in a few cases. Features that have been dropped from this version of @code{g77} due to their being implemented via @code{g77}-specific patches to the @code{gcc} back end in previous releases include: ! @itemize @minus @item Support for @code{__restrict__} keyword, the options @samp{-fargument-alias}, @samp{-fargument-noalias}, *************** applying to stack-allocated data *** 437,469 **** as well as statically-allocate data. @end itemize Note that the @file{gcc/f/gbe/} subdirectory has been removed from this distribution as a result of @code{g77} no longer including patches for the @code{gcc} back end. @item ! Fix bugs in the @code{libU77} intrinsic @samp{HostNm} ! that wrote one byte beyond the end of its @samp{CHARACTER} argument, and in the @code{libU77} intrinsics ! @samp{GMTime} and @samp{LTime} that overwrote their arguments. @item Support @code{gcc} version 2.8, and remove support for prior versions of @code{gcc}. @cindex -@w{}-driver option ! @cindex g77 options, -@w{}-driver @cindex options, -@w{}-driver @item Remove support for the @samp{--driver} option, as @code{g77} now does all the driving, just like @code{gcc}. @item @code{CASE DEFAULT} no longer crashes @code{g77}. @item Valid combinations of @code{EXTERNAL}, passing that external as a dummy argument --- 808,847 ---- as well as statically-allocate data. @end itemize + @ifclear USERVISONLY Note that the @file{gcc/f/gbe/} subdirectory has been removed from this distribution as a result of @code{g77} no longer including patches for the @code{gcc} back end. + @end ifclear + @ifclear USERVISONLY @item ! Fix bugs in the @code{libU77} intrinsic @code{HostNm} ! that wrote one byte beyond the end of its @code{CHARACTER} argument, and in the @code{libU77} intrinsics ! @code{GMTime} and @code{LTime} that overwrote their arguments. + @end ifclear @item Support @code{gcc} version 2.8, and remove support for prior versions of @code{gcc}. @cindex -@w{}-driver option ! @cindex @code{g77} options, -@w{}-driver @cindex options, -@w{}-driver @item Remove support for the @samp{--driver} option, as @code{g77} now does all the driving, just like @code{gcc}. + @ifclear USERVISONLY @item @code{CASE DEFAULT} no longer crashes @code{g77}. + @end ifclear + @ifclear USERVISONLY @item Valid combinations of @code{EXTERNAL}, passing that external as a dummy argument *************** and, in a subsequent program unit, *** 472,478 **** --- 850,858 ---- referencing that external as an external function with a different type no longer crash @code{g77}. + @end ifclear + @ifclear USERVISONLY @item @code{g77} no longer installs the @file{f77} command and @file{f77.1} man page *************** in the @file{/usr} or @file{/usr/local} *** 480,486 **** --- 860,868 ---- even if the @file{f77-install-ok} file exists in the source or build directory. See the installation documentation for more information. + @end ifclear + @ifclear USERVISONLY @item @code{g77} no longer installs the @file{libf2c.a} library and @file{f2c.h} include file *************** in the @file{/usr} or @file{/usr/local} *** 488,494 **** --- 870,878 ---- even if the @file{f2c-install-ok} or @file{f2c-exists-ok} files exist in the source or build directory. See the installation documentation for more information. + @end ifclear + @ifclear USERVISONLY @item The @file{libf2c.a} library produced by @code{g77} has been renamed to @file{libg2c.a}. *************** This allows system administrators and us *** 498,504 **** --- 882,890 ---- version of the @code{libf2c} library from @code{netlib} they wish to use on a case-by-case basis. See the installation documentation for more information. + @end ifclear + @ifclear USERVISONLY @item The @file{f2c.h} include (header) file produced by @code{g77} has been renamed to @file{g2c.h}. *************** This allows system administrators and us *** 508,513 **** --- 894,900 ---- version of the include file from @code{netlib} they wish to use on a case-by-case basis. See the installation documentation for more information. + @end ifclear @item The @code{g77} command now expects the run-time library *************** to be named @code{libg2c.a} instead of @ *** 515,524 **** --- 902,913 ---- to ensure that a version other than the one built and installed as part of the same @code{g77} version is picked up. + @ifclear USERVISONLY @item The @samp{-Wunused} option no longer issues a spurious warning about the ``master'' procedure generated by @code{g77} for procedures containing @code{ENTRY} statements. + @end ifclear @item @code{g77}'s version of @code{libf2c} separates out *************** that have their own (non-Fortran) @code{ *** 532,537 **** --- 921,927 ---- properly set up the @code{libf2c} environment, even when @code{libf2c} (now @code{libg2c}) is a shared library. + @ifclear USERVISONLY @item During the configuration and build process, @code{g77} creates subdirectories it needs only as it *************** needs them, thus avoiding unnecessary cr *** 539,549 **** --- 929,942 ---- @file{stage1/f/runtime} when doing a non-bootstrap build. Other cleaning up of the configuration and build process has been performed as well. + @end ifclear + @ifclear USERVISONLY @item @code{install-info} now used to update the directory of Info documentation to contain an entry for @code{g77} (during installation). + @end ifclear @item Some diagnostics have been changed from warnings to errors, *************** in the @code{OPEN}, @code{INQUIRE}, @cod *** 554,580 **** @code{WRITE} statements, and about truncations of various sorts of constants. @item Improve documentation and indexing. @item Upgrade to @code{libf2c} as of 1998-04-20. This should fix a variety of problems, including ! those involving some uses of the @samp{T} format specifier, and perhaps some build (porting) problems as well. @end itemize @c 1998-03-16: 0.5.22 released. ! @heading In 0.5.22 (versus 0.5.21): @itemize @bullet @item Fix code generation for iterative @code{DO} loops that have one or more references to the iteration variable, or to aliases of it, in their control expressions. For example, @samp{DO 10 J=2,J} now is compiled correctly. @cindex DNRM2 @cindex stack, 387 coprocessor @cindex Intel x86 --- 947,980 ---- @code{WRITE} statements, and about truncations of various sorts of constants. + @ifclear USERVISONLY @item Improve documentation and indexing. + @end ifclear + @ifclear USERVISONLY @item Upgrade to @code{libf2c} as of 1998-04-20. This should fix a variety of problems, including ! those involving some uses of the @code{T} format specifier, and perhaps some build (porting) problems as well. + @end ifclear @end itemize @c 1998-03-16: 0.5.22 released. ! @heading In 0.5.22 versus 0.5.21: @itemize @bullet + @ifclear USERVISONLY @item Fix code generation for iterative @code{DO} loops that have one or more references to the iteration variable, or to aliases of it, in their control expressions. For example, @samp{DO 10 J=2,J} now is compiled correctly. + @end ifclear + @ifclear USERVISONLY @cindex DNRM2 @cindex stack, 387 coprocessor @cindex Intel x86 *************** For example, @samp{DO 10 J=2,J} now is c *** 583,636 **** Fix a code-generation bug that afflicted Intel x86 targets when @samp{-O2} was specified compiling, for example, an old version of ! the @samp{DNRM2} routine. The x87 coprocessor stack was being mismanaged in cases involving assigned @code{GOTO} and @code{ASSIGN}. @item Fix @code{DTime} intrinsic so as not to truncate results to integer values (on some systems). @item Fix @code{Signal} intrinsic so it offers portable support for 64-bit systems (such as Digital Alphas running GNU/Linux). @item Fix run-time crash involving @code{NAMELIST} on 64-bit machines such as Alphas. @item Fix @code{g77} version of @code{libf2c} so it no longer produces a spurious @samp{I/O recursion} diagnostic at run time when an I/O operation (such as @samp{READ *,I}) is interrupted in a manner that causes the program to be terminated ! via the @samp{f_exit} routine (such as via @kbd{C-c}). @item Fix @code{g77} crash triggered by @code{CASE} statement with an omitted lower or upper bound. @item Fix @code{g77} crash compiling references to @code{CPU_Time} intrinsic. @item Fix @code{g77} crash (or apparently infinite run-time) when compiling certain complicated expressions involving @code{COMPLEX} arithmetic (especially multiplication). @item Fix @code{g77} crash on statements such as @samp{PRINT *, (REAL(Z(I)),I=1,2)}, where @samp{Z} is @code{DOUBLE COMPLEX}. @item Fix a @code{g++} crash. @item Support @samp{FORMAT(I<@var{expr}>)} when @var{expr} is a --- 983,1053 ---- Fix a code-generation bug that afflicted Intel x86 targets when @samp{-O2} was specified compiling, for example, an old version of ! the @code{DNRM2} routine. The x87 coprocessor stack was being mismanaged in cases involving assigned @code{GOTO} and @code{ASSIGN}. + @end ifclear + @ifclear USERVISONLY @item Fix @code{DTime} intrinsic so as not to truncate results to integer values (on some systems). + @end ifclear @item Fix @code{Signal} intrinsic so it offers portable support for 64-bit systems (such as Digital Alphas running GNU/Linux). + @ifclear USERVISONLY @item Fix run-time crash involving @code{NAMELIST} on 64-bit machines such as Alphas. + @end ifclear + @ifclear USERVISONLY @item Fix @code{g77} version of @code{libf2c} so it no longer produces a spurious @samp{I/O recursion} diagnostic at run time when an I/O operation (such as @samp{READ *,I}) is interrupted in a manner that causes the program to be terminated ! via the @code{f_exit} routine (such as via @kbd{C-c}). ! @end ifclear + @ifclear USERVISONLY @item Fix @code{g77} crash triggered by @code{CASE} statement with an omitted lower or upper bound. + @end ifclear + @ifclear USERVISONLY @item Fix @code{g77} crash compiling references to @code{CPU_Time} intrinsic. + @end ifclear + @ifclear USERVISONLY @item Fix @code{g77} crash (or apparently infinite run-time) when compiling certain complicated expressions involving @code{COMPLEX} arithmetic (especially multiplication). + @end ifclear + @ifclear USERVISONLY @item Fix @code{g77} crash on statements such as @samp{PRINT *, (REAL(Z(I)),I=1,2)}, where @samp{Z} is @code{DOUBLE COMPLEX}. + @end ifclear + @ifclear USERVISONLY @item Fix a @code{g++} crash. + @end ifclear @item Support @samp{FORMAT(I<@var{expr}>)} when @var{expr} is a *************** compile-time constant @code{INTEGER} exp *** 638,649 **** @item Fix @code{g77} @samp{-g} option so procedures that ! use @samp{ENTRY} can be stepped through, line by line, in @code{gdb}. @item Fix a profiling-related bug in @code{gcc} back end for Intel x86 architecture. @item Allow any @code{REAL} argument to intrinsics --- 1055,1068 ---- @item Fix @code{g77} @samp{-g} option so procedures that ! use @code{ENTRY} can be stepped through, line by line, in @code{gdb}. + @ifclear USERVISONLY @item Fix a profiling-related bug in @code{gcc} back end for Intel x86 architecture. + @end ifclear @item Allow any @code{REAL} argument to intrinsics *************** C programs. *** 666,674 **** --- 1085,1095 ---- Support for @code{restrict} is now more like support for @code{complex}. + @ifclear USERVISONLY @item Fix @samp{-fpedantic} to not reject procedure invocations such as @samp{I=J()} and @samp{CALL FOO()}. + @end ifclear @item Fix @samp{-fugly-comma} to affect invocations of *************** arguments to intrinsics, as in @samp{I=M *** 680,685 **** --- 1101,1107 ---- Fix compiler so it accepts @samp{-fgnu-intrinsics-*} and @samp{-fbadu77-intrinsics-*} options. + @ifclear USERVISONLY @item Improve diagnostic messages from @code{libf2c} so it is more likely that the printing of the *************** format string specified via a @code{FORM *** 692,736 **** However, @code{f2c} would exhibit the problem anyway for a statement like @samp{PRINT '(I)garbage', 1} by printing @samp{(I)garbage} as the format string.) @item Improve compilation of @code{FORMAT} expressions so that a null byte is appended to the last operand if it is a constant. This provides a cleaner run-time diagnostic as provided by @code{libf2c} for statements like @samp{PRINT '(I1', 42}. @item Fix various crashes involving code with diagnosed errors. @item Fix cross-compilation bug when configuring @code{libf2c}. @item Improve diagnostics. @item Improve documentation and indexing. @item Upgrade to @code{libf2c} as of 1997-09-23. This fixes a formatted-I/O bug that afflicted 64-bit systems with 32-bit integers (such as Digital Alpha running GNU/Linux). @end itemize ! @c 1998-03-15: egcs-1.0.2 released. ! @heading In @code{egcs} 1.0.2 (versus @code{egcs} 1.0.1): @itemize @bullet @item Fix @code{g77} crash triggered by @code{CASE} statement with an omitted lower or upper bound. @item Fix @code{g77} crash on statements such as @samp{PRINT *, (REAL(Z(I)),I=1,2)}, where @samp{Z} is @code{DOUBLE COMPLEX}. @cindex ELF support @cindex support, ELF @cindex -fPIC option --- 1114,1176 ---- However, @code{f2c} would exhibit the problem anyway for a statement like @samp{PRINT '(I)garbage', 1} by printing @samp{(I)garbage} as the format string.) + @end ifclear + @ifclear USERVISONLY @item Improve compilation of @code{FORMAT} expressions so that a null byte is appended to the last operand if it is a constant. This provides a cleaner run-time diagnostic as provided by @code{libf2c} for statements like @samp{PRINT '(I1', 42}. + @end ifclear + @ifclear USERVISONLY @item Fix various crashes involving code with diagnosed errors. + @end ifclear + @ifclear USERVISONLY @item Fix cross-compilation bug when configuring @code{libf2c}. + @end ifclear + @ifclear USERVISONLY @item Improve diagnostics. + @end ifclear + @ifclear USERVISONLY @item Improve documentation and indexing. + @end ifclear + @ifclear USERVISONLY @item Upgrade to @code{libf2c} as of 1997-09-23. This fixes a formatted-I/O bug that afflicted 64-bit systems with 32-bit integers (such as Digital Alpha running GNU/Linux). + @end ifclear @end itemize ! @c 1998-03-18: EGCS 1.0.2 released. ! @heading In @code{EGCS} 1.0.2 versus @code{EGCS} 1.0.1: @itemize @bullet + @ifclear USERVISONLY @item Fix @code{g77} crash triggered by @code{CASE} statement with an omitted lower or upper bound. + @end ifclear + @ifclear USERVISONLY @item Fix @code{g77} crash on statements such as @samp{PRINT *, (REAL(Z(I)),I=1,2)}, where @samp{Z} is @code{DOUBLE COMPLEX}. + @end ifclear + @ifclear USERVISONLY @cindex ELF support @cindex support, ELF @cindex -fPIC option *************** Fix @code{g77} crash on statements such *** 739,770 **** Fix @samp{-fPIC} (such as compiling for ELF targets) on the Intel x86 architecture target so invalid assembler code is no longer produced. @item Fix @samp{-fpedantic} to not reject procedure invocations such as @samp{I=J()} and @samp{CALL FOO()}. @item Fix @samp{-fugly-comma} to affect invocations of only external procedures. Restore rejection of gratuitous trailing omitted arguments to intrinsics, as in @samp{I=MAX(3,4,,)}. @item Fix compiler so it accepts @samp{-fgnu-intrinsics-*} and @samp{-fbadu77-intrinsics-*} options. @end itemize ! @c 1998-01-02: egcs-1.0.1 released. ! @heading In @code{egcs} 1.0.1 (versus @code{egcs} 1.0): @itemize @bullet @item Fix run-time crash involving @code{NAMELIST} on 64-bit machines such as Alphas. @end itemize ! @c 1997-12-03: egcs-1.0 released. ! @heading In @code{egcs} 1.0 (versus 0.5.21): @itemize @bullet @item Version 1.0 of @code{egcs} --- 1179,1217 ---- Fix @samp{-fPIC} (such as compiling for ELF targets) on the Intel x86 architecture target so invalid assembler code is no longer produced. + @end ifclear + @ifclear USERVISONLY @item Fix @samp{-fpedantic} to not reject procedure invocations such as @samp{I=J()} and @samp{CALL FOO()}. + @end ifclear + @ifclear USERVISONLY @item Fix @samp{-fugly-comma} to affect invocations of only external procedures. Restore rejection of gratuitous trailing omitted arguments to intrinsics, as in @samp{I=MAX(3,4,,)}. + @end ifclear @item Fix compiler so it accepts @samp{-fgnu-intrinsics-*} and @samp{-fbadu77-intrinsics-*} options. @end itemize ! @c 1998-01-06: EGCS 1.0.1 released. ! @heading In @code{EGCS} 1.0.1 versus @code{EGCS} 1.0: ! @ifclear USERVISONLY @itemize @bullet @item Fix run-time crash involving @code{NAMELIST} on 64-bit machines such as Alphas. @end itemize + @end ifclear ! @c 1997-12-03: EGCS 1.0 released. ! @heading In @code{EGCS} 1.0 versus @code{g77} 0.5.21: @itemize @bullet @item Version 1.0 of @code{egcs} *************** due to using the *** 775,798 **** it to fix a few bugs and improve performance in a few cases. - @ifset last-up-date - @xref{Actual Bugs,,Actual Bugs We Haven't Fixed Yet}, - for information on the known bugs in this version, - including the regressions. - @end ifset - - @ifset NEWSONLY - See @file{egcs/gcc/f/BUGS}, - for information on the known bugs in this version, - including the regressions. - @end ifset - Features that have been dropped from this version of @code{g77} due to their being implemented via @code{g77}-specific patches to the @code{gcc} back end in previous releases include: ! @itemize -- @item Support for the C-language @code{restrict} keyword. --- 1222,1233 ---- it to fix a few bugs and improve performance in a few cases. Features that have been dropped from this version of @code{g77} due to their being implemented via @code{g77}-specific patches to the @code{gcc} back end in previous releases include: ! @itemize @minus @item Support for the C-language @code{restrict} keyword. *************** applying to stack-allocated data *** 806,831 **** as well as statically-allocate data. @end itemize Note that the @file{gcc/f/gbe/} subdirectory has been removed from this distribution as a result of @code{g77} being fully integrated with the @code{egcs} variant of the @code{gcc} back end. @item Fix code generation for iterative @code{DO} loops that have one or more references to the iteration variable, or to aliases of it, in their control expressions. For example, @samp{DO 10 J=2,J} now is compiled correctly. @item Fix @code{DTime} intrinsic so as not to truncate results to integer values (on some systems). @item Remove support for non-@code{egcs} versions of @code{gcc}. @cindex -@w{}-driver option ! @cindex g77 options, -@w{}-driver @cindex options, -@w{}-driver @item Remove support for the @samp{--driver} option, --- 1241,1288 ---- as well as statically-allocate data. @end itemize + @ifclear USERVISONLY Note that the @file{gcc/f/gbe/} subdirectory has been removed from this distribution as a result of @code{g77} being fully integrated with the @code{egcs} variant of the @code{gcc} back end. + @end ifclear + @ifclear USERVISONLY @item Fix code generation for iterative @code{DO} loops that have one or more references to the iteration variable, or to aliases of it, in their control expressions. For example, @samp{DO 10 J=2,J} now is compiled correctly. + @end ifclear + @ifclear USERVISONLY @item Fix @code{DTime} intrinsic so as not to truncate results to integer values (on some systems). + @end ifclear + @ifclear USERVISONLY + @item + @c Toon Moene discovered these. + Some Fortran code, miscompiled + by @code{g77} built on @code{gcc} version 2.8.1 + on m68k-next-nextstep3 configurations + when using the @samp{-O2} option, + is now compiled correctly. + It is believed that a C function known to miscompile + on that configuration + when using the @samp{-O2 -funroll-loops} options + also is now compiled correctly. + @end ifclear + + @ifclear USERVISONLY @item Remove support for non-@code{egcs} versions of @code{gcc}. + @end ifclear @cindex -@w{}-driver option ! @cindex @code{g77} options, -@w{}-driver @cindex options, -@w{}-driver @item Remove support for the @samp{--driver} option, *************** just like @code{gcc}. *** 836,841 **** --- 1293,1299 ---- Allow any numeric argument to intrinsics @code{Int2} and @code{Int8}. + @ifclear USERVISONLY @item Improve diagnostic messages from @code{libf2c} so it is more likely that the printing of the *************** format string specified via a @code{FORM *** 848,864 **** --- 1306,1326 ---- However, @code{f2c} would exhibit the problem anyway for a statement like @samp{PRINT '(I)garbage', 1} by printing @samp{(I)garbage} as the format string.) + @end ifclear + @ifclear USERVISONLY @item Upgrade to @code{libf2c} as of 1997-09-23. This fixes a formatted-I/O bug that afflicted 64-bit systems with 32-bit integers (such as Digital Alpha running GNU/Linux). + @end ifclear @end itemize @c 1997-09-09: 0.5.21 released. @heading In 0.5.21: @itemize @bullet + @ifclear USERVISONLY @item Fix a code-generation bug introduced by 0.5.20 caused by loop unrolling (by specifying *************** caused by loop unrolling (by specifying *** 866,872 **** --- 1328,1336 ---- This bug afflicted all code compiled by version 2.7.2.2.f.2 of @code{gcc} (C, C++, Fortran, and so on). + @end ifclear + @ifclear USERVISONLY @item Fix a code-generation bug manifested when combining local @code{EQUIVALENCE} with a *************** the first executable statement (or is *** 875,881 **** --- 1339,1347 ---- treated as an executable-context statement as a result of using the @samp{-fpedantic} option). + @end ifclear + @ifclear USERVISONLY @item Fix a compiler crash that occured when an integer division by a constant zero is detected. *************** the @code{gcc} back end issues a warning *** 884,917 **** This bug afflicted all code compiled by version 2.7.2.2.f.2 of @code{gcc} (C, C++, Fortran, and so on). @item Fix a compiler crash that occurred in some cases of procedure inlining. (Such cases became more frequent in 0.5.20.) @item Fix a compiler crash resulting from using @code{DATA} or similar to initialize a @code{COMPLEX} variable or array to zero. @item Fix compiler crashes involving use of @code{AND}, @code{OR}, or @code{XOR} intrinsics. @item Fix compiler bug triggered when using a @code{COMMON} or @code{EQUIVALENCE} variable as the target of an @code{ASSIGN} or assigned-@code{GOTO} statement. @item Fix compiler crashes due to using the name of a some ! non-standard intrinsics (such as @samp{FTELL} or ! @samp{FPUTC}) as such and as the name of a procedure or common block. Such dual use of a name in a program is allowed by the standard. @c @code{g77}'s version of @code{libf2c} has been modified @c so that the external names of library's procedures do not --- 1350,1401 ---- This bug afflicted all code compiled by version 2.7.2.2.f.2 of @code{gcc} (C, C++, Fortran, and so on). + @end ifclear + @ifset USERVISONLY + @item + When the @samp{-W} option is specified, @code{gcc}, @code{g77}, + and other GNU compilers that incorporate the @code{gcc} + back end as modified by @code{g77}, issue + a warning about integer division by constant zero. + @end ifset + @ifclear USERVISONLY @item Fix a compiler crash that occurred in some cases of procedure inlining. (Such cases became more frequent in 0.5.20.) + @end ifclear + @ifclear USERVISONLY @item Fix a compiler crash resulting from using @code{DATA} or similar to initialize a @code{COMPLEX} variable or array to zero. + @end ifclear + @ifclear USERVISONLY @item Fix compiler crashes involving use of @code{AND}, @code{OR}, or @code{XOR} intrinsics. + @end ifclear + @ifclear USERVISONLY @item Fix compiler bug triggered when using a @code{COMMON} or @code{EQUIVALENCE} variable as the target of an @code{ASSIGN} or assigned-@code{GOTO} statement. + @end ifclear + @ifclear USERVISONLY @item Fix compiler crashes due to using the name of a some ! non-standard intrinsics (such as @code{FTell} or ! @code{FPutC}) as such and as the name of a procedure or common block. Such dual use of a name in a program is allowed by the standard. + @end ifclear @c @code{g77}'s version of @code{libf2c} has been modified @c so that the external names of library's procedures do not *************** the standard. *** 924,953 **** @c @c For example, the intrinsic @code{FPUTC} previously was @c implemented by @code{g77} as a call to the @code{libf2c} ! @c routine @samp{fputc_}. @c This would conflict with a Fortran procedure named @code{FPUTC} @c (using default compiler options), and this conflict @c would cause a crash under certain circumstances. @c ! @c Now, the intrinsic @code{FPUTC} calls @samp{G77_fputc_0}, ! @c which does not conflict with the @samp{fputc_} external @c that implements a Fortran procedure named @code{FPUTC}. @c @c Programs that refer to @code{FPUTC} as an external procedure @c without supplying their own implementation will link to ! @c the new @code{libf2c} routine @samp{fputc_}, which is ! @c simply a jacket routine that calls @samp{G77_fputc_0}. @item Place automatic arrays on the stack, even if @code{SAVE} or the @samp{-fno-automatic} option is in effect. This avoids a compiler crash in some cases. @item The @samp{-malign-double} option now reliably aligns @code{DOUBLE PRECISION} optimally on Pentium and Pentium Pro architectures (586 and 686 in @code{gcc}). @item New option @samp{-Wno-globals} disables warnings --- 1408,1441 ---- @c @c For example, the intrinsic @code{FPUTC} previously was @c implemented by @code{g77} as a call to the @code{libf2c} ! @c routine @code{fputc_}. @c This would conflict with a Fortran procedure named @code{FPUTC} @c (using default compiler options), and this conflict @c would cause a crash under certain circumstances. @c ! @c Now, the intrinsic @code{FPUTC} calls @code{G77_fputc_0}, ! @c which does not conflict with the @code{fputc_} external @c that implements a Fortran procedure named @code{FPUTC}. @c @c Programs that refer to @code{FPUTC} as an external procedure @c without supplying their own implementation will link to ! @c the new @code{libf2c} routine @code{fputc_}, which is ! @c simply a jacket routine that calls @code{G77_fputc_0}. + @ifclear USERVISONLY @item Place automatic arrays on the stack, even if @code{SAVE} or the @samp{-fno-automatic} option is in effect. This avoids a compiler crash in some cases. + @end ifclear + @ifclear USERVISONLY @item The @samp{-malign-double} option now reliably aligns @code{DOUBLE PRECISION} optimally on Pentium and Pentium Pro architectures (586 and 686 in @code{gcc}). + @end ifclear @item New option @samp{-Wno-globals} disables warnings *************** This option also disables inlining of gl *** 977,1017 **** --- 1465,1517 ---- to avoid compiler crashes resulting from coding errors that these diagnostics normally would identify. + @ifclear USERVISONLY @item Diagnose cases where a reference to a procedure disagrees with the type of that procedure, or where disagreements about the number or nature of arguments exist. This avoids a compiler crash. + @end ifclear + @ifclear USERVISONLY @item Fix parsing bug whereby @code{g77} rejected a second initialization specification immediately following the first's closing @samp{/} without an intervening comma in a @code{DATA} statement, and the second specification was an implied-DO list. + @end ifclear + @ifclear USERVISONLY @item Improve performance of the @code{gcc} back end so certain complicated expressions involving @code{COMPLEX} arithmetic (especially multiplication) don't appear to take forever to compile. + @end ifclear + @ifclear USERVISONLY @item Fix a couple of profiling-related bugs in @code{gcc} back end. + @end ifclear + @ifclear USERVISONLY @item Integrate GNU Ada's (GNAT's) changes to the back end, which consist almost entirely of bug fixes. These fixes are circa version 3.10p of GNAT. + @end ifclear + @ifclear USERVISONLY @item Include some other @code{gcc} fixes that seem useful in @code{g77}'s version of @code{gcc}. (See @file{gcc/ChangeLog} for details---compare it to that file in the vanilla @code{gcc-2.7.2.3.tar.gz} distribution.) + @end ifclear @item Fix @code{libU77} routines that accept file and other names *************** that have embedded blanks, commas, and s *** 1027,1039 **** @item Fix @code{SIGNAL} intrinsic so it accepts an ! optional third @samp{Status} argument. @item Fix @code{IDATE()} intrinsic subroutine (VXT form) so it accepts arguments in the correct order. Documentation fixed accordingly, and for @code{GMTIME()} and @code{LTIME()} as well. @item Make many changes to @code{libU77} intrinsics to --- 1527,1541 ---- @item Fix @code{SIGNAL} intrinsic so it accepts an ! optional third @code{Status} argument. + @ifclear USERVISONLY @item Fix @code{IDATE()} intrinsic subroutine (VXT form) so it accepts arguments in the correct order. Documentation fixed accordingly, and for @code{GMTIME()} and @code{LTIME()} as well. + @end ifclear @item Make many changes to @code{libU77} intrinsics to *************** return @code{INTEGER(KIND=2)} values, *** 1047,1088 **** --- 1549,1605 ---- and placing functions that are intended to perform side effects in a new intrinsic group, @code{badu77}. + @ifclear USERVISONLY @item Improve @code{libU77} so it is more portable. + @end ifclear @item Add options @samp{-fbadu77-intrinsics-delete}, @samp{-fbadu77-intrinsics-hide}, and so on. + @ifclear USERVISONLY @item Fix crashes involving diagnosed or invalid code. + @end ifclear + @ifclear USERVISONLY @item @code{g77} and @code{gcc} now do a somewhat better job detecting and diagnosing arrays that are too large to handle before these cause diagnostics during the assembler or linker phase, a compiler crash, or generation of incorrect code. + @end ifclear + @ifclear USERVISONLY @item Make some fixes to alias analysis code. + @end ifclear + @ifclear USERVISONLY @item Add support for @code{restrict} keyword in @code{gcc} front end. + @end ifclear + @ifclear USERVISONLY @item Support @code{gcc} version 2.7.2.3 (modified by @code{g77} into version 2.7.2.3.f.1), and remove support for prior versions of @code{gcc}. + @end ifclear + @ifclear USERVISONLY @item Incorporate GNAT's patches to the @code{gcc} back end into @code{g77}'s, so GNAT users do not need to apply GNAT's patches to build both GNAT and @code{g77} from the same source tree. + @end ifclear + @ifclear USERVISONLY @item Modify @code{make} rules and related code so that generation of Info documentation doesn't require *************** compilation using @code{gcc}. *** 1090,1095 **** --- 1607,1613 ---- Now, any ANSI C compiler should be adequate to produce the @code{g77} documentation (in particular, the tables of intrinsics) from scratch. + @end ifclear @item Add @code{INT2} and @code{INT8} intrinsics. *************** Add @code{ALARM} intrinsic. *** 1104,1149 **** @code{CTIME} intrinsic now accepts any @code{INTEGER} argument, not just @code{INTEGER(KIND=2)}. @item Warn when explicit type declaration disagrees with the type of an intrinsic invocation. @item Support @samp{*f771} entry in @code{gcc} @file{specs} file. @item ! Fix typo in @code{make} rule @samp{g77-cross}, used only for cross-compiling. @item Fix @code{libf2c} build procedure to re-archive library if previous attempt to archive was interrupted. @item Change @code{gcc} to unroll loops only during the last invocation (of as many as two invocations) of loop optimization. @item Improve handling of @samp{-fno-f2c} so that code that attempts to pass an intrinsic as an actual argument, such as @samp{CALL FOO(ABS)}, is rejected due to the fact that the run-time-library routine is, effectively, compiled with @samp{-ff2c} in effect. @item Fix @code{g77} driver to recognize @samp{-fsyntax-only} as an option that inhibits linking, just like @samp{-c} or @samp{-S}, and to recognize and properly handle the @samp{-nostdlib}, @samp{-M}, @samp{-MM}, @samp{-nodefaultlibs}, and @samp{-Xlinker} options. @item Upgrade to @code{libf2c} as of 1997-08-16. @item Modify @code{libf2c} to consistently and clearly diagnose recursive I/O (at run time). @item @code{g77} driver now prints version information (such as produced --- 1622,1685 ---- @code{CTIME} intrinsic now accepts any @code{INTEGER} argument, not just @code{INTEGER(KIND=2)}. + @ifclear USERVISONLY @item Warn when explicit type declaration disagrees with the type of an intrinsic invocation. + @end ifclear + @ifclear USERVISONLY @item Support @samp{*f771} entry in @code{gcc} @file{specs} file. + @end ifclear + @ifclear USERVISONLY @item ! Fix typo in @code{make} rule @code{g77-cross}, used only for cross-compiling. + @end ifclear + @ifclear USERVISONLY @item Fix @code{libf2c} build procedure to re-archive library if previous attempt to archive was interrupted. + @end ifclear + @ifclear USERVISONLY @item Change @code{gcc} to unroll loops only during the last invocation (of as many as two invocations) of loop optimization. + @end ifclear + @ifclear USERVISONLY @item Improve handling of @samp{-fno-f2c} so that code that attempts to pass an intrinsic as an actual argument, such as @samp{CALL FOO(ABS)}, is rejected due to the fact that the run-time-library routine is, effectively, compiled with @samp{-ff2c} in effect. + @end ifclear + @ifclear USERVISONLY @item Fix @code{g77} driver to recognize @samp{-fsyntax-only} as an option that inhibits linking, just like @samp{-c} or @samp{-S}, and to recognize and properly handle the @samp{-nostdlib}, @samp{-M}, @samp{-MM}, @samp{-nodefaultlibs}, and @samp{-Xlinker} options. + @end ifclear + @ifclear USERVISONLY @item Upgrade to @code{libf2c} as of 1997-08-16. + @end ifclear + @ifclear USERVISONLY @item Modify @code{libf2c} to consistently and clearly diagnose recursive I/O (at run time). + @end ifclear @item @code{g77} driver now prints version information (such as produced *************** The @samp{.r} suffix now designates a Ra *** 1154,1179 **** --- 1690,1725 ---- to be preprocessed via the @code{ratfor} command, available separately. + @ifclear USERVISONLY @item Fix some aspects of how @code{gcc} determines what kind of system is being configured and what kinds are supported. For example, GNU Linux/Alpha ELF systems now are directly supported. + @end ifclear + @ifclear USERVISONLY @item Improve diagnostics. + @end ifclear + @ifclear USERVISONLY @item Improve documentation and indexing. + @end ifclear + @ifclear USERVISONLY @item Include all pertinent files for @code{libf2c} that come from @code{netlib.bell-labs.com}; give any such files that aren't quite accurate in @code{g77}'s version of @code{libf2c} the suffix @samp{.netlib}. + @end ifclear + @ifclear USERVISONLY @item Reserve @code{INTEGER(KIND=0)} for future use. + @end ifclear @end itemize @c 1997-02-28: 0.5.20 released. *************** The @samp{-fno-typeless-boz} option is n *** 1184,1196 **** This option specifies that non-decimal-radix constants using the prefixed-radix form (such as @samp{Z'1234'}) ! are to be interpreted as @code{INTEGER} constants. Specify @samp{-ftypeless-boz} to cause such constants to be interpreted as typeless. (Version 0.5.19 introduced @samp{-fno-typeless-boz} and its inverse.) @item Options @samp{-ff90-intrinsics-enable} and @samp{-fvxt-intrinsics-enable} now are the --- 1730,1747 ---- This option specifies that non-decimal-radix constants using the prefixed-radix form (such as @samp{Z'1234'}) ! are to be interpreted as @code{INTEGER(KIND=1)} constants. Specify @samp{-ftypeless-boz} to cause such constants to be interpreted as typeless. (Version 0.5.19 introduced @samp{-fno-typeless-boz} and its inverse.) + @ifset DOC-G77 + @xref{Fortran Dialect Options,,Options Controlling Fortran Dialect}, + for information on the @samp{-ftypeless-boz} option. + @end ifset + @item Options @samp{-ff90-intrinsics-enable} and @samp{-fvxt-intrinsics-enable} now are the *************** statements specifying that these names a *** 1206,1220 **** to be names of intrinsics. @item ! The @samp{ALWAYS_FLUSH} macro is no longer defined when building @code{libf2c}, which should result in improved I/O performance, especially over NFS. @emph{Note:} If you have code that depends on the behavior ! of @code{libf2c} when built with @samp{ALWAYS_FLUSH} defined, you will have to modify @code{libf2c} accordingly before building it from this and future versions of @code{g77}. @item Dave Love's implementation of @code{libU77} has been added to the version of @code{libf2c} distributed with --- 1757,1775 ---- to be names of intrinsics. @item ! The @code{ALWAYS_FLUSH} macro is no longer defined when building @code{libf2c}, which should result in improved I/O performance, especially over NFS. @emph{Note:} If you have code that depends on the behavior ! of @code{libf2c} when built with @code{ALWAYS_FLUSH} defined, you will have to modify @code{libf2c} accordingly before building it from this and future versions of @code{g77}. + @ifset DOC-G77 + @xref{Output Assumed To Flush}, for more information. + @end ifset + @item Dave Love's implementation of @code{libU77} has been added to the version of @code{libf2c} distributed with *************** as intrinsics. *** 1226,1231 **** --- 1781,1791 ---- New option @samp{-fvxt} specifies that the source file is written in VXT Fortran, instead of GNU Fortran. + @ifset DOC-G77 + @xref{VXT Fortran}, for more information on the constructs + recognized when the @samp{-fvxt} option is specified. + @end ifset + @item The @samp{-fvxt-not-f90} option has been deleted, along with its inverse, @samp{-ff90-not-vxt}. *************** re-read the pertinent documentation to d *** 1235,1240 **** --- 1795,1804 ---- options, if any, are appropriate for compiling your code with this version of @code{g77}. + @ifset DOC-G77 + @xref{Other Dialects}, for more information. + @end ifset + @item The @samp{-fugly} option now issues a warning, as it likely will be removed in a future version. *************** The @samp{-fugly-assumed} option, introd *** 1250,1272 **** version 0.5.19, has been changed to better accommodate old and new code. @item Make a number of fixes to the @code{g77} front end and the @code{gcc} back end to better support Alpha (AXP) machines. This includes providing at least one bug-fix to the @code{gcc} back end for Alphas. @item Related to supporting Alpha (AXP) machines, the @code{LOC()} intrinsic and @code{%LOC()} construct now return ! values of integer type that is the same width (holds ! the same number of bits) as the pointer type on the ! machine. ! ! On most machines, this won't make a difference, whereas ! on Alphas, the type these constructs return is ! @code{INTEGER*8} instead of the more common @code{INTEGER*4}. @item Emulate @code{COMPLEX} arithmetic in the @code{g77} front --- 1814,1848 ---- version 0.5.19, has been changed to better accommodate old and new code. + @ifset DOC-G77 + @xref{Ugly Assumed-Size Arrays}, for more information. + @end ifset + + @ifclear USERVISONLY @item Make a number of fixes to the @code{g77} front end and the @code{gcc} back end to better support Alpha (AXP) machines. This includes providing at least one bug-fix to the @code{gcc} back end for Alphas. + @end ifclear @item Related to supporting Alpha (AXP) machines, the @code{LOC()} intrinsic and @code{%LOC()} construct now return ! values of @code{INTEGER(KIND=0)} type, ! as defined by the GNU Fortran language. ! ! This type is wide enough ! (holds the same number of bits) ! as the character-pointer type on the machine. ! ! On most machines, this won't make a difference, ! whereas, on Alphas and other systems with 64-bit pointers, ! the @code{INTEGER(KIND=0)} type is equivalent to @code{INTEGER(KIND=2)} ! (often referred to as @code{INTEGER*8}) ! instead of the more common @code{INTEGER(KIND=1)} ! (often referred to as @code{INTEGER*4}). @item Emulate @code{COMPLEX} arithmetic in the @code{g77} front *************** end, to avoid bugs in @code{complex} sup *** 1275,1293 **** --- 1851,1874 ---- New option @samp{-fno-emulate-complex} causes @code{g77} to revert the 0.5.19 behavior. + @ifclear USERVISONLY @item Fix bug whereby @samp{REAL A(1)}, for example, caused a compiler crash if @samp{-fugly-assumed} was in effect and @var{A} was a local (automatic) array. That case is no longer affected by the new handling of @samp{-fugly-assumed}. + @end ifclear + @ifclear USERVISONLY @item Fix @code{g77} command driver so that @samp{g77 -o foo.f} no longer deletes @file{foo.f} before issuing other diagnostics, and so the @samp{-x} option is properly handled. + @end ifclear + @ifclear USERVISONLY @item Enable inlining of subroutines and functions by the @code{gcc} back end. *************** This works as it does for @code{gcc} its *** 1295,1300 **** --- 1876,1882 ---- may be inlined for invocations that follow them in the same program unit, as long as the appropriate compile-time options are specified. + @end ifclear @item Dummy arguments are no longer assumed to potentially alias *************** New options @samp{-falias-check}, @samp{ *** 1312,1321 **** --- 1894,1912 ---- and @samp{-fno-argument-noalias-global} control the way @code{g77} handles potential aliasing. + @ifset DOC-G77 + @xref{Aliasing Assumed To Work}, for detailed information on why the + new defaults might result in some programs no longer working the way they + did when compiled by previous versions of @code{g77}. + @end ifset + + @ifclear USERVISONLY @item The @code{CONJG()} and @code{DCONJG()} intrinsics now are compiled in-line. + @end ifclear + @ifclear USERVISONLY @item The bug-fix for 0.5.19.1 has been re-done. The @code{g77} compiler has been changed back to *************** particular, if the linker complains abou *** 1340,1345 **** --- 1931,1937 ---- references to names like @samp{g77__fvers__}---that strongly suggests your installation has an obsolete version of @code{libf2c}.) + @end ifclear @item New option @samp{-fugly-assign} specifies that the *************** values assigned by both statements @samp *** 1349,1365 **** --- 1941,1966 ---- (Normally, @code{g77} uses a separate memory location to hold assigned statement labels.) + @ifset DOC-G77 + @xref{Ugly Assigned Labels}, for more information. + @end ifset + @item @code{FORMAT} and @code{ENTRY} statements now are allowed to precede @code{IMPLICIT NONE} statements. + @ifclear USERVISONLY @item Produce diagnostic for unsupported @code{SELECT CASE} on @code{CHARACTER} type, instead of crashing, at compile time. + @end ifclear + @ifclear USERVISONLY @item Fix crashes involving diagnosed or invalid code. + @end ifclear + @ifclear USERVISONLY @item Change approach to building @code{libf2c} archive (@file{libf2c.a}) so that members are added to it *************** an already-built @code{g77} doesn't need *** 1368,1394 **** access to the build tree (whereas the user doing the build might not have access to install new software on the system). @item Support @code{gcc} version 2.7.2.2 (modified by @code{g77} into version 2.7.2.2.f.2), and remove support for prior versions of @code{gcc}. @item Upgrade to @code{libf2c} as of 1997-02-08, and fix up some of the build procedures. @item Improve general build procedures for @code{g77}, fixing minor bugs (such as deletion of any file named @file{f771} in the parent directory of @code{gcc/}). @item ! Enable full support of @code{INTEGER*8} available in @code{libf2c} and @file{f2c.h} so that @code{f2c} users may make full use of its features via the @code{g77} ! version of @file{f2c.h} and the @code{INTEGER*8} support routines in the @code{g77} version of @code{libf2c}. @item --- 1969,2004 ---- access to the build tree (whereas the user doing the build might not have access to install new software on the system). + @end ifclear + @ifclear USERVISONLY @item Support @code{gcc} version 2.7.2.2 (modified by @code{g77} into version 2.7.2.2.f.2), and remove support for prior versions of @code{gcc}. + @end ifclear + @ifclear USERVISONLY @item Upgrade to @code{libf2c} as of 1997-02-08, and fix up some of the build procedures. + @end ifclear + @ifclear USERVISONLY @item Improve general build procedures for @code{g77}, fixing minor bugs (such as deletion of any file named @file{f771} in the parent directory of @code{gcc/}). + @end ifclear @item ! Enable full support of @code{INTEGER(KIND=2)} ! (often referred to as @code{INTEGER*8}) ! available in @code{libf2c} and @file{f2c.h} so that @code{f2c} users may make full use of its features via the @code{g77} ! version of @file{f2c.h} and the @code{INTEGER(KIND=2)} support routines in the @code{g77} version of @code{libf2c}. @item *************** These are @code{REALPART}, @code{IMAGPAR *** 1407,1416 **** @code{LONG}, and @code{SHORT}. @item ! A new group of intrinsics, @samp{gnu}, has been added to contain the new @code{REALPART}, @code{IMAGPART}, and @code{COMPLEX} intrinsics. ! An old group, @samp{dcp}, has been removed. @item Complain about industry-wide ambiguous references --- 2017,2026 ---- @code{LONG}, and @code{SHORT}. @item ! A new group of intrinsics, @code{gnu}, has been added to contain the new @code{REALPART}, @code{IMAGPART}, and @code{COMPLEX} intrinsics. ! An old group, @code{dcp}, has been removed. @item Complain about industry-wide ambiguous references *************** complex type other than @code{COMPLEX}), *** 1421,1443 **** or new @samp{-fugly-complex} option, in conjunction with @samp{-fnot-f90}, specifies @code{f2c} interpretation. @item Make improvements to diagnostics. @item Speed up compiler a bit. @item Improvements to documentation and indexing, including a new chapter containing information on one, later more, diagnostics that users are directed to pull up automatically via a message in the diagnostic itself. ! (Hence the menu item @samp{M} for the node ! @samp{Diagnostics} in the top-level menu of the Info documentation.) @end itemize @c 1997-02-01: 0.5.19.1 released. @heading In 0.5.19.1: @itemize @bullet --- 2031,2068 ---- or new @samp{-fugly-complex} option, in conjunction with @samp{-fnot-f90}, specifies @code{f2c} interpretation. + @ifclear USERVISONLY @item Make improvements to diagnostics. + @end ifclear + @ifclear USERVISONLY @item Speed up compiler a bit. + @end ifclear + @ifclear USERVISONLY @item Improvements to documentation and indexing, including a new chapter containing information on one, later more, diagnostics that users are directed to pull up automatically via a message in the diagnostic itself. ! (Hence the menu item @code{M} for the node ! @code{Diagnostics} in the top-level menu of the Info documentation.) + @end ifclear @end itemize + @ifclear DOC-OLDNEWS + @heading In previous versions: + + Information on previous versions is archived + in @file{@value{path-g77}/news.texi} + following the test of the @code{DOC-OLDNEWS} macro. + @end ifclear + + @ifset DOC-OLDNEWS @c 1997-02-01: 0.5.19.1 released. @heading In 0.5.19.1: @itemize @bullet *************** These bugs occurred when assigning the r *** 1449,1462 **** operation to a complex variable (or array element) that also served as an input to that operation. ! The operations affected by this bug were: @samp{CONJG()}, ! @samp{DCONJG()}, @samp{CCOS()}, @samp{CDCOS()}, ! @samp{CLOG()}, @samp{CDLOG()}, @samp{CSIN()}, @samp{CDSIN()}, ! @samp{CSQRT()}, @samp{CDSQRT()}, complex division, and raising a @code{DOUBLE COMPLEX} operand to an @code{INTEGER} power. (The related generic and @samp{Z}-prefixed intrinsics, ! such as @samp{ZSIN()}, also were affected.) For example, @samp{C = CSQRT(C)}, @samp{Z = Z/C}, and @samp{Z = Z**I} (where @samp{C} is @code{COMPLEX} and @samp{Z} is --- 2074,2087 ---- operation to a complex variable (or array element) that also served as an input to that operation. ! The operations affected by this bug were: @code{CONJG()}, ! @code{DCONJG()}, @code{CCOS()}, @code{CDCOS()}, ! @code{CLOG()}, @code{CDLOG()}, @code{CSIN()}, @code{CDSIN()}, ! @code{CSQRT()}, @code{CDSQRT()}, complex division, and raising a @code{DOUBLE COMPLEX} operand to an @code{INTEGER} power. (The related generic and @samp{Z}-prefixed intrinsics, ! such as @code{ZSIN()}, also were affected.) For example, @samp{C = CSQRT(C)}, @samp{Z = Z/C}, and @samp{Z = Z**I} (where @samp{C} is @code{COMPLEX} and @samp{Z} is *************** For example, @samp{C = CSQRT(C)}, @samp{ *** 1468,1474 **** @itemize @bullet @item Fix @code{FORMAT} statement parsing so negative values for ! specifiers such as @samp{P} (e.g. @samp{FORMAT(-1PF8.1)}) are correctly processed as negative. @item --- 2093,2099 ---- @itemize @bullet @item Fix @code{FORMAT} statement parsing so negative values for ! specifiers such as @code{P} (e.g. @samp{FORMAT(-1PF8.1)}) are correctly processed as negative. @item *************** procedures in @code{libf2c}. *** 1552,1558 **** @item Modify @code{fseek_()} in @code{libf2c} to be more portable (though, in practice, there might be no systems where this ! matters) and to catch invalid @samp{whence} arguments. @item Some useless warnings from the @samp{-Wunused} option have --- 2177,2183 ---- @item Modify @code{fseek_()} in @code{libf2c} to be more portable (though, in practice, there might be no systems where this ! matters) and to catch invalid @code{whence} arguments. @item Some useless warnings from the @samp{-Wunused} option have *************** on AIX systems by linking with the @samp *** 1564,1570 **** @item Abort configuration if @code{gcc} has not been patched ! using the patch file provided in the @samp{gcc/f/gbe/} subdirectory. @item --- 2189,2195 ---- @item Abort configuration if @code{gcc} has not been patched ! using the patch file provided in the @file{gcc/f/gbe/} subdirectory. @item *************** maintainer's new address is @email{dmg@@ *** 1776,1782 **** @itemize @bullet @item @strong{Fix serious bug} in @samp{g77 -v} command that can cause removal of a ! system's @file{/dev/null} special file if run by user @samp{root}. @strong{All users} of version 0.5.16 should ensure that they have not removed @file{/dev/null} or replaced it with an ordinary --- 2401,2407 ---- @itemize @bullet @item @strong{Fix serious bug} in @samp{g77 -v} command that can cause removal of a ! system's @file{/dev/null} special file if run by user @code{root}. @strong{All users} of version 0.5.16 should ensure that they have not removed @file{/dev/null} or replaced it with an ordinary *************** never happen). *** 1815,1821 **** @item Make @code{libf2c} build procedures work on more systems again by ! eliminating unnecessary invocations of @samp{ld -r -x} and @samp{mv}. @item Fix omission of @samp{-funix-intrinsics-@dots{}} options in list of permitted --- 2440,2446 ---- @item Make @code{libf2c} build procedures work on more systems again by ! eliminating unnecessary invocations of @samp{ld -r -x} and @code{mv}. @item Fix omission of @samp{-funix-intrinsics-@dots{}} options in list of permitted *************** This is known to fix code invoking @code *** 1894,1900 **** @item Update @code{libf2c} to include netlib patches through 1995-08-16, and ! @code{#define} @samp{WANT_LEAD_0} to 1 to make @code{g77}-compiled code more consistent with other Fortran implementations by outputting leading zeros in formatted and list-directed output. --- 2519,2525 ---- @item Update @code{libf2c} to include netlib patches through 1995-08-16, and ! @code{#define} @code{WANT_LEAD_0} to 1 to make @code{g77}-compiled code more consistent with other Fortran implementations by outputting leading zeros in formatted and list-directed output. *************** and @code{SYSTEM}, append a final argume *** 1976,1987 **** variable or array element (e.g. @samp{CALL SYSTEM('rm foo',ISTAT)}). @item ! Add new intrinsic group named @samp{unix} to contain the new intrinsics, and by default enable this new group. @item ! Move @code{LOC()} intrinsic out of the @samp{vxt} group to the new ! @samp{unix} group. @item Improve @code{g77} so that @samp{g77 -v} by itself (or with --- 2601,2612 ---- variable or array element (e.g. @samp{CALL SYSTEM('rm foo',ISTAT)}). @item ! Add new intrinsic group named @code{unix} to contain the new intrinsics, and by default enable this new group. @item ! Move @code{LOC()} intrinsic out of the @code{vxt} group to the new ! @code{unix} group. @item Improve @code{g77} so that @samp{g77 -v} by itself (or with *************** macros defined in @file{gcc/f/target.h} *** 2038,2045 **** Add warning to be printed for each invocation of the compiler if the target machine @code{INTEGER}, @code{REAL}, or @code{LOGICAL} size is not 32 bits, ! since @code{g77} is known to not work well for such cases (to be ! fixed in Version 0.6---@pxref{Actual Bugs,,Actual Bugs We Haven't Fixed Yet}). @item Lots of new documentation (though work is still needed to put it into --- 2663,2669 ---- Add warning to be printed for each invocation of the compiler if the target machine @code{INTEGER}, @code{REAL}, or @code{LOGICAL} size is not 32 bits, ! since @code{g77} is known to not work well for such cases. @item Lots of new documentation (though work is still needed to put it into *************** Allow @code{RETURN} in main program unit *** 2239,2245 **** Changes to Hollerith-constant support to obey Appendix C of the standard: ! @itemize -- @item Now padded on the right with zeros, not spaces. --- 2863,2869 ---- Changes to Hollerith-constant support to obey Appendix C of the standard: ! @itemize @minus @item Now padded on the right with zeros, not spaces. *************** to widen to @code{INTEGER}), essentially *** 2267,2273 **** @item Changes and fixes to typeless-constant support: ! @itemize -- @item Now treated as a typeless double-length @code{INTEGER} value. --- 2891,2897 ---- @item Changes and fixes to typeless-constant support: ! @itemize @minus @item Now treated as a typeless double-length @code{INTEGER} value. *************** Generate better code for some kinds of a *** 2328,2330 **** --- 2952,2957 ---- Speed up lexing somewhat (this makes the compilation phase noticeably faster). @end itemize + + @end ifset + @end ifclear diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/news0.texi gcc-2.95/gcc/f/news0.texi *** egcs-1.1.2/gcc/f/news0.texi Tue Aug 12 00:47:35 1997 --- gcc-2.95/gcc/f/news0.texi Sat Mar 13 04:04:02 1999 *************** *** 1,14 **** ! @setfilename NEW ! @set NEWSONLY ! @c The immediately following lines apply to the NEWS file ! @c which is generated using this file. ! This file lists recent changes to the GNU Fortran compiler. ! Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! You may copy, distribute, and modify it freely as long as you preserve ! this copyright notice and permission notice. ! ! @node Top,,, (dir) ! @chapter News About GNU Fortran @include news.texi @bye --- 1,9 ---- ! \input texinfo @c -*-texinfo-*- ! @c %**start of header ! @setfilename NEWS ! @c %**end of header ! @c This tells news.texi that it's generating just the NEWS file. ! @set DOC-NEWS @include news.texi @bye diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/output.j gcc-2.95/gcc/f/output.j *** egcs-1.1.2/gcc/f/output.j Mon Jun 15 00:37:28 1998 --- gcc-2.95/gcc/f/output.j Mon Feb 15 10:17:15 1999 *************** *** 1,6 **** /* output.j -- Wrapper for GCC's output.h Copyright (C) 1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* output.j -- Wrapper for GCC's output.h Copyright (C) 1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** the Free Software Foundation, 59 Temple *** 22,28 **** #ifndef MAKING_DEPENDENCIES #ifndef _J_f_output #define _J_f_output - #include "gansidecl.h" #include "output.h" #endif #endif --- 22,27 ---- diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/parse.c gcc-2.95/gcc/f/parse.c *** egcs-1.1.2/gcc/f/parse.c Mon Jun 15 19:23:28 1998 --- gcc-2.95/gcc/f/parse.c Mon Feb 15 10:17:16 1999 *************** *** 1,6 **** /* GNU Fortran Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* GNU Fortran Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/proj.c gcc-2.95/gcc/f/proj.c *** egcs-1.1.2/gcc/f/proj.c Mon Jun 15 19:23:29 1998 --- gcc-2.95/gcc/f/proj.c Mon Feb 15 10:17:17 1999 *************** *** 1,6 **** /* proj.c file for GNU Fortran Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* proj.c file for GNU Fortran Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/proj.h gcc-2.95/gcc/f/proj.h *** egcs-1.1.2/gcc/f/proj.h Wed Jul 15 02:35:58 1998 --- gcc-2.95/gcc/f/proj.h Mon Feb 15 10:17:18 1999 *************** *** 1,6 **** /* proj.h file for Gnu Fortran Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* proj.h file for Gnu Fortran Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/root.texi gcc-2.95/gcc/f/root.texi *** egcs-1.1.2/gcc/f/root.texi Wed Dec 31 16:00:00 1969 --- gcc-2.95/gcc/f/root.texi Sat Jul 17 20:59:09 1999 *************** *** 0 **** --- 1,40 ---- + @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 egcs), + @c clear this and set the version information correctly. + @clear DEVELOPMENT + @set version-g77 0.5.25 + @set version-egcs 1.2 + @set version-gcc 2.95 + + @c GCC-G77 indicates this is the GCC (2.95 or later) version of g77. + @set GCC-G77 + + @c EGCS-G77 indicates this is the EGCS (1.0 or 1.1) version of g77. + @clear EGCS-G77 + + @c FSF-G77 indicates this is the FSF (0.5.23 or earlier) version of g77. + @clear FSF-G77 + + @set email-general gcc@@gcc.gnu.org + @set email-bugs gcc-bugs@@gcc.gnu.org + @set path-g77 egcs/gcc/f + @set path-libf2c egcs/libf2c + + @ifset GCC-G77 + @set which-g77 GCC-@value{version-gcc} + @set which-gcc GCC + @end ifset + + @ifset EGCS-G77 + @set which-g77 EGCS-@value{version-egcs} + @set which-gcc EGCS + @end ifset + + @ifset FSF-G77 + @set which-g77 FSF-@value{version-g77} + @set which-gcc GCC + @end ifset + + @set email-burley craig@@jcb-sc.com + @set www-burley http://world.std.com/%7Eburley diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/rtl.j gcc-2.95/gcc/f/rtl.j *** egcs-1.1.2/gcc/f/rtl.j Tue May 19 03:50:01 1998 --- gcc-2.95/gcc/f/rtl.j Mon Feb 15 10:17:19 1999 *************** *** 1,6 **** /* rtl.j -- Wrapper for GCC's rtl.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* rtl.j -- Wrapper for GCC's rtl.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/src.c gcc-2.95/gcc/f/src.c *** egcs-1.1.2/gcc/f/src.c Mon Jun 15 19:23:31 1998 --- gcc-2.95/gcc/f/src.c Mon Feb 15 10:17:20 1999 *************** *** 1,6 **** /* src.c -- Implementation File Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* src.c -- Implementation File Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/src.h gcc-2.95/gcc/f/src.h *** egcs-1.1.2/gcc/f/src.h Mon Jun 15 19:23:32 1998 --- gcc-2.95/gcc/f/src.h Mon Feb 15 10:17:21 1999 *************** *** 1,6 **** /* src.h -- Public #include File Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* src.h -- Public #include File Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/st.c gcc-2.95/gcc/f/st.c *** egcs-1.1.2/gcc/f/st.c Tue May 19 03:50:04 1998 --- gcc-2.95/gcc/f/st.c Mon Feb 15 10:17:22 1999 *************** *** 1,6 **** /* st.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* st.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/st.h gcc-2.95/gcc/f/st.h *** egcs-1.1.2/gcc/f/st.h Tue May 19 03:50:05 1998 --- gcc-2.95/gcc/f/st.h Mon Feb 15 10:17:23 1999 *************** *** 1,6 **** /* st.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* st.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/sta.c gcc-2.95/gcc/f/sta.c *** egcs-1.1.2/gcc/f/sta.c Mon Jun 15 19:23:33 1998 --- gcc-2.95/gcc/f/sta.c Tue Mar 30 01:23:33 1999 *************** *** 1,6 **** /* sta.c -- Implementation File (module.c template V1.0) Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* sta.c -- Implementation File (module.c template V1.0) Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** ffesta_ffebad_1p (ffebad errnum, ffelexT *** 1701,1707 **** } void ! ffesta_ffebad_1sp (ffebad errnum, char *s, ffelexToken names_token, ffeTokenLength index, ffelexToken next_token) { ffewhereLine line; --- 1701,1707 ---- } void ! ffesta_ffebad_1sp (ffebad errnum, const char *s, ffelexToken names_token, ffeTokenLength index, ffelexToken next_token) { ffewhereLine line; *************** ffesta_ffebad_1sp (ffebad errnum, char * *** 1735,1741 **** } void ! ffesta_ffebad_1st (ffebad errnum, char *s, ffelexToken t) { if (ffesta_ffebad_start (errnum)) { --- 1735,1741 ---- } void ! ffesta_ffebad_1st (ffebad errnum, const char *s, ffelexToken t) { if (ffesta_ffebad_start (errnum)) { *************** ffesta_ffebad_1t (ffebad errnum, ffelexT *** 1764,1770 **** } void ! ffesta_ffebad_2st (ffebad errnum, char *s, ffelexToken t1, ffelexToken t2) { if (ffesta_ffebad_start (errnum)) { --- 1764,1770 ---- } void ! ffesta_ffebad_2st (ffebad errnum, const char *s, ffelexToken t1, ffelexToken t2) { if (ffesta_ffebad_start (errnum)) { diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/sta.h gcc-2.95/gcc/f/sta.h *** egcs-1.1.2/gcc/f/sta.h Tue May 19 03:50:07 1998 --- gcc-2.95/gcc/f/sta.h Tue Mar 30 01:23:34 1999 *************** *** 1,6 **** /* sta.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* sta.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** ffesymbol ffesta_sym_end_transition (ffe *** 90,100 **** ffesymbol ffesta_sym_exec_transition (ffesymbol s); void ffesta_ffebad_1p (ffebad msg, ffelexToken names_token, ffeTokenLength index, ffelexToken next_token); ! void ffesta_ffebad_1sp (ffebad msg, char *s, ffelexToken names_token, ffeTokenLength index, ffelexToken next_token); ! void ffesta_ffebad_1st (ffebad msg, char *s, ffelexToken t); void ffesta_ffebad_1t (ffebad msg, ffelexToken t); ! void ffesta_ffebad_2st (ffebad msg, char *s, ffelexToken t1, ffelexToken t2); void ffesta_ffebad_2t (ffebad msg, ffelexToken t1, ffelexToken t2); ffelexHandler ffesta_zero (ffelexToken t); ffelexHandler ffesta_two (ffelexToken first, ffelexToken second); --- 90,100 ---- ffesymbol ffesta_sym_exec_transition (ffesymbol s); void ffesta_ffebad_1p (ffebad msg, ffelexToken names_token, ffeTokenLength index, ffelexToken next_token); ! void ffesta_ffebad_1sp (ffebad msg, const char *s, ffelexToken names_token, ffeTokenLength index, ffelexToken next_token); ! void ffesta_ffebad_1st (ffebad msg, const char *s, ffelexToken t); void ffesta_ffebad_1t (ffebad msg, ffelexToken t); ! void ffesta_ffebad_2st (ffebad msg, const char *s, ffelexToken t1, ffelexToken t2); void ffesta_ffebad_2t (ffebad msg, ffelexToken t1, ffelexToken t2); ffelexHandler ffesta_zero (ffelexToken t); ffelexHandler ffesta_two (ffelexToken first, ffelexToken second); diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/stb.c gcc-2.95/gcc/f/stb.c *** egcs-1.1.2/gcc/f/stb.c Mon Jun 15 19:23:35 1998 --- gcc-2.95/gcc/f/stb.c Mon Apr 19 15:27:03 1999 *************** *** 1,6 **** /* stb.c -- Implementation File (module.c template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* stb.c -- Implementation File (module.c template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** union ffestb_local_u_ *** 404,410 **** dimlist; struct { ! char *badname; ffestrFirst first_kw; bool is_subr; } --- 404,410 ---- dimlist; struct { ! const char *badname; ffestrFirst first_kw; bool is_subr; } *************** union ffestb_local_u_ *** 421,427 **** ffesttTokenList toklist;/* For ambiguity resolution. */ ffesttImpList imps; /* List of IMPLICIT letters. */ ffelexHandler imp_handler; /* Call if paren list wasn't letters. */ ! char *badname; ffestrOther kw; /* INTENT(IN/OUT/INOUT). */ ffestpType type; bool parameter; /* If PARAMETER attribute seen (governs =expr --- 421,427 ---- ffesttTokenList toklist;/* For ambiguity resolution. */ ffesttImpList imps; /* List of IMPLICIT letters. */ ffelexHandler imp_handler; /* Call if paren list wasn't letters. */ ! const char *badname; ffestrOther kw; /* INTENT(IN/OUT/INOUT). */ ffestpType type; bool parameter; /* If PARAMETER attribute seen (governs =expr *************** ffelexHandler *** 1859,1865 **** ffestb_do (ffelexToken t) { ffeTokenLength i; ! char *p; ffelexHandler next; ffelexToken nt; ffestrSecond kw; --- 1859,1865 ---- ffestb_do (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; ffelexHandler next; ffelexToken nt; ffestrSecond kw; *************** ffelexHandler *** 2033,2039 **** ffestb_dowhile (ffelexToken t) { ffeTokenLength i; ! char *p; ffelexHandler next; ffelexToken nt; --- 2033,2039 ---- ffestb_dowhile (ffelexToken t) { ffeTokenLength i; ! const char *p; ffelexHandler next; ffelexToken nt; *************** ffelexHandler *** 2507,2513 **** ffestb_else (ffelexToken t) { ffeTokenLength i; ! char *p; switch (ffelex_token_type (ffesta_tokens[0])) { --- 2507,2513 ---- ffestb_else (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; switch (ffelex_token_type (ffesta_tokens[0])) { *************** ffelexHandler *** 2600,2606 **** ffestb_elsexyz (ffelexToken t) { ffeTokenLength i; ! char *p; switch (ffelex_token_type (ffesta_tokens[0])) { --- 2600,2606 ---- ffestb_elsexyz (ffelexToken t) { ffeTokenLength i; ! const char *p; switch (ffelex_token_type (ffesta_tokens[0])) { *************** static ffelexHandler *** 2787,2793 **** ffestb_else3_ (ffelexToken t) { ffeTokenLength i; ! char *p; ffelex_set_names (FALSE); --- 2787,2793 ---- ffestb_else3_ (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; ffelex_set_names (FALSE); *************** ffelexHandler *** 3013,3019 **** ffestb_endxyz (ffelexToken t) { ffeTokenLength i; ! char *p; switch (ffelex_token_type (ffesta_tokens[0])) { --- 3013,3019 ---- ffestb_endxyz (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; switch (ffelex_token_type (ffesta_tokens[0])) { *************** ffelexHandler *** 3319,3325 **** ffestb_goto (ffelexToken t) { ffeTokenLength i; ! char *p; ffelexHandler next; ffelexToken nt; --- 3319,3325 ---- ffestb_goto (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; ffelexHandler next; ffelexToken nt; *************** ffestb_let (ffelexToken t) *** 4152,4158 **** ffelexHandler next; bool vxtparam; /* TRUE if it might really be a VXT PARAMETER stmt. */ ! char *p; switch (ffelex_token_type (ffesta_tokens[0])) { --- 4152,4158 ---- ffelexHandler next; bool vxtparam; /* TRUE if it might really be a VXT PARAMETER stmt. */ ! unsigned const char *p; switch (ffelex_token_type (ffesta_tokens[0])) { *************** ffelexHandler *** 4292,4298 **** ffestb_type (ffelexToken t) { ffeTokenLength i; ! char *p; switch (ffelex_token_type (ffesta_tokens[0])) { --- 4292,4298 ---- ffestb_type (ffelexToken t) { ffeTokenLength i; ! const char *p; switch (ffelex_token_type (ffesta_tokens[0])) { *************** static ffelexHandler *** 4376,4382 **** ffestb_type1_ (ffelexToken t) { ffeTokenLength i; ! char *p; ffelex_set_names (FALSE); --- 4376,4382 ---- ffestb_type1_ (ffelexToken t) { ffeTokenLength i; ! const char *p; ffelex_set_names (FALSE); *************** ffelexHandler *** 4537,4543 **** ffestb_varlist (ffelexToken t) { ffeTokenLength i; ! char *p; ffelexToken nt; ffelexHandler next; --- 4537,4543 ---- ffestb_varlist (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; ffelexToken nt; ffelexHandler next; *************** ffestb_varlist6_ (ffelexToken t) *** 5215,5221 **** ffelexHandler ffestb_R423B (ffelexToken t) { ! char *p; ffeTokenLength i; switch (ffelex_token_type (ffesta_tokens[0])) --- 5215,5221 ---- ffelexHandler ffestb_R423B (ffelexToken t) { ! const char *p; ffeTokenLength i; switch (ffelex_token_type (ffesta_tokens[0])) *************** ffelexHandler *** 5284,5290 **** ffestb_R522 (ffelexToken t) { ffeTokenLength i; ! char *p; ffelexToken nt; ffelexHandler next; --- 5284,5290 ---- ffestb_R522 (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; ffelexToken nt; ffelexHandler next; *************** ffestb_R5224_ (ffelexToken t) *** 5528,5534 **** ffelexHandler ffestb_R528 (ffelexToken t) { ! char *p; ffeTokenLength i; ffelexToken nt; ffelexHandler next; --- 5528,5534 ---- ffelexHandler ffestb_R528 (ffelexToken t) { ! unsigned const char *p; ffeTokenLength i; ffelexToken nt; ffelexHandler next; *************** ffestb_R5282_ (ffelexToken ft, ffebld ex *** 5707,5713 **** case FFELEX_typeASTERISK: if (expr == NULL) break; ! ffestb_local_.data.expr = expr; ffesta_tokens[1] = ffelex_token_use (ft); return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextDATA, --- 5707,5718 ---- case FFELEX_typeASTERISK: if (expr == NULL) break; ! ffestb_local_.data.expr = ffeexpr_convert (expr, ft, t, ! FFEINFO_basictypeINTEGER, ! FFEINFO_kindtypeINTEGER1, ! 0, ! FFETARGET_charactersizeNONE, ! FFEEXPR_contextLET); ffesta_tokens[1] = ffelex_token_use (ft); return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextDATA, *************** ffestb_R5373_ (ffelexToken t) *** 6005,6011 **** ffelexHandler ffestb_R542 (ffelexToken t) { ! char *p; ffeTokenLength i; switch (ffelex_token_type (ffesta_tokens[0])) --- 6010,6016 ---- ffelexHandler ffestb_R542 (ffelexToken t) { ! const char *p; ffeTokenLength i; switch (ffelex_token_type (ffesta_tokens[0])) *************** ffelexHandler *** 6419,6425 **** ffestb_R834 (ffelexToken t) { ffeTokenLength i; ! char *p; switch (ffelex_token_type (ffesta_tokens[0])) { --- 6424,6430 ---- ffestb_R834 (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; switch (ffelex_token_type (ffesta_tokens[0])) { *************** ffelexHandler *** 6534,6540 **** ffestb_R835 (ffelexToken t) { ffeTokenLength i; ! char *p; switch (ffelex_token_type (ffesta_tokens[0])) { --- 6539,6545 ---- ffestb_R835 (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; switch (ffelex_token_type (ffesta_tokens[0])) { *************** ffestb_R8351_ (ffelexToken t) *** 6648,6654 **** ffelexHandler ffestb_R838 (ffelexToken t) { ! char *p; ffeTokenLength i; ffelexHandler next; ffelexToken et; /* First token in target. */ --- 6653,6659 ---- ffelexHandler ffestb_R838 (ffelexToken t) { ! unsigned const char *p; ffeTokenLength i; ffelexHandler next; ffelexToken et; /* First token in target. */ *************** ffestb_R8407_ (ffelexToken t) *** 7073,7079 **** ffelexHandler ffestb_R841 (ffelexToken t) { ! char *p; ffeTokenLength i; switch (ffelex_token_type (ffesta_tokens[0])) --- 7078,7084 ---- ffelexHandler ffestb_R841 (ffelexToken t) { ! const char *p; ffeTokenLength i; switch (ffelex_token_type (ffesta_tokens[0])) *************** ffelexHandler *** 7141,7147 **** ffestb_R1102 (ffelexToken t) { ffeTokenLength i; ! char *p; switch (ffelex_token_type (ffesta_tokens[0])) { --- 7146,7152 ---- ffestb_R1102 (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; switch (ffelex_token_type (ffesta_tokens[0])) { *************** ffelexHandler *** 7293,7299 **** ffestb_blockdata (ffelexToken t) { ffeTokenLength i; ! char *p; switch (ffelex_token_type (ffesta_tokens[0])) { --- 7298,7304 ---- ffestb_blockdata (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; switch (ffelex_token_type (ffesta_tokens[0])) { *************** ffelexHandler *** 7436,7442 **** ffestb_R1212 (ffelexToken t) { ffeTokenLength i; ! char *p; ffelexHandler next; ffelexToken nt; --- 7441,7447 ---- ffestb_R1212 (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; ffelexHandler next; ffelexToken nt; *************** ffestb_R12271_ (ffelexToken ft, ffebld e *** 7675,7681 **** ffelexHandler ffestb_R1228 (ffelexToken t) { ! char *p; ffeTokenLength i; switch (ffelex_token_type (ffesta_tokens[0])) --- 7680,7686 ---- ffelexHandler ffestb_R1228 (ffelexToken t) { ! const char *p; ffeTokenLength i; switch (ffelex_token_type (ffesta_tokens[0])) *************** bad_i: /* :::::::::::::::::::: */ *** 7744,7750 **** ffelexHandler ffestb_V009 (ffelexToken t) { ! char *p; ffeTokenLength i; switch (ffelex_token_type (ffesta_tokens[0])) --- 7749,7755 ---- ffelexHandler ffestb_V009 (ffelexToken t) { ! const char *p; ffeTokenLength i; switch (ffelex_token_type (ffesta_tokens[0])) *************** ffelexHandler *** 8156,8162 **** ffestb_module (ffelexToken t) { ffeTokenLength i; ! char *p; ffelexToken nt; ffelexToken mt; /* Name in MODULE PROCEDUREname, i.e. includes "PROCEDURE". */ --- 8161,8167 ---- ffestb_module (ffelexToken t) { ffeTokenLength i; ! const char *p; ffelexToken nt; ffelexToken mt; /* Name in MODULE PROCEDUREname, i.e. includes "PROCEDURE". */ *************** ffelexHandler *** 8429,8435 **** ffestb_R809 (ffelexToken t) { ffeTokenLength i; ! char *p; switch (ffelex_token_type (ffesta_tokens[0])) { --- 8434,8440 ---- ffestb_R809 (ffelexToken t) { ffeTokenLength i; ! const char *p; switch (ffelex_token_type (ffesta_tokens[0])) { *************** ffelexHandler *** 8630,8636 **** ffestb_R810 (ffelexToken t) { ffeTokenLength i; ! char *p; switch (ffelex_token_type (ffesta_tokens[0])) { --- 8635,8641 ---- ffestb_R810 (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; switch (ffelex_token_type (ffesta_tokens[0])) { *************** ffestb_R10014_ (ffelexToken t) *** 9185,9191 **** { ffesttFormatList f; ffeTokenLength i; ! char *p; ffestrFormat kw; ffelex_set_expecting_hollerith (0, '\0', --- 9190,9196 ---- { ffesttFormatList f; ffeTokenLength i; ! const char *p; ffestrFormat kw; ffelex_set_expecting_hollerith (0, '\0', *************** ffestb_R10014_ (ffelexToken t) *** 9709,9715 **** i += ffelex_token_length (ffestb_local_.format.post.t); if (*p == '\0') return (ffelexHandler) ffestb_R10016_; ! if ((kw != FFESTR_formatP) || !ffelex_is_firstnamechar (*p)) { if (ffestb_local_.format.current != FFESTP_formattypeH) ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL); --- 9714,9721 ---- i += ffelex_token_length (ffestb_local_.format.post.t); if (*p == '\0') return (ffelexHandler) ffestb_R10016_; ! if ((kw != FFESTR_formatP) || ! !ffelex_is_firstnamechar ((unsigned char)*p)) { if (ffestb_local_.format.current != FFESTP_formattypeH) ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL); *************** ffestb_R10015_ (ffelexToken t) *** 9813,9819 **** bool split_pea; /* New NAMES requires splitting kP from new edit desc. */ ffestrFormat kw; ! char *p; ffeTokenLength i; switch (ffelex_token_type (t)) --- 9819,9825 ---- bool split_pea; /* New NAMES requires splitting kP from new edit desc. */ ffestrFormat kw; ! const char *p; ffeTokenLength i; switch (ffelex_token_type (t)) *************** static ffelexHandler *** 10190,10196 **** ffestb_R10018_ (ffelexToken t) { ffeTokenLength i; ! char *p; switch (ffelex_token_type (t)) { --- 10196,10202 ---- ffestb_R10018_ (ffelexToken t) { ffeTokenLength i; ! const char *p; switch (ffelex_token_type (t)) { *************** ffelexHandler *** 10984,10990 **** ffestb_R1107 (ffelexToken t) { ffeTokenLength i; ! char *p; switch (ffelex_token_type (ffesta_tokens[0])) { --- 10990,10996 ---- ffestb_R1107 (ffelexToken t) { ffeTokenLength i; ! const char *p; switch (ffelex_token_type (ffesta_tokens[0])) { *************** ffelexHandler *** 11430,11436 **** ffestb_R1202 (ffelexToken t) { ffeTokenLength i; ! char *p; switch (ffelex_token_type (ffesta_tokens[0])) { --- 11436,11442 ---- ffestb_R1202 (ffelexToken t) { ffeTokenLength i; ! const char *p; switch (ffelex_token_type (ffesta_tokens[0])) { *************** ffestb_R12025_ (ffelexToken t) *** 11821,11827 **** static ffelexHandler ffestb_R12026_ (ffelexToken t) { ! char *p; switch (ffelex_token_type (t)) { --- 11827,11833 ---- static ffelexHandler ffestb_R12026_ (ffelexToken t) { ! const char *p; switch (ffelex_token_type (t)) { *************** ffelexHandler *** 11964,11970 **** ffestb_S3P4 (ffelexToken t) { ffeTokenLength i; ! char *p; ffelexHandler next; ffelexToken nt; ffelexToken ut; --- 11970,11976 ---- ffestb_S3P4 (ffelexToken t) { ffeTokenLength i; ! const char *p; ffelexHandler next; ffelexToken nt; ffelexToken ut; *************** ffestb_S3P41_ (ffelexToken ft, ffebld ex *** 12096,12102 **** ffelexHandler ffestb_V012 (ffelexToken t) { ! char *p; ffeTokenLength i; switch (ffelex_token_type (ffesta_tokens[0])) --- 12102,12108 ---- ffelexHandler ffestb_V012 (ffelexToken t) { ! const char *p; ffeTokenLength i; switch (ffelex_token_type (ffesta_tokens[0])) *************** ffelexHandler *** 12165,12171 **** ffestb_V014 (ffelexToken t) { ffeTokenLength i; ! char *p; ffelexToken nt; ffelexHandler next; --- 12171,12177 ---- ffestb_V014 (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; ffelexToken nt; ffelexHandler next; *************** ffelexHandler *** 12399,12405 **** ffestb_V025 (ffelexToken t) { ffeTokenLength i; ! char *p; ffelexToken nt; ffelexHandler next; --- 12405,12411 ---- ffestb_V025 (ffelexToken t) { ffeTokenLength i; ! const char *p; ffelexToken nt; ffelexHandler next; *************** ffestb_V0254_ (ffelexToken ft, ffebld ex *** 12595,12601 **** static ffelexHandler ffestb_V0255_ (ffelexToken t) { ! char *p; switch (ffelex_token_type (t)) { --- 12601,12607 ---- static ffelexHandler ffestb_V0255_ (ffelexToken t) { ! const char *p; switch (ffelex_token_type (t)) { *************** ffelexHandler *** 17909,17915 **** ffestb_V020 (ffelexToken t) { ffeTokenLength i; ! char *p; ffelexHandler next; ffestpTypeIx ix; --- 17915,17921 ---- ffestb_V020 (ffelexToken t) { ffeTokenLength i; ! const char *p; ffelexHandler next; ffestpTypeIx ix; *************** ffelexHandler *** 18845,18851 **** ffestb_dimlist (ffelexToken t) { ffeTokenLength i; ! char *p; ffelexToken nt; ffelexHandler next; --- 18851,18857 ---- ffestb_dimlist (ffelexToken t) { ffeTokenLength i; ! const char *p; ffelexToken nt; ffelexHandler next; *************** ffelexHandler *** 19399,19405 **** ffestb_dummy (ffelexToken t) { ffeTokenLength i; ! char *p; switch (ffelex_token_type (ffesta_tokens[0])) { --- 19405,19411 ---- ffestb_dummy (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; switch (ffelex_token_type (ffesta_tokens[0])) { *************** ffelexHandler *** 19618,19624 **** ffestb_R524 (ffelexToken t) { ffeTokenLength i; ! char *p; ffelexToken nt; ffelexHandler next; --- 19624,19630 ---- ffestb_R524 (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; ffelexToken nt; ffelexHandler next; *************** ffelexHandler *** 19847,19853 **** ffestb_R547 (ffelexToken t) { ffeTokenLength i; ! char *p; ffelexToken nt; ffelexHandler next; --- 19853,19859 ---- ffestb_R547 (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; ffelexToken nt; ffelexHandler next; *************** ffelexHandler *** 20485,20491 **** ffestb_decl_chartype (ffelexToken t) { ffeTokenLength i; ! char *p; ffestb_local_.decl.type = FFESTP_typeCHARACTER; ffestb_local_.decl.recursive = NULL; --- 20491,20497 ---- ffestb_decl_chartype (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; ffestb_local_.decl.type = FFESTP_typeCHARACTER; ffestb_local_.decl.recursive = NULL; *************** ffelexHandler *** 20672,20678 **** ffestb_decl_dbltype (ffelexToken t) { ffeTokenLength i; ! char *p; ffestb_local_.decl.type = ffestb_args.decl.type; ffestb_local_.decl.recursive = NULL; --- 20678,20684 ---- ffestb_decl_dbltype (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; ffestb_local_.decl.type = ffestb_args.decl.type; ffestb_local_.decl.recursive = NULL; *************** ffelexHandler *** 20863,20869 **** ffestb_decl_gentype (ffelexToken t) { ffeTokenLength i; ! char *p; ffestb_local_.decl.type = ffestb_args.decl.type; ffestb_local_.decl.recursive = NULL; --- 20869,20875 ---- ffestb_decl_gentype (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; ffestb_local_.decl.type = ffestb_args.decl.type; ffestb_local_.decl.recursive = NULL; *************** ffelexHandler *** 21009,21015 **** ffestb_decl_recursive (ffelexToken t) { ffeTokenLength i; ! char *p; ffelexToken nt; ffelexToken ot; ffelexHandler next; --- 21015,21021 ---- ffestb_decl_recursive (ffelexToken t) { ffeTokenLength i; ! const char *p; ffelexToken nt; ffelexToken ot; ffelexHandler next; *************** ffestb_decl_entsp_2_ (ffelexToken t) *** 22667,22673 **** { ffelexToken nt; bool asterisk_ok; ! char *p; ffeTokenLength i; switch (ffelex_token_type (t)) --- 22673,22679 ---- { ffelexToken nt; bool asterisk_ok; ! unsigned const char *p; ffeTokenLength i; switch (ffelex_token_type (t)) *************** ffestb_decl_entsp_8_ (ffelexToken t) *** 23094,23100 **** static ffelexHandler ffestb_decl_func_ (ffelexToken t) { ! char *p; ffeTokenLength i; ffelex_set_names (FALSE); --- 23100,23106 ---- static ffelexHandler ffestb_decl_func_ (ffelexToken t) { ! const char *p; ffeTokenLength i; ffelex_set_names (FALSE); *************** ffelexHandler *** 23572,23578 **** ffestb_V003 (ffelexToken t) { ffeTokenLength i; ! char *p; ffelexToken nt; ffelexHandler next; --- 23578,23584 ---- ffestb_V003 (ffelexToken t) { ffeTokenLength i; ! const char *p; ffelexToken nt; ffelexHandler next; *************** bad: /* :::::::::::::::::::: */ *** 23888,23894 **** ffelexHandler ffestb_V016 (ffelexToken t) { ! char *p; ffeTokenLength i; switch (ffelex_token_type (ffesta_tokens[0])) --- 23894,23900 ---- ffelexHandler ffestb_V016 (ffelexToken t) { ! const char *p; ffeTokenLength i; switch (ffelex_token_type (ffesta_tokens[0])) *************** ffestb_V0166_ (ffelexToken t) *** 24156,24162 **** ffelexHandler ffestb_V027 (ffelexToken t) { ! char *p; ffeTokenLength i; switch (ffelex_token_type (ffesta_tokens[0])) --- 24162,24168 ---- ffelexHandler ffestb_V027 (ffelexToken t) { ! unsigned const char *p; ffeTokenLength i; switch (ffelex_token_type (ffesta_tokens[0])) *************** ffelexHandler *** 24336,24342 **** ffestb_decl_R539 (ffelexToken t) { ffeTokenLength i; ! char *p; ffelexToken nt; ffestrSecond kw; --- 24342,24348 ---- ffestb_decl_R539 (ffelexToken t) { ffeTokenLength i; ! unsigned const char *p; ffelexToken nt; ffestrSecond kw; diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/stb.h gcc-2.95/gcc/f/stb.h *** egcs-1.1.2/gcc/f/stb.h Tue May 19 03:50:10 1998 --- gcc-2.95/gcc/f/stb.h Tue Mar 30 01:23:38 1999 *************** *** 1,6 **** /* stb.h -- Private #include File (module.h template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* stb.h -- Private #include File (module.h template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** struct _ffestb_args_ *** 50,56 **** { struct { ! char *badname; ffeTokenLength len; /* Length of "ENTRY/FUNCTION/SUBROUTINE". */ bool is_subr; /* TRUE if SUBROUTINE or if ENTRY within SUBROUTINE. */ --- 50,56 ---- { struct { ! const char *badname; ffeTokenLength len; /* Length of "ENTRY/FUNCTION/SUBROUTINE". */ bool is_subr; /* TRUE if SUBROUTINE or if ENTRY within SUBROUTINE. */ *************** struct _ffestb_args_ *** 58,64 **** dummy; struct { ! char *badname; ffeTokenLength len; /* Length of "BACKSPACE/ENDFILE/REWIND/UNLOCK". */ } --- 58,64 ---- dummy; struct { ! const char *badname; ffeTokenLength len; /* Length of "BACKSPACE/ENDFILE/REWIND/UNLOCK". */ } *************** struct _ffestb_args_ *** 82,88 **** #if FFESTR_F90 struct { ! char *badname; ffeTokenLength len; /* Length of "ALLOCATE/DEALLOCATE". */ ffeexprContext ctx; /* Either ALLOCATE or DEALLOCATE. */ } --- 82,88 ---- #if FFESTR_F90 struct { ! const char *badname; ffeTokenLength len; /* Length of "ALLOCATE/DEALLOCATE". */ ffeexprContext ctx; /* Either ALLOCATE or DEALLOCATE. */ } *************** struct _ffestb_args_ *** 90,96 **** #endif struct { ! char *badname; ffeTokenLength len; /* Length of "EXTERNAL/INTENT/INTRINSIC/OPTIONAL/PUBLIC/ PRIVATE". */ --- 90,96 ---- #endif struct { ! const char *badname; ffeTokenLength len; /* Length of "EXTERNAL/INTENT/INTRINSIC/OPTIONAL/PUBLIC/ PRIVATE". */ *************** struct _ffestb_args_ *** 99,105 **** #if FFESTR_VXT struct { ! char *badname; ffeTokenLength len; /* Length of "ENCODE/DECODE". */ } vxtcode; --- 99,105 ---- #if FFESTR_VXT struct { ! const char *badname; ffeTokenLength len; /* Length of "ENCODE/DECODE". */ } vxtcode; *************** struct _ffestb_args_ *** 107,120 **** #if FFESTR_F90 struct { ! char *badname; ffeTokenLength len; /* Length of "ALLOCATABLE/POINTER/TARGET". */ } dimlist; #endif struct { ! char *badname; ffeTokenLength len; /* Length of "DIMENSION/VIRTUAL". */ } R524; --- 107,120 ---- #if FFESTR_F90 struct { ! const char *badname; ffeTokenLength len; /* Length of "ALLOCATABLE/POINTER/TARGET". */ } dimlist; #endif struct { ! const char *badname; ffeTokenLength len; /* Length of "DIMENSION/VIRTUAL". */ } R524; diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/stc.c gcc-2.95/gcc/f/stc.c *** egcs-1.1.2/gcc/f/stc.c Sun Jul 26 07:43:36 1998 --- gcc-2.95/gcc/f/stc.c Sat Apr 17 03:58:27 1999 *************** *** 1,6 **** /* stc.c -- Implementation File (module.c template V1.0) Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* stc.c -- Implementation File (module.c template V1.0) Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** static void ffestc_shriek_where_ (bool o *** 339,352 **** #if FFESTR_F90 static void ffestc_shriek_wherethen_ (bool ok); #endif ! static int ffestc_subr_binsrch_ (char **list, int size, ffestpFile *spec, ! char *whine); static ffestvFormat ffestc_subr_format_ (ffestpFile *spec); static bool ffestc_subr_is_branch_ (ffestpFile *spec); static bool ffestc_subr_is_format_ (ffestpFile *spec); ! static bool ffestc_subr_is_present_ (char *name, ffestpFile *spec); ! static int ffestc_subr_speccmp_ (char *string, ffestpFile *spec, ! char **target, int *length); static ffestvUnit ffestc_subr_unit_ (ffestpFile *spec); static void ffestc_try_shriek_do_ (void); --- 339,352 ---- #if FFESTR_F90 static void ffestc_shriek_wherethen_ (bool ok); #endif ! static int ffestc_subr_binsrch_ (const char **list, int size, ffestpFile *spec, ! const char *whine); static ffestvFormat ffestc_subr_format_ (ffestpFile *spec); static bool ffestc_subr_is_branch_ (ffestpFile *spec); static bool ffestc_subr_is_format_ (ffestpFile *spec); ! static bool ffestc_subr_is_present_ (const char *name, ffestpFile *spec); ! static int ffestc_subr_speccmp_ (const char *string, ffestpFile *spec, ! const char **target, int *length); static ffestvUnit ffestc_subr_unit_ (ffestpFile *spec); static void ffestc_try_shriek_do_ (void); *************** ffestc_shriek_wherethen_ (bool ok) *** 5044,5057 **** using "etc" as the pick-one-of-these string. */ static int ! ffestc_subr_binsrch_ (char **list, int size, ffestpFile *spec, char *whine) { int lowest_tested; int highest_tested; int halfway; int offset; int c; ! char *str; int len; if (size == 0) --- 5044,5057 ---- using "etc" as the pick-one-of-these string. */ static int ! ffestc_subr_binsrch_ (const char **list, int size, ffestpFile *spec, const char *whine) { int lowest_tested; int highest_tested; int halfway; int offset; int c; ! const char *str; int len; if (size == 0) *************** ffestc_subr_is_format_ (ffestpFile *spec *** 5186,5192 **** ffestc_subr_is_present_("SPECIFIER",&specifier); */ static bool ! ffestc_subr_is_present_ (char *name, ffestpFile *spec) { if (spec->kw_or_val_present) { --- 5186,5192 ---- ffestc_subr_is_present_("SPECIFIER",&specifier); */ static bool ! ffestc_subr_is_present_ (const char *name, ffestpFile *spec) { if (spec->kw_or_val_present) { *************** ffestc_subr_is_present_ (char *name, ffe *** 5219,5225 **** 0 if 2 is returned, the length of the constant string value otherwise. */ static int ! ffestc_subr_speccmp_ (char *string, ffestpFile *spec, char **target, int *length) { ffebldConstant c; --- 5219,5225 ---- 0 if 2 is returned, the length of the constant string value otherwise. */ static int ! ffestc_subr_speccmp_ (const char *string, ffestpFile *spec, const char **target, int *length) { ffebldConstant c; *************** ffestc_R838 (ffelexToken label_token, ff *** 10000,10005 **** --- 10000,10009 ---- return; ffestc_labeldef_branch_begin_ (); + /* Mark target symbol as target of an ASSIGN. */ + if (ffebld_op (target) == FFEBLD_opSYMTER) + ffesymbol_set_assigned (ffebld_symter (target), TRUE); + if (ffestc_labelref_is_assignable_ (label_token, &label)) ffestd_R838 (label, target); *************** ffestc_R904 () *** 10198,10204 **** { int i; int expect_file; ! char *status_strs[] = { "New", --- 10202,10208 ---- { int i; int expect_file; ! const char *status_strs[] = { "New", *************** ffestc_R904 () *** 10207,10213 **** "Scratch", "Unknown" }; ! char *access_strs[] = { "Append", --- 10211,10217 ---- "Scratch", "Unknown" }; ! const char *access_strs[] = { "Append", *************** ffestc_R904 () *** 10215,10234 **** "Keyed", "Sequential" }; ! char *blank_strs[] = { "Null", "Zero" }; ! char *carriagecontrol_strs[] = { "Fortran", "List", "None" }; ! char *dispose_strs[] = { "Delete", --- 10219,10238 ---- "Keyed", "Sequential" }; ! const char *blank_strs[] = { "Null", "Zero" }; ! const char *carriagecontrol_strs[] = { "Fortran", "List", "None" }; ! const char *dispose_strs[] = { "Delete", *************** ffestc_R904 () *** 10239,10279 **** "Submit", "Submit/Delete" }; ! char *form_strs[] = { "Formatted", "Unformatted" }; ! char *organization_strs[] = { "Indexed", "Relative", "Sequential" }; ! char *position_strs[] = { "Append", "AsIs", "Rewind" }; ! char *action_strs[] = { "Read", "ReadWrite", "Write" }; ! char *delim_strs[] = { "Apostrophe", "None", "Quote" }; ! char *recordtype_strs[] = { "Fixed", --- 10243,10283 ---- "Submit", "Submit/Delete" }; ! const char *form_strs[] = { "Formatted", "Unformatted" }; ! const char *organization_strs[] = { "Indexed", "Relative", "Sequential" }; ! const char *position_strs[] = { "Append", "AsIs", "Rewind" }; ! const char *action_strs[] = { "Read", "ReadWrite", "Write" }; ! const char *delim_strs[] = { "Apostrophe", "None", "Quote" }; ! const char *recordtype_strs[] = { "Fixed", *************** ffestc_R904 () *** 10283,10289 **** "Stream_LF", "Variable" }; ! char *pad_strs[] = { "No", --- 10287,10293 ---- "Stream_LF", "Variable" }; ! const char *pad_strs[] = { "No", *************** ffestc_R904 () *** 10453,10459 **** void ffestc_R907 () { ! char *status_strs[] = { "Delete", --- 10457,10463 ---- void ffestc_R907 () { ! const char *status_strs[] = { "Delete", diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/stc.h gcc-2.95/gcc/f/stc.h *** egcs-1.1.2/gcc/f/stc.h Tue May 19 03:50:12 1998 --- gcc-2.95/gcc/f/stc.h Mon Feb 15 10:17:31 1999 *************** *** 1,6 **** /* stc.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* stc.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/std.c gcc-2.95/gcc/f/std.c *** egcs-1.1.2/gcc/f/std.c Tue May 19 03:50:13 1998 --- gcc-2.95/gcc/f/std.c Sat Apr 17 03:58:28 1999 *************** *** 1,6 **** /* std.c -- Implementation File (module.c template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* std.c -- Implementation File (module.c template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** struct _ffestd_stmt_ *** 192,208 **** --- 192,220 ---- struct { mallocPool pool; + ffestw block; ffebld expr; } R803; struct { mallocPool pool; + ffestw block; ffebld expr; } R804; struct { + ffestw block; + } + R805; + struct + { + ffestw block; + } + R806; + struct + { mallocPool pool; ffebld expr; } *************** static void ffestd_subr_f90_ (void); *** 526,550 **** static void ffestd_subr_labels_ (bool unexpected); static void ffestd_R1001dump_ (ffests s, ffesttFormatList list); static void ffestd_R1001dump_1005_1_ (ffests s, ffesttFormatList f, ! char *string); static void ffestd_R1001dump_1005_2_ (ffests s, ffesttFormatList f, ! char *string); static void ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f, ! char *string); static void ffestd_R1001dump_1005_4_ (ffests s, ffesttFormatList f, ! char *string); static void ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f, ! char *string); static void ffestd_R1001dump_1010_1_ (ffests s, ffesttFormatList f, ! char *string); static void ffestd_R1001dump_1010_2_ (ffests s, ffesttFormatList f, ! char *string); static void ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f, ! char *string); static void ffestd_R1001dump_1010_4_ (ffests s, ffesttFormatList f, ! char *string); static void ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f, ! char *string); static void ffestd_R1001error_ (ffesttFormatList f); static void ffestd_R1001rtexpr_ (ffests s, ffesttFormatList f, ffebld expr); --- 538,562 ---- static void ffestd_subr_labels_ (bool unexpected); static void ffestd_R1001dump_ (ffests s, ffesttFormatList list); static void ffestd_R1001dump_1005_1_ (ffests s, ffesttFormatList f, ! const char *string); static void ffestd_R1001dump_1005_2_ (ffests s, ffesttFormatList f, ! const char *string); static void ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f, ! const char *string); static void ffestd_R1001dump_1005_4_ (ffests s, ffesttFormatList f, ! const char *string); static void ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f, ! const char *string); static void ffestd_R1001dump_1010_1_ (ffests s, ffesttFormatList f, ! const char *string); static void ffestd_R1001dump_1010_2_ (ffests s, ffesttFormatList f, ! const char *string); static void ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f, ! const char *string); static void ffestd_R1001dump_1010_4_ (ffests s, ffesttFormatList f, ! const char *string); static void ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f, ! const char *string); static void ffestd_R1001error_ (ffesttFormatList f); static void ffestd_R1001rtexpr_ (ffests s, ffesttFormatList f, ffebld expr); *************** ffestd_stmt_pass_ () *** 750,776 **** case FFESTD_stmtidR803_: ffestd_subr_line_restore_ (stmt); if (okay) ! ffeste_R803 (stmt->u.R803.expr); malloc_pool_kill (stmt->u.R803.pool); break; case FFESTD_stmtidR804_: ffestd_subr_line_restore_ (stmt); if (okay) ! ffeste_R804 (stmt->u.R804.expr); malloc_pool_kill (stmt->u.R804.pool); break; case FFESTD_stmtidR805_: ffestd_subr_line_restore_ (stmt); if (okay) ! ffeste_R805 (); break; case FFESTD_stmtidR806_: ffestd_subr_line_restore_ (stmt); if (okay) ! ffeste_R806 (); break; case FFESTD_stmtidR807_: --- 762,789 ---- case FFESTD_stmtidR803_: ffestd_subr_line_restore_ (stmt); if (okay) ! ffeste_R803 (stmt->u.R803.block, stmt->u.R803.expr); malloc_pool_kill (stmt->u.R803.pool); break; case FFESTD_stmtidR804_: ffestd_subr_line_restore_ (stmt); if (okay) ! ffeste_R804 (stmt->u.R803.block, stmt->u.R804.expr); malloc_pool_kill (stmt->u.R804.pool); break; case FFESTD_stmtidR805_: ffestd_subr_line_restore_ (stmt); if (okay) ! ffeste_R805 (stmt->u.R803.block); break; case FFESTD_stmtidR806_: ffestd_subr_line_restore_ (stmt); if (okay) ! ffeste_R806 (stmt->u.R806.block); ! ffestw_kill (stmt->u.R806.block); break; case FFESTD_stmtidR807_: *************** ffestd_labeldef_format (ffelab label) *** 1597,1603 **** --- 1610,1628 ---- ffestdStmt_ stmt; stmt = ffestd_stmt_new_ (FFESTD_stmtidFORMATLABEL_); + #if 0 + /* Don't bother with this. See FORMAT statement. */ + /* Prepend FORMAT label instead of appending it, so all the + FORMAT label/statement pairs end up at the top of the list. + This helps ensure all decls for a block (in the GBE) are + known before any executable statements are generated. */ + stmt->previous = (ffestdStmt_) &ffestd_stmt_list_.first; + stmt->next = ffestd_stmt_list_.first; + stmt->next->previous = stmt; + stmt->previous->next = stmt; + #else ffestd_stmt_append_ (stmt); + #endif stmt->u.formatlabel.label = label; } #endif *************** ffestd_R744 () *** 2989,3001 **** #endif } ! /* ffestd_R745 -- Implicit END WHERE statement ! ! ffestd_R745(TRUE); ! ! Implement the end of the current WHERE "block". ok==TRUE iff statement ! following WHERE (substatement) is valid; else, statement is invalid ! or stack forcibly popped due to ffestd_eof_(). */ void ffestd_R745 (bool ok) --- 3014,3020 ---- #endif } ! /* ffestd_R745 -- Implicit END WHERE statement. */ void ffestd_R745 (bool ok) *************** ffestd_R745 (bool ok) *** 3011,3021 **** } #endif - /* ffestd_R803 -- Block IF (IF-THEN) statement - - ffestd_R803(construct_name,expr,expr_token); ! Make sure statement is valid here; implement. */ void ffestd_R803 (ffelexToken construct_name UNUSED, ffebld expr) --- 3030,3037 ---- } #endif ! /* Block IF (IF-THEN) statement. */ void ffestd_R803 (ffelexToken construct_name UNUSED, ffebld expr) *************** ffestd_R803 (ffelexToken construct_name *** 3033,3038 **** --- 3049,3055 ---- ffestd_stmt_append_ (stmt); ffestd_subr_line_save_ (stmt); stmt->u.R803.pool = ffesta_output_pool; + stmt->u.R803.block = ffestw_use (ffestw_stack_top ()); stmt->u.R803.expr = expr; ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } *************** ffestd_R803 (ffelexToken construct_name *** 3042,3054 **** assert (ffestd_block_level_ > 0); } ! /* ffestd_R804 -- ELSE IF statement ! ! ffestd_R804(expr,expr_token,name_token); ! ! Make sure ffestd_kind_ identifies an IF block. If not ! NULL, make sure name_token gives the correct name. Implement the else ! of the IF block. */ void ffestd_R804 (ffebld expr, ffelexToken name UNUSED) --- 3059,3065 ---- assert (ffestd_block_level_ > 0); } ! /* ELSE IF statement. */ void ffestd_R804 (ffebld expr, ffelexToken name UNUSED) *************** ffestd_R804 (ffebld expr, ffelexToken na *** 3066,3084 **** ffestd_stmt_append_ (stmt); ffestd_subr_line_save_ (stmt); stmt->u.R804.pool = ffesta_output_pool; stmt->u.R804.expr = expr; ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } #endif } ! /* ffestd_R805 -- ELSE statement ! ! ffestd_R805(name_token); ! ! Make sure ffestd_kind_ identifies an IF block. If not ! NULL, make sure name_token gives the correct name. Implement the ELSE ! of the IF block. */ void ffestd_R805 (ffelexToken name UNUSED) --- 3077,3090 ---- ffestd_stmt_append_ (stmt); ffestd_subr_line_save_ (stmt); stmt->u.R804.pool = ffesta_output_pool; + stmt->u.R804.block = ffestw_use (ffestw_stack_top ()); stmt->u.R804.expr = expr; ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } #endif } ! /* ELSE statement. */ void ffestd_R805 (ffelexToken name UNUSED) *************** ffestd_R805 (ffelexToken name UNUSED) *** 3095,3107 **** stmt = ffestd_stmt_new_ (FFESTD_stmtidR805_); ffestd_stmt_append_ (stmt); ffestd_subr_line_save_ (stmt); } #endif } ! /* ffestd_R806 -- End an IF-THEN ! ! ffestd_R806(TRUE); */ void ffestd_R806 (bool ok UNUSED) --- 3101,3112 ---- stmt = ffestd_stmt_new_ (FFESTD_stmtidR805_); ffestd_stmt_append_ (stmt); ffestd_subr_line_save_ (stmt); + stmt->u.R805.block = ffestw_use (ffestw_stack_top ()); } #endif } ! /* END IF statement. */ void ffestd_R806 (bool ok UNUSED) *************** ffestd_R806 (bool ok UNUSED) *** 3116,3121 **** --- 3121,3127 ---- stmt = ffestd_stmt_new_ (FFESTD_stmtidR806_); ffestd_stmt_append_ (stmt); ffestd_subr_line_save_ (stmt); + stmt->u.R806.block = ffestw_use (ffestw_stack_top ()); } #endif *************** ffestd_R1001 (ffesttFormatList f) *** 4273,4279 **** --- 4279,4302 ---- ffestdStmt_ stmt; stmt = ffestd_stmt_new_ (FFESTD_stmtidR1001_); + #if 0 + /* Don't bother with this. After all, things like cilists also are + declared midway through code-generation. Perhaps the only problems + the gcc back end has with midway declarations are with stack vars, + maybe only with vars that can be put in registers. Unless/until the + need is established, handle FORMAT just like cilists and others; at + that point, they'd likely *all* have to be fixed, which would be + very painful anyway. */ + /* Insert FORMAT statement just after the first item on the + statement list, which must be a FORMAT label, which see. */ + assert (ffestd_stmt_list_.first->id == FFESTD_stmtidFORMATLABEL_); + stmt->previous = ffestd_stmt_list_.first; + stmt->next = ffestd_stmt_list_.first->next; + stmt->next->previous = stmt; + stmt->previous->next = stmt; + #else ffestd_stmt_append_ (stmt); + #endif stmt->u.R1001.str = str; } #endif *************** ffestd_R1001dump_ (ffests s, ffesttForma *** 4487,4493 **** The format is dumped with form [r]X[w]. */ static void ! ffestd_R1001dump_1005_1_ (ffests s, ffesttFormatList f, char *string) { assert (!f->u.R1005.R1007_or_R1008.present); assert (!f->u.R1005.R1009.present); --- 4510,4516 ---- The format is dumped with form [r]X[w]. */ static void ! ffestd_R1001dump_1005_1_ (ffests s, ffesttFormatList f, const char *string) { assert (!f->u.R1005.R1007_or_R1008.present); assert (!f->u.R1005.R1009.present); *************** ffestd_R1001dump_1005_1_ (ffests s, ffes *** 4519,4525 **** The format is dumped with form [r]Xw. */ static void ! ffestd_R1001dump_1005_2_ (ffests s, ffesttFormatList f, char *string) { assert (!f->u.R1005.R1007_or_R1008.present); assert (!f->u.R1005.R1009.present); --- 4542,4548 ---- The format is dumped with form [r]Xw. */ static void ! ffestd_R1001dump_1005_2_ (ffests s, ffesttFormatList f, const char *string) { assert (!f->u.R1005.R1007_or_R1008.present); assert (!f->u.R1005.R1009.present); *************** ffestd_R1001dump_1005_2_ (ffests s, ffes *** 4549,4555 **** The format is dumped with form [r]Xw[.m]. */ static void ! ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f, char *string) { assert (!f->u.R1005.R1009.present); assert (f->u.R1005.R1006.present); --- 4572,4578 ---- The format is dumped with form [r]Xw[.m]. */ static void ! ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f, const char *string) { assert (!f->u.R1005.R1009.present); assert (f->u.R1005.R1006.present); *************** ffestd_R1001dump_1005_3_ (ffests s, ffes *** 4588,4594 **** The format is dumped with form [r]Xw.d. */ static void ! ffestd_R1001dump_1005_4_ (ffests s, ffesttFormatList f, char *string) { assert (!f->u.R1005.R1009.present); assert (f->u.R1005.R1007_or_R1008.present); --- 4611,4617 ---- The format is dumped with form [r]Xw.d. */ static void ! ffestd_R1001dump_1005_4_ (ffests s, ffesttFormatList f, const char *string) { assert (!f->u.R1005.R1009.present); assert (f->u.R1005.R1007_or_R1008.present); *************** ffestd_R1001dump_1005_4_ (ffests s, ffes *** 4624,4630 **** The format is dumped with form [r]Xw.d[Ee]. */ static void ! ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f, char *string) { assert (f->u.R1005.R1007_or_R1008.present); assert (f->u.R1005.R1006.present); --- 4647,4653 ---- The format is dumped with form [r]Xw.d[Ee]. */ static void ! ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f, const char *string) { assert (f->u.R1005.R1007_or_R1008.present); assert (f->u.R1005.R1006.present); *************** ffestd_R1001dump_1005_5_ (ffests s, ffes *** 4668,4674 **** The format is dumped with form X. */ static void ! ffestd_R1001dump_1010_1_ (ffests s, ffesttFormatList f, char *string) { assert (!f->u.R1010.val.present); --- 4691,4697 ---- The format is dumped with form X. */ static void ! ffestd_R1001dump_1010_1_ (ffests s, ffesttFormatList f, const char *string) { assert (!f->u.R1010.val.present); *************** ffestd_R1001dump_1010_1_ (ffests s, ffes *** 4683,4689 **** The format is dumped with form [r]X. */ static void ! ffestd_R1001dump_1010_2_ (ffests s, ffesttFormatList f, char *string) { if (f->u.R1010.val.present) { --- 4706,4712 ---- The format is dumped with form [r]X. */ static void ! ffestd_R1001dump_1010_2_ (ffests s, ffesttFormatList f, const char *string) { if (f->u.R1010.val.present) { *************** ffestd_R1001dump_1010_2_ (ffests s, ffes *** 4704,4710 **** The format is dumped with form nX. */ static void ! ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f, char *string) { assert (f->u.R1010.val.present); --- 4727,4733 ---- The format is dumped with form nX. */ static void ! ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f, const char *string) { assert (f->u.R1010.val.present); *************** ffestd_R1001dump_1010_3_ (ffests s, ffes *** 4724,4730 **** The format is dumped with form kX. Note that k is signed. */ static void ! ffestd_R1001dump_1010_4_ (ffests s, ffesttFormatList f, char *string) { assert (f->u.R1010.val.present); --- 4747,4753 ---- The format is dumped with form kX. Note that k is signed. */ static void ! ffestd_R1001dump_1010_4_ (ffests s, ffesttFormatList f, const char *string) { assert (f->u.R1010.val.present); *************** ffestd_R1001dump_1010_4_ (ffests s, ffes *** 4744,4750 **** The format is dumped with form Xn. */ static void ! ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f, char *string) { assert (f->u.R1010.val.present); --- 4767,4773 ---- The format is dumped with form Xn. */ static void ! ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f, const char *string) { assert (f->u.R1010.val.present); diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/std.h gcc-2.95/gcc/f/std.h *** egcs-1.1.2/gcc/f/std.h Tue May 19 03:50:15 1998 --- gcc-2.95/gcc/f/std.h Mon Feb 15 10:17:33 1999 *************** *** 1,6 **** /* std.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* std.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/ste.c gcc-2.95/gcc/f/ste.c *** egcs-1.1.2/gcc/f/ste.c Mon Jun 15 19:23:37 1998 --- gcc-2.95/gcc/f/ste.c Sun May 2 07:04:25 1999 *************** *** 1,6 **** /* ste.c -- Implementation File (module.c template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* ste.c -- Implementation File (module.c template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** the Free Software Foundation, 59 Temple *** 28,48 **** Modifications: */ - /* As of 0.5.4, any statement that calls on ffecom to transform an - expression might need to be wrapped in ffecom_push_calltemps () - and ffecom_pop_calltemps () as are some other cases. That is - the case when the transformation might involve generation of - a temporary that must be auto-popped, the specific case being - when a COMPLEX operation requiring a call to libf2c being - generated, whereby a temp is needed to hold the result since - libf2c doesn't return COMPLEX results directly. Cases where it - is known that ffecom_expr () won't need to do this, such as - the CALL statement (where it's the transformation of the - call expr itself that does the wrapping), don't need to bother - with this wrapping. Forgetting to do the wrapping currently - means a crash at an assertion when the wrapping would be helpful - to keep temporaries from being wasted -- see ffecom_push_tempvar. */ - /* Include files. */ #include "proj.h" --- 28,33 ---- *************** static void ffeste_begin_iterdo_ (ffestw *** 113,121 **** ffebld start, ffelexToken start_token, ffebld end, ffelexToken end_token, ffebld incr, ffelexToken incr_token, ! char *msg); ! static void ffeste_end_iterdo_ (tree tvar, tree tincr, tree itersvar); static void ffeste_io_call_ (tree call, bool do_check); static tree ffeste_io_dofio_ (ffebld expr); static tree ffeste_io_dolio_ (ffebld expr); static tree ffeste_io_douio_ (ffebld expr); --- 98,108 ---- ffebld start, ffelexToken start_token, ffebld end, ffelexToken end_token, ffebld incr, ffelexToken incr_token, ! const char *msg); ! static void ffeste_end_iterdo_ (ffestw block, tree tvar, tree tincr, ! tree itersvar); static void ffeste_io_call_ (tree call, bool do_check); + static void ffeste_io_impdo_ (ffebld impdo, ffelexToken impdo_token); static tree ffeste_io_dofio_ (ffebld expr); static tree ffeste_io_dolio_ (ffebld expr); static tree ffeste_io_douio_ (ffebld expr); *************** static tree ffeste_io_cllist_ (bool have *** 131,137 **** static tree ffeste_io_icilist_ (bool have_err, ffebld unit_expr, bool have_end, ffestvFormat format, ffestpFile *format_spec); ! static void ffeste_io_impdo_ (ffebld impdo, ffelexToken impdo_token); static tree ffeste_io_olist_ (bool have_err, ffebld unit_expr, ffestpFile *file_spec, ffestpFile *stat_spec, --- 118,140 ---- static tree ffeste_io_icilist_ (bool have_err, ffebld unit_expr, bool have_end, ffestvFormat format, ffestpFile *format_spec); ! static tree ffeste_io_inlist_ (bool have_err, ! ffestpFile *unit_spec, ! ffestpFile *file_spec, ! ffestpFile *exist_spec, ! ffestpFile *open_spec, ! ffestpFile *number_spec, ! ffestpFile *named_spec, ! ffestpFile *name_spec, ! ffestpFile *access_spec, ! ffestpFile *sequential_spec, ! ffestpFile *direct_spec, ! ffestpFile *form_spec, ! ffestpFile *formatted_spec, ! ffestpFile *unformatted_spec, ! ffestpFile *recl_spec, ! ffestpFile *nextrec_spec, ! ffestpFile *blank_spec); static tree ffeste_io_olist_ (bool have_err, ffebld unit_expr, ffestpFile *file_spec, ffestpFile *stat_spec, *************** static tree ffeste_io_olist_ (bool have_ *** 141,147 **** ffestpFile *blank_spec); static void ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt); #elif FFECOM_targetCURRENT == FFECOM_targetFFE ! static void ffeste_subr_file_ (char *kw, ffestpFile *spec); #else #error #endif --- 144,150 ---- ffestpFile *blank_spec); static void ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt); #elif FFECOM_targetCURRENT == FFECOM_targetFFE ! static void ffeste_subr_file_ (const char *kw, ffestpFile *spec); #else #error #endif *************** static void ffeste_subr_file_ (char *kw, *** 177,294 **** || ffeste_statelet_ == FFESTE_stateletITEM_); \ ffeste_statelet_ = FFESTE_stateletSIMPLE_ ! #define ffeste_f2c_charnolenspec_(Spec,Exp,Init) \ do \ { \ ! if (Spec->kw_or_val_present) \ ! Exp = ffecom_arg_ptr_to_expr(Spec->u.expr,&ignore); \ else \ Exp = null_pointer_node; \ ! if (TREE_CONSTANT(Exp)) \ ! { \ Init = Exp; \ - Exp = NULL_TREE; \ - } \ else \ { \ ! Init = null_pointer_node; \ ! constantp = FALSE; \ } \ } while(0) ! #define ffeste_f2c_charspec_(Spec,Exp,Init,Lenexp,Leninit) \ do \ { \ ! if (Spec->kw_or_val_present) \ ! Exp = ffecom_arg_ptr_to_expr(Spec->u.expr,&Lenexp); \ else \ { \ ! Exp = null_pointer_node; \ ! Lenexp = ffecom_f2c_ftnlen_zero_node; \ } \ ! if (TREE_CONSTANT(Exp)) \ ! { \ Init = Exp; \ ! Exp = NULL_TREE; \ } \ else \ { \ ! Init = null_pointer_node; \ ! constantp = FALSE; \ } \ ! if ((Lenexp != NULL_TREE) && TREE_CONSTANT(Lenexp)) \ { \ ! Leninit = Lenexp; \ ! Lenexp = NULL_TREE; \ } \ else \ { \ ! Leninit = ffecom_f2c_ftnlen_zero_node; \ ! constantp = FALSE; \ } \ } while(0) ! #define ffeste_f2c_exp_(Field,Exp) \ do \ { \ ! if (Exp != NULL_TREE) \ { \ ! Exp = ffecom_modify(void_type_node,ffecom_2(COMPONENT_REF, \ ! TREE_TYPE(Field),t,Field),Exp); \ ! expand_expr_stmt(Exp); \ } \ } while(0) ! #define ffeste_f2c_init_(Init) \ do \ { \ ! TREE_CHAIN(initn) = build_tree_list((field = TREE_CHAIN(field)),Init); \ ! initn = TREE_CHAIN(initn); \ } while(0) ! #define ffeste_f2c_flagspec_(Flag,Init) \ ! do { Init = convert (ffecom_f2c_flag_type_node, \ ! Flag ? integer_one_node : integer_zero_node); } \ ! while(0) ! #define ffeste_f2c_intspec_(Spec,Exp,Init) \ do \ { \ ! if (Spec->kw_or_val_present) \ ! Exp = ffecom_expr(Spec->u.expr); \ ! else \ ! Exp = ffecom_integer_zero_node; \ ! if (TREE_CONSTANT(Exp)) \ { \ ! Init = Exp; \ ! Exp = NULL_TREE; \ } \ ! else \ { \ ! Init = ffecom_integer_zero_node; \ ! constantp = FALSE; \ } \ } while(0) ! #define ffeste_f2c_ptrtointspec_(Spec,Exp,Init) \ do \ { \ ! if (Spec->kw_or_val_present) \ ! Exp = ffecom_ptr_to_expr(Spec->u.expr); \ ! else \ ! Exp = null_pointer_node; \ ! if (TREE_CONSTANT(Exp)) \ { \ ! Init = Exp; \ ! Exp = NULL_TREE; \ } \ ! else \ { \ ! Init = null_pointer_node; \ ! constantp = FALSE; \ } \ } while(0) /* Begin an iterative DO loop. Pass the block to start if applicable. --- 180,504 ---- || ffeste_statelet_ == FFESTE_stateletITEM_); \ ffeste_statelet_ = FFESTE_stateletSIMPLE_ ! #define ffeste_f2c_init_charnolen_(Exp,Init,Spec) \ do \ { \ ! if ((Spec)->kw_or_val_present) \ ! Exp = ffecom_arg_ptr_to_const_expr ((Spec)->u.expr, &ignore); \ else \ Exp = null_pointer_node; \ ! if (Exp) \ Init = Exp; \ else \ { \ ! Init = null_pointer_node; \ ! constantp = FALSE; \ } \ } while(0) ! #define ffeste_f2c_init_char_(Exp,Init,Lenexp,Leninit,Spec) \ do \ { \ ! if ((Spec)->kw_or_val_present) \ ! Exp = ffecom_arg_ptr_to_const_expr ((Spec)->u.expr, &Lenexp); \ else \ { \ ! Exp = null_pointer_node; \ ! Lenexp = ffecom_f2c_ftnlen_zero_node; \ } \ ! if (Exp) \ Init = Exp; \ ! else \ ! { \ ! Init = null_pointer_node; \ ! constantp = FALSE; \ } \ + if (Lenexp) \ + Leninit = Lenexp; \ else \ { \ ! Leninit = ffecom_f2c_ftnlen_zero_node; \ ! constantp = FALSE; \ } \ ! } while(0) ! ! #define ffeste_f2c_init_flag_(Flag,Init) \ ! do \ ! { \ ! Init = convert (ffecom_f2c_flag_type_node, \ ! (Flag) ? integer_one_node : integer_zero_node); \ ! } while(0) ! ! #define ffeste_f2c_init_format_(Exp,Init,Spec) \ ! do \ ! { \ ! Exp = ffecom_arg_ptr_to_const_expr ((Spec)->u.expr, NULL); \ ! if (Exp) \ ! Init = Exp; \ ! else \ { \ ! Init = null_pointer_node; \ ! constantp = FALSE; \ } \ + } while(0) + + #define ffeste_f2c_init_int_(Exp,Init,Spec) \ + do \ + { \ + if ((Spec)->kw_or_val_present) \ + Exp = ffecom_const_expr ((Spec)->u.expr); \ + else \ + Exp = ffecom_integer_zero_node; \ + if (Exp) \ + Init = Exp; \ else \ { \ ! Init = ffecom_integer_zero_node; \ ! constantp = FALSE; \ } \ } while(0) ! #define ffeste_f2c_init_ptrtoint_(Exp,Init,Spec) \ do \ { \ ! if ((Spec)->kw_or_val_present) \ ! Exp = ffecom_ptr_to_const_expr ((Spec)->u.expr); \ ! else \ ! Exp = null_pointer_node; \ ! if (Exp) \ ! Init = Exp; \ ! else \ { \ ! Init = null_pointer_node; \ ! constantp = FALSE; \ } \ } while(0) ! #define ffeste_f2c_init_next_(Init) \ do \ { \ ! TREE_CHAIN (initn) = build_tree_list ((field = TREE_CHAIN (field)), \ ! (Init)); \ ! initn = TREE_CHAIN(initn); \ } while(0) ! #define ffeste_f2c_prepare_charnolen_(Spec,Exp) \ ! do \ ! { \ ! if (! (Exp)) \ ! ffecom_prepare_arg_ptr_to_expr ((Spec)->u.expr); \ ! } while(0) ! #define ffeste_f2c_prepare_char_(Spec,Exp) \ do \ { \ ! if (! (Exp)) \ ! ffecom_prepare_arg_ptr_to_expr ((Spec)->u.expr); \ ! } while(0) ! ! #define ffeste_f2c_prepare_format_(Spec,Exp) \ ! do \ ! { \ ! if (! (Exp)) \ ! ffecom_prepare_arg_ptr_to_expr ((Spec)->u.expr); \ ! } while(0) ! ! #define ffeste_f2c_prepare_int_(Spec,Exp) \ ! do \ ! { \ ! if (! (Exp)) \ ! ffecom_prepare_expr ((Spec)->u.expr); \ ! } while(0) ! ! #define ffeste_f2c_prepare_ptrtoint_(Spec,Exp) \ ! do \ ! { \ ! if (! (Exp)) \ ! ffecom_prepare_ptr_to_expr ((Spec)->u.expr); \ ! } while(0) ! ! #define ffeste_f2c_compile_(Field,Exp) \ ! do \ ! { \ ! tree exz; \ ! if ((Exp)) \ { \ ! exz = ffecom_modify (void_type_node, \ ! ffecom_2 (COMPONENT_REF, TREE_TYPE (Field), \ ! t, (Field)), \ ! (Exp)); \ ! expand_expr_stmt (exz); \ } \ ! } while(0) ! ! #define ffeste_f2c_compile_charnolen_(Field,Spec,Exp) \ ! do \ ! { \ ! tree exq; \ ! if (! (Exp)) \ { \ ! exq = ffecom_arg_ptr_to_expr ((Spec)->u.expr, &ignore); \ ! ffeste_f2c_compile_ ((Field), exq); \ } \ } while(0) ! #define ffeste_f2c_compile_char_(Field,Lenfield,Spec,Exp,Lenexp) \ do \ { \ ! tree exq = (Exp); \ ! tree lenexq = (Lenexp); \ ! int need_exq = (! exq); \ ! int need_lenexq = (! lenexq); \ ! if (need_exq || need_lenexq) \ { \ ! exq = ffecom_arg_ptr_to_expr ((Spec)->u.expr, &lenexq); \ ! if (need_exq) \ ! ffeste_f2c_compile_ ((Field), exq); \ ! if (need_lenexq) \ ! ffeste_f2c_compile_ ((Lenfield), lenexq); \ } \ ! } while(0) ! ! #define ffeste_f2c_compile_format_(Field,Spec,Exp) \ ! do \ ! { \ ! tree exq; \ ! if (! (Exp)) \ ! { \ ! exq = ffecom_arg_ptr_to_expr ((Spec)->u.expr, NULL); \ ! ffeste_f2c_compile_ ((Field), exq); \ ! } \ ! } while(0) ! ! #define ffeste_f2c_compile_int_(Field,Spec,Exp) \ ! do \ ! { \ ! tree exq; \ ! if (! (Exp)) \ ! { \ ! exq = ffecom_expr ((Spec)->u.expr); \ ! ffeste_f2c_compile_ ((Field), exq); \ ! } \ ! } while(0) ! ! #define ffeste_f2c_compile_ptrtoint_(Field,Spec,Exp) \ ! do \ ! { \ ! tree exq; \ ! if (! (Exp)) \ { \ ! exq = ffecom_ptr_to_expr ((Spec)->u.expr); \ ! ffeste_f2c_compile_ ((Field), exq); \ } \ } while(0) + /* Start a Fortran block. */ + + #ifdef ENABLE_CHECKING + + typedef struct gbe_block + { + struct gbe_block *outer; + ffestw block; + int lineno; + char *input_filename; + bool is_stmt; + } *gbe_block; + + gbe_block ffeste_top_block_ = NULL; + + static void + ffeste_start_block_ (ffestw block) + { + gbe_block b = xmalloc (sizeof (*b)); + + b->outer = ffeste_top_block_; + b->block = block; + b->lineno = lineno; + b->input_filename = input_filename; + b->is_stmt = FALSE; + + ffeste_top_block_ = b; + + ffecom_start_compstmt (); + } + + /* End a Fortran block. */ + + static void + ffeste_end_block_ (ffestw block) + { + gbe_block b = ffeste_top_block_; + + assert (b); + assert (! b->is_stmt); + assert (b->block == block); + assert (! b->is_stmt); + + ffeste_top_block_ = b->outer; + + free (b); + + clear_momentary (); + + ffecom_end_compstmt (); + } + + /* Start a Fortran statement. + + Starts a back-end block, so temporaries can be managed, clean-ups + properly handled, etc. Nesting of statements *is* allowed -- the + handling of I/O items, even implied-DO I/O lists, within a READ, + PRINT, or WRITE statement is one example. */ + + static void + ffeste_start_stmt_(void) + { + gbe_block b = xmalloc (sizeof (*b)); + + b->outer = ffeste_top_block_; + b->block = NULL; + b->lineno = lineno; + b->input_filename = input_filename; + b->is_stmt = TRUE; + + ffeste_top_block_ = b; + + ffecom_start_compstmt (); + } + + /* End a Fortran statement. */ + + static void + ffeste_end_stmt_(void) + { + gbe_block b = ffeste_top_block_; + + assert (b); + assert (b->is_stmt); + + ffeste_top_block_ = b->outer; + + free (b); + + clear_momentary (); + + ffecom_end_compstmt (); + } + + #else /* ! defined (ENABLE_CHECKING) */ + + #define ffeste_start_block_(b) ffecom_start_compstmt () + #define ffeste_end_block_(b) \ + do \ + { \ + clear_momentary (); \ + ffecom_end_compstmt (); \ + } while(0) + #define ffeste_start_stmt_() ffeste_start_block_(NULL) + #define ffeste_end_stmt_() ffeste_end_block_(NULL) + + #endif /* ! defined (ENABLE_CHECKING) */ /* Begin an iterative DO loop. Pass the block to start if applicable. *************** ffeste_begin_iterdo_ (ffestw block, tree *** 302,308 **** ffebld start, ffelexToken start_token, ffebld end, ffelexToken end_token, ffebld incr, ffelexToken incr_token, ! char *msg) { tree tvar; tree expr; --- 512,518 ---- ffebld start, ffelexToken start_token, ffebld end, ffelexToken end_token, ffebld incr, ffelexToken incr_token, ! const char *msg) { tree tvar; tree expr; *************** ffeste_begin_iterdo_ (ffestw block, tree *** 311,322 **** tree tincr; tree tincr_saved; tree niters; ! push_momentary (); /* Want to save these throughout the loop. */ ! tvar = ffecom_expr_rw (var); tincr = ffecom_expr (incr); /* Check whether incr is known to be zero, complain and fix. */ if (integer_zerop (tincr) || real_zerop (tincr)) --- 521,563 ---- tree tincr; tree tincr_saved; tree niters; + struct nesting *expanded_loop; + + /* Want to have tvar, tincr, and niters for the whole loop body. */ + + if (block) + ffeste_start_block_ (block); + else + ffeste_start_stmt_ (); + + niters = ffecom_make_tempvar (block ? "do" : "impdo", + ffecom_integer_type_node, + FFETARGET_charactersizeNONE, -1); + + ffecom_prepare_expr (incr); + ffecom_prepare_expr_rw (NULL_TREE, var); ! ffecom_prepare_end (); ! tvar = ffecom_expr_rw (NULL_TREE, var); tincr = ffecom_expr (incr); + if (TREE_CODE (tvar) == ERROR_MARK + || TREE_CODE (tincr) == ERROR_MARK) + { + if (block) + { + ffeste_end_block_ (block); + ffestw_set_do_tvar (block, error_mark_node); + } + else + { + ffeste_end_stmt_ (); + *xtvar = error_mark_node; + } + return; + } + /* Check whether incr is known to be zero, complain and fix. */ if (integer_zerop (tincr) || real_zerop (tincr)) *************** ffeste_begin_iterdo_ (ffestw block, tree *** 331,346 **** tincr_saved = ffecom_save_tree (tincr); ! push_momentary (); /* Want to discard the rest after the loop. */ tstart = ffecom_expr (start); tend = ffecom_expr (end); ! { /* For warnings only, nothing else ! happens here. */ tree try; ! if (!ffe_is_onetrip ()) { try = ffecom_2 (MINUS_EXPR, TREE_TYPE (tvar), tend, --- 572,614 ---- tincr_saved = ffecom_save_tree (tincr); ! preserve_momentary (); ! ! /* Want to have tstart, tend for just this statement. */ ! ! ffeste_start_stmt_ (); ! ! ffecom_prepare_expr (start); ! ffecom_prepare_expr (end); ! ! ffecom_prepare_end (); tstart = ffecom_expr (start); tend = ffecom_expr (end); ! if (TREE_CODE (tstart) == ERROR_MARK ! || TREE_CODE (tend) == ERROR_MARK) ! { ! ffeste_end_stmt_ (); ! ! if (block) ! { ! ffeste_end_block_ (block); ! ffestw_set_do_tvar (block, error_mark_node); ! } ! else ! { ! ffeste_end_stmt_ (); ! *xtvar = error_mark_node; ! } ! return; ! } ! ! /* For warnings only, nothing else happens here. */ ! { tree try; ! if (! ffe_is_onetrip ()) { try = ffecom_2 (MINUS_EXPR, TREE_TYPE (tvar), tend, *************** ffeste_begin_iterdo_ (ffestw block, tree *** 402,408 **** tend, tstart); ! if (!ffe_is_onetrip ()) { expr = ffecom_2 (PLUS_EXPR, TREE_TYPE (expr), expr, --- 670,676 ---- tend, tstart); ! if (! ffe_is_onetrip ()) { expr = ffecom_2 (PLUS_EXPR, TREE_TYPE (expr), expr, *************** ffeste_begin_iterdo_ (ffestw block, tree *** 434,454 **** expr = convert (ffecom_integer_type_node, expr); #endif ! niters = ffecom_push_tempvar (TREE_TYPE (expr), ! FFETARGET_charactersizeNONE, -1, FALSE); expr = ffecom_modify (void_type_node, niters, expr); expand_expr_stmt (expr); expr = ffecom_modify (void_type_node, tvar, tstart); expand_expr_stmt (expr); ! if (block == NULL) ! expand_start_loop_continue_elsewhere (0); ! else ! ffestw_set_do_hook (block, ! expand_start_loop_continue_elsewhere (1)); ! if (!ffe_is_onetrip ()) { expr = ffecom_truth_value (ffecom_2 (GE_EXPR, integer_type_node, --- 702,723 ---- expr = convert (ffecom_integer_type_node, expr); #endif ! assert (TYPE_MAIN_VARIANT (TREE_TYPE (niters)) ! == TYPE_MAIN_VARIANT (TREE_TYPE (expr))); ! expr = ffecom_modify (void_type_node, niters, expr); expand_expr_stmt (expr); expr = ffecom_modify (void_type_node, tvar, tstart); expand_expr_stmt (expr); ! ffeste_end_stmt_ (); ! ! expanded_loop = expand_start_loop_continue_elsewhere (!! block); ! if (block) ! ffestw_set_do_hook (block, expanded_loop); ! if (! ffe_is_onetrip ()) { expr = ffecom_truth_value (ffecom_2 (GE_EXPR, integer_type_node, *************** ffeste_begin_iterdo_ (ffestw block, tree *** 463,483 **** expand_exit_loop_if_false (0, expr); } ! clear_momentary (); /* Discard the above now that we're done with ! DO stmt. */ ! ! if (block == NULL) ! { ! *xtvar = tvar; ! *xtincr = tincr_saved; ! *xitersvar = niters; ! } ! else { ffestw_set_do_tvar (block, tvar); ffestw_set_do_incr_saved (block, tincr_saved); ffestw_set_do_count_var (block, niters); } } #endif --- 732,749 ---- expand_exit_loop_if_false (0, expr); } ! if (block) { ffestw_set_do_tvar (block, tvar); ffestw_set_do_incr_saved (block, tincr_saved); ffestw_set_do_count_var (block, niters); } + else + { + *xtvar = tvar; + *xtincr = tincr_saved; + *xitersvar = niters; + } } #endif *************** ffeste_begin_iterdo_ (ffestw block, tree *** 487,499 **** #if FFECOM_targetCURRENT == FFECOM_targetGCC static void ! ffeste_end_iterdo_ (tree tvar, tree tincr, tree itersvar) { tree expr; tree niters = itersvar; expand_loop_continue_here (); if (ffe_is_onetrip ()) { expr = ffecom_truth_value --- 753,770 ---- #if FFECOM_targetCURRENT == FFECOM_targetGCC static void ! ffeste_end_iterdo_ (ffestw block, tree tvar, tree tincr, tree itersvar) { tree expr; tree niters = itersvar; + if (tvar == error_mark_node) + return; + expand_loop_continue_here (); + ffeste_start_stmt_ (); + if (ffe_is_onetrip ()) { expr = ffecom_truth_value *************** ffeste_end_iterdo_ (tree tvar, tree tinc *** 514,540 **** tvar, tincr)); expand_expr_stmt (expr); - expand_end_loop (); ! ffecom_pop_tempvar (itersvar); /* Free #iters var. */ ! clear_momentary (); ! pop_momentary (); /* Lose the stuff we just built. */ ! clear_momentary (); ! pop_momentary (); /* Lose the tvar and incr_saved trees. */ } - #endif - /* ffeste_io_call_ -- Generate call to run-time I/O routine - - tree callexpr = build(CALL_EXPR,...); - ffeste_io_call_(callexpr,TRUE); ! Sets TREE_SIDE_EFFECTS(callexpr) = 1. If ffeste_io_iostat_ is not ! NULL_TREE, replaces callexpr with "iostat = callexpr;". Expands the ! result. If ffeste_io_abort_ is not NULL_TREE and the second argument ! is TRUE, generates "if (iostat != 0) goto ffeste_io_abort_;". */ #if FFECOM_targetCURRENT == FFECOM_targetGCC static void --- 785,805 ---- tvar, tincr)); expand_expr_stmt (expr); ! /* Lose the stuff we just built. */ ! ffeste_end_stmt_ (); ! expand_end_loop (); ! /* Lose the tvar and incr_saved trees. */ ! if (block) ! ffeste_end_block_ (block); ! else ! ffeste_end_stmt_ (); } #endif ! /* Generate call to run-time I/O routine. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC static void *************** ffeste_io_call_ (tree call, bool do_chec *** 544,558 **** TREE_SIDE_EFFECTS (call) = 1; if (ffeste_io_iostat_ != NULL_TREE) ! { ! call = ffecom_modify (do_check ? NULL_TREE : void_type_node, ! ffeste_io_iostat_, call); ! } expand_expr_stmt (call); ! if (!do_check ! || (ffeste_io_abort_ == NULL_TREE) ! || (TREE_CODE (ffeste_io_abort_) == ERROR_MARK)) return; /* Generate optional test. */ --- 809,821 ---- TREE_SIDE_EFFECTS (call) = 1; if (ffeste_io_iostat_ != NULL_TREE) ! call = ffecom_modify (do_check ? NULL_TREE : void_type_node, ! ffeste_io_iostat_, call); expand_expr_stmt (call); ! if (! do_check ! || ffeste_io_abort_ == NULL_TREE ! || TREE_CODE (ffeste_io_abort_) == ERROR_MARK) return; /* Generate optional test. */ *************** ffeste_io_call_ (tree call, bool do_chec *** 561,573 **** expand_goto (ffeste_io_abort_); expand_end_cond (); } #endif - /* ffeste_io_dofio_ -- Generate call to do_fio for formatted I/O item ! ffebld expr; ! tree call; ! call = ffeste_io_dofio_(expr); Returns a tree for a CALL_EXPR to the do_fio function, which handles a formatted I/O list item, along with the appropriate arguments for --- 824,919 ---- expand_goto (ffeste_io_abort_); expand_end_cond (); } + #endif + + /* Handle implied-DO in I/O list. + + Expands code to start up the DO loop. Then for each item in the + DO loop, handles appropriately (possibly including recursively calling + itself). Then expands code to end the DO loop. */ + + #if FFECOM_targetCURRENT == FFECOM_targetGCC + static void + ffeste_io_impdo_ (ffebld impdo, ffelexToken impdo_token) + { + ffebld var = ffebld_head (ffebld_right (impdo)); + ffebld start = ffebld_head (ffebld_trail (ffebld_right (impdo))); + ffebld end = ffebld_head (ffebld_trail (ffebld_trail + (ffebld_right (impdo)))); + ffebld incr = ffebld_head (ffebld_trail (ffebld_trail + (ffebld_trail (ffebld_right (impdo))))); + ffebld list; + ffebld item; + tree tvar; + tree tincr; + tree titervar; + + if (incr == NULL) + { + incr = ffebld_new_conter (ffebld_constant_new_integerdefault_val (1)); + ffebld_set_info (incr, ffeinfo_new + (FFEINFO_basictypeINTEGER, + FFEINFO_kindtypeINTEGERDEFAULT, + 0, + FFEINFO_kindENTITY, + FFEINFO_whereCONSTANT, + FFETARGET_charactersizeNONE)); + } + + /* Start the DO loop. */ + + start = ffeexpr_convert_expr (start, impdo_token, var, impdo_token, + FFEEXPR_contextLET); + end = ffeexpr_convert_expr (end, impdo_token, var, impdo_token, + FFEEXPR_contextLET); + incr = ffeexpr_convert_expr (incr, impdo_token, var, impdo_token, + FFEEXPR_contextLET); + + ffeste_begin_iterdo_ (NULL, &tvar, &tincr, &titervar, var, + start, impdo_token, + end, impdo_token, + incr, impdo_token, + "Implied DO loop"); + + /* Handle the list of items. */ + + for (list = ffebld_left (impdo); list != NULL; list = ffebld_trail (list)) + { + item = ffebld_head (list); + if (item == NULL) + continue; + + /* Strip parens off items such as in "READ *,(A)". This is really a bug + in the user's code, but I've been told lots of code does this. */ + while (ffebld_op (item) == FFEBLD_opPAREN) + item = ffebld_left (item); + if (ffebld_op (item) == FFEBLD_opANY) + continue; + + if (ffebld_op (item) == FFEBLD_opIMPDO) + ffeste_io_impdo_ (item, impdo_token); + else + { + ffeste_start_stmt_ (); + + ffecom_prepare_arg_ptr_to_expr (item); + + ffecom_prepare_end (); + + ffeste_io_call_ ((*ffeste_io_driver_) (item), TRUE); + + ffeste_end_stmt_ (); + } + } + + /* Generate end of implied-do construct. */ + + ffeste_end_iterdo_ (NULL, tvar, tincr, titervar); + } #endif ! /* I/O driver for formatted I/O item (do_fio) Returns a tree for a CALL_EXPR to the do_fio function, which handles a formatted I/O list item, along with the appropriate arguments for *************** ffeste_io_dofio_ (ffebld expr) *** 603,618 **** else is_complex = FALSE; - ffecom_push_calltemps (); - variable = ffecom_arg_ptr_to_expr (expr, &size); if ((variable == error_mark_node) || (size == error_mark_node)) ! { ! ffecom_pop_calltemps (); ! return error_mark_node; ! } if (size == NULL_TREE) /* Already filled in for CHARACTER type. */ { /* "(ftnlen) sizeof(type)" */ --- 949,959 ---- else is_complex = FALSE; variable = ffecom_arg_ptr_to_expr (expr, &size); if ((variable == error_mark_node) || (size == error_mark_node)) ! return error_mark_node; if (size == NULL_TREE) /* Already filled in for CHARACTER type. */ { /* "(ftnlen) sizeof(type)" */ *************** ffeste_io_dofio_ (ffebld expr) *** 629,642 **** size = convert (ffecom_f2c_ftnlen_type_node, size); } ! if ((ffeinfo_rank (ffebld_info (expr)) == 0) ! || (TREE_CODE (TREE_TYPE (TREE_TYPE (variable))) != ARRAY_TYPE)) ! num_elements = is_complex ? ffecom_f2c_ftnlen_two_node ! : ffecom_f2c_ftnlen_one_node; else { num_elements = size_binop (CEIL_DIV_EXPR, ! TYPE_SIZE (TREE_TYPE (TREE_TYPE (variable))), size); num_elements = size_binop (CEIL_DIV_EXPR, num_elements, size_int (TYPE_PRECISION --- 970,984 ---- size = convert (ffecom_f2c_ftnlen_type_node, size); } ! if (ffeinfo_rank (ffebld_info (expr)) == 0 ! || TREE_CODE (TREE_TYPE (TREE_TYPE (variable))) != ARRAY_TYPE) ! num_elements ! = is_complex ? ffecom_f2c_ftnlen_two_node : ffecom_f2c_ftnlen_one_node; else { num_elements = size_binop (CEIL_DIV_EXPR, ! TYPE_SIZE (TREE_TYPE (TREE_TYPE (variable))), ! size); num_elements = size_binop (CEIL_DIV_EXPR, num_elements, size_int (TYPE_PRECISION *************** ffeste_io_dofio_ (ffebld expr) *** 655,671 **** TREE_CHAIN (arglist) = build_tree_list (NULL_TREE, variable); TREE_CHAIN (TREE_CHAIN (arglist)) = build_tree_list (NULL_TREE, size); ! ffecom_pop_calltemps (); ! ! return ffecom_call_gfrt (FFECOM_gfrtDOFIO, arglist); } #endif ! /* ffeste_io_dolio_ -- Generate call to do_lio for list-directed I/O item ! ! ffebld expr; ! tree call; ! call = ffeste_io_dolio_(expr); Returns a tree for a CALL_EXPR to the do_lio function, which handles a list-directed I/O list item, along with the appropriate arguments for --- 997,1007 ---- TREE_CHAIN (arglist) = build_tree_list (NULL_TREE, variable); TREE_CHAIN (TREE_CHAIN (arglist)) = build_tree_list (NULL_TREE, size); ! return ffecom_call_gfrt (FFECOM_gfrtDOFIO, arglist, NULL_TREE); } #endif ! /* I/O driver for list-directed I/O item (do_lio) Returns a tree for a CALL_EXPR to the do_lio function, which handles a list-directed I/O list item, along with the appropriate arguments for *************** ffeste_io_dolio_ (ffebld expr) *** 694,701 **** || (kt == FFEINFO_kindtypeANY)) return error_mark_node; - ffecom_push_calltemps (); - tc = ffecom_f2c_typecode (bt, kt); assert (tc != -1); type_id = build_int_2 (tc, 0); --- 1030,1035 ---- *************** ffeste_io_dolio_ (ffebld expr) *** 710,719 **** if ((type_id == error_mark_node) || (variable == error_mark_node) || (size == error_mark_node)) ! { ! ffecom_pop_calltemps (); ! return error_mark_node; ! } if (size == NULL_TREE) /* Already filled in for CHARACTER type. */ { /* "(ftnlen) sizeof(type)" */ --- 1044,1050 ---- if ((type_id == error_mark_node) || (variable == error_mark_node) || (size == error_mark_node)) ! return error_mark_node; if (size == NULL_TREE) /* Already filled in for CHARACTER type. */ { /* "(ftnlen) sizeof(type)" */ *************** ffeste_io_dolio_ (ffebld expr) *** 730,742 **** size = convert (ffecom_f2c_ftnlen_type_node, size); } ! if ((ffeinfo_rank (ffebld_info (expr)) == 0) ! || (TREE_CODE (TREE_TYPE (TREE_TYPE (variable))) != ARRAY_TYPE)) num_elements = ffecom_integer_one_node; else { num_elements = size_binop (CEIL_DIV_EXPR, ! TYPE_SIZE (TREE_TYPE (TREE_TYPE (variable))), size); num_elements = size_binop (CEIL_DIV_EXPR, num_elements, size_int (TYPE_PRECISION --- 1061,1074 ---- size = convert (ffecom_f2c_ftnlen_type_node, size); } ! if (ffeinfo_rank (ffebld_info (expr)) == 0 ! || TREE_CODE (TREE_TYPE (TREE_TYPE (variable))) != ARRAY_TYPE) num_elements = ffecom_integer_one_node; else { num_elements = size_binop (CEIL_DIV_EXPR, ! TYPE_SIZE (TREE_TYPE (TREE_TYPE (variable))), ! size); num_elements = size_binop (CEIL_DIV_EXPR, num_elements, size_int (TYPE_PRECISION *************** ffeste_io_dolio_ (ffebld expr) *** 757,773 **** TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (arglist))) = build_tree_list (NULL_TREE, size); ! ffecom_pop_calltemps (); ! ! return ffecom_call_gfrt (FFECOM_gfrtDOLIO, arglist); } #endif ! /* ffeste_io_douio_ -- Generate call to do_uio for unformatted I/O item ! ! ffebld expr; ! tree call; ! call = ffeste_io_douio_(expr); Returns a tree for a CALL_EXPR to the do_uio function, which handles an unformatted I/O list item, along with the appropriate arguments for --- 1089,1099 ---- TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (arglist))) = build_tree_list (NULL_TREE, size); ! return ffecom_call_gfrt (FFECOM_gfrtDOLIO, arglist, NULL_TREE); } #endif ! /* I/O driver for unformatted I/O item (do_uio) Returns a tree for a CALL_EXPR to the do_uio function, which handles an unformatted I/O list item, along with the appropriate arguments for *************** ffeste_io_douio_ (ffebld expr) *** 803,818 **** else is_complex = FALSE; - ffecom_push_calltemps (); - variable = ffecom_arg_ptr_to_expr (expr, &size); if ((variable == error_mark_node) || (size == error_mark_node)) ! { ! ffecom_pop_calltemps (); ! return error_mark_node; ! } if (size == NULL_TREE) /* Already filled in for CHARACTER type. */ { /* "(ftnlen) sizeof(type)" */ --- 1129,1139 ---- else is_complex = FALSE; variable = ffecom_arg_ptr_to_expr (expr, &size); if ((variable == error_mark_node) || (size == error_mark_node)) ! return error_mark_node; if (size == NULL_TREE) /* Already filled in for CHARACTER type. */ { /* "(ftnlen) sizeof(type)" */ *************** ffeste_io_douio_ (ffebld expr) *** 829,842 **** size = convert (ffecom_f2c_ftnlen_type_node, size); } ! if ((ffeinfo_rank (ffebld_info (expr)) == 0) ! || (TREE_CODE (TREE_TYPE (TREE_TYPE (variable))) != ARRAY_TYPE)) ! num_elements = is_complex ? ffecom_f2c_ftnlen_two_node ! : ffecom_f2c_ftnlen_one_node; else { num_elements = size_binop (CEIL_DIV_EXPR, ! TYPE_SIZE (TREE_TYPE (TREE_TYPE (variable))), size); num_elements = size_binop (CEIL_DIV_EXPR, num_elements, size_int (TYPE_PRECISION (char_type_node))); --- 1150,1164 ---- size = convert (ffecom_f2c_ftnlen_type_node, size); } ! if (ffeinfo_rank (ffebld_info (expr)) == 0 ! || TREE_CODE (TREE_TYPE (TREE_TYPE (variable))) != ARRAY_TYPE) ! num_elements ! = is_complex ? ffecom_f2c_ftnlen_two_node : ffecom_f2c_ftnlen_one_node; else { num_elements = size_binop (CEIL_DIV_EXPR, ! TYPE_SIZE (TREE_TYPE (TREE_TYPE (variable))), ! size); num_elements = size_binop (CEIL_DIV_EXPR, num_elements, size_int (TYPE_PRECISION (char_type_node))); *************** ffeste_io_douio_ (ffebld expr) *** 854,874 **** TREE_CHAIN (arglist) = build_tree_list (NULL_TREE, variable); TREE_CHAIN (TREE_CHAIN (arglist)) = build_tree_list (NULL_TREE, size); ! ffecom_pop_calltemps (); ! ! return ffecom_call_gfrt (FFECOM_gfrtDOUIO, arglist); } #endif ! /* ffeste_io_ialist_ -- Make arglist with ptr to B/E/R control list ! ! tree arglist; ! arglist = ffeste_io_ialist_(...); Returns a tree suitable as an argument list containing a pointer to a BACKSPACE/ENDFILE/REWIND control list. First, generates that control list, if necessary, along with any static and run-time initializations ! that are needed as specified by the arguments to this function. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC static tree --- 1176,1199 ---- TREE_CHAIN (arglist) = build_tree_list (NULL_TREE, variable); TREE_CHAIN (TREE_CHAIN (arglist)) = build_tree_list (NULL_TREE, size); ! return ffecom_call_gfrt (FFECOM_gfrtDOUIO, arglist, NULL_TREE); } #endif ! /* Make arglist with ptr to BACKSPACE/ENDFILE/REWIND control list. Returns a tree suitable as an argument list containing a pointer to a BACKSPACE/ENDFILE/REWIND control list. First, generates that control list, if necessary, along with any static and run-time initializations ! that are needed as specified by the arguments to this function. ! ! Must ensure that all expressions are prepared before being evaluated, ! for any whose evaluation might result in the generation of temporaries. ! ! Note that this means this function causes a transition, within the ! current block being code-generated via the back end, from the ! declaration of variables (temporaries) to the expanding of expressions, ! statements, etc. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC static tree *************** ffeste_io_ialist_ (bool have_err, *** 912,934 **** f2c_alist_struct = ref; } ! ffeste_f2c_flagspec_ (have_err, errinit); switch (unit) { case FFESTV_unitNONE: case FFESTV_unitASTERISK: unitinit = build_int_2 (unit_dflt, 0); ! unitexp = NULL_TREE; break; case FFESTV_unitINTEXPR: ! unitexp = ffecom_expr (unit_expr); ! if (TREE_CONSTANT (unitexp)) ! { ! unitinit = unitexp; ! unitexp = NULL_TREE; ! } else { unitinit = ffecom_integer_zero_node; --- 1237,1259 ---- f2c_alist_struct = ref; } ! /* Try to do as much compile-time initialization of the structure ! as possible, to save run time. */ ! ! ffeste_f2c_init_flag_ (have_err, errinit); switch (unit) { case FFESTV_unitNONE: case FFESTV_unitASTERISK: unitinit = build_int_2 (unit_dflt, 0); ! unitexp = unitinit; break; case FFESTV_unitINTEXPR: ! unitexp = ffecom_const_expr (unit_expr); ! if (unitexp) ! unitinit = unitexp; else { unitinit = ffecom_integer_zero_node; *************** ffeste_io_ialist_ (bool have_err, *** 938,951 **** default: assert ("bad unit spec" == NULL); - unitexp = NULL_TREE; unitinit = ffecom_integer_zero_node; break; } inits = build_tree_list ((field = TYPE_FIELDS (f2c_alist_struct)), errinit); initn = inits; ! ffeste_f2c_init_ (unitinit); inits = build (CONSTRUCTOR, f2c_alist_struct, NULL_TREE, inits); TREE_CONSTANT (inits) = constantp ? 1 : 0; --- 1263,1276 ---- default: assert ("bad unit spec" == NULL); unitinit = ffecom_integer_zero_node; + unitexp = unitinit; break; } inits = build_tree_list ((field = TYPE_FIELDS (f2c_alist_struct)), errinit); initn = inits; ! ffeste_f2c_init_next_ (unitinit); inits = build (CONSTRUCTOR, f2c_alist_struct, NULL_TREE, inits); TREE_CONSTANT (inits) = constantp ? 1 : 0; *************** ffeste_io_ialist_ (bool have_err, *** 963,969 **** resume_momentary (yes); ! ffeste_f2c_exp_ (unitfield, unitexp); ttype = build_pointer_type (TREE_TYPE (t)); t = ffecom_1 (ADDR_EXPR, ttype, t); --- 1288,1307 ---- resume_momentary (yes); ! /* Prepare run-time expressions. */ ! ! if (! unitexp) ! ffecom_prepare_expr (unit_expr); ! ! ffecom_prepare_end (); ! ! /* Now evaluate run-time expressions as needed. */ ! ! if (! unitexp) ! { ! unitexp = ffecom_expr (unit_expr); ! ffeste_f2c_compile_ (unitfield, unitexp); ! } ttype = build_pointer_type (TREE_TYPE (t)); t = ffecom_1 (ADDR_EXPR, ttype, t); *************** ffeste_io_ialist_ (bool have_err, *** 974,988 **** } #endif ! /* ffeste_io_cilist_ -- Make arglist with ptr to external I/O control list ! ! tree arglist; ! arglist = ffeste_io_cilist_(...); Returns a tree suitable as an argument list containing a pointer to ! an external-file I/O control list. First, generates that control list, if necessary, along with any static and run-time initializations ! that are needed as specified by the arguments to this function. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC static tree --- 1312,1331 ---- } #endif ! /* Make arglist with ptr to external-I/O control list. Returns a tree suitable as an argument list containing a pointer to ! an external-I/O control list. First, generates that control list, if necessary, along with any static and run-time initializations ! that are needed as specified by the arguments to this function. ! ! Must ensure that all expressions are prepared before being evaluated, ! for any whose evaluation might result in the generation of temporaries. ! ! Note that this means this function causes a transition, within the ! current block being code-generated via the back end, from the ! declaration of variables (temporaries) to the expanding of expressions, ! statements, etc. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC static tree *************** ffeste_io_cilist_ (bool have_err, *** 1037,1059 **** f2c_cilist_struct = ref; } ! ffeste_f2c_flagspec_ (have_err, errinit); switch (unit) { case FFESTV_unitNONE: case FFESTV_unitASTERISK: unitinit = build_int_2 (unit_dflt, 0); ! unitexp = NULL_TREE; break; case FFESTV_unitINTEXPR: ! unitexp = ffecom_expr (unit_expr); ! if (TREE_CONSTANT (unitexp)) ! { ! unitinit = unitexp; ! unitexp = NULL_TREE; ! } else { unitinit = ffecom_integer_zero_node; --- 1380,1402 ---- f2c_cilist_struct = ref; } ! /* Try to do as much compile-time initialization of the structure ! as possible, to save run time. */ ! ! ffeste_f2c_init_flag_ (have_err, errinit); switch (unit) { case FFESTV_unitNONE: case FFESTV_unitASTERISK: unitinit = build_int_2 (unit_dflt, 0); ! unitexp = unitinit; break; case FFESTV_unitINTEXPR: ! unitexp = ffecom_const_expr (unit_expr); ! if (unitexp) ! unitinit = unitexp; else { unitinit = ffecom_integer_zero_node; *************** ffeste_io_cilist_ (bool have_err, *** 1063,1070 **** default: assert ("bad unit spec" == NULL); - unitexp = NULL_TREE; unitinit = ffecom_integer_zero_node; break; } --- 1406,1413 ---- default: assert ("bad unit spec" == NULL); unitinit = ffecom_integer_zero_node; + unitexp = unitinit; break; } *************** ffeste_io_cilist_ (bool have_err, *** 1072,1082 **** { case FFESTV_formatNONE: formatinit = null_pointer_node; ! formatexp = NULL_TREE; break; case FFESTV_formatLABEL: ! formatexp = NULL_TREE; formatinit = ffecom_lookup_label (format_spec->u.label); if ((formatinit == NULL_TREE) || (TREE_CODE (formatinit) == ERROR_MARK)) --- 1415,1425 ---- { case FFESTV_formatNONE: formatinit = null_pointer_node; ! formatexp = formatinit; break; case FFESTV_formatLABEL: ! formatexp = error_mark_node; formatinit = ffecom_lookup_label (format_spec->u.label); if ((formatinit == NULL_TREE) || (TREE_CODE (formatinit) == ERROR_MARK)) *************** ffeste_io_cilist_ (bool have_err, *** 1088,1099 **** break; case FFESTV_formatCHAREXPR: ! formatexp = ffecom_arg_ptr_to_expr (format_spec->u.expr, NULL); ! if (TREE_CONSTANT (formatexp)) ! { ! formatinit = formatexp; ! formatexp = NULL_TREE; ! } else { formatinit = null_pointer_node; --- 1431,1439 ---- break; case FFESTV_formatCHAREXPR: ! formatexp = ffecom_arg_ptr_to_const_expr (format_spec->u.expr, NULL); ! if (formatexp) ! formatinit = formatexp; else { formatinit = null_pointer_node; *************** ffeste_io_cilist_ (bool have_err, *** 1103,1109 **** case FFESTV_formatASTERISK: formatinit = null_pointer_node; ! formatexp = NULL_TREE; break; case FFESTV_formatINTEXPR: --- 1443,1449 ---- case FFESTV_formatASTERISK: formatinit = null_pointer_node; ! formatexp = formatinit; break; case FFESTV_formatINTEXPR: *************** ffeste_io_cilist_ (bool have_err, *** 1117,1143 **** case FFESTV_formatNAMELIST: formatinit = ffecom_expr (format_spec->u.expr); ! formatexp = NULL_TREE; break; default: assert ("bad format spec" == NULL); - formatexp = NULL_TREE; formatinit = integer_zero_node; break; } ! ffeste_f2c_flagspec_ (have_end, endinit); if (rec) ! recexp = ffecom_expr (rec_expr); else recexp = ffecom_integer_zero_node; ! if (TREE_CONSTANT (recexp)) ! { ! recinit = recexp; ! recexp = NULL_TREE; ! } else { recinit = ffecom_integer_zero_node; --- 1457,1480 ---- case FFESTV_formatNAMELIST: formatinit = ffecom_expr (format_spec->u.expr); ! formatexp = formatinit; break; default: assert ("bad format spec" == NULL); formatinit = integer_zero_node; + formatexp = formatinit; break; } ! ffeste_f2c_init_flag_ (have_end, endinit); if (rec) ! recexp = ffecom_const_expr (rec_expr); else recexp = ffecom_integer_zero_node; ! if (recexp) ! recinit = recexp; else { recinit = ffecom_integer_zero_node; *************** ffeste_io_cilist_ (bool have_err, *** 1146,1155 **** inits = build_tree_list ((field = TYPE_FIELDS (f2c_cilist_struct)), errinit); initn = inits; ! ffeste_f2c_init_ (unitinit); ! ffeste_f2c_init_ (endinit); ! ffeste_f2c_init_ (formatinit); ! ffeste_f2c_init_ (recinit); inits = build (CONSTRUCTOR, f2c_cilist_struct, NULL_TREE, inits); TREE_CONSTANT (inits) = constantp ? 1 : 0; --- 1483,1492 ---- inits = build_tree_list ((field = TYPE_FIELDS (f2c_cilist_struct)), errinit); initn = inits; ! ffeste_f2c_init_next_ (unitinit); ! ffeste_f2c_init_next_ (endinit); ! ffeste_f2c_init_next_ (formatinit); ! ffeste_f2c_init_next_ (recinit); inits = build (CONSTRUCTOR, f2c_cilist_struct, NULL_TREE, inits); TREE_CONSTANT (inits) = constantp ? 1 : 0; *************** ffeste_io_cilist_ (bool have_err, *** 1167,1175 **** resume_momentary (yes); ! ffeste_f2c_exp_ (unitfield, unitexp); ! ffeste_f2c_exp_ (formatfield, formatexp); ! ffeste_f2c_exp_ (recfield, recexp); ttype = build_pointer_type (TREE_TYPE (t)); t = ffecom_1 (ADDR_EXPR, ttype, t); --- 1504,1543 ---- resume_momentary (yes); ! /* Prepare run-time expressions. */ ! ! if (! unitexp) ! ffecom_prepare_expr (unit_expr); ! ! if (! formatexp) ! ffecom_prepare_arg_ptr_to_expr (format_spec->u.expr); ! ! if (! recexp) ! ffecom_prepare_expr (rec_expr); ! ! ffecom_prepare_end (); ! ! /* Now evaluate run-time expressions as needed. */ ! ! if (! unitexp) ! { ! unitexp = ffecom_expr (unit_expr); ! ffeste_f2c_compile_ (unitfield, unitexp); ! } ! ! if (! formatexp) ! { ! formatexp = ffecom_arg_ptr_to_expr (format_spec->u.expr, NULL); ! ffeste_f2c_compile_ (formatfield, formatexp); ! } ! else if (format == FFESTV_formatINTEXPR) ! ffeste_f2c_compile_ (formatfield, formatexp); ! ! if (! recexp) ! { ! recexp = ffecom_expr (rec_expr); ! ffeste_f2c_compile_ (recfield, recexp); ! } ttype = build_pointer_type (TREE_TYPE (t)); t = ffecom_1 (ADDR_EXPR, ttype, t); *************** ffeste_io_cilist_ (bool have_err, *** 1180,1194 **** } #endif ! /* ffeste_io_cllist_ -- Make arglist with ptr to CLOSE control list ! ! tree arglist; ! arglist = ffeste_io_cllist_(...); Returns a tree suitable as an argument list containing a pointer to a CLOSE-statement control list. First, generates that control list, if necessary, along with any static and run-time initializations ! that are needed as specified by the arguments to this function. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC static tree --- 1548,1567 ---- } #endif ! /* Make arglist with ptr to CLOSE control list. Returns a tree suitable as an argument list containing a pointer to a CLOSE-statement control list. First, generates that control list, if necessary, along with any static and run-time initializations ! that are needed as specified by the arguments to this function. ! ! Must ensure that all expressions are prepared before being evaluated, ! for any whose evaluation might result in the generation of temporaries. ! ! Note that this means this function causes a transition, within the ! current block being code-generated via the back end, from the ! declaration of variables (temporaries) to the expanding of expressions, ! statements, etc. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC static tree *************** ffeste_io_cllist_ (bool have_err, *** 1234,1259 **** f2c_close_struct = ref; } ! ffeste_f2c_flagspec_ (have_err, errinit); ! unitexp = ffecom_expr (unit_expr); ! if (TREE_CONSTANT (unitexp)) ! { ! unitinit = unitexp; ! unitexp = NULL_TREE; ! } else { unitinit = ffecom_integer_zero_node; constantp = FALSE; } ! ffeste_f2c_charnolenspec_ (stat_spec, statexp, statinit); inits = build_tree_list ((field = TYPE_FIELDS (f2c_close_struct)), errinit); initn = inits; ! ffeste_f2c_init_ (unitinit); ! ffeste_f2c_init_ (statinit); inits = build (CONSTRUCTOR, f2c_close_struct, NULL_TREE, inits); TREE_CONSTANT (inits) = constantp ? 1 : 0; --- 1607,1632 ---- f2c_close_struct = ref; } ! /* Try to do as much compile-time initialization of the structure ! as possible, to save run time. */ ! ! ffeste_f2c_init_flag_ (have_err, errinit); ! unitexp = ffecom_const_expr (unit_expr); ! if (unitexp) ! unitinit = unitexp; else { unitinit = ffecom_integer_zero_node; constantp = FALSE; } ! ffeste_f2c_init_charnolen_ (statexp, statinit, stat_spec); inits = build_tree_list ((field = TYPE_FIELDS (f2c_close_struct)), errinit); initn = inits; ! ffeste_f2c_init_next_ (unitinit); ! ffeste_f2c_init_next_ (statinit); inits = build (CONSTRUCTOR, f2c_close_struct, NULL_TREE, inits); TREE_CONSTANT (inits) = constantp ? 1 : 0; *************** ffeste_io_cllist_ (bool have_err, *** 1271,1278 **** resume_momentary (yes); ! ffeste_f2c_exp_ (unitfield, unitexp); ! ffeste_f2c_exp_ (statfield, statexp); ttype = build_pointer_type (TREE_TYPE (t)); t = ffecom_1 (ADDR_EXPR, ttype, t); --- 1644,1668 ---- resume_momentary (yes); ! /* Prepare run-time expressions. */ ! ! if (! unitexp) ! ffecom_prepare_expr (unit_expr); ! ! if (! statexp) ! ffecom_prepare_arg_ptr_to_expr (stat_spec->u.expr); ! ! ffecom_prepare_end (); ! ! /* Now evaluate run-time expressions as needed. */ ! ! if (! unitexp) ! { ! unitexp = ffecom_expr (unit_expr); ! ffeste_f2c_compile_ (unitfield, unitexp); ! } ! ! ffeste_f2c_compile_charnolen_ (statfield, stat_spec, statexp); ttype = build_pointer_type (TREE_TYPE (t)); t = ffecom_1 (ADDR_EXPR, ttype, t); *************** ffeste_io_cllist_ (bool have_err, *** 1283,1297 **** } #endif ! /* ffeste_io_icilist_ -- Make arglist with ptr to internal I/O control list ! ! tree arglist; ! arglist = ffeste_io_icilist_(...); Returns a tree suitable as an argument list containing a pointer to ! an internal-file I/O control list. First, generates that control list, if necessary, along with any static and run-time initializations ! that are needed as specified by the arguments to this function. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC static tree --- 1673,1692 ---- } #endif ! /* Make arglist with ptr to internal-I/O control list. Returns a tree suitable as an argument list containing a pointer to ! an internal-I/O control list. First, generates that control list, if necessary, along with any static and run-time initializations ! that are needed as specified by the arguments to this function. ! ! Must ensure that all expressions are prepared before being evaluated, ! for any whose evaluation might result in the generation of temporaries. ! ! Note that this means this function causes a transition, within the ! current block being code-generated via the back end, from the ! declaration of variables (temporaries) to the expanding of expressions, ! statements, etc. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC static tree *************** ffeste_io_icilist_ (bool have_err, *** 1345,1392 **** f2c_icilist_struct = ref; } ! ffeste_f2c_flagspec_ (have_err, errinit); ! unitexp = ffecom_arg_ptr_to_expr (unit_expr, &unitlenexp); ! if ((ffeinfo_rank (ffebld_info (unit_expr)) == 0) ! || (TREE_CODE (TREE_TYPE (TREE_TYPE (unitexp))) != ARRAY_TYPE)) ! unitnumexp = ffecom_integer_one_node; ! else ! { ! unitnumexp = size_binop (CEIL_DIV_EXPR, ! TYPE_SIZE (TREE_TYPE (TREE_TYPE (unitexp))), unitlenexp); ! unitnumexp = size_binop (CEIL_DIV_EXPR, ! unitnumexp, size_int (TYPE_PRECISION ! (char_type_node))); ! } ! if (TREE_CONSTANT (unitexp)) ! { ! unitinit = unitexp; ! unitexp = NULL_TREE; ! } else { unitinit = null_pointer_node; constantp = FALSE; } ! if ((unitlenexp != NULL_TREE) && TREE_CONSTANT (unitlenexp)) ! { ! unitleninit = unitlenexp; ! unitlenexp = NULL_TREE; ! } else { unitleninit = ffecom_integer_zero_node; constantp = FALSE; } ! if (TREE_CONSTANT (unitnumexp)) ! { ! unitnuminit = unitnumexp; ! unitnumexp = NULL_TREE; } else { unitnuminit = ffecom_integer_zero_node; constantp = FALSE; } --- 1740,1793 ---- f2c_icilist_struct = ref; } ! /* Try to do as much compile-time initialization of the structure ! as possible, to save run time. */ ! ffeste_f2c_init_flag_ (have_err, errinit); ! ! unitexp = ffecom_arg_ptr_to_const_expr (unit_expr, &unitlenexp); ! if (unitexp) ! unitinit = unitexp; else { unitinit = null_pointer_node; constantp = FALSE; } ! if (unitlenexp) ! unitleninit = unitlenexp; else { unitleninit = ffecom_integer_zero_node; constantp = FALSE; } ! ! /* Now see if we can fully initialize the number of elements, or ! if we have to compute that at run time. */ ! if (ffeinfo_rank (ffebld_info (unit_expr)) == 0 ! || (unitexp ! && TREE_CODE (TREE_TYPE (TREE_TYPE (unitexp))) != ARRAY_TYPE)) ! { ! /* Not an array, so just one element. */ ! unitnuminit = ffecom_integer_one_node; ! unitnumexp = unitnuminit; ! } ! else if (unitexp && unitlenexp) ! { ! /* An array, but all the info is constant, so compute now. */ ! unitnuminit = size_binop (CEIL_DIV_EXPR, ! TYPE_SIZE (TREE_TYPE (TREE_TYPE (unitexp))), ! unitlenexp); ! unitnuminit = size_binop (CEIL_DIV_EXPR, ! unitnuminit, ! size_int (TYPE_PRECISION ! (char_type_node))); ! unitnumexp = unitnuminit; } else { + /* Put off computing until run time. */ unitnuminit = ffecom_integer_zero_node; + unitnumexp = NULL_TREE; constantp = FALSE; } *************** ffeste_io_icilist_ (bool have_err, *** 1394,1404 **** { case FFESTV_formatNONE: formatinit = null_pointer_node; ! formatexp = NULL_TREE; break; case FFESTV_formatLABEL: ! formatexp = NULL_TREE; formatinit = ffecom_lookup_label (format_spec->u.label); if ((formatinit == NULL_TREE) || (TREE_CODE (formatinit) == ERROR_MARK)) --- 1795,1805 ---- { case FFESTV_formatNONE: formatinit = null_pointer_node; ! formatexp = formatinit; break; case FFESTV_formatLABEL: ! formatexp = error_mark_node; formatinit = ffecom_lookup_label (format_spec->u.label); if ((formatinit == NULL_TREE) || (TREE_CODE (formatinit) == ERROR_MARK)) *************** ffeste_io_icilist_ (bool have_err, *** 1410,1431 **** break; case FFESTV_formatCHAREXPR: ! formatexp = ffecom_arg_ptr_to_expr (format_spec->u.expr, NULL); ! if (TREE_CONSTANT (formatexp)) ! { ! formatinit = formatexp; ! formatexp = NULL_TREE; ! } ! else ! { ! formatinit = null_pointer_node; ! constantp = FALSE; ! } break; case FFESTV_formatASTERISK: formatinit = null_pointer_node; ! formatexp = NULL_TREE; break; case FFESTV_formatINTEXPR: --- 1811,1822 ---- break; case FFESTV_formatCHAREXPR: ! ffeste_f2c_init_format_ (formatexp, formatinit, format_spec); break; case FFESTV_formatASTERISK: formatinit = null_pointer_node; ! formatexp = formatinit; break; case FFESTV_formatINTEXPR: *************** ffeste_io_icilist_ (bool have_err, *** 1439,1459 **** default: assert ("bad format spec" == NULL); - formatexp = NULL_TREE; formatinit = ffecom_integer_zero_node; break; } ! ffeste_f2c_flagspec_ (have_end, endinit); inits = build_tree_list ((field = TYPE_FIELDS (f2c_icilist_struct)), errinit); initn = inits; ! ffeste_f2c_init_ (unitinit); ! ffeste_f2c_init_ (endinit); ! ffeste_f2c_init_ (formatinit); ! ffeste_f2c_init_ (unitleninit); ! ffeste_f2c_init_ (unitnuminit); inits = build (CONSTRUCTOR, f2c_icilist_struct, NULL_TREE, inits); TREE_CONSTANT (inits) = constantp ? 1 : 0; --- 1830,1850 ---- default: assert ("bad format spec" == NULL); formatinit = ffecom_integer_zero_node; + formatexp = formatinit; break; } ! ffeste_f2c_init_flag_ (have_end, endinit); inits = build_tree_list ((field = TYPE_FIELDS (f2c_icilist_struct)), errinit); initn = inits; ! ffeste_f2c_init_next_ (unitinit); ! ffeste_f2c_init_next_ (endinit); ! ffeste_f2c_init_next_ (formatinit); ! ffeste_f2c_init_next_ (unitleninit); ! ffeste_f2c_init_next_ (unitnuminit); inits = build (CONSTRUCTOR, f2c_icilist_struct, NULL_TREE, inits); TREE_CONSTANT (inits) = constantp ? 1 : 0; *************** ffeste_io_icilist_ (bool have_err, *** 1471,1576 **** resume_momentary (yes); ! ffeste_f2c_exp_ (unitfield, unitexp); ! ffeste_f2c_exp_ (formatfield, formatexp); ! ffeste_f2c_exp_ (unitlenfield, unitlenexp); ! ffeste_f2c_exp_ (unitnumfield, unitnumexp); ! ! ttype = build_pointer_type (TREE_TYPE (t)); ! t = ffecom_1 (ADDR_EXPR, ttype, t); ! ! t = build_tree_list (NULL_TREE, t); ! ! return t; ! } ! #endif ! /* ffeste_io_impdo_ -- Handle implied-DO in I/O list ! ffebld expr; ! ffeste_io_impdo_(expr); ! Expands code to start up the DO loop. Then for each item in the ! DO loop, handles appropriately (possibly including recursively calling ! itself). Then expands code to end the DO loop. */ ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static void ! ffeste_io_impdo_ (ffebld impdo, ffelexToken impdo_token) ! { ! ffebld var = ffebld_head (ffebld_right (impdo)); ! ffebld start = ffebld_head (ffebld_trail (ffebld_right (impdo))); ! ffebld end = ffebld_head (ffebld_trail (ffebld_trail ! (ffebld_right (impdo)))); ! ffebld incr = ffebld_head (ffebld_trail (ffebld_trail ! (ffebld_trail (ffebld_right (impdo))))); ! ffebld list; /* Used for list of items in left part of ! impdo. */ ! ffebld item; /* I/O item from head of given list. */ ! tree tvar; ! tree tincr; ! tree titervar; ! if (incr == NULL) { ! incr = ffebld_new_conter (ffebld_constant_new_integerdefault_val (1)); ! ffebld_set_info (incr, ffeinfo_new ! (FFEINFO_basictypeINTEGER, ! FFEINFO_kindtypeINTEGERDEFAULT, ! 0, ! FFEINFO_kindENTITY, ! FFEINFO_whereCONSTANT, ! FFETARGET_charactersizeNONE)); } ! /* Start the DO loop. */ ! ! start = ffeexpr_convert_expr (start, impdo_token, var, impdo_token, ! FFEEXPR_contextLET); ! end = ffeexpr_convert_expr (end, impdo_token, var, impdo_token, ! FFEEXPR_contextLET); ! incr = ffeexpr_convert_expr (incr, impdo_token, var, impdo_token, ! FFEEXPR_contextLET); ! ! ffeste_begin_iterdo_ (NULL, &tvar, &tincr, &titervar, var, ! start, impdo_token, ! end, impdo_token, ! incr, impdo_token, ! "Implied DO loop"); ! ! /* Handle the list of items. */ ! ! for (list = ffebld_left (impdo); list != NULL; list = ffebld_trail (list)) { ! item = ffebld_head (list); ! if (item == NULL) ! continue; ! while (ffebld_op (item) == FFEBLD_opPAREN) ! item = ffebld_left (item); ! if (ffebld_op (item) == FFEBLD_opANY) ! continue; ! if (ffebld_op (item) == FFEBLD_opIMPDO) ! ffeste_io_impdo_ (item, impdo_token); ! else ! ffeste_io_call_ ((*ffeste_io_driver_) (item), TRUE); ! clear_momentary (); } ! /* Generate end of implied-do construct. */ ! ffeste_end_iterdo_ (tvar, tincr, titervar); ! } #endif - /* ffeste_io_inlist_ -- Make arglist with ptr to INQUIRE control list ! tree arglist; ! arglist = ffeste_io_inlist_(...); Returns a tree suitable as an argument list containing a pointer to an INQUIRE-statement control list. First, generates that control list, if necessary, along with any static and run-time initializations ! that are needed as specified by the arguments to this function. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC static tree --- 1862,1932 ---- resume_momentary (yes); ! /* Prepare run-time expressions. */ ! if (! unitexp) ! ffecom_prepare_arg_ptr_to_expr (unit_expr); ! ffeste_f2c_prepare_format_ (format_spec, formatexp); ! ffecom_prepare_end (); ! /* Now evaluate run-time expressions as needed. */ ! if (! unitexp || ! unitlenexp) { ! int need_unitexp = (! unitexp); ! int need_unitlenexp = (! unitlenexp); ! ! unitexp = ffecom_arg_ptr_to_expr (unit_expr, &unitlenexp); ! if (need_unitexp) ! ffeste_f2c_compile_ (unitfield, unitexp); ! if (need_unitlenexp) ! ffeste_f2c_compile_ (unitlenfield, unitlenexp); } ! if (! unitnumexp ! && unitexp != error_mark_node ! && unitlenexp != error_mark_node) { ! unitnumexp = size_binop (CEIL_DIV_EXPR, ! TYPE_SIZE (TREE_TYPE (TREE_TYPE (unitexp))), ! unitlenexp); ! unitnumexp = size_binop (CEIL_DIV_EXPR, ! unitnumexp, ! size_int (TYPE_PRECISION ! (char_type_node))); ! ffeste_f2c_compile_ (unitnumfield, unitnumexp); } ! if (format == FFESTV_formatINTEXPR) ! ffeste_f2c_compile_ (formatfield, formatexp); ! else ! ffeste_f2c_compile_format_ (formatfield, format_spec, formatexp); ! ttype = build_pointer_type (TREE_TYPE (t)); ! t = ffecom_1 (ADDR_EXPR, ttype, t); ! ! t = build_tree_list (NULL_TREE, t); + return t; + } #endif ! /* Make arglist with ptr to INQUIRE control list Returns a tree suitable as an argument list containing a pointer to an INQUIRE-statement control list. First, generates that control list, if necessary, along with any static and run-time initializations ! that are needed as specified by the arguments to this function. ! ! Must ensure that all expressions are prepared before being evaluated, ! for any whose evaluation might result in the generation of temporaries. ! ! Note that this means this function causes a transition, within the ! current block being code-generated via the back end, from the ! declaration of variables (temporaries) to the expanding of expressions, ! statements, etc. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC static tree *************** ffeste_io_inlist_ (bool have_err, *** 1691,1748 **** f2c_inquire_struct = ref; } ! ffeste_f2c_flagspec_ (have_err, errinit); ! ffeste_f2c_intspec_ (unit_spec, unitexp, unitinit); ! ffeste_f2c_charspec_ (file_spec, fileexp, fileinit, filelenexp, fileleninit); ! ffeste_f2c_ptrtointspec_ (exist_spec, existexp, existinit); ! ffeste_f2c_ptrtointspec_ (open_spec, openexp, openinit); ! ffeste_f2c_ptrtointspec_ (number_spec, numberexp, numberinit); ! ffeste_f2c_ptrtointspec_ (named_spec, namedexp, namedinit); ! ffeste_f2c_charspec_ (name_spec, nameexp, nameinit, namelenexp, nameleninit); ! ffeste_f2c_charspec_ (access_spec, accessexp, accessinit, accesslenexp, ! accessleninit); ! ffeste_f2c_charspec_ (sequential_spec, sequentialexp, sequentialinit, ! sequentiallenexp, sequentialleninit); ! ffeste_f2c_charspec_ (direct_spec, directexp, directinit, directlenexp, ! directleninit); ! ffeste_f2c_charspec_ (form_spec, formexp, forminit, formlenexp, formleninit); ! ffeste_f2c_charspec_ (formatted_spec, formattedexp, formattedinit, ! formattedlenexp, formattedleninit); ! ffeste_f2c_charspec_ (unformatted_spec, unformattedexp, unformattedinit, ! unformattedlenexp, unformattedleninit); ! ffeste_f2c_ptrtointspec_ (recl_spec, reclexp, reclinit); ! ffeste_f2c_ptrtointspec_ (nextrec_spec, nextrecexp, nextrecinit); ! ffeste_f2c_charspec_ (blank_spec, blankexp, blankinit, blanklenexp, ! blankleninit); inits = build_tree_list ((field = TYPE_FIELDS (f2c_inquire_struct)), errinit); initn = inits; ! ffeste_f2c_init_ (unitinit); ! ffeste_f2c_init_ (fileinit); ! ffeste_f2c_init_ (fileleninit); ! ffeste_f2c_init_ (existinit); ! ffeste_f2c_init_ (openinit); ! ffeste_f2c_init_ (numberinit); ! ffeste_f2c_init_ (namedinit); ! ffeste_f2c_init_ (nameinit); ! ffeste_f2c_init_ (nameleninit); ! ffeste_f2c_init_ (accessinit); ! ffeste_f2c_init_ (accessleninit); ! ffeste_f2c_init_ (sequentialinit); ! ffeste_f2c_init_ (sequentialleninit); ! ffeste_f2c_init_ (directinit); ! ffeste_f2c_init_ (directleninit); ! ffeste_f2c_init_ (forminit); ! ffeste_f2c_init_ (formleninit); ! ffeste_f2c_init_ (formattedinit); ! ffeste_f2c_init_ (formattedleninit); ! ffeste_f2c_init_ (unformattedinit); ! ffeste_f2c_init_ (unformattedleninit); ! ffeste_f2c_init_ (reclinit); ! ffeste_f2c_init_ (nextrecinit); ! ffeste_f2c_init_ (blankinit); ! ffeste_f2c_init_ (blankleninit); inits = build (CONSTRUCTOR, f2c_inquire_struct, NULL_TREE, inits); TREE_CONSTANT (inits) = constantp ? 1 : 0; --- 2047,2110 ---- f2c_inquire_struct = ref; } ! /* Try to do as much compile-time initialization of the structure ! as possible, to save run time. */ ! ! ffeste_f2c_init_flag_ (have_err, errinit); ! ffeste_f2c_init_int_ (unitexp, unitinit, unit_spec); ! ffeste_f2c_init_char_ (fileexp, fileinit, filelenexp, fileleninit, ! file_spec); ! ffeste_f2c_init_ptrtoint_ (existexp, existinit, exist_spec); ! ffeste_f2c_init_ptrtoint_ (openexp, openinit, open_spec); ! ffeste_f2c_init_ptrtoint_ (numberexp, numberinit, number_spec); ! ffeste_f2c_init_ptrtoint_ (namedexp, namedinit, named_spec); ! ffeste_f2c_init_char_ (nameexp, nameinit, namelenexp, nameleninit, ! name_spec); ! ffeste_f2c_init_char_ (accessexp, accessinit, accesslenexp, ! accessleninit, access_spec); ! ffeste_f2c_init_char_ (sequentialexp, sequentialinit, sequentiallenexp, ! sequentialleninit, sequential_spec); ! ffeste_f2c_init_char_ (directexp, directinit, directlenexp, ! directleninit, direct_spec); ! ffeste_f2c_init_char_ (formexp, forminit, formlenexp, formleninit, ! form_spec); ! ffeste_f2c_init_char_ (formattedexp, formattedinit, ! formattedlenexp, formattedleninit, formatted_spec); ! ffeste_f2c_init_char_ (unformattedexp, unformattedinit, unformattedlenexp, ! unformattedleninit, unformatted_spec); ! ffeste_f2c_init_ptrtoint_ (reclexp, reclinit, recl_spec); ! ffeste_f2c_init_ptrtoint_ (nextrecexp, nextrecinit, nextrec_spec); ! ffeste_f2c_init_char_ (blankexp, blankinit, blanklenexp, ! blankleninit, blank_spec); inits = build_tree_list ((field = TYPE_FIELDS (f2c_inquire_struct)), errinit); initn = inits; ! ffeste_f2c_init_next_ (unitinit); ! ffeste_f2c_init_next_ (fileinit); ! ffeste_f2c_init_next_ (fileleninit); ! ffeste_f2c_init_next_ (existinit); ! ffeste_f2c_init_next_ (openinit); ! ffeste_f2c_init_next_ (numberinit); ! ffeste_f2c_init_next_ (namedinit); ! ffeste_f2c_init_next_ (nameinit); ! ffeste_f2c_init_next_ (nameleninit); ! ffeste_f2c_init_next_ (accessinit); ! ffeste_f2c_init_next_ (accessleninit); ! ffeste_f2c_init_next_ (sequentialinit); ! ffeste_f2c_init_next_ (sequentialleninit); ! ffeste_f2c_init_next_ (directinit); ! ffeste_f2c_init_next_ (directleninit); ! ffeste_f2c_init_next_ (forminit); ! ffeste_f2c_init_next_ (formleninit); ! ffeste_f2c_init_next_ (formattedinit); ! ffeste_f2c_init_next_ (formattedleninit); ! ffeste_f2c_init_next_ (unformattedinit); ! ffeste_f2c_init_next_ (unformattedleninit); ! ffeste_f2c_init_next_ (reclinit); ! ffeste_f2c_init_next_ (nextrecinit); ! ffeste_f2c_init_next_ (blankinit); ! ffeste_f2c_init_next_ (blankleninit); inits = build (CONSTRUCTOR, f2c_inquire_struct, NULL_TREE, inits); TREE_CONSTANT (inits) = constantp ? 1 : 0; *************** ffeste_io_inlist_ (bool have_err, *** 1760,1790 **** resume_momentary (yes); ! ffeste_f2c_exp_ (unitfield, unitexp); ! ffeste_f2c_exp_ (filefield, fileexp); ! ffeste_f2c_exp_ (filelenfield, filelenexp); ! ffeste_f2c_exp_ (existfield, existexp); ! ffeste_f2c_exp_ (openfield, openexp); ! ffeste_f2c_exp_ (numberfield, numberexp); ! ffeste_f2c_exp_ (namedfield, namedexp); ! ffeste_f2c_exp_ (namefield, nameexp); ! ffeste_f2c_exp_ (namelenfield, namelenexp); ! ffeste_f2c_exp_ (accessfield, accessexp); ! ffeste_f2c_exp_ (accesslenfield, accesslenexp); ! ffeste_f2c_exp_ (sequentialfield, sequentialexp); ! ffeste_f2c_exp_ (sequentiallenfield, sequentiallenexp); ! ffeste_f2c_exp_ (directfield, directexp); ! ffeste_f2c_exp_ (directlenfield, directlenexp); ! ffeste_f2c_exp_ (formfield, formexp); ! ffeste_f2c_exp_ (formlenfield, formlenexp); ! ffeste_f2c_exp_ (formattedfield, formattedexp); ! ffeste_f2c_exp_ (formattedlenfield, formattedlenexp); ! ffeste_f2c_exp_ (unformattedfield, unformattedexp); ! ffeste_f2c_exp_ (unformattedlenfield, unformattedlenexp); ! ffeste_f2c_exp_ (reclfield, reclexp); ! ffeste_f2c_exp_ (nextrecfield, nextrecexp); ! ffeste_f2c_exp_ (blankfield, blankexp); ! ffeste_f2c_exp_ (blanklenfield, blanklenexp); ttype = build_pointer_type (TREE_TYPE (t)); t = ffecom_1 (ADDR_EXPR, ttype, t); --- 2122,2177 ---- resume_momentary (yes); ! /* Prepare run-time expressions. */ ! ! ffeste_f2c_prepare_int_ (unit_spec, unitexp); ! ffeste_f2c_prepare_char_ (file_spec, fileexp); ! ffeste_f2c_prepare_ptrtoint_ (exist_spec, existexp); ! ffeste_f2c_prepare_ptrtoint_ (open_spec, openexp); ! ffeste_f2c_prepare_ptrtoint_ (number_spec, numberexp); ! ffeste_f2c_prepare_ptrtoint_ (named_spec, namedexp); ! ffeste_f2c_prepare_char_ (name_spec, nameexp); ! ffeste_f2c_prepare_char_ (access_spec, accessexp); ! ffeste_f2c_prepare_char_ (sequential_spec, sequentialexp); ! ffeste_f2c_prepare_char_ (direct_spec, directexp); ! ffeste_f2c_prepare_char_ (form_spec, formexp); ! ffeste_f2c_prepare_char_ (formatted_spec, formattedexp); ! ffeste_f2c_prepare_char_ (unformatted_spec, unformattedexp); ! ffeste_f2c_prepare_ptrtoint_ (recl_spec, reclexp); ! ffeste_f2c_prepare_ptrtoint_ (nextrec_spec, nextrecexp); ! ffeste_f2c_prepare_char_ (blank_spec, blankexp); ! ! ffecom_prepare_end (); ! ! /* Now evaluate run-time expressions as needed. */ ! ! ffeste_f2c_compile_int_ (unitfield, unit_spec, unitexp); ! ffeste_f2c_compile_char_ (filefield, filelenfield, file_spec, ! fileexp, filelenexp); ! ffeste_f2c_compile_ptrtoint_ (existfield, exist_spec, existexp); ! ffeste_f2c_compile_ptrtoint_ (openfield, open_spec, openexp); ! ffeste_f2c_compile_ptrtoint_ (numberfield, number_spec, numberexp); ! ffeste_f2c_compile_ptrtoint_ (namedfield, named_spec, namedexp); ! ffeste_f2c_compile_char_ (namefield, namelenfield, name_spec, nameexp, ! namelenexp); ! ffeste_f2c_compile_char_ (accessfield, accesslenfield, access_spec, ! accessexp, accesslenexp); ! ffeste_f2c_compile_char_ (sequentialfield, sequentiallenfield, ! sequential_spec, sequentialexp, ! sequentiallenexp); ! ffeste_f2c_compile_char_ (directfield, directlenfield, direct_spec, ! directexp, directlenexp); ! ffeste_f2c_compile_char_ (formfield, formlenfield, form_spec, formexp, ! formlenexp); ! ffeste_f2c_compile_char_ (formattedfield, formattedlenfield, formatted_spec, ! formattedexp, formattedlenexp); ! ffeste_f2c_compile_char_ (unformattedfield, unformattedlenfield, ! unformatted_spec, unformattedexp, ! unformattedlenexp); ! ffeste_f2c_compile_ptrtoint_ (reclfield, recl_spec, reclexp); ! ffeste_f2c_compile_ptrtoint_ (nextrecfield, nextrec_spec, nextrecexp); ! ffeste_f2c_compile_char_ (blankfield, blanklenfield, blank_spec, blankexp, ! blanklenexp); ttype = build_pointer_type (TREE_TYPE (t)); t = ffecom_1 (ADDR_EXPR, ttype, t); *************** ffeste_io_inlist_ (bool have_err, *** 1795,1809 **** } #endif ! /* ffeste_io_olist_ -- Make arglist with ptr to OPEN control list ! ! tree arglist; ! arglist = ffeste_io_olist_(...); Returns a tree suitable as an argument list containing a pointer to an OPEN-statement control list. First, generates that control list, if necessary, along with any static and run-time initializations ! that are needed as specified by the arguments to this function. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC static tree --- 2182,2201 ---- } #endif ! /* Make arglist with ptr to OPEN control list Returns a tree suitable as an argument list containing a pointer to an OPEN-statement control list. First, generates that control list, if necessary, along with any static and run-time initializations ! that are needed as specified by the arguments to this function. ! ! Must ensure that all expressions are prepared before being evaluated, ! for any whose evaluation might result in the generation of temporaries. ! ! Note that this means this function causes a transition, within the ! current block being code-generated via the back end, from the ! declaration of variables (temporaries) to the expanding of expressions, ! statements, etc. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC static tree *************** ffeste_io_olist_ (bool have_err, *** 1870,1906 **** f2c_open_struct = ref; } ! ffeste_f2c_flagspec_ (have_err, errinit); ! unitexp = ffecom_expr (unit_expr); ! if (TREE_CONSTANT (unitexp)) ! { ! unitinit = unitexp; ! unitexp = NULL_TREE; ! } else { unitinit = ffecom_integer_zero_node; constantp = FALSE; } ! ffeste_f2c_charspec_ (file_spec, fileexp, fileinit, filelenexp, fileleninit); ! ffeste_f2c_charnolenspec_ (stat_spec, statexp, statinit); ! ffeste_f2c_charnolenspec_ (access_spec, accessexp, accessinit); ! ffeste_f2c_charnolenspec_ (form_spec, formexp, forminit); ! ffeste_f2c_intspec_ (recl_spec, reclexp, reclinit); ! ffeste_f2c_charnolenspec_ (blank_spec, blankexp, blankinit); inits = build_tree_list ((field = TYPE_FIELDS (f2c_open_struct)), errinit); initn = inits; ! ffeste_f2c_init_ (unitinit); ! ffeste_f2c_init_ (fileinit); ! ffeste_f2c_init_ (fileleninit); ! ffeste_f2c_init_ (statinit); ! ffeste_f2c_init_ (accessinit); ! ffeste_f2c_init_ (forminit); ! ffeste_f2c_init_ (reclinit); ! ffeste_f2c_init_ (blankinit); inits = build (CONSTRUCTOR, f2c_open_struct, NULL_TREE, inits); TREE_CONSTANT (inits) = constantp ? 1 : 0; --- 2262,2299 ---- f2c_open_struct = ref; } ! /* Try to do as much compile-time initialization of the structure ! as possible, to save run time. */ ! ffeste_f2c_init_flag_ (have_err, errinit); ! ! unitexp = ffecom_const_expr (unit_expr); ! if (unitexp) ! unitinit = unitexp; else { unitinit = ffecom_integer_zero_node; constantp = FALSE; } ! ffeste_f2c_init_char_ (fileexp, fileinit, filelenexp, fileleninit, ! file_spec); ! ffeste_f2c_init_charnolen_ (statexp, statinit, stat_spec); ! ffeste_f2c_init_charnolen_ (accessexp, accessinit, access_spec); ! ffeste_f2c_init_charnolen_ (formexp, forminit, form_spec); ! ffeste_f2c_init_int_ (reclexp, reclinit, recl_spec); ! ffeste_f2c_init_charnolen_ (blankexp, blankinit, blank_spec); inits = build_tree_list ((field = TYPE_FIELDS (f2c_open_struct)), errinit); initn = inits; ! ffeste_f2c_init_next_ (unitinit); ! ffeste_f2c_init_next_ (fileinit); ! ffeste_f2c_init_next_ (fileleninit); ! ffeste_f2c_init_next_ (statinit); ! ffeste_f2c_init_next_ (accessinit); ! ffeste_f2c_init_next_ (forminit); ! ffeste_f2c_init_next_ (reclinit); ! ffeste_f2c_init_next_ (blankinit); inits = build (CONSTRUCTOR, f2c_open_struct, NULL_TREE, inits); TREE_CONSTANT (inits) = constantp ? 1 : 0; *************** ffeste_io_olist_ (bool have_err, *** 1918,1931 **** resume_momentary (yes); ! ffeste_f2c_exp_ (unitfield, unitexp); ! ffeste_f2c_exp_ (filefield, fileexp); ! ffeste_f2c_exp_ (filelenfield, filelenexp); ! ffeste_f2c_exp_ (statfield, statexp); ! ffeste_f2c_exp_ (accessfield, accessexp); ! ffeste_f2c_exp_ (formfield, formexp); ! ffeste_f2c_exp_ (reclfield, reclexp); ! ffeste_f2c_exp_ (blankfield, blankexp); ttype = build_pointer_type (TREE_TYPE (t)); t = ffecom_1 (ADDR_EXPR, ttype, t); --- 2311,2345 ---- resume_momentary (yes); ! /* Prepare run-time expressions. */ ! ! if (! unitexp) ! ffecom_prepare_expr (unit_expr); ! ! ffeste_f2c_prepare_char_ (file_spec, fileexp); ! ffeste_f2c_prepare_charnolen_ (stat_spec, statexp); ! ffeste_f2c_prepare_charnolen_ (access_spec, accessexp); ! ffeste_f2c_prepare_charnolen_ (form_spec, formexp); ! ffeste_f2c_prepare_int_ (recl_spec, reclexp); ! ffeste_f2c_prepare_charnolen_ (blank_spec, blankexp); ! ! ffecom_prepare_end (); ! ! /* Now evaluate run-time expressions as needed. */ ! ! if (! unitexp) ! { ! unitexp = ffecom_expr (unit_expr); ! ffeste_f2c_compile_ (unitfield, unitexp); ! } ! ! ffeste_f2c_compile_char_ (filefield, filelenfield, file_spec, fileexp, ! filelenexp); ! ffeste_f2c_compile_charnolen_ (statfield, stat_spec, statexp); ! ffeste_f2c_compile_charnolen_ (accessfield, access_spec, accessexp); ! ffeste_f2c_compile_charnolen_ (formfield, form_spec, formexp); ! ffeste_f2c_compile_int_ (reclfield, recl_spec, reclexp); ! ffeste_f2c_compile_charnolen_ (blankfield, blank_spec, blankexp); ttype = build_pointer_type (TREE_TYPE (t)); t = ffecom_1 (ADDR_EXPR, ttype, t); *************** ffeste_io_olist_ (bool have_err, *** 1936,1948 **** } #endif ! /* ffeste_subr_file_ -- Display file-statement specifier ! ! ffeste_subr_file_(&specifier); */ #if FFECOM_targetCURRENT == FFECOM_targetFFE static void ! ffeste_subr_file_ (char *kw, ffestpFile *spec) { if (!spec->kw_or_val_present) return; --- 2350,2360 ---- } #endif ! /* Display file-statement specifier. */ #if FFECOM_targetCURRENT == FFECOM_targetFFE static void ! ffeste_subr_file_ (const char *kw, ffestpFile *spec) { if (!spec->kw_or_val_present) return; *************** ffeste_subr_file_ (char *kw, ffestpFile *** 1963,1971 **** } #endif ! /* ffeste_subr_beru_ -- Generate code for BACKSPACE/ENDFILE/REWIND ! ! ffeste_subr_beru_(FFECOM_gfrtFBACK); */ #if FFECOM_targetCURRENT == FFECOM_targetGCC static void --- 2375,2381 ---- } #endif ! /* Generate code for BACKSPACE/ENDFILE/REWIND. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC static void *************** ffeste_subr_beru_ (ffestpBeruStmt *info, *** 1975,1989 **** bool iostat; bool errl; - #define specified(something) (info->beru_spec[something].kw_or_val_present) - ffeste_emit_line_note_ (); ! /* Do the real work. */ iostat = specified (FFESTP_beruixIOSTAT); errl = specified (FFESTP_beruixERR); /* ~~For now, we assume the unit number is specified and is not ASTERISK, because the FFE doesn't support BACKSPACE(*) and rejects a BACKSPACE without any unit specifier. f2c, however, supports the former --- 2385,2399 ---- bool iostat; bool errl; ffeste_emit_line_note_ (); ! #define specified(something) (info->beru_spec[something].kw_or_val_present) iostat = specified (FFESTP_beruixIOSTAT); errl = specified (FFESTP_beruixERR); + #undef specified + /* ~~For now, we assume the unit number is specified and is not ASTERISK, because the FFE doesn't support BACKSPACE(*) and rejects a BACKSPACE without any unit specifier. f2c, however, supports the former *************** ffeste_subr_beru_ (ffestpBeruStmt *info, *** 1992,2006 **** ffestvUnit indicator of FFESTV_unitINTEXPR or _unitASTERISK to ffeste_R919 and company, and they will want to pass that same value to this function, and that argument will replace the constant _unitINTEXPR_ ! in the call below. Right now, the default unit number, 6, is ignored. */ ! ! ffecom_push_calltemps (); ! alist = ffeste_io_ialist_ (errl || iostat, FFESTV_unitINTEXPR, ! info->beru_spec[FFESTP_beruixUNIT].u.expr, 6); if (errl) ! { /* ERR= */ ffeste_io_err_ = ffeste_io_abort_ = ffecom_lookup_label --- 2402,2415 ---- ffestvUnit indicator of FFESTV_unitINTEXPR or _unitASTERISK to ffeste_R919 and company, and they will want to pass that same value to this function, and that argument will replace the constant _unitINTEXPR_ ! in the call below. Right now, the default unit number, 6, is ignored. */ ! ffeste_start_stmt_ (); if (errl) ! { ! /* Have ERR= specification. */ ! ffeste_io_err_ = ffeste_io_abort_ = ffecom_lookup_label *************** ffeste_subr_beru_ (ffestpBeruStmt *info, *** 2008,2014 **** ffeste_io_abort_is_temp_ = FALSE; } else ! { /* no ERR= */ ffeste_io_err_ = NULL_TREE; if ((ffeste_io_abort_is_temp_ = iostat)) --- 2417,2425 ---- ffeste_io_abort_is_temp_ = FALSE; } else ! { ! /* No ERR= specification. */ ! ffeste_io_err_ = NULL_TREE; if ((ffeste_io_abort_is_temp_ = iostat)) *************** ffeste_subr_beru_ (ffestpBeruStmt *info, *** 2018,2046 **** } if (iostat) ! { /* IOSTAT= */ ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = ffecom_expr (info->beru_spec[FFESTP_beruixIOSTAT].u.expr); } else if (ffeste_io_abort_ != NULL_TREE) ! { /* no IOSTAT= but ERR= */ ffeste_io_iostat_is_temp_ = TRUE; ffeste_io_iostat_ ! = ffecom_push_tempvar (ffecom_integer_type_node, ! FFETARGET_charactersizeNONE, -1, FALSE); } else ! { /* no IOSTAT=, or ERR= */ ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = NULL_TREE; } /* Don't generate "if (iostat != 0) goto label;" if label is temp abort label, since we're gonna fall through to there anyway. */ ! ffeste_io_call_ (ffecom_call_gfrt (rt, alist), ! !ffeste_io_abort_is_temp_); /* If we've got a temp label, generate its code here. */ --- 2429,2468 ---- } if (iostat) ! { ! /* Have IOSTAT= specification. */ ! ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = ffecom_expr (info->beru_spec[FFESTP_beruixIOSTAT].u.expr); } else if (ffeste_io_abort_ != NULL_TREE) ! { ! /* Have no IOSTAT= but have ERR=. */ ! ffeste_io_iostat_is_temp_ = TRUE; ffeste_io_iostat_ ! = ffecom_make_tempvar ("beru", ffecom_integer_type_node, ! FFETARGET_charactersizeNONE, -1); } else ! { ! /* No IOSTAT= or ERR= specification. */ ! ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = NULL_TREE; } + /* Now prescan, then convert, all the arguments. */ + + alist = ffeste_io_ialist_ (errl || iostat, FFESTV_unitINTEXPR, + info->beru_spec[FFESTP_beruixUNIT].u.expr, 6); + /* Don't generate "if (iostat != 0) goto label;" if label is temp abort label, since we're gonna fall through to there anyway. */ ! ffeste_io_call_ (ffecom_call_gfrt (rt, alist, NULL_TREE), ! ! ffeste_io_abort_is_temp_); /* If we've got a temp label, generate its code here. */ *************** ffeste_subr_beru_ (ffestpBeruStmt *info, *** 2053,2080 **** assert (ffeste_io_err_ == NULL_TREE); } ! /* If we've got a temp iostat, pop the temp. */ ! ! if (ffeste_io_iostat_is_temp_) ! ffecom_pop_tempvar (ffeste_io_iostat_); ! ! ffecom_pop_calltemps (); ! ! #undef specified ! ! clear_momentary (); } - #endif - /* ffeste_do -- End of statement following DO-term-stmt etc ! ffeste_do(TRUE); Also invoked by _labeldef_branch_finish_ (or, in cases of errors, other _labeldef_ functions) when the label definition is for a DO-target (LOOPEND) label, once per matching/outstanding DO ! block on the stack. These cases invoke this function with ok==TRUE, so ! only forced stack popping (via ffeste_eof_()) invokes it with ok==FALSE. */ void ffeste_do (ffestw block) --- 2475,2490 ---- assert (ffeste_io_err_ == NULL_TREE); } ! ffeste_end_stmt_ (); } #endif ! /* END DO statement Also invoked by _labeldef_branch_finish_ (or, in cases of errors, other _labeldef_ functions) when the label definition is for a DO-target (LOOPEND) label, once per matching/outstanding DO ! block on the stack. */ void ffeste_do (ffestw block) *************** ffeste_do (ffestw block) *** 2083,2110 **** fputs ("+ END_DO\n", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); if (ffestw_do_tvar (block) == 0) ! expand_end_loop (); /* DO WHILE and just DO. */ else ! ffeste_end_iterdo_ (ffestw_do_tvar (block), ffestw_do_incr_saved (block), ffestw_do_count_var (block)); - - clear_momentary (); #else #error #endif } ! /* ffeste_end_R807 -- End of statement following logical IF ! ! ffeste_end_R807(TRUE); ! Applies ONLY to logical IF, not to IF-THEN. For example, does not ! ffelex_token_kill the construct name for an IF-THEN block (the name ! field is invalid for logical IF). ok==TRUE iff statement following ! logical IF (substatement) is valid; else, statement is invalid or ! stack forcibly popped due to ffeste_eof_(). */ void ffeste_end_R807 () --- 2493,2518 ---- fputs ("+ END_DO\n", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); + if (ffestw_do_tvar (block) == 0) ! { ! expand_end_loop (); /* DO WHILE and just DO. */ ! ! ffeste_end_block_ (block); ! } else ! ffeste_end_iterdo_ (block, ! ffestw_do_tvar (block), ffestw_do_incr_saved (block), ffestw_do_count_var (block)); #else #error #endif } ! /* End of statement following logical IF. ! Applies to *only* logical IF, not to IF-THEN. */ void ffeste_end_R807 () *************** ffeste_end_R807 () *** 2113,2128 **** fputs ("+ END_IF\n", dmpout); /* Also see ffeste_R806. */ #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); expand_end_cond (); ! clear_momentary (); #else #error #endif } ! /* ffeste_labeldef_branch -- Generate "code" for branch label def ! ! ffeste_labeldef_branch(label); */ void ffeste_labeldef_branch (ffelab label) --- 2521,2536 ---- fputs ("+ END_IF\n", dmpout); /* Also see ffeste_R806. */ #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); + expand_end_cond (); ! ! ffeste_end_block_ (NULL); #else #error #endif } ! /* Generate "code" for branch label definition. */ void ffeste_labeldef_branch (ffelab label) *************** ffeste_labeldef_branch (ffelab label) *** 2137,2147 **** --- 2545,2559 ---- assert (glabel != NULL_TREE); if (TREE_CODE (glabel) == ERROR_MARK) return; + assert (DECL_INITIAL (glabel) == NULL_TREE); + DECL_INITIAL (glabel) = error_mark_node; DECL_SOURCE_FILE (glabel) = ffelab_definition_filename (label); DECL_SOURCE_LINE (glabel) = ffelab_definition_filelinenum (label); + emit_nop (); + expand_label (glabel); } #else *************** ffeste_labeldef_branch (ffelab label) *** 2149,2157 **** #endif } ! /* ffeste_labeldef_format -- Generate "code" for FORMAT label def ! ! ffeste_labeldef_format(label); */ void ffeste_labeldef_format (ffelab label) --- 2561,2567 ---- #endif } ! /* Generate "code" for FORMAT label definition. */ void ffeste_labeldef_format (ffelab label) *************** ffeste_labeldef_format (ffelab label) *** 2165,2173 **** #endif } ! /* ffeste_R737A -- Assignment statement outside of WHERE ! ! ffeste_R737A(dest_expr,source_expr); */ void ffeste_R737A (ffebld dest, ffebld source) --- 2575,2581 ---- #endif } ! /* Assignment statement (outside of WHERE). */ void ffeste_R737A (ffebld dest, ffebld source) *************** ffeste_R737A (ffebld dest, ffebld source *** 2182,2206 **** fputc ('\n', dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); ! ffecom_push_calltemps (); ffecom_expand_let_stmt (dest, source); ! ffecom_pop_calltemps (); ! clear_momentary (); #else #error #endif } ! /* ffeste_R803 -- Block IF (IF-THEN) statement ! ! ffeste_R803(construct_name,expr,expr_token); ! ! Make sure statement is valid here; implement. */ void ! ffeste_R803 (ffebld expr) { ffeste_check_simple_ (); --- 2590,2610 ---- fputc ('\n', dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); ! ! ffeste_start_stmt_ (); ffecom_expand_let_stmt (dest, source); ! ffeste_end_stmt_ (); #else #error #endif } ! /* Block IF (IF-THEN) statement. */ void ! ffeste_R803 (ffestw block, ffebld expr) { ffeste_check_simple_ (); *************** ffeste_R803 (ffebld expr) *** 2209,2236 **** ffebld_dump (expr); fputs (")\n", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ! ffeste_emit_line_note_ (); ! ffecom_push_calltemps (); ! expand_start_cond (ffecom_truth_value (ffecom_expr (expr)), 0); ! ffecom_pop_calltemps (); ! clear_momentary (); #else #error #endif } ! /* ffeste_R804 -- ELSE IF statement ! ! ffeste_R804(expr,expr_token,name_token); ! ! Make sure ffeste_kind_ identifies an IF block. If not ! NULL, make sure name_token gives the correct name. Implement the else ! of the IF block. */ void ! ffeste_R804 (ffebld expr) { ffeste_check_simple_ (); --- 2613,2665 ---- ffebld_dump (expr); fputs (")\n", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ! { ! tree temp; ! ffeste_emit_line_note_ (); ! ffeste_start_block_ (block); ! ! temp = ffecom_make_tempvar ("ifthen", integer_type_node, ! FFETARGET_charactersizeNONE, -1); ! ! ffeste_start_stmt_ (); ! ! ffecom_prepare_expr (expr); ! ! if (ffecom_prepare_end ()) ! { ! tree result; ! ! result = ffecom_modify (void_type_node, ! temp, ! ffecom_truth_value (ffecom_expr (expr))); ! ! expand_expr_stmt (result); ! ! ffeste_end_stmt_ (); ! } ! else ! { ! ffeste_end_stmt_ (); ! ! temp = ffecom_truth_value (ffecom_expr (expr)); ! } ! ! expand_start_cond (temp, 0); ! ! /* No fake `else' constructs introduced (yet). */ ! ffestw_set_ifthen_fake_else (block, 0); ! } #else #error #endif } ! /* ELSE IF statement. */ void ! ffeste_R804 (ffestw block, ffebld expr) { ffeste_check_simple_ (); *************** ffeste_R804 (ffebld expr) *** 2239,2266 **** ffebld_dump (expr); fputs (")\n", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ! ffeste_emit_line_note_ (); ! ffecom_push_calltemps (); ! expand_start_elseif (ffecom_truth_value (ffecom_expr (expr))); ! ffecom_pop_calltemps (); ! clear_momentary (); #else #error #endif } ! /* ffeste_R805 -- ELSE statement ! ! ffeste_R805(name_token); ! ! Make sure ffeste_kind_ identifies an IF block. If not ! NULL, make sure name_token gives the correct name. Implement the ELSE ! of the IF block. */ void ! ffeste_R805 () { ffeste_check_simple_ (); --- 2668,2732 ---- ffebld_dump (expr); fputs (")\n", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ! { ! tree temp; ! ffeste_emit_line_note_ (); ! /* Since ELSEIF(expr) might require preparations for expr, ! implement as ELSE; prepare-expr; IF (expr) THEN ...; ENDIF. */ ! ! expand_start_else (); ! ! ffeste_start_block_ (block); ! ! temp = ffecom_make_tempvar ("elseif", integer_type_node, ! FFETARGET_charactersizeNONE, -1); ! ! ffeste_start_stmt_ (); ! ! ffecom_prepare_expr (expr); ! ! if (ffecom_prepare_end ()) ! { ! tree result; ! ! result = ffecom_modify (void_type_node, ! temp, ! ffecom_truth_value (ffecom_expr (expr))); ! ! expand_expr_stmt (result); ! ! ffeste_end_stmt_ (); ! } ! else ! { ! /* In this case, we could probably have used expand_start_elseif ! instead, saving the need for a fake `else' construct. But, ! until it's clear that'd improve performance, it's easier this ! way, since we have to expand_start_else before we get to this ! test, given the current design. */ ! ! ffeste_end_stmt_ (); ! ! temp = ffecom_truth_value (ffecom_expr (expr)); ! } ! ! expand_start_cond (temp, 0); ! ! /* Increment number of fake `else' constructs introduced. */ ! ffestw_set_ifthen_fake_else (block, ! ffestw_ifthen_fake_else (block) + 1); ! } #else #error #endif } ! /* ELSE statement. */ void ! ffeste_R805 (ffestw block UNUSED) { ffeste_check_simple_ (); *************** ffeste_R805 () *** 2268,2303 **** fputs ("+ ELSE\n", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); expand_start_else (); - clear_momentary (); #else #error #endif } ! /* ffeste_R806 -- End an IF-THEN ! ! ffeste_R806(TRUE); */ void ! ffeste_R806 () { #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ END_IF_then\n", dmpout); /* Also see ffeste_shriek_if_. */ #elif FFECOM_targetCURRENT == FFECOM_targetGCC ! ffeste_emit_line_note_ (); ! expand_end_cond (); ! clear_momentary (); #else #error #endif } ! /* ffeste_R807 -- Logical IF statement ! ! ffeste_R807(expr,expr_token); ! ! Make sure statement is valid here; implement. */ void ffeste_R807 (ffebld expr) --- 2734,2772 ---- fputs ("+ ELSE\n", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); + expand_start_else (); #else #error #endif } ! /* END IF statement. */ void ! ffeste_R806 (ffestw block) { #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ END_IF_then\n", dmpout); /* Also see ffeste_shriek_if_. */ #elif FFECOM_targetCURRENT == FFECOM_targetGCC ! { ! int i = ffestw_ifthen_fake_else (block) + 1; ! ! ffeste_emit_line_note_ (); ! ! for (; i; --i) ! { ! expand_end_cond (); ! ! ffeste_end_block_ (block); ! } ! } #else #error #endif } ! /* Logical IF statement. */ void ffeste_R807 (ffebld expr) *************** ffeste_R807 (ffebld expr) *** 2309,2331 **** ffebld_dump (expr); fputs (")\n", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ! ffeste_emit_line_note_ (); ! ffecom_push_calltemps (); ! expand_start_cond (ffecom_truth_value (ffecom_expr (expr)), 0); ! ffecom_pop_calltemps (); ! clear_momentary (); #else #error #endif } ! /* ffeste_R809 -- SELECT CASE statement ! ! ffeste_R809(construct_name,expr,expr_token); ! ! Make sure statement is valid here; implement. */ void ffeste_R809 (ffestw block, ffebld expr) --- 2778,2824 ---- ffebld_dump (expr); fputs (")\n", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ! { ! tree temp; ! ! ffeste_emit_line_note_ (); ! ! ffeste_start_block_ (NULL); ! ! temp = ffecom_make_tempvar ("if", integer_type_node, ! FFETARGET_charactersizeNONE, -1); ! ! ffeste_start_stmt_ (); ! ! ffecom_prepare_expr (expr); ! ! if (ffecom_prepare_end ()) ! { ! tree result; ! ! result = ffecom_modify (void_type_node, ! temp, ! ffecom_truth_value (ffecom_expr (expr))); ! ! expand_expr_stmt (result); ! ffeste_end_stmt_ (); ! } ! else ! { ! ffeste_end_stmt_ (); ! temp = ffecom_truth_value (ffecom_expr (expr)); ! } ! ! expand_start_cond (temp, 0); ! } #else #error #endif } ! /* SELECT CASE statement. */ void ffeste_R809 (ffestw block, ffebld expr) *************** ffeste_R809 (ffestw block, ffebld expr) *** 2337,2388 **** ffebld_dump (expr); fputs (")\n", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ! ffecom_push_calltemps (); ! { ! tree texpr; ! ffeste_emit_line_note_ (); ! if ((expr == NULL) ! || (ffeinfo_basictype (ffebld_info (expr)) ! == FFEINFO_basictypeANY)) ! { ! ffestw_set_select_texpr (block, error_mark_node); ! clear_momentary (); ! } ! else ! { ! texpr = ffecom_expr (expr); ! if (ffeinfo_basictype (ffebld_info (expr)) ! != FFEINFO_basictypeCHARACTER) ! { ! expand_start_case (1, texpr, TREE_TYPE (texpr), ! "SELECT CASE statement"); ! ffestw_set_select_texpr (block, texpr); ! ffestw_set_select_break (block, FALSE); ! push_momentary (); ! } ! else ! { ! ffebad_start_msg ("SELECT CASE on CHARACTER type (at %0) not supported -- sorry", ! FFEBAD_severityFATAL); ! ffebad_here (0, ffestw_line (block), ffestw_col (block)); ! ffebad_finish (); ! ffestw_set_select_texpr (block, error_mark_node); ! } ! } ! } ! ffecom_pop_calltemps (); #else #error #endif } ! /* ffeste_R810 -- CASE statement ! ! ffeste_R810(case_value_range_list,name); If casenum is 0, it's CASE DEFAULT. Else it's the case ranges at the start of the first_stmt list in the select object at the top of --- 2830,2892 ---- ffebld_dump (expr); fputs (")\n", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ! ffeste_emit_line_note_ (); ! ffeste_start_block_ (block); ! if ((expr == NULL) ! || (ffeinfo_basictype (ffebld_info (expr)) ! == FFEINFO_basictypeANY)) ! ffestw_set_select_texpr (block, error_mark_node); ! else if (ffeinfo_basictype (ffebld_info (expr)) ! == FFEINFO_basictypeCHARACTER) ! { ! /* ~~~Someday handle CHARACTER*1, CHARACTER*N */ ! ! ffebad_start_msg ("SELECT CASE on CHARACTER type (at %0) not supported -- sorry", ! FFEBAD_severityFATAL); ! ffebad_here (0, ffestw_line (block), ffestw_col (block)); ! ffebad_finish (); ! ffestw_set_select_texpr (block, error_mark_node); ! } ! else ! { ! tree result; ! tree texpr; ! result = ffecom_make_tempvar ("select", ffecom_type_expr (expr), ! ffeinfo_size (ffebld_info (expr)), ! -1); ! ! ffeste_start_stmt_ (); ! ! ffecom_prepare_expr (expr); ! ! ffecom_prepare_end (); ! ! texpr = ffecom_expr (expr); ! ! assert (TYPE_MAIN_VARIANT (TREE_TYPE (texpr)) ! == TYPE_MAIN_VARIANT (TREE_TYPE (result))); ! ! texpr = ffecom_modify (void_type_node, ! result, ! texpr); ! expand_expr_stmt (texpr); ! ffeste_end_stmt_ (); ! ! expand_start_case (1, result, TREE_TYPE (result), ! "SELECT CASE statement"); ! ffestw_set_select_texpr (block, texpr); ! ffestw_set_select_break (block, FALSE); ! } #else #error #endif } ! /* CASE statement. If casenum is 0, it's CASE DEFAULT. Else it's the case ranges at the start of the first_stmt list in the select object at the top of *************** ffeste_R810 (ffestw block, unsigned long *** 2440,2456 **** { tree texprlow; tree texprhigh; ! tree tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE); int pushok; tree duplicate; ffeste_emit_line_note_ (); ! if (TREE_CODE (ffestw_select_texpr (block)) == ERROR_MARK) ! { ! clear_momentary (); ! return; ! } if (ffestw_select_break (block)) expand_exit_something (); --- 2944,2961 ---- { tree texprlow; tree texprhigh; ! tree tlabel; int pushok; tree duplicate; ffeste_emit_line_note_ (); ! if (ffestw_select_texpr (block) == error_mark_node) ! return; ! ! /* ~~~Someday handle CHARACTER*1, CHARACTER*N */ ! ! tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE); if (ffestw_select_break (block)) expand_exit_something (); *************** ffeste_R810 (ffestw block, unsigned long *** 2490,2504 **** while ((c != (ffestwCase) &s->first_rel) && (casenum == c->casenum)); clear_momentary (); ! } /* ~~~handle character, character*1 */ #else #error #endif } ! /* ffeste_R811 -- End a SELECT ! ! ffeste_R811(TRUE); */ void ffeste_R811 (ffestw block) --- 2995,3007 ---- while ((c != (ffestwCase) &s->first_rel) && (casenum == c->casenum)); clear_momentary (); ! } #else #error #endif } ! /* END SELECT statement. */ void ffeste_R811 (ffestw block) *************** ffeste_R811 (ffestw block) *** 2508,2522 **** #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); ! if (TREE_CODE (ffestw_select_texpr (block)) == ERROR_MARK) ! { ! clear_momentary (); ! return; ! } ! expand_end_case (ffestw_select_texpr (block)); ! pop_momentary (); ! clear_momentary (); /* ~~~handle character and character*1 */ #else #error #endif --- 3011,3022 ---- #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); ! /* ~~~Someday handle CHARACTER*1, CHARACTER*N */ ! ! if (TREE_CODE (ffestw_select_texpr (block)) != ERROR_MARK) ! expand_end_case (ffestw_select_texpr (block)); ! ffeste_end_block_ (block); #else #error #endif *************** ffeste_R819A (ffestw block, ffelab label *** 2559,2567 **** #elif FFECOM_targetCURRENT == FFECOM_targetGCC { ffeste_emit_line_note_ (); - ffecom_push_calltemps (); - - /* Start the DO loop. */ ffeste_begin_iterdo_ (block, NULL, NULL, NULL, var, --- 3059,3064 ---- *************** ffeste_R819A (ffestw block, ffelab label *** 2569,2587 **** end, end_token, incr, incr_token, "Iterative DO loop"); - - ffecom_pop_calltemps (); } #else #error #endif } ! /* ffeste_R819B -- DO WHILE statement ! ! ffeste_R819B(construct_name,label_token,expr,expr_token); ! ! Make sure statement is valid here; implement. */ void ffeste_R819B (ffestw block, ffelab label UNUSED, ffebld expr) --- 3066,3078 ---- end, end_token, incr, incr_token, "Iterative DO loop"); } #else #error #endif } ! /* DO WHILE statement. */ void ffeste_R819B (ffestw block, ffelab label UNUSED, ffebld expr) *************** ffeste_R819B (ffestw block, ffelab label *** 2597,2628 **** fputs (")\n", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC { ffeste_emit_line_note_ (); - ffecom_push_calltemps (); ! ffestw_set_do_hook (block, expand_start_loop (1)); ! ffestw_set_do_tvar (block, 0); /* Means DO WHILE vs. iter DO. */ ! if (expr != NULL) ! expand_exit_loop_if_false (0, ffecom_truth_value (ffecom_expr (expr))); ! ffecom_pop_calltemps (); ! clear_momentary (); } #else #error #endif } ! /* ffeste_R825 -- END DO statement ! ! ffeste_R825(name_token); ! Make sure ffeste_kind_ identifies a DO block. If not ! NULL, make sure name_token gives the correct name. Do whatever ! is specific to seeing END DO with a DO-target label definition on it, ! where the END DO is really treated as a CONTINUE (i.e. generate th ! same code you would for CONTINUE). ffeste_do handles the actual ! generation of end-loop code. */ void ffeste_R825 () --- 3088,3141 ---- fputs (")\n", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC { + tree result; + ffeste_emit_line_note_ (); ! ffeste_start_block_ (block); ! if (expr) ! { ! struct nesting *loop; ! tree mod; ! ! result = ffecom_make_tempvar ("dowhile", integer_type_node, ! FFETARGET_charactersizeNONE, -1); ! loop = expand_start_loop (1); ! ! ffeste_start_stmt_ (); ! ! ffecom_prepare_expr (expr); ! ! ffecom_prepare_end (); ! ! mod = ffecom_modify (void_type_node, ! result, ! ffecom_truth_value (ffecom_expr (expr))); ! expand_expr_stmt (mod); ! ! ffeste_end_stmt_ (); ! ! ffestw_set_do_hook (block, loop); ! expand_exit_loop_if_false (0, result); ! } ! else ! ffestw_set_do_hook (block, expand_start_loop (1)); ! ! ffestw_set_do_tvar (block, NULL_TREE); } #else #error #endif } ! /* END DO statement. ! This is the MIL-STD 1753 END DO. It's syntactic sugar, similar to ! CONTINUE (except that it has to have a label that is the target of ! one or more iterative DO statement), not the Fortran-90 structured ! END DO, which is handled elsewhere, as is the actual mechanism of ! ending an iterative DO statement, even one that ends at a label. */ void ffeste_R825 () *************** ffeste_R825 () *** 2633,2649 **** fputs ("+ END_DO_sugar\n", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); emit_nop (); #else #error #endif } ! /* ffeste_R834 -- CYCLE statement ! ! ffeste_R834(name_token); ! ! Handle a CYCLE within a loop. */ void ffeste_R834 (ffestw block) --- 3146,3159 ---- fputs ("+ END_DO_sugar\n", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); + emit_nop (); #else #error #endif } ! /* CYCLE statement. */ void ffeste_R834 (ffestw block) *************** ffeste_R834 (ffestw block) *** 2654,2671 **** fprintf (dmpout, "+ CYCLE block #%lu\n", ffestw_blocknum (block)); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); expand_continue_loop (ffestw_do_hook (block)); - clear_momentary (); #else #error #endif } ! /* ffeste_R835 -- EXIT statement ! ! ffeste_R835(name_token); ! ! Handle a EXIT within a loop. */ void ffeste_R835 (ffestw block) --- 3164,3177 ---- fprintf (dmpout, "+ CYCLE block #%lu\n", ffestw_blocknum (block)); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); + expand_continue_loop (ffestw_do_hook (block)); #else #error #endif } ! /* EXIT statement. */ void ffeste_R835 (ffestw block) *************** ffeste_R835 (ffestw block) *** 2676,2694 **** fprintf (dmpout, "+ EXIT block #%lu\n", ffestw_blocknum (block)); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); expand_exit_loop (ffestw_do_hook (block)); - clear_momentary (); #else #error #endif } ! /* ffeste_R836 -- GOTO statement ! ! ffeste_R836(label); ! ! Make sure label_token identifies a valid label for a GOTO. Update ! that label's info to indicate it is the target of a GOTO. */ void ffeste_R836 (ffelab label) --- 3182,3195 ---- fprintf (dmpout, "+ EXIT block #%lu\n", ffestw_blocknum (block)); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); + expand_exit_loop (ffestw_do_hook (block)); #else #error #endif } ! /* GOTO statement. */ void ffeste_R836 (ffelab label) *************** ffeste_R836 (ffelab label) *** 2702,2714 **** tree glabel; ffeste_emit_line_note_ (); glabel = ffecom_lookup_label (label); if ((glabel != NULL_TREE) && (TREE_CODE (glabel) != ERROR_MARK)) { - TREE_USED (glabel) = 1; expand_goto (glabel); ! clear_momentary (); } } #else --- 3203,3215 ---- tree glabel; ffeste_emit_line_note_ (); + glabel = ffecom_lookup_label (label); if ((glabel != NULL_TREE) && (TREE_CODE (glabel) != ERROR_MARK)) { expand_goto (glabel); ! TREE_USED (glabel) = 1; } } #else *************** ffeste_R836 (ffelab label) *** 2716,2727 **** #endif } ! /* ffeste_R837 -- Computed GOTO statement ! ! ffeste_R837(labels,count,expr); ! ! Make sure label_list identifies valid labels for a GOTO. Update ! each label's info to indicate it is the target of a GOTO. */ void ffeste_R837 (ffelab *labels, int count, ffebld expr) --- 3217,3223 ---- #endif } ! /* Computed GOTO statement. */ void ffeste_R837 (ffelab *labels, int count, ffebld expr) *************** ffeste_R837 (ffelab *labels, int count, *** 2750,2761 **** tree duplicate; ffeste_emit_line_note_ (); ! ffecom_push_calltemps (); texpr = ffecom_expr (expr); expand_start_case (0, texpr, TREE_TYPE (texpr), "computed GOTO statement"); ! push_momentary (); /* In case of lots of labels, keep clearing ! them out. */ for (i = 0; i < count; ++i) { value = build_int_2 (i + 1, 0); --- 3246,3262 ---- tree duplicate; ffeste_emit_line_note_ (); ! ! ffeste_start_stmt_ (); ! ! ffecom_prepare_expr (expr); ! ! ffecom_prepare_end (); texpr = ffecom_expr (expr); + expand_start_case (0, texpr, TREE_TYPE (texpr), "computed GOTO statement"); ! for (i = 0; i < count; ++i) { value = build_int_2 (i + 1, 0); *************** ffeste_R837 (ffelab *labels, int count, *** 2763,2795 **** pushok = pushcase (value, convert, tlabel, &duplicate); assert (pushok == 0); tlabel = ffecom_lookup_label (labels[i]); if ((tlabel == NULL_TREE) || (TREE_CODE (tlabel) == ERROR_MARK)) continue; ! TREE_USED (tlabel) = 1; expand_goto (tlabel); ! clear_momentary (); } - pop_momentary (); expand_end_case (texpr); ! ffecom_pop_calltemps (); ! clear_momentary (); } #else #error #endif } ! /* ffeste_R838 -- ASSIGN statement ! ! ffeste_R838(label_token,target_variable,target_token); ! ! Make sure label_token identifies a valid label for an assignment. Update ! that label's info to indicate it is the source of an assignment. Update ! target_variable's info to indicate it is the target the assignment of that ! label. */ void ffeste_R838 (ffelab label, ffebld target) --- 3264,3288 ---- pushok = pushcase (value, convert, tlabel, &duplicate); assert (pushok == 0); + tlabel = ffecom_lookup_label (labels[i]); if ((tlabel == NULL_TREE) || (TREE_CODE (tlabel) == ERROR_MARK)) continue; ! expand_goto (tlabel); ! TREE_USED (tlabel) = 1; } expand_end_case (texpr); ! ffeste_end_stmt_ (); } #else #error #endif } ! /* ASSIGN statement. */ void ffeste_R838 (ffelab label, ffebld target) *************** ffeste_R838 (ffelab label, ffebld target *** 2807,2813 **** tree target_tree; ffeste_emit_line_note_ (); ! ffecom_push_calltemps (); label_tree = ffecom_lookup_label (label); if ((label_tree != NULL_TREE) --- 3300,3308 ---- tree target_tree; ffeste_emit_line_note_ (); ! ! /* No need to call ffeste_start_stmt_(), as the sorts of expressions ! seen here should never require use of temporaries. */ label_tree = ffecom_lookup_label (label); if ((label_tree != NULL_TREE) *************** ffeste_R838 (ffelab label, ffebld target *** 2817,2847 **** build_pointer_type (void_type_node), label_tree); TREE_CONSTANT (label_tree) = 1; target_tree = ffecom_expr_assign_w (target); if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (target_tree))) < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (label_tree)))) error ("ASSIGN to variable that is too small"); label_tree = convert (TREE_TYPE (target_tree), label_tree); expr_tree = ffecom_modify (void_type_node, target_tree, label_tree); expand_expr_stmt (expr_tree); clear_momentary (); } - - ffecom_pop_calltemps (); } #else #error #endif } ! /* ffeste_R839 -- Assigned GOTO statement ! ! ffeste_R839(target,target_token,label_list); ! ! Make sure label_list identifies valid labels for a GOTO. Update ! each label's info to indicate it is the target of a GOTO. */ void ffeste_R839 (ffebld target) --- 3312,3339 ---- build_pointer_type (void_type_node), label_tree); TREE_CONSTANT (label_tree) = 1; + target_tree = ffecom_expr_assign_w (target); if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (target_tree))) < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (label_tree)))) error ("ASSIGN to variable that is too small"); + label_tree = convert (TREE_TYPE (target_tree), label_tree); + expr_tree = ffecom_modify (void_type_node, target_tree, label_tree); expand_expr_stmt (expr_tree); + clear_momentary (); } } #else #error #endif } ! /* Assigned GOTO statement. */ void ffeste_R839 (ffebld target) *************** ffeste_R839 (ffebld target) *** 2857,2871 **** tree t; ffeste_emit_line_note_ (); ! ffecom_push_calltemps (); t = ffecom_expr_assign (target); if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (t))) < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node)))) error ("ASSIGNed GOTO target variable is too small"); expand_computed_goto (convert (TREE_TYPE (null_pointer_node), t)); - ffecom_pop_calltemps (); clear_momentary (); } #else --- 3349,3365 ---- tree t; ffeste_emit_line_note_ (); ! ! /* No need to call ffeste_start_stmt_(), as the sorts of expressions ! seen here should never require use of temporaries. */ t = ffecom_expr_assign (target); if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (t))) < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node)))) error ("ASSIGNed GOTO target variable is too small"); + expand_computed_goto (convert (TREE_TYPE (null_pointer_node), t)); clear_momentary (); } #else *************** ffeste_R839 (ffebld target) *** 2873,2883 **** #endif } ! /* ffeste_R840 -- Arithmetic IF statement ! ! ffeste_R840(expr,expr_token,neg,zero,pos); ! ! Make sure the labels are valid; implement. */ void ffeste_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos) --- 3367,3373 ---- #endif } ! /* Arithmetic IF statement. */ void ffeste_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos) *************** ffeste_R840 (ffebld expr, ffelab neg, ff *** 2896,2901 **** --- 3386,3393 ---- tree gpos = ffecom_lookup_label (pos); tree texpr; + ffeste_emit_line_note_ (); + if ((gneg == NULL_TREE) || (gzero == NULL_TREE) || (gpos == NULL_TREE)) return; if ((TREE_CODE (gneg) == ERROR_MARK) *************** ffeste_R840 (ffebld expr, ffelab neg, ff *** 2903,2917 **** || (TREE_CODE (gpos) == ERROR_MARK)) return; ! ffecom_push_calltemps (); if (neg == zero) { if (neg == pos) expand_goto (gzero); else ! { /* IF (expr.LE.0) THEN GOTO neg/zero ELSE ! GOTO pos. */ texpr = ffecom_expr (expr); texpr = ffecom_2 (LE_EXPR, integer_type_node, texpr, --- 3395,3413 ---- || (TREE_CODE (gpos) == ERROR_MARK)) return; ! ffeste_start_stmt_ (); ! ! ffecom_prepare_expr (expr); ! ! ffecom_prepare_end (); if (neg == zero) { if (neg == pos) expand_goto (gzero); else ! { ! /* IF (expr.LE.0) THEN GOTO neg/zero ELSE GOTO pos. */ texpr = ffecom_expr (expr); texpr = ffecom_2 (LE_EXPR, integer_type_node, texpr, *************** ffeste_R840 (ffebld expr, ffelab neg, ff *** 2925,2932 **** } } else if (neg == pos) ! { /* IF (expr.NE.0) THEN GOTO neg/pos ELSE GOTO ! zero. */ texpr = ffecom_expr (expr); texpr = ffecom_2 (NE_EXPR, integer_type_node, texpr, --- 3421,3428 ---- } } else if (neg == pos) ! { ! /* IF (expr.NE.0) THEN GOTO neg/pos ELSE GOTO zero. */ texpr = ffecom_expr (expr); texpr = ffecom_2 (NE_EXPR, integer_type_node, texpr, *************** ffeste_R840 (ffebld expr, ffelab neg, ff *** 2939,2946 **** expand_end_cond (); } else if (zero == pos) ! { /* IF (expr.GE.0) THEN GOTO zero/pos ELSE ! GOTO neg. */ texpr = ffecom_expr (expr); texpr = ffecom_2 (GE_EXPR, integer_type_node, texpr, --- 3435,3442 ---- expand_end_cond (); } else if (zero == pos) ! { ! /* IF (expr.GE.0) THEN GOTO zero/pos ELSE GOTO neg. */ texpr = ffecom_expr (expr); texpr = ffecom_2 (GE_EXPR, integer_type_node, texpr, *************** ffeste_R840 (ffebld expr, ffelab neg, ff *** 2953,2962 **** expand_end_cond (); } else ! { /* Use a SAVE_EXPR in combo with: ! IF (expr.LT.0) THEN GOTO neg ! ELSEIF (expr.GT.0) THEN GOTO pos ! ELSE GOTO zero. */ tree expr_saved = ffecom_save_tree (ffecom_expr (expr)); texpr = ffecom_2 (LT_EXPR, integer_type_node, --- 3449,3459 ---- expand_end_cond (); } else ! { ! /* Use a SAVE_EXPR in combo with: ! IF (expr.LT.0) THEN GOTO neg ! ELSEIF (expr.GT.0) THEN GOTO pos ! ELSE GOTO zero. */ tree expr_saved = ffecom_save_tree (ffecom_expr (expr)); texpr = ffecom_2 (LT_EXPR, integer_type_node, *************** ffeste_R840 (ffebld expr, ffelab neg, ff *** 2975,2993 **** expand_goto (gzero); expand_end_cond (); } - ffeste_emit_line_note_ (); ! ffecom_pop_calltemps (); ! clear_momentary (); } #else #error #endif } ! /* ffeste_R841 -- CONTINUE statement ! ! ffeste_R841(); */ void ffeste_R841 () --- 3472,3486 ---- expand_goto (gzero); expand_end_cond (); } ! ffeste_end_stmt_ (); } #else #error #endif } ! /* CONTINUE statement. */ void ffeste_R841 () *************** ffeste_R841 () *** 2998,3012 **** fputs ("+ CONTINUE\n", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); emit_nop (); #else #error #endif } ! /* ffeste_R842 -- STOP statement ! ! ffeste_R842(expr); */ void ffeste_R842 (ffebld expr) --- 3491,3504 ---- fputs ("+ CONTINUE\n", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); + emit_nop (); #else #error #endif } ! /* STOP statement. */ void ffeste_R842 (ffebld expr) *************** ffeste_R842 (ffebld expr) *** 3030,3035 **** --- 3522,3528 ---- ffelexToken msg; ffeste_emit_line_note_ (); + if ((expr == NULL) || (ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeANY)) *************** ffeste_R842 (ffebld expr) *** 3073,3084 **** == FFEINFO_kindtypeCHARACTERDEFAULT); } ! ffecom_push_calltemps (); callit = ffecom_call_gfrt (FFECOM_gfrtSTOP, ! ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL))); ! ffecom_pop_calltemps (); TREE_SIDE_EFFECTS (callit) = 1; expand_expr_stmt (callit); clear_momentary (); } #else --- 3566,3581 ---- == FFEINFO_kindtypeCHARACTERDEFAULT); } ! /* No need to call ffeste_start_stmt_(), as the sorts of expressions ! seen here should never require use of temporaries. */ ! callit = ffecom_call_gfrt (FFECOM_gfrtSTOP, ! ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)), ! NULL_TREE); TREE_SIDE_EFFECTS (callit) = 1; + expand_expr_stmt (callit); + clear_momentary (); } #else *************** ffeste_R842 (ffebld expr) *** 3086,3097 **** #endif } ! /* ffeste_R843 -- PAUSE statement ! ! ffeste_R843(expr,expr_token); ! ! Make sure statement is valid here; implement. expr and expr_token are ! both NULL if there was no expression. */ void ffeste_R843 (ffebld expr) --- 3583,3589 ---- #endif } ! /* PAUSE statement. */ void ffeste_R843 (ffebld expr) *************** ffeste_R843 (ffebld expr) *** 3115,3120 **** --- 3607,3613 ---- ffelexToken msg; ffeste_emit_line_note_ (); + if ((expr == NULL) || (ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeANY)) *************** ffeste_R843 (ffebld expr) *** 3158,3169 **** == FFEINFO_kindtypeCHARACTERDEFAULT); } ! ffecom_push_calltemps (); callit = ffecom_call_gfrt (FFECOM_gfrtPAUSE, ! ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL))); ! ffecom_pop_calltemps (); TREE_SIDE_EFFECTS (callit) = 1; expand_expr_stmt (callit); clear_momentary (); } #if 0 /* Old approach for phantom g77 run-time --- 3651,3666 ---- == FFEINFO_kindtypeCHARACTERDEFAULT); } ! /* No need to call ffeste_start_stmt_(), as the sorts of expressions ! seen here should never require use of temporaries. */ ! callit = ffecom_call_gfrt (FFECOM_gfrtPAUSE, ! ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)), ! NULL_TREE); TREE_SIDE_EFFECTS (callit) = 1; + expand_expr_stmt (callit); + clear_momentary (); } #if 0 /* Old approach for phantom g77 run-time *************** ffeste_R843 (ffebld expr) *** 3172,3199 **** tree callit; ffeste_emit_line_note_ (); if (expr == NULL) ! callit = ffecom_call_gfrt (FFECOM_gfrtPAUSENIL, NULL_TREE); else if (ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeINTEGER) ! { ! ffecom_push_calltemps (); ! callit = ffecom_call_gfrt (FFECOM_gfrtPAUSEINT, ! ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL))); ! ffecom_pop_calltemps (); ! } else ! { ! if (ffeinfo_basictype (ffebld_info (expr)) ! != FFEINFO_basictypeCHARACTER) ! break; ! ffecom_push_calltemps (); ! callit = ffecom_call_gfrt (FFECOM_gfrtPAUSECHAR, ! ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL))); ! ffecom_pop_calltemps (); ! } TREE_SIDE_EFFECTS (callit) = 1; expand_expr_stmt (callit); clear_momentary (); } #endif --- 3669,3693 ---- tree callit; ffeste_emit_line_note_ (); + if (expr == NULL) ! callit = ffecom_call_gfrt (FFECOM_gfrtPAUSENIL, NULL_TREE, NULL_TREE); else if (ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeINTEGER) ! callit = ffecom_call_gfrt (FFECOM_gfrtPAUSEINT, ! ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)), ! NULL_TREE); ! else if (ffeinfo_basictype (ffebld_info (expr)) ! == FFEINFO_basictypeCHARACTER) ! callit = ffecom_call_gfrt (FFECOM_gfrtPAUSECHAR, ! ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)), ! NULL_TREE); else ! abort (); TREE_SIDE_EFFECTS (callit) = 1; + expand_expr_stmt (callit); + clear_momentary (); } #endif *************** ffeste_R843 (ffebld expr) *** 3202,3212 **** #endif } ! /* ffeste_R904 -- OPEN statement ! ! ffeste_R904(); ! ! Make sure an OPEN is valid in the current context, and implement it. */ void ffeste_R904 (ffestpOpenStmt *info) --- 3696,3702 ---- #endif } ! /* OPEN statement. */ void ffeste_R904 (ffestpOpenStmt *info) *************** ffeste_R904 (ffestpOpenStmt *info) *** 3251,3273 **** bool iostat; bool errl; - #define specified(something) (info->open_spec[something].kw_or_val_present) - ffeste_emit_line_note_ (); iostat = specified (FFESTP_openixIOSTAT); errl = specified (FFESTP_openixERR); ! ffecom_push_calltemps (); ! args = ffeste_io_olist_ (errl || iostat, ! info->open_spec[FFESTP_openixUNIT].u.expr, ! &info->open_spec[FFESTP_openixFILE], ! &info->open_spec[FFESTP_openixSTATUS], ! &info->open_spec[FFESTP_openixACCESS], ! &info->open_spec[FFESTP_openixFORM], ! &info->open_spec[FFESTP_openixRECL], ! &info->open_spec[FFESTP_openixBLANK]); if (errl) { --- 3741,3756 ---- bool iostat; bool errl; ffeste_emit_line_note_ (); + #define specified(something) (info->open_spec[something].kw_or_val_present) + iostat = specified (FFESTP_openixIOSTAT); errl = specified (FFESTP_openixERR); ! #undef specified ! ffeste_start_stmt_ (); if (errl) { *************** ffeste_R904 (ffestpOpenStmt *info) *** 3288,3318 **** } if (iostat) ! { /* IOSTAT= */ ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = ffecom_expr (info->open_spec[FFESTP_openixIOSTAT].u.expr); } else if (ffeste_io_abort_ != NULL_TREE) ! { /* no IOSTAT= but ERR= */ ffeste_io_iostat_is_temp_ = TRUE; ffeste_io_iostat_ ! = ffecom_push_tempvar (ffecom_integer_type_node, ! FFETARGET_charactersizeNONE, -1, FALSE); } else ! { /* no IOSTAT=, or ERR= */ ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = NULL_TREE; } /* Don't generate "if (iostat != 0) goto label;" if label is temp abort label, since we're gonna fall through to there anyway. */ ! ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFOPEN, args), ! !ffeste_io_abort_is_temp_); ! /* If we've got a temp label, generate its code here. */ if (ffeste_io_abort_is_temp_) { --- 3771,3818 ---- } if (iostat) ! { ! /* Have IOSTAT= specification. */ ! ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = ffecom_expr (info->open_spec[FFESTP_openixIOSTAT].u.expr); } else if (ffeste_io_abort_ != NULL_TREE) ! { ! /* Have no IOSTAT= but have ERR=. */ ! ffeste_io_iostat_is_temp_ = TRUE; ffeste_io_iostat_ ! = ffecom_make_tempvar ("open", ffecom_integer_type_node, ! FFETARGET_charactersizeNONE, -1); } else ! { ! /* No IOSTAT= or ERR= specification. */ ! ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = NULL_TREE; } + /* Now prescan, then convert, all the arguments. */ + + args = ffeste_io_olist_ (errl || iostat, + info->open_spec[FFESTP_openixUNIT].u.expr, + &info->open_spec[FFESTP_openixFILE], + &info->open_spec[FFESTP_openixSTATUS], + &info->open_spec[FFESTP_openixACCESS], + &info->open_spec[FFESTP_openixFORM], + &info->open_spec[FFESTP_openixRECL], + &info->open_spec[FFESTP_openixBLANK]); + /* Don't generate "if (iostat != 0) goto label;" if label is temp abort label, since we're gonna fall through to there anyway. */ ! ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFOPEN, args, NULL_TREE), ! ! ffeste_io_abort_is_temp_); ! /* If we've got a temp label, generate its code here. */ if (ffeste_io_abort_is_temp_) { *************** ffeste_R904 (ffestpOpenStmt *info) *** 3323,3349 **** assert (ffeste_io_err_ == NULL_TREE); } ! /* If we've got a temp iostat, pop the temp. */ ! ! if (ffeste_io_iostat_is_temp_) ! ffecom_pop_tempvar (ffeste_io_iostat_); ! ! ffecom_pop_calltemps (); ! ! #undef specified } - - clear_momentary (); #else #error #endif } ! /* ffeste_R907 -- CLOSE statement ! ! ffeste_R907(); ! ! Make sure a CLOSE is valid in the current context, and implement it. */ void ffeste_R907 (ffestpCloseStmt *info) --- 3823,3836 ---- assert (ffeste_io_err_ == NULL_TREE); } ! ffeste_end_stmt_ (); } #else #error #endif } ! /* CLOSE statement. */ void ffeste_R907 (ffestpCloseStmt *info) *************** ffeste_R907 (ffestpCloseStmt *info) *** 3363,3380 **** bool iostat; bool errl; - #define specified(something) (info->close_spec[something].kw_or_val_present) - ffeste_emit_line_note_ (); iostat = specified (FFESTP_closeixIOSTAT); errl = specified (FFESTP_closeixERR); ! ffecom_push_calltemps (); ! args = ffeste_io_cllist_ (errl || iostat, ! info->close_spec[FFESTP_closeixUNIT].u.expr, ! &info->close_spec[FFESTP_closeixSTATUS]); if (errl) { --- 3850,3865 ---- bool iostat; bool errl; ffeste_emit_line_note_ (); + #define specified(something) (info->close_spec[something].kw_or_val_present) + iostat = specified (FFESTP_closeixIOSTAT); errl = specified (FFESTP_closeixERR); ! #undef specified ! ffeste_start_stmt_ (); if (errl) { *************** ffeste_R907 (ffestpCloseStmt *info) *** 3395,3423 **** } if (iostat) ! { /* IOSTAT= */ ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = ffecom_expr (info->close_spec[FFESTP_closeixIOSTAT].u.expr); } else if (ffeste_io_abort_ != NULL_TREE) ! { /* no IOSTAT= but ERR= */ ffeste_io_iostat_is_temp_ = TRUE; ffeste_io_iostat_ ! = ffecom_push_tempvar (ffecom_integer_type_node, ! FFETARGET_charactersizeNONE, -1, FALSE); } else ! { /* no IOSTAT=, or ERR= */ ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = NULL_TREE; } /* Don't generate "if (iostat != 0) goto label;" if label is temp abort label, since we're gonna fall through to there anyway. */ ! ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFCLOS, args), ! !ffeste_io_abort_is_temp_); /* If we've got a temp label, generate its code here. */ --- 3880,3920 ---- } if (iostat) ! { ! /* Have IOSTAT= specification. */ ! ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = ffecom_expr (info->close_spec[FFESTP_closeixIOSTAT].u.expr); } else if (ffeste_io_abort_ != NULL_TREE) ! { ! /* Have no IOSTAT= but have ERR=. */ ! ffeste_io_iostat_is_temp_ = TRUE; ffeste_io_iostat_ ! = ffecom_make_tempvar ("close", ffecom_integer_type_node, ! FFETARGET_charactersizeNONE, -1); } else ! { ! /* No IOSTAT= or ERR= specification. */ ! ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = NULL_TREE; } + /* Now prescan, then convert, all the arguments. */ + + args = ffeste_io_cllist_ (errl || iostat, + info->close_spec[FFESTP_closeixUNIT].u.expr, + &info->close_spec[FFESTP_closeixSTATUS]); + /* Don't generate "if (iostat != 0) goto label;" if label is temp abort label, since we're gonna fall through to there anyway. */ ! ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFCLOS, args, NULL_TREE), ! ! ffeste_io_abort_is_temp_); /* If we've got a temp label, generate its code here. */ *************** ffeste_R907 (ffestpCloseStmt *info) *** 3430,3457 **** assert (ffeste_io_err_ == NULL_TREE); } ! /* If we've got a temp iostat, pop the temp. */ ! ! if (ffeste_io_iostat_is_temp_) ! ffecom_pop_tempvar (ffeste_io_iostat_); ! ! ffecom_pop_calltemps (); ! ! #undef specified } - - clear_momentary (); #else #error #endif } ! /* ffeste_R909_start -- READ(...) statement list begin ! ! ffeste_R909_start(FALSE); ! ! Verify that READ is valid here, and begin accepting items in the ! list. */ void ffeste_R909_start (ffestpReadStmt *info, bool only_format UNUSED, --- 3927,3940 ---- assert (ffeste_io_err_ == NULL_TREE); } ! ffeste_end_stmt_ (); } #else #error #endif } ! /* READ(...) statement -- start. */ void ffeste_R909_start (ffestpReadStmt *info, bool only_format UNUSED, *************** ffeste_R909_start (ffestpReadStmt *info, *** 3527,3538 **** fputs (") ", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC - #define specified(something) (info->read_spec[something].kw_or_val_present) - ffeste_emit_line_note_ (); - /* Do the real work. */ - { ffecomGfrt start; ffecomGfrt end; --- 4010,4017 ---- *************** ffeste_R909_start (ffestpReadStmt *info, *** 3542,3551 **** bool endl; /* First determine the start, per-item, and end run-time functions to ! call. The per-item function is picked by choosing an ffeste functio to call to handle a given item; it knows how to generate a call to the ! appropriate run-time function, and is called an "io driver". It ! handles the implied-DO construct, for example. */ switch (format) { --- 4021,4029 ---- bool endl; /* First determine the start, per-item, and end run-time functions to ! call. The per-item function is picked by choosing an ffeste function to call to handle a given item; it knows how to generate a call to the ! appropriate run-time function, and is called an "I/O driver". */ switch (format) { *************** ffeste_R909_start (ffestpReadStmt *info, *** 3598,3642 **** } ffeste_io_endgfrt_ = end; iostat = specified (FFESTP_readixIOSTAT); errl = specified (FFESTP_readixERR); endl = specified (FFESTP_readixEND); ! ffecom_push_calltemps (); ! if (unit == FFESTV_unitCHAREXPR) ! { ! cilist = ffeste_io_icilist_ (errl || iostat, ! info->read_spec[FFESTP_readixUNIT].u.expr, ! endl || iostat, format, ! &info->read_spec[FFESTP_readixFORMAT]); ! } ! else ! { ! cilist = ffeste_io_cilist_ (errl || iostat, unit, ! info->read_spec[FFESTP_readixUNIT].u.expr, ! 5, endl || iostat, format, ! &info->read_spec[FFESTP_readixFORMAT], ! rec, ! info->read_spec[FFESTP_readixREC].u.expr); ! } if (errl) ! { /* ERR= */ ffeste_io_err_ ! = ffecom_lookup_label ! (info->read_spec[FFESTP_readixERR].u.label); if (endl) ! { /* ERR= END= */ ffeste_io_end_ ! = ffecom_lookup_label ! (info->read_spec[FFESTP_readixEND].u.label); ffeste_io_abort_is_temp_ = TRUE; ffeste_io_abort_ = ffecom_temp_label (); } else ! { /* ERR= but no END= */ ffeste_io_end_ = NULL_TREE; if ((ffeste_io_abort_is_temp_ = iostat)) ffeste_io_abort_ = ffecom_temp_label (); --- 4076,4109 ---- } ffeste_io_endgfrt_ = end; + #define specified(something) (info->read_spec[something].kw_or_val_present) + iostat = specified (FFESTP_readixIOSTAT); errl = specified (FFESTP_readixERR); endl = specified (FFESTP_readixEND); ! #undef specified ! ffeste_start_stmt_ (); if (errl) ! { ! /* Have ERR= specification. */ ! ffeste_io_err_ ! = ffecom_lookup_label (info->read_spec[FFESTP_readixERR].u.label); if (endl) ! { ! /* Have both ERR= and END=. Need a temp label to handle both. */ ffeste_io_end_ ! = ffecom_lookup_label (info->read_spec[FFESTP_readixEND].u.label); ffeste_io_abort_is_temp_ = TRUE; ffeste_io_abort_ = ffecom_temp_label (); } else ! { ! /* Have ERR= but no END=. */ ffeste_io_end_ = NULL_TREE; if ((ffeste_io_abort_is_temp_ = iostat)) ffeste_io_abort_ = ffecom_temp_label (); *************** ffeste_R909_start (ffestpReadStmt *info, *** 3645,3664 **** } } else ! { /* no ERR= */ ffeste_io_err_ = NULL_TREE; if (endl) ! { /* END= but no ERR= */ ffeste_io_end_ ! = ffecom_lookup_label ! (info->read_spec[FFESTP_readixEND].u.label); if ((ffeste_io_abort_is_temp_ = iostat)) ffeste_io_abort_ = ffecom_temp_label (); else ffeste_io_abort_ = ffeste_io_end_; } else ! { /* no ERR= or END= */ ffeste_io_end_ = NULL_TREE; if ((ffeste_io_abort_is_temp_ = iostat)) ffeste_io_abort_ = ffecom_temp_label (); --- 4112,4135 ---- } } else ! { ! /* No ERR= specification. */ ! ffeste_io_err_ = NULL_TREE; if (endl) ! { ! /* Have END= but no ERR=. */ ffeste_io_end_ ! = ffecom_lookup_label (info->read_spec[FFESTP_readixEND].u.label); if ((ffeste_io_abort_is_temp_ = iostat)) ffeste_io_abort_ = ffecom_temp_label (); else ffeste_io_abort_ = ffeste_io_end_; } else ! { ! /* Have no ERR= or END=. */ ! ffeste_io_end_ = NULL_TREE; if ((ffeste_io_abort_is_temp_ = iostat)) ffeste_io_abort_ = ffecom_temp_label (); *************** ffeste_R909_start (ffestpReadStmt *info, *** 3668,3713 **** } if (iostat) ! { /* IOSTAT= */ ffeste_io_iostat_is_temp_ = FALSE; ! ffeste_io_iostat_ = ffecom_expr ! (info->read_spec[FFESTP_readixIOSTAT].u.expr); } else if (ffeste_io_abort_ != NULL_TREE) ! { /* no IOSTAT= but ERR= or END= or both */ ffeste_io_iostat_is_temp_ = TRUE; ffeste_io_iostat_ ! = ffecom_push_tempvar (ffecom_integer_type_node, ! FFETARGET_charactersizeNONE, -1, FALSE); } else ! { /* no IOSTAT=, ERR=, or END= */ ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = NULL_TREE; } /* If there is no end function, then there are no item functions (i.e. it's a NAMELIST), and vice versa by the way. In this situation, don't generate the "if (iostat != 0) goto label;" if the label is temp abort label, since we're gonna fall through to there anyway. */ ! ffeste_io_call_ (ffecom_call_gfrt (start, cilist), ! !ffeste_io_abort_is_temp_ || (end != FFECOM_gfrt)); } - - #undef specified - - push_momentary (); #else #error #endif } ! /* ffeste_R909_item -- READ statement i/o item ! ! ffeste_R909_item(expr,expr_token); ! ! Implement output-list expression. */ void ffeste_R909_item (ffebld expr, ffelexToken expr_token) --- 4139,4197 ---- } if (iostat) ! { ! /* Have IOSTAT= specification. */ ! ffeste_io_iostat_is_temp_ = FALSE; ! ffeste_io_iostat_ ! = ffecom_expr (info->read_spec[FFESTP_readixIOSTAT].u.expr); } else if (ffeste_io_abort_ != NULL_TREE) ! { ! /* Have no IOSTAT= but have ERR= and/or END=. */ ! ffeste_io_iostat_is_temp_ = TRUE; ffeste_io_iostat_ ! = ffecom_make_tempvar ("read", ffecom_integer_type_node, ! FFETARGET_charactersizeNONE, -1); } else ! { ! /* No IOSTAT=, ERR=, or END= specification. */ ! ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = NULL_TREE; } + /* Now prescan, then convert, all the arguments. */ + + if (unit == FFESTV_unitCHAREXPR) + cilist = ffeste_io_icilist_ (errl || iostat, + info->read_spec[FFESTP_readixUNIT].u.expr, + endl || iostat, format, + &info->read_spec[FFESTP_readixFORMAT]); + else + cilist = ffeste_io_cilist_ (errl || iostat, unit, + info->read_spec[FFESTP_readixUNIT].u.expr, + 5, endl || iostat, format, + &info->read_spec[FFESTP_readixFORMAT], + rec, + info->read_spec[FFESTP_readixREC].u.expr); + /* If there is no end function, then there are no item functions (i.e. it's a NAMELIST), and vice versa by the way. In this situation, don't generate the "if (iostat != 0) goto label;" if the label is temp abort label, since we're gonna fall through to there anyway. */ ! ffeste_io_call_ (ffecom_call_gfrt (start, cilist, NULL_TREE), ! (! ffeste_io_abort_is_temp_) || (end != FFECOM_gfrt)); } #else #error #endif } ! /* READ statement -- I/O item. */ void ffeste_R909_item (ffebld expr, ffelexToken expr_token) *************** ffeste_R909_item (ffebld expr, ffelexTok *** 3720,3746 **** #elif FFECOM_targetCURRENT == FFECOM_targetGCC if (expr == NULL) return; while (ffebld_op (expr) == FFEBLD_opPAREN) ! expr = ffebld_left (expr); /* "READ *,(A)" -- really a bug in the user's ! code, but I've been told lots of code does ! this (blech)! */ if (ffebld_op (expr) == FFEBLD_opANY) return; if (ffebld_op (expr) == FFEBLD_opIMPDO) ffeste_io_impdo_ (expr, expr_token); else ! ffeste_io_call_ ((*ffeste_io_driver_) (expr), TRUE); ! clear_momentary (); #else #error #endif } ! /* ffeste_R909_finish -- READ statement list complete ! ! ffeste_R909_finish(); ! ! Just wrap up any local activities. */ void ffeste_R909_finish () --- 4204,4238 ---- #elif FFECOM_targetCURRENT == FFECOM_targetGCC if (expr == NULL) return; + + /* Strip parens off items such as in "READ *,(A)". This is really a bug + in the user's code, but I've been told lots of code does this. */ while (ffebld_op (expr) == FFEBLD_opPAREN) ! expr = ffebld_left (expr); ! if (ffebld_op (expr) == FFEBLD_opANY) return; + if (ffebld_op (expr) == FFEBLD_opIMPDO) ffeste_io_impdo_ (expr, expr_token); else ! { ! ffeste_start_stmt_ (); ! ! ffecom_prepare_arg_ptr_to_expr (expr); ! ! ffecom_prepare_end (); ! ! ffeste_io_call_ ((*ffeste_io_driver_) (expr), TRUE); ! ! ffeste_end_stmt_ (); ! } #else #error #endif } ! /* READ statement -- end. */ void ffeste_R909_finish () *************** ffeste_R909_finish () *** 3754,3826 **** /* Don't generate "if (iostat != 0) goto label;" if label is temp abort label, since we're gonna fall through to there anyway. */ ! { ! if (ffeste_io_endgfrt_ != FFECOM_gfrt) ! ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE), ! !ffeste_io_abort_is_temp_); ! ! clear_momentary (); ! pop_momentary (); ! ! /* If we've got a temp label, generate its code here and have it fan out ! to the END= or ERR= label as appropriate. */ ! ! if (ffeste_io_abort_is_temp_) ! { ! DECL_INITIAL (ffeste_io_abort_) = error_mark_node; ! emit_nop (); ! expand_label (ffeste_io_abort_); ! /* if (iostat<0) goto end_label; */ ! if ((ffeste_io_end_ != NULL_TREE) ! && (TREE_CODE (ffeste_io_end_) != ERROR_MARK)) ! { ! expand_start_cond (ffecom_truth_value ! (ffecom_2 (LT_EXPR, integer_type_node, ! ffeste_io_iostat_, ! ffecom_integer_zero_node)), ! 0); ! expand_goto (ffeste_io_end_); ! expand_end_cond (); ! } ! ! /* if (iostat>0) goto err_label; */ ! ! if ((ffeste_io_err_ != NULL_TREE) ! && (TREE_CODE (ffeste_io_err_) != ERROR_MARK)) ! { ! expand_start_cond (ffecom_truth_value ! (ffecom_2 (GT_EXPR, integer_type_node, ! ffeste_io_iostat_, ! ffecom_integer_zero_node)), ! 0); ! expand_goto (ffeste_io_err_); ! expand_end_cond (); ! } ! } ! /* If we've got a temp iostat, pop the temp. */ ! if (ffeste_io_iostat_is_temp_) ! ffecom_pop_tempvar (ffeste_io_iostat_); ! ffecom_pop_calltemps (); ! clear_momentary (); ! } #else #error #endif } ! /* ffeste_R910_start -- WRITE(...) statement list begin ! ! ffeste_R910_start(); ! ! Verify that WRITE is valid here, and begin accepting items in the ! list. */ void ffeste_R910_start (ffestpWriteStmt *info, ffestvUnit unit, --- 4246,4301 ---- /* Don't generate "if (iostat != 0) goto label;" if label is temp abort label, since we're gonna fall through to there anyway. */ ! if (ffeste_io_endgfrt_ != FFECOM_gfrt) ! ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE, ! NULL_TREE), ! ! ffeste_io_abort_is_temp_); ! /* If we've got a temp label, generate its code here and have it fan out ! to the END= or ERR= label as appropriate. */ ! if (ffeste_io_abort_is_temp_) ! { ! DECL_INITIAL (ffeste_io_abort_) = error_mark_node; ! emit_nop (); ! expand_label (ffeste_io_abort_); ! /* "if (iostat<0) goto end_label;". */ ! if ((ffeste_io_end_ != NULL_TREE) ! && (TREE_CODE (ffeste_io_end_) != ERROR_MARK)) ! { ! expand_start_cond (ffecom_truth_value ! (ffecom_2 (LT_EXPR, integer_type_node, ! ffeste_io_iostat_, ! ffecom_integer_zero_node)), ! 0); ! expand_goto (ffeste_io_end_); ! expand_end_cond (); ! } ! /* "if (iostat>0) goto err_label;". */ ! if ((ffeste_io_err_ != NULL_TREE) ! && (TREE_CODE (ffeste_io_err_) != ERROR_MARK)) ! { ! expand_start_cond (ffecom_truth_value ! (ffecom_2 (GT_EXPR, integer_type_node, ! ffeste_io_iostat_, ! ffecom_integer_zero_node)), ! 0); ! expand_goto (ffeste_io_err_); ! expand_end_cond (); ! } ! } ! ffeste_end_stmt_ (); #else #error #endif } ! /* WRITE statement -- start. */ void ffeste_R910_start (ffestpWriteStmt *info, ffestvUnit unit, *************** ffeste_R910_start (ffestpWriteStmt *info *** 3874,3885 **** fputs (") ", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC - #define specified(something) (info->write_spec[something].kw_or_val_present) - ffeste_emit_line_note_ (); - /* Do the real work. */ - { ffecomGfrt start; ffecomGfrt end; --- 4349,4356 ---- *************** ffeste_R910_start (ffestpWriteStmt *info *** 3888,3897 **** bool errl; /* First determine the start, per-item, and end run-time functions to ! call. The per-item function is picked by choosing an ffeste functio to call to handle a given item; it knows how to generate a call to the ! appropriate run-time function, and is called an "io driver". It ! handles the implied-DO construct, for example. */ switch (format) { --- 4359,4367 ---- bool errl; /* First determine the start, per-item, and end run-time functions to ! call. The per-item function is picked by choosing an ffeste function to call to handle a given item; it knows how to generate a call to the ! appropriate run-time function, and is called an "I/O driver". */ switch (format) { *************** ffeste_R910_start (ffestpWriteStmt *info *** 3936,3967 **** } ffeste_io_endgfrt_ = end; iostat = specified (FFESTP_writeixIOSTAT); errl = specified (FFESTP_writeixERR); ! ffecom_push_calltemps (); ! if (unit == FFESTV_unitCHAREXPR) ! { ! cilist = ffeste_io_icilist_ (errl || iostat, ! info->write_spec[FFESTP_writeixUNIT].u.expr, ! FALSE, format, ! &info->write_spec[FFESTP_writeixFORMAT]); ! } ! else ! { ! cilist = ffeste_io_cilist_ (errl || iostat, unit, ! info->write_spec[FFESTP_writeixUNIT].u.expr, ! 6, FALSE, format, ! &info->write_spec[FFESTP_writeixFORMAT], ! rec, ! info->write_spec[FFESTP_writeixREC].u.expr); ! } ffeste_io_end_ = NULL_TREE; if (errl) ! { /* ERR= */ ffeste_io_err_ = ffeste_io_abort_ = ffecom_lookup_label --- 4406,4426 ---- } ffeste_io_endgfrt_ = end; + #define specified(something) (info->write_spec[something].kw_or_val_present) + iostat = specified (FFESTP_writeixIOSTAT); errl = specified (FFESTP_writeixERR); ! #undef specified ! ffeste_start_stmt_ (); ffeste_io_end_ = NULL_TREE; if (errl) ! { ! /* Have ERR= specification. */ ! ffeste_io_err_ = ffeste_io_abort_ = ffecom_lookup_label *************** ffeste_R910_start (ffestpWriteStmt *info *** 3969,3975 **** ffeste_io_abort_is_temp_ = FALSE; } else ! { /* no ERR= */ ffeste_io_err_ = NULL_TREE; if ((ffeste_io_abort_is_temp_ = iostat)) --- 4428,4436 ---- ffeste_io_abort_is_temp_ = FALSE; } else ! { ! /* No ERR= specification. */ ! ffeste_io_err_ = NULL_TREE; if ((ffeste_io_abort_is_temp_ = iostat)) *************** ffeste_R910_start (ffestpWriteStmt *info *** 3979,4024 **** } if (iostat) ! { /* IOSTAT= */ ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = ffecom_expr (info->write_spec[FFESTP_writeixIOSTAT].u.expr); } else if (ffeste_io_abort_ != NULL_TREE) ! { /* no IOSTAT= but ERR= */ ffeste_io_iostat_is_temp_ = TRUE; ffeste_io_iostat_ ! = ffecom_push_tempvar (ffecom_integer_type_node, ! FFETARGET_charactersizeNONE, -1, FALSE); } else ! { /* no IOSTAT=, or ERR= */ ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = NULL_TREE; } /* If there is no end function, then there are no item functions (i.e. it's a NAMELIST), and vice versa by the way. In this situation, don't generate the "if (iostat != 0) goto label;" if the label is temp abort label, since we're gonna fall through to there anyway. */ ! ffeste_io_call_ (ffecom_call_gfrt (start, cilist), ! !ffeste_io_abort_is_temp_ || (end != FFECOM_gfrt)); } - - #undef specified - - push_momentary (); #else #error #endif } ! /* ffeste_R910_item -- WRITE statement i/o item ! ! ffeste_R910_item(expr,expr_token); ! ! Implement output-list expression. */ void ffeste_R910_item (ffebld expr, ffelexToken expr_token) --- 4440,4498 ---- } if (iostat) ! { ! /* Have IOSTAT= specification. */ ! ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = ffecom_expr (info->write_spec[FFESTP_writeixIOSTAT].u.expr); } else if (ffeste_io_abort_ != NULL_TREE) ! { ! /* Have no IOSTAT= but have ERR=. */ ! ffeste_io_iostat_is_temp_ = TRUE; ffeste_io_iostat_ ! = ffecom_make_tempvar ("write", ffecom_integer_type_node, ! FFETARGET_charactersizeNONE, -1); } else ! { ! /* No IOSTAT= or ERR= specification. */ ! ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = NULL_TREE; } + /* Now prescan, then convert, all the arguments. */ + + if (unit == FFESTV_unitCHAREXPR) + cilist = ffeste_io_icilist_ (errl || iostat, + info->write_spec[FFESTP_writeixUNIT].u.expr, + FALSE, format, + &info->write_spec[FFESTP_writeixFORMAT]); + else + cilist = ffeste_io_cilist_ (errl || iostat, unit, + info->write_spec[FFESTP_writeixUNIT].u.expr, + 6, FALSE, format, + &info->write_spec[FFESTP_writeixFORMAT], + rec, + info->write_spec[FFESTP_writeixREC].u.expr); + /* If there is no end function, then there are no item functions (i.e. it's a NAMELIST), and vice versa by the way. In this situation, don't generate the "if (iostat != 0) goto label;" if the label is temp abort label, since we're gonna fall through to there anyway. */ ! ffeste_io_call_ (ffecom_call_gfrt (start, cilist, NULL_TREE), ! (! ffeste_io_abort_is_temp_) || (end != FFECOM_gfrt)); } #else #error #endif } ! /* WRITE statement -- I/O item. */ void ffeste_R910_item (ffebld expr, ffelexToken expr_token) *************** ffeste_R910_item (ffebld expr, ffelexTok *** 4031,4053 **** #elif FFECOM_targetCURRENT == FFECOM_targetGCC if (expr == NULL) return; if (ffebld_op (expr) == FFEBLD_opANY) return; if (ffebld_op (expr) == FFEBLD_opIMPDO) ffeste_io_impdo_ (expr, expr_token); else ! ffeste_io_call_ ((*ffeste_io_driver_) (expr), TRUE); ! clear_momentary (); #else #error #endif } ! /* ffeste_R910_finish -- WRITE statement list complete ! ! ffeste_R910_finish(); ! ! Just wrap up any local activities. */ void ffeste_R910_finish () --- 4505,4534 ---- #elif FFECOM_targetCURRENT == FFECOM_targetGCC if (expr == NULL) return; + if (ffebld_op (expr) == FFEBLD_opANY) return; + if (ffebld_op (expr) == FFEBLD_opIMPDO) ffeste_io_impdo_ (expr, expr_token); else ! { ! ffeste_start_stmt_ (); ! ! ffecom_prepare_arg_ptr_to_expr (expr); ! ! ffecom_prepare_end (); ! ! ffeste_io_call_ ((*ffeste_io_driver_) (expr), TRUE); ! ! ffeste_end_stmt_ (); ! } #else #error #endif } ! /* WRITE statement -- end. */ void ffeste_R910_finish () *************** ffeste_R910_finish () *** 4061,4105 **** /* Don't generate "if (iostat != 0) goto label;" if label is temp abort label, since we're gonna fall through to there anyway. */ ! { ! if (ffeste_io_endgfrt_ != FFECOM_gfrt) ! ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE), ! !ffeste_io_abort_is_temp_); ! ! clear_momentary (); ! pop_momentary (); ! ! /* If we've got a temp label, generate its code here. */ ! ! if (ffeste_io_abort_is_temp_) ! { ! DECL_INITIAL (ffeste_io_abort_) = error_mark_node; ! emit_nop (); ! expand_label (ffeste_io_abort_); ! ! assert (ffeste_io_err_ == NULL_TREE); ! } ! /* If we've got a temp iostat, pop the temp. */ ! if (ffeste_io_iostat_is_temp_) ! ffecom_pop_tempvar (ffeste_io_iostat_); ! ffecom_pop_calltemps (); ! clear_momentary (); ! } #else #error #endif } ! /* ffeste_R911_start -- PRINT statement list begin ! ! ffeste_R911_start(); ! ! Verify that PRINT is valid here, and begin accepting items in the ! list. */ void ffeste_R911_start (ffestpPrintStmt *info, ffestvFormat format) --- 4542,4570 ---- /* Don't generate "if (iostat != 0) goto label;" if label is temp abort label, since we're gonna fall through to there anyway. */ ! if (ffeste_io_endgfrt_ != FFECOM_gfrt) ! ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE, ! NULL_TREE), ! ! ffeste_io_abort_is_temp_); ! /* If we've got a temp label, generate its code here. */ ! if (ffeste_io_abort_is_temp_) ! { ! DECL_INITIAL (ffeste_io_abort_) = error_mark_node; ! emit_nop (); ! expand_label (ffeste_io_abort_); ! assert (ffeste_io_err_ == NULL_TREE); ! } ! ffeste_end_stmt_ (); #else #error #endif } ! /* PRINT statement -- start. */ void ffeste_R911_start (ffestpPrintStmt *info, ffestvFormat format) *************** ffeste_R911_start (ffestpPrintStmt *info *** 4132,4149 **** ffeste_emit_line_note_ (); - /* Do the real work. */ - { ffecomGfrt start; ffecomGfrt end; tree cilist; /* First determine the start, per-item, and end run-time functions to ! call. The per-item function is picked by choosing an ffeste functio to call to handle a given item; it knows how to generate a call to the ! appropriate run-time function, and is called an "io driver". It ! handles the implied-DO construct, for example. */ switch (format) { --- 4597,4611 ---- ffeste_emit_line_note_ (); { ffecomGfrt start; ffecomGfrt end; tree cilist; /* First determine the start, per-item, and end run-time functions to ! call. The per-item function is picked by choosing an ffeste function to call to handle a given item; it knows how to generate a call to the ! appropriate run-time function, and is called an "I/O driver". */ switch (format) { *************** ffeste_R911_start (ffestpPrintStmt *info *** 4172,4181 **** } ffeste_io_endgfrt_ = end; ! ffecom_push_calltemps (); ! ! cilist = ffeste_io_cilist_ (FALSE, FFESTV_unitNONE, NULL, 6, FALSE, format, ! &info->print_spec[FFESTP_printixFORMAT], FALSE, NULL); ffeste_io_end_ = NULL_TREE; ffeste_io_err_ = NULL_TREE; --- 4634,4640 ---- } ffeste_io_endgfrt_ = end; ! ffeste_start_stmt_ (); ffeste_io_end_ = NULL_TREE; ffeste_io_err_ = NULL_TREE; *************** ffeste_R911_start (ffestpPrintStmt *info *** 4184,4209 **** ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = NULL_TREE; /* If there is no end function, then there are no item functions (i.e. it's a NAMELIST), and vice versa by the way. In this situation, don't generate the "if (iostat != 0) goto label;" if the label is temp abort label, since we're gonna fall through to there anyway. */ ! ffeste_io_call_ (ffecom_call_gfrt (start, cilist), ! !ffeste_io_abort_is_temp_ || (end != FFECOM_gfrt)); } - - push_momentary (); #else #error #endif } ! /* ffeste_R911_item -- PRINT statement i/o item ! ! ffeste_R911_item(expr,expr_token); ! ! Implement output-list expression. */ void ffeste_R911_item (ffebld expr, ffelexToken expr_token) --- 4643,4667 ---- ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = NULL_TREE; + /* Now prescan, then convert, all the arguments. */ + + cilist = ffeste_io_cilist_ (FALSE, FFESTV_unitNONE, NULL, 6, FALSE, format, + &info->print_spec[FFESTP_printixFORMAT], FALSE, NULL); + /* If there is no end function, then there are no item functions (i.e. it's a NAMELIST), and vice versa by the way. In this situation, don't generate the "if (iostat != 0) goto label;" if the label is temp abort label, since we're gonna fall through to there anyway. */ ! ffeste_io_call_ (ffecom_call_gfrt (start, cilist, NULL_TREE), ! (! ffeste_io_abort_is_temp_) || (end != FFECOM_gfrt)); } #else #error #endif } ! /* PRINT statement -- I/O item. */ void ffeste_R911_item (ffebld expr, ffelexToken expr_token) *************** ffeste_R911_item (ffebld expr, ffelexTok *** 4216,4238 **** #elif FFECOM_targetCURRENT == FFECOM_targetGCC if (expr == NULL) return; if (ffebld_op (expr) == FFEBLD_opANY) return; if (ffebld_op (expr) == FFEBLD_opIMPDO) ffeste_io_impdo_ (expr, expr_token); else ! ffeste_io_call_ ((*ffeste_io_driver_) (expr), FALSE); ! clear_momentary (); #else #error #endif } ! /* ffeste_R911_finish -- PRINT statement list complete ! ! ffeste_R911_finish(); ! ! Just wrap up any local activities. */ void ffeste_R911_finish () --- 4674,4703 ---- #elif FFECOM_targetCURRENT == FFECOM_targetGCC if (expr == NULL) return; + if (ffebld_op (expr) == FFEBLD_opANY) return; + if (ffebld_op (expr) == FFEBLD_opIMPDO) ffeste_io_impdo_ (expr, expr_token); else ! { ! ffeste_start_stmt_ (); ! ! ffecom_prepare_arg_ptr_to_expr (expr); ! ! ffecom_prepare_end (); ! ! ffeste_io_call_ ((*ffeste_io_driver_) (expr), TRUE); ! ! ffeste_end_stmt_ (); ! } #else #error #endif } ! /* PRINT statement -- end. */ void ffeste_R911_finish () *************** ffeste_R911_finish () *** 4242,4268 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - if (ffeste_io_endgfrt_ != FFECOM_gfrt) - ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE), - FALSE); ! ffecom_pop_calltemps (); ! clear_momentary (); ! pop_momentary (); ! clear_momentary (); ! } #else #error #endif } ! /* ffeste_R919 -- BACKSPACE statement ! ! ffeste_R919(); ! ! Make sure a BACKSPACE is valid in the current context, and implement it. */ void ffeste_R919 (ffestpBeruStmt *info) --- 4707,4725 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC ! if (ffeste_io_endgfrt_ != FFECOM_gfrt) ! ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE, ! NULL_TREE), ! FALSE); ! ffeste_end_stmt_ (); #else #error #endif } ! /* BACKSPACE statement. */ void ffeste_R919 (ffestpBeruStmt *info) *************** ffeste_R919 (ffestpBeruStmt *info) *** 4282,4292 **** #endif } ! /* ffeste_R920 -- ENDFILE statement ! ! ffeste_R920(); ! ! Make sure a ENDFILE is valid in the current context, and implement it. */ void ffeste_R920 (ffestpBeruStmt *info) --- 4739,4745 ---- #endif } ! /* ENDFILE statement. */ void ffeste_R920 (ffestpBeruStmt *info) *************** ffeste_R920 (ffestpBeruStmt *info) *** 4306,4316 **** #endif } ! /* ffeste_R921 -- REWIND statement ! ! ffeste_R921(); ! ! Make sure a REWIND is valid in the current context, and implement it. */ void ffeste_R921 (ffestpBeruStmt *info) --- 4759,4765 ---- #endif } ! /* REWIND statement. */ void ffeste_R921 (ffestpBeruStmt *info) *************** ffeste_R921 (ffestpBeruStmt *info) *** 4330,4340 **** #endif } ! /* ffeste_R923A -- INQUIRE statement (non-IOLENGTH version) ! ! ffeste_R923A(bool by_file); ! ! Make sure an INQUIRE is valid in the current context, and implement it. */ void ffeste_R923A (ffestpInquireStmt *info, bool by_file UNUSED) --- 4779,4785 ---- #endif } ! /* INQUIRE statement (non-IOLENGTH version). */ void ffeste_R923A (ffestpInquireStmt *info, bool by_file UNUSED) *************** ffeste_R923A (ffestpInquireStmt *info, b *** 4387,4418 **** bool iostat; bool errl; - #define specified(something) (info->inquire_spec[something].kw_or_val_present) - ffeste_emit_line_note_ (); iostat = specified (FFESTP_inquireixIOSTAT); errl = specified (FFESTP_inquireixERR); ! ffecom_push_calltemps (); ! args = ffeste_io_inlist_ (errl || iostat, ! &info->inquire_spec[FFESTP_inquireixUNIT], ! &info->inquire_spec[FFESTP_inquireixFILE], ! &info->inquire_spec[FFESTP_inquireixEXIST], ! &info->inquire_spec[FFESTP_inquireixOPENED], ! &info->inquire_spec[FFESTP_inquireixNUMBER], ! &info->inquire_spec[FFESTP_inquireixNAMED], ! &info->inquire_spec[FFESTP_inquireixNAME], ! &info->inquire_spec[FFESTP_inquireixACCESS], ! &info->inquire_spec[FFESTP_inquireixSEQUENTIAL], ! &info->inquire_spec[FFESTP_inquireixDIRECT], ! &info->inquire_spec[FFESTP_inquireixFORM], ! &info->inquire_spec[FFESTP_inquireixFORMATTED], ! &info->inquire_spec[FFESTP_inquireixUNFORMATTED], ! &info->inquire_spec[FFESTP_inquireixRECL], ! &info->inquire_spec[FFESTP_inquireixNEXTREC], ! &info->inquire_spec[FFESTP_inquireixBLANK]); if (errl) { --- 4832,4847 ---- bool iostat; bool errl; ffeste_emit_line_note_ (); + #define specified(something) (info->inquire_spec[something].kw_or_val_present) + iostat = specified (FFESTP_inquireixIOSTAT); errl = specified (FFESTP_inquireixERR); ! #undef specified ! ffeste_start_stmt_ (); if (errl) { *************** ffeste_R923A (ffestpInquireStmt *info, b *** 4433,4463 **** } if (iostat) ! { /* IOSTAT= */ ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = ffecom_expr (info->inquire_spec[FFESTP_inquireixIOSTAT].u.expr); } else if (ffeste_io_abort_ != NULL_TREE) ! { /* no IOSTAT= but ERR= */ ffeste_io_iostat_is_temp_ = TRUE; ffeste_io_iostat_ ! = ffecom_push_tempvar (ffecom_integer_type_node, ! FFETARGET_charactersizeNONE, -1, FALSE); } else ! { /* no IOSTAT=, or ERR= */ ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = NULL_TREE; } /* Don't generate "if (iostat != 0) goto label;" if label is temp abort label, since we're gonna fall through to there anyway. */ ! ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFINQU, args), ! !ffeste_io_abort_is_temp_); ! /* If we've got a temp label, generate its code here. */ if (ffeste_io_abort_is_temp_) { --- 4862,4919 ---- } if (iostat) ! { ! /* Have IOSTAT= specification. */ ! ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = ffecom_expr (info->inquire_spec[FFESTP_inquireixIOSTAT].u.expr); } else if (ffeste_io_abort_ != NULL_TREE) ! { ! /* Have no IOSTAT= but have ERR=. */ ! ffeste_io_iostat_is_temp_ = TRUE; ffeste_io_iostat_ ! = ffecom_make_tempvar ("inquire", ffecom_integer_type_node, ! FFETARGET_charactersizeNONE, -1); } else ! { ! /* No IOSTAT= or ERR= specification. */ ! ffeste_io_iostat_is_temp_ = FALSE; ffeste_io_iostat_ = NULL_TREE; } + /* Now prescan, then convert, all the arguments. */ + + args + = ffeste_io_inlist_ (errl || iostat, + &info->inquire_spec[FFESTP_inquireixUNIT], + &info->inquire_spec[FFESTP_inquireixFILE], + &info->inquire_spec[FFESTP_inquireixEXIST], + &info->inquire_spec[FFESTP_inquireixOPENED], + &info->inquire_spec[FFESTP_inquireixNUMBER], + &info->inquire_spec[FFESTP_inquireixNAMED], + &info->inquire_spec[FFESTP_inquireixNAME], + &info->inquire_spec[FFESTP_inquireixACCESS], + &info->inquire_spec[FFESTP_inquireixSEQUENTIAL], + &info->inquire_spec[FFESTP_inquireixDIRECT], + &info->inquire_spec[FFESTP_inquireixFORM], + &info->inquire_spec[FFESTP_inquireixFORMATTED], + &info->inquire_spec[FFESTP_inquireixUNFORMATTED], + &info->inquire_spec[FFESTP_inquireixRECL], + &info->inquire_spec[FFESTP_inquireixNEXTREC], + &info->inquire_spec[FFESTP_inquireixBLANK]); + /* Don't generate "if (iostat != 0) goto label;" if label is temp abort label, since we're gonna fall through to there anyway. */ ! ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFINQU, args, NULL_TREE), ! ! ffeste_io_abort_is_temp_); ! /* If we've got a temp label, generate its code here. */ if (ffeste_io_abort_is_temp_) { *************** ffeste_R923A (ffestpInquireStmt *info, b *** 4468,4495 **** assert (ffeste_io_err_ == NULL_TREE); } ! /* If we've got a temp iostat, pop the temp. */ ! ! if (ffeste_io_iostat_is_temp_) ! ffecom_pop_tempvar (ffeste_io_iostat_); ! ! ffecom_pop_calltemps (); ! ! #undef specified } - - clear_momentary (); #else #error #endif } ! /* ffeste_R923B_start -- INQUIRE(IOLENGTH=expr) statement list begin ! ! ffeste_R923B_start(); ! ! Verify that INQUIRE is valid here, and begin accepting items in the ! list. */ void ffeste_R923B_start (ffestpInquireStmt *info UNUSED) --- 4924,4937 ---- assert (ffeste_io_err_ == NULL_TREE); } ! ffeste_end_stmt_ (); } #else #error #endif } ! /* INQUIRE(IOLENGTH=expr) statement -- start. */ void ffeste_R923B_start (ffestpInquireStmt *info UNUSED) *************** ffeste_R923B_start (ffestpInquireStmt *i *** 4502,4519 **** fputs (") ", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC assert ("INQUIRE(IOLENGTH=) not implemented yet! ~~~" == NULL); ffeste_emit_line_note_ (); - clear_momentary (); #else #error #endif } ! /* ffeste_R923B_item -- INQUIRE statement i/o item ! ! ffeste_R923B_item(expr,expr_token); ! ! Implement output-list expression. */ void ffeste_R923B_item (ffebld expr UNUSED) --- 4944,4957 ---- fputs (") ", dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC assert ("INQUIRE(IOLENGTH=) not implemented yet! ~~~" == NULL); + ffeste_emit_line_note_ (); #else #error #endif } ! /* INQUIRE(IOLENGTH=expr) statement -- I/O item. */ void ffeste_R923B_item (ffebld expr UNUSED) *************** ffeste_R923B_item (ffebld expr UNUSED) *** 4524,4540 **** ffebld_dump (expr); fputc (',', dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC - clear_momentary (); #else #error #endif } ! /* ffeste_R923B_finish -- INQUIRE statement list complete ! ! ffeste_R923B_finish(); ! ! Just wrap up any local activities. */ void ffeste_R923B_finish () --- 4962,4973 ---- ffebld_dump (expr); fputc (',', dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else #error #endif } ! /* INQUIRE(IOLENGTH=expr) statement -- end. */ void ffeste_R923B_finish () *************** ffeste_R923B_finish () *** 4544,4550 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', dmpout); #elif FFECOM_targetCURRENT == FFECOM_targetGCC - clear_momentary (); #else #error #endif --- 4977,4982 ---- *************** ffeste_R1001 (ffests s) *** 4616,4624 **** #endif } ! /* ffeste_R1103 -- End a PROGRAM ! ! ffeste_R1103(); */ void ffeste_R1103 () --- 5048,5054 ---- #endif } ! /* END PROGRAM. */ void ffeste_R1103 () *************** ffeste_R1103 () *** 4631,4639 **** #endif } ! /* ffeste_R1112 -- End a BLOCK DATA ! ! ffeste_R1112(TRUE); */ void ffeste_R1112 () --- 5061,5067 ---- #endif } ! /* END BLOCK DATA. */ void ffeste_R1112 () *************** ffeste_R1112 () *** 4646,4656 **** #endif } ! /* ffeste_R1212 -- CALL statement ! ! ffeste_R1212(expr,expr_token); ! ! Make sure statement is valid here; implement. */ void ffeste_R1212 (ffebld expr) --- 5074,5080 ---- #endif } ! /* CALL statement. */ void ffeste_R1212 (ffebld expr) *************** ffeste_R1212 (ffebld expr) *** 4715,4720 **** --- 5139,5165 ---- else ffebld_set_trail (prevargs, NULL); + ffeste_start_stmt_ (); + + /* No temporaries are actually needed at this level, but we go + through the motions anyway, just to be sure in case they do + get made. Temporaries needed for arguments should be in the + scopes of inner blocks, and if clean-up actions are supported, + such as CALL-ing an intrinsic that writes to an argument of one + type when a variable of a different type is provided (requiring + assignment to the variable from a temporary after the library + routine returns), the clean-up must be done by the expression + evaluator, generally, to handle alternate returns (which we hope + won't ever be supported by intrinsics, but might be a similar + issue, such as CALL-ing an F90-style subroutine with an INTERFACE + block). That implies the expression evaluator will have to + recognize the need for its own temporary anyway, meaning it'll + construct a block within the one constructed here. */ + + ffecom_prepare_expr (expr); + + ffecom_prepare_end (); + if (labels == NULL) expand_expr_stmt (ffecom_expr (expr)); else *************** ffeste_R1212 (ffebld expr) *** 4725,4767 **** int caseno; int pushok; tree duplicate; texpr = ffecom_expr (expr); expand_start_case (0, texpr, TREE_TYPE (texpr), "CALL statement"); ! push_momentary (); /* In case of many labels, keep 'em cleared ! out. */ ! for (caseno = 1; ! labels != NULL; ! ++caseno, labels = ffebld_trail (labels)) { value = build_int_2 (caseno, 0); tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE); pushok = pushcase (value, convert, tlabel, &duplicate); assert (pushok == 0); tlabel ! = ffecom_lookup_label (ffebld_labter (ffebld_head (labels))); if ((tlabel == NULL_TREE) || (TREE_CODE (tlabel) == ERROR_MARK)) continue; TREE_USED (tlabel) = 1; expand_goto (tlabel); - clear_momentary (); } - pop_momentary (); expand_end_case (texpr); } ! clear_momentary (); } #else #error #endif } ! /* ffeste_R1221 -- End a FUNCTION ! ! ffeste_R1221(TRUE); */ void ffeste_R1221 () --- 5170,5210 ---- int caseno; int pushok; tree duplicate; + ffebld label; texpr = ffecom_expr (expr); expand_start_case (0, texpr, TREE_TYPE (texpr), "CALL statement"); ! ! for (caseno = 1, label = labels; ! label != NULL; ! ++caseno, label = ffebld_trail (label)) { value = build_int_2 (caseno, 0); tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE); pushok = pushcase (value, convert, tlabel, &duplicate); assert (pushok == 0); + tlabel ! = ffecom_lookup_label (ffebld_labter (ffebld_head (label))); if ((tlabel == NULL_TREE) || (TREE_CODE (tlabel) == ERROR_MARK)) continue; TREE_USED (tlabel) = 1; expand_goto (tlabel); } expand_end_case (texpr); } ! ! ffeste_end_stmt_ (); } #else #error #endif } ! /* END FUNCTION. */ void ffeste_R1221 () *************** ffeste_R1221 () *** 4774,4782 **** #endif } ! /* ffeste_R1225 -- End a SUBROUTINE ! ! ffeste_R1225(TRUE); */ void ffeste_R1225 () --- 5217,5223 ---- #endif } ! /* END SUBROUTINE. */ void ffeste_R1225 () *************** ffeste_R1225 () *** 4789,4800 **** #endif } ! /* ffeste_R1226 -- ENTRY statement ! ! ffeste_R1226(entryname,arglist,ending_token); ! ! Make sure we're in a SUBROUTINE or FUNCTION, register arguments for the ! entry point name, and so on. */ void ffeste_R1226 (ffesymbol entry) --- 5230,5236 ---- #endif } ! /* ENTRY statement. */ void ffeste_R1226 (ffesymbol entry) *************** ffeste_R1226 (ffesymbol entry) *** 4842,4864 **** ffeste_emit_line_note_ (); DECL_INITIAL (label) = error_mark_node; emit_nop (); expand_label (label); - - clear_momentary (); } #else #error #endif } ! /* ffeste_R1227 -- RETURN statement ! ! ffeste_R1227(expr); ! ! Make sure statement is valid here; implement. expr and expr_token are ! both NULL if there was no expression. */ void ffeste_R1227 (ffestw block UNUSED, ffebld expr) --- 5278,5296 ---- ffeste_emit_line_note_ (); + if (label == error_mark_node) + return; + DECL_INITIAL (label) = error_mark_node; emit_nop (); expand_label (label); } #else #error #endif } ! /* RETURN statement. */ void ffeste_R1227 (ffestw block UNUSED, ffebld expr) *************** ffeste_R1227 (ffestw block UNUSED, ffebl *** 4881,4887 **** tree rtn; ffeste_emit_line_note_ (); ! ffecom_push_calltemps (); rtn = ffecom_return_expr (expr); --- 5313,5324 ---- tree rtn; ffeste_emit_line_note_ (); ! ! ffeste_start_stmt_ (); ! ! ffecom_prepare_return_expr (expr); ! ! ffecom_prepare_end (); rtn = ffecom_return_expr (expr); *************** ffeste_R1227 (ffestw block UNUSED, ffebl *** 4902,4921 **** expand_null_return (); } ! ffecom_pop_calltemps (); ! clear_momentary (); } #else #error #endif } ! /* ffeste_V018_start -- REWRITE(...) statement list begin ! ! ffeste_V018_start(); ! ! Verify that REWRITE is valid here, and begin accepting items in the ! list. */ #if FFESTR_VXT void --- 5339,5352 ---- expand_null_return (); } ! ffeste_end_stmt_ (); } #else #error #endif } ! /* REWRITE statement -- start. */ #if FFESTR_VXT void *************** ffeste_V018_start (ffestpRewriteStmt *in *** 4950,4960 **** #endif } ! /* ffeste_V018_item -- REWRITE statement i/o item ! ! ffeste_V018_item(expr,expr_token); ! ! Implement output-list expression. */ void ffeste_V018_item (ffebld expr) --- 5381,5387 ---- #endif } ! /* REWRITE statement -- I/O item. */ void ffeste_V018_item (ffebld expr) *************** ffeste_V018_item (ffebld expr) *** 4970,4980 **** #endif } ! /* ffeste_V018_finish -- REWRITE statement list complete ! ! ffeste_V018_finish(); ! ! Just wrap up any local activities. */ void ffeste_V018_finish () --- 5397,5403 ---- #endif } ! /* REWRITE statement -- end. */ void ffeste_V018_finish () *************** ffeste_V018_finish () *** 4989,5000 **** #endif } ! /* ffeste_V019_start -- ACCEPT statement list begin ! ! ffeste_V019_start(); ! ! Verify that ACCEPT is valid here, and begin accepting items in the ! list. */ void ffeste_V019_start (ffestpAcceptStmt *info, ffestvFormat format) --- 5412,5418 ---- #endif } ! /* ACCEPT statement -- start. */ void ffeste_V019_start (ffestpAcceptStmt *info, ffestvFormat format) *************** ffeste_V019_start (ffestpAcceptStmt *inf *** 5029,5039 **** #endif } ! /* ffeste_V019_item -- ACCEPT statement i/o item ! ! ffeste_V019_item(expr,expr_token); ! ! Implement output-list expression. */ void ffeste_V019_item (ffebld expr) --- 5447,5453 ---- #endif } ! /* ACCEPT statement -- I/O item. */ void ffeste_V019_item (ffebld expr) *************** ffeste_V019_item (ffebld expr) *** 5049,5059 **** #endif } ! /* ffeste_V019_finish -- ACCEPT statement list complete ! ! ffeste_V019_finish(); ! ! Just wrap up any local activities. */ void ffeste_V019_finish () --- 5463,5469 ---- #endif } ! /* ACCEPT statement -- end. */ void ffeste_V019_finish () *************** ffeste_V019_finish () *** 5069,5080 **** } #endif ! /* ffeste_V020_start -- TYPE statement list begin ! ! ffeste_V020_start(); ! ! Verify that TYPE is valid here, and begin accepting items in the ! list. */ void ffeste_V020_start (ffestpTypeStmt *info UNUSED, --- 5479,5485 ---- } #endif ! /* TYPE statement -- start. */ void ffeste_V020_start (ffestpTypeStmt *info UNUSED, *************** ffeste_V020_start (ffestpTypeStmt *info *** 5110,5120 **** #endif } ! /* ffeste_V020_item -- TYPE statement i/o item ! ! ffeste_V020_item(expr,expr_token); ! ! Implement output-list expression. */ void ffeste_V020_item (ffebld expr UNUSED) --- 5515,5521 ---- #endif } ! /* TYPE statement -- I/O item. */ void ffeste_V020_item (ffebld expr UNUSED) *************** ffeste_V020_item (ffebld expr UNUSED) *** 5130,5140 **** #endif } ! /* ffeste_V020_finish -- TYPE statement list complete ! ! ffeste_V020_finish(); ! ! Just wrap up any local activities. */ void ffeste_V020_finish () --- 5531,5537 ---- #endif } ! /* TYPE statement -- end. */ void ffeste_V020_finish () *************** ffeste_V020_finish () *** 5149,5159 **** #endif } ! /* ffeste_V021 -- DELETE statement ! ! ffeste_V021(); ! ! Make sure a DELETE is valid in the current context, and implement it. */ #if FFESTR_VXT void --- 5546,5552 ---- #endif } ! /* DELETE statement. */ #if FFESTR_VXT void *************** ffeste_V021 (ffestpDeleteStmt *info) *** 5174,5184 **** #endif } ! /* ffeste_V022 -- UNLOCK statement ! ! ffeste_V022(); ! ! Make sure a UNLOCK is valid in the current context, and implement it. */ void ffeste_V022 (ffestpBeruStmt *info) --- 5567,5573 ---- #endif } ! /* UNLOCK statement. */ void ffeste_V022 (ffestpBeruStmt *info) *************** ffeste_V022 (ffestpBeruStmt *info) *** 5197,5208 **** #endif } ! /* ffeste_V023_start -- ENCODE(...) statement list begin ! ! ffeste_V023_start(); ! ! Verify that ENCODE is valid here, and begin accepting items in the ! list. */ void ffeste_V023_start (ffestpVxtcodeStmt *info) --- 5586,5592 ---- #endif } ! /* ENCODE statement -- start. */ void ffeste_V023_start (ffestpVxtcodeStmt *info) *************** ffeste_V023_start (ffestpVxtcodeStmt *in *** 5223,5233 **** #endif } ! /* ffeste_V023_item -- ENCODE statement i/o item ! ! ffeste_V023_item(expr,expr_token); ! ! Implement output-list expression. */ void ffeste_V023_item (ffebld expr) --- 5607,5613 ---- #endif } ! /* ENCODE statement -- I/O item. */ void ffeste_V023_item (ffebld expr) *************** ffeste_V023_item (ffebld expr) *** 5243,5253 **** #endif } ! /* ffeste_V023_finish -- ENCODE statement list complete ! ! ffeste_V023_finish(); ! ! Just wrap up any local activities. */ void ffeste_V023_finish () --- 5623,5629 ---- #endif } ! /* ENCODE statement -- end. */ void ffeste_V023_finish () *************** ffeste_V023_finish () *** 5262,5273 **** #endif } ! /* ffeste_V024_start -- DECODE(...) statement list begin ! ! ffeste_V024_start(); ! ! Verify that DECODE is valid here, and begin accepting items in the ! list. */ void ffeste_V024_start (ffestpVxtcodeStmt *info) --- 5638,5644 ---- #endif } ! /* DECODE statement -- start. */ void ffeste_V024_start (ffestpVxtcodeStmt *info) *************** ffeste_V024_start (ffestpVxtcodeStmt *in *** 5288,5298 **** #endif } ! /* ffeste_V024_item -- DECODE statement i/o item ! ! ffeste_V024_item(expr,expr_token); ! ! Implement output-list expression. */ void ffeste_V024_item (ffebld expr) --- 5659,5665 ---- #endif } ! /* DECODE statement -- I/O item. */ void ffeste_V024_item (ffebld expr) *************** ffeste_V024_item (ffebld expr) *** 5308,5318 **** #endif } ! /* ffeste_V024_finish -- DECODE statement list complete ! ! ffeste_V024_finish(); ! ! Just wrap up any local activities. */ void ffeste_V024_finish () --- 5675,5681 ---- #endif } ! /* DECODE statement -- end. */ void ffeste_V024_finish () *************** ffeste_V024_finish () *** 5327,5338 **** #endif } ! /* ffeste_V025_start -- DEFINEFILE statement list begin ! ! ffeste_V025_start(); ! ! Verify that DEFINEFILE is valid here, and begin accepting items in the ! list. */ void ffeste_V025_start () --- 5690,5696 ---- #endif } ! /* DEFINEFILE statement -- start. */ void ffeste_V025_start () *************** ffeste_V025_start () *** 5347,5357 **** #endif } ! /* ffeste_V025_item -- DEFINE FILE statement item ! ! ffeste_V025_item(u,ut,m,mt,n,nt,asv,asvt); ! ! Implement item. */ void ffeste_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv) --- 5705,5711 ---- #endif } ! /* DEFINE FILE statement -- item. */ void ffeste_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv) *************** ffeste_V025_item (ffebld u, ffebld m, ff *** 5373,5383 **** #endif } ! /* ffeste_V025_finish -- DEFINE FILE statement list complete ! ! ffeste_V025_finish(); ! ! Just wrap up any local activities. */ void ffeste_V025_finish () --- 5727,5733 ---- #endif } ! /* DEFINE FILE statement -- end. */ void ffeste_V025_finish () *************** ffeste_V025_finish () *** 5392,5402 **** #endif } ! /* ffeste_V026 -- FIND statement ! ! ffeste_V026(); ! ! Make sure a FIND is valid in the current context, and implement it. */ void ffeste_V026 (ffestpFindStmt *info) --- 5742,5748 ---- #endif } ! /* FIND statement. */ void ffeste_V026 (ffestpFindStmt *info) *************** ffeste_V026 (ffestpFindStmt *info) *** 5416,5419 **** --- 5762,5773 ---- #endif } + #endif + + #ifdef ENABLE_CHECKING + void + ffeste_terminate_2 (void) + { + assert (! ffeste_top_block_); + } #endif diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/ste.h gcc-2.95/gcc/f/ste.h *** egcs-1.1.2/gcc/f/ste.h Tue May 19 03:50:17 1998 --- gcc-2.95/gcc/f/ste.h Sat Apr 17 03:58:30 1999 *************** *** 1,6 **** /* ste.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* ste.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** void ffeste_end_R807 (void); *** 62,71 **** void ffeste_labeldef_branch (ffelab label); void ffeste_labeldef_format (ffelab label); void ffeste_R737A (ffebld dest, ffebld source); ! void ffeste_R803 (ffebld expr); ! void ffeste_R804 (ffebld expr); ! void ffeste_R805 (void); ! void ffeste_R806 (void); void ffeste_R807 (ffebld expr); void ffeste_R809 (ffestw block, ffebld expr); void ffeste_R810 (ffestw block, unsigned long casenum); --- 62,71 ---- void ffeste_labeldef_branch (ffelab label); void ffeste_labeldef_format (ffelab label); void ffeste_R737A (ffebld dest, ffebld source); ! void ffeste_R803 (ffestw block, ffebld expr); ! void ffeste_R804 (ffestw block, ffebld expr); ! void ffeste_R805 (ffestw block); ! void ffeste_R806 (ffestw block); void ffeste_R807 (ffebld expr); void ffeste_R809 (ffestw block, ffebld expr); void ffeste_R810 (ffestw block, unsigned long casenum); *************** void ffeste_V026 (ffestpFindStmt *info); *** 159,165 **** --- 159,169 ---- #endif /* FFECOM_targetCURRENT == FFECOM_targetFFE */ #define ffeste_terminate_0() #define ffeste_terminate_1() + #ifdef ENABLE_CHECKING + void ffeste_terminate_2 (void); + #else #define ffeste_terminate_2() + #endif #define ffeste_terminate_3() #define ffeste_terminate_4() diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/storag.c gcc-2.95/gcc/f/storag.c *** egcs-1.1.2/gcc/f/storag.c Tue May 19 03:50:18 1998 --- gcc-2.95/gcc/f/storag.c Mon Feb 15 10:17:36 1999 *************** *** 1,6 **** /* storag.c -- Implementation File (module.c template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* storag.c -- Implementation File (module.c template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/storag.h gcc-2.95/gcc/f/storag.h *** egcs-1.1.2/gcc/f/storag.h Tue May 19 03:50:19 1998 --- gcc-2.95/gcc/f/storag.h Mon Feb 15 10:17:37 1999 *************** *** 1,6 **** /* storag.h -- Public #include File (module.h template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* storag.h -- Public #include File (module.h template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/stp.c gcc-2.95/gcc/f/stp.c *** egcs-1.1.2/gcc/f/stp.c Tue May 19 03:50:20 1998 --- gcc-2.95/gcc/f/stp.c Mon Feb 15 10:17:38 1999 *************** *** 1,6 **** /* stp.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* stp.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/stp.h gcc-2.95/gcc/f/stp.h *** egcs-1.1.2/gcc/f/stp.h Tue May 19 03:50:21 1998 --- gcc-2.95/gcc/f/stp.h Mon Feb 15 10:17:39 1999 *************** *** 1,6 **** /* stp.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* stp.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/str-1t.fin gcc-2.95/gcc/f/str-1t.fin *** egcs-1.1.2/gcc/f/str-1t.fin Sun Jul 19 16:56:13 1998 --- gcc-2.95/gcc/f/str-1t.fin Mon Feb 15 10:17:40 1999 *************** *** 1,6 **** { Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- { Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/str-2t.fin gcc-2.95/gcc/f/str-2t.fin *** egcs-1.1.2/gcc/f/str-2t.fin Tue May 19 03:50:23 1998 --- gcc-2.95/gcc/f/str-2t.fin Mon Feb 15 10:17:41 1999 *************** *** 1,6 **** { Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- { Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/str-fo.fin gcc-2.95/gcc/f/str-fo.fin *** egcs-1.1.2/gcc/f/str-fo.fin Tue May 19 03:50:24 1998 --- gcc-2.95/gcc/f/str-fo.fin Mon Feb 15 10:17:42 1999 *************** *** 1,6 **** { Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- { Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/str-io.fin gcc-2.95/gcc/f/str-io.fin *** egcs-1.1.2/gcc/f/str-io.fin Tue May 19 03:50:25 1998 --- gcc-2.95/gcc/f/str-io.fin Mon Feb 15 10:17:43 1999 *************** *** 1,6 **** { Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- { Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/str-nq.fin gcc-2.95/gcc/f/str-nq.fin *** egcs-1.1.2/gcc/f/str-nq.fin Tue May 19 03:50:26 1998 --- gcc-2.95/gcc/f/str-nq.fin Mon Feb 15 10:17:44 1999 *************** *** 1,6 **** { Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- { Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/str-op.fin gcc-2.95/gcc/f/str-op.fin *** egcs-1.1.2/gcc/f/str-op.fin Tue May 19 03:50:27 1998 --- gcc-2.95/gcc/f/str-op.fin Mon Feb 15 10:17:46 1999 *************** *** 1,6 **** { Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- { Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/str-ot.fin gcc-2.95/gcc/f/str-ot.fin *** egcs-1.1.2/gcc/f/str-ot.fin Tue May 19 03:50:28 1998 --- gcc-2.95/gcc/f/str-ot.fin Mon Feb 15 10:17:47 1999 *************** *** 1,6 **** { Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- { Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/str.c gcc-2.95/gcc/f/str.c *** egcs-1.1.2/gcc/f/str.c Tue May 19 03:50:29 1998 --- gcc-2.95/gcc/f/str.c Mon Feb 15 10:17:48 1999 *************** *** 1,6 **** /* str.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* str.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/str.h gcc-2.95/gcc/f/str.h *** egcs-1.1.2/gcc/f/str.h Tue May 19 03:50:30 1998 --- gcc-2.95/gcc/f/str.h Mon Feb 15 10:17:49 1999 *************** *** 1,6 **** /* str.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* str.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/sts.c gcc-2.95/gcc/f/sts.c *** egcs-1.1.2/gcc/f/sts.c Tue May 19 03:50:31 1998 --- gcc-2.95/gcc/f/sts.c Tue Mar 30 01:23:44 1999 *************** *** 1,6 **** /* sts.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* sts.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** ffests_new (ffests s, mallocPool pool, f *** 104,110 **** Like printf, but into a string. */ void ! ffests_printf_1D (ffests s, char *ctl, long arg1) { char quickbuf[40]; char *buff; --- 104,110 ---- Like printf, but into a string. */ void ! ffests_printf_1D (ffests s, const char *ctl, long arg1) { char quickbuf[40]; char *buff; *************** ffests_printf_1D (ffests s, char *ctl, l *** 133,139 **** Like printf, but into a string. */ void ! ffests_printf_1U (ffests s, char *ctl, unsigned long arg1) { char quickbuf[40]; char *buff; --- 133,139 ---- Like printf, but into a string. */ void ! ffests_printf_1U (ffests s, const char *ctl, unsigned long arg1) { char quickbuf[40]; char *buff; *************** ffests_printf_1U (ffests s, char *ctl, u *** 162,168 **** Like printf, but into a string. */ void ! ffests_printf_1s (ffests s, char *ctl, char *arg1) { char quickbuf[40]; char *buff; --- 162,168 ---- Like printf, but into a string. */ void ! ffests_printf_1s (ffests s, const char *ctl, const char *arg1) { char quickbuf[40]; char *buff; *************** ffests_printf_1s (ffests s, char *ctl, c *** 190,196 **** Like printf, but into a string. */ void ! ffests_printf_2Us (ffests s, char *ctl, unsigned long arg1, char *arg2) { char quickbuf[60]; char *buff; --- 190,196 ---- Like printf, but into a string. */ void ! ffests_printf_2Us (ffests s, const char *ctl, unsigned long arg1, const char *arg2) { char quickbuf[60]; char *buff; *************** ffests_putc (ffests s, char c) *** 228,234 **** ffests_puts(s,"append me"); */ void ! ffests_puts (ffests s, char *string) { ffests_puttext (s, string, strlen (string)); } --- 228,234 ---- ffests_puts(s,"append me"); */ void ! ffests_puts (ffests s, const char *string) { ffests_puttext (s, string, strlen (string)); } *************** ffests_puts (ffests s, char *string) *** 242,248 **** and may be 0. */ void ! ffests_puttext (ffests s, char *text, ffestsLength length) { ffestsLength newlen; ffestsLength newmax; --- 242,248 ---- and may be 0. */ void ! ffests_puttext (ffests s, const char *text, ffestsLength length) { ffestsLength newlen; ffestsLength newmax; diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/sts.h gcc-2.95/gcc/f/sts.h *** egcs-1.1.2/gcc/f/sts.h Tue May 19 03:50:32 1998 --- gcc-2.95/gcc/f/sts.h Tue Mar 30 01:23:45 1999 *************** *** 1,6 **** /* sts.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* sts.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** struct _ffests_ *** 60,73 **** void ffests_kill (ffests s); void ffests_new (ffests s, mallocPool pool, ffestsLength size); ! void ffests_printf_1D (ffests s, char *ctl, long arg1); ! void ffests_printf_1U (ffests s, char *ctl, unsigned long arg1); ! void ffests_printf_1s (ffests s, char *ctl, char *arg1); ! void ffests_printf_2Us (ffests s, char *ctl, unsigned long arg1, ! char *arg2); void ffests_putc (ffests s, char c); ! void ffests_puts (ffests s, char *string); ! void ffests_puttext (ffests s, char *text, ffestsLength length); /* Define macros. */ --- 60,73 ---- void ffests_kill (ffests s); void ffests_new (ffests s, mallocPool pool, ffestsLength size); ! void ffests_printf_1D (ffests s, const char *ctl, long arg1); ! void ffests_printf_1U (ffests s, const char *ctl, unsigned long arg1); ! void ffests_printf_1s (ffests s, const char *ctl, const char *arg1); ! void ffests_printf_2Us (ffests s, const char *ctl, unsigned long arg1, ! const char *arg2); void ffests_putc (ffests s, char c); ! void ffests_puts (ffests s, const char *string); ! void ffests_puttext (ffests s, const char *text, ffestsLength length); /* Define macros. */ diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/stt.c gcc-2.95/gcc/f/stt.c *** egcs-1.1.2/gcc/f/stt.c Mon Jun 15 19:23:38 1998 --- gcc-2.95/gcc/f/stt.c Tue Mar 30 01:23:46 1999 *************** *** 1,6 **** /* stt.c -- Implementation File (module.c template V1.0) Copyright (C) 1995, 1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* stt.c -- Implementation File (module.c template V1.0) Copyright (C) 1995, 1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** ffestt_exprlist_create () *** 598,604 **** at a time. */ void ! ffestt_exprlist_drive (ffesttExprList list, void (*fn) ()) { ffesttExprList next; --- 598,604 ---- at a time. */ void ! ffestt_exprlist_drive (ffesttExprList list, void (*fn) (ffebld, ffelexToken)) { ffesttExprList next; *************** ffestt_implist_create () *** 837,843 **** The token pairs in the list are passed to the function one pair at a time. */ void ! ffestt_implist_drive (ffesttImpList list, void (*fn) ()) { ffesttImpList next; --- 837,843 ---- The token pairs in the list are passed to the function one pair at a time. */ void ! ffestt_implist_drive (ffesttImpList list, void (*fn) (ffelexToken, ffelexToken)) { ffesttImpList next; *************** ffestt_tokenlist_create () *** 951,957 **** The tokens in the list are passed to the given function. */ void ! ffestt_tokenlist_drive (ffesttTokenList tl, void (*fn) ()) { ffesttTokenItem ti; --- 951,957 ---- The tokens in the list are passed to the given function. */ void ! ffestt_tokenlist_drive (ffesttTokenList tl, void (*fn) (ffelexToken)) { ffesttTokenItem ti; diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/stt.h gcc-2.95/gcc/f/stt.h *** egcs-1.1.2/gcc/f/stt.h Mon Jun 15 19:23:39 1998 --- gcc-2.95/gcc/f/stt.h Tue Mar 30 01:23:47 1999 *************** *** 1,6 **** /* stt.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* stt.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** void ffestt_dimlist_kill (ffesttDimList *** 181,187 **** ffestpDimtype ffestt_dimlist_type (ffesttDimList dims, bool is_ugly_assumed); void ffestt_exprlist_append (ffesttExprList list, ffebld expr, ffelexToken t); ffesttExprList ffestt_exprlist_create (void); ! void ffestt_exprlist_drive (ffesttExprList list, void (*fn) ()); #if FFECOM_targetCURRENT == FFECOM_targetFFE void ffestt_exprlist_dump (ffesttExprList list); #endif --- 181,187 ---- ffestpDimtype ffestt_dimlist_type (ffesttDimList dims, bool is_ugly_assumed); void ffestt_exprlist_append (ffesttExprList list, ffebld expr, ffelexToken t); ffesttExprList ffestt_exprlist_create (void); ! void ffestt_exprlist_drive (ffesttExprList list, void (*fn) (ffebld, ffelexToken)); #if FFECOM_targetCURRENT == FFECOM_targetFFE void ffestt_exprlist_dump (ffesttExprList list); #endif *************** void ffestt_formatlist_kill (ffesttForma *** 196,209 **** void ffestt_implist_append (ffesttImpList list, ffelexToken first, ffelexToken last); ffesttImpList ffestt_implist_create (void); ! void ffestt_implist_drive (ffesttImpList list, void (*fn) ()); #if FFECOM_targetCURRENT == FFECOM_targetFFE void ffestt_implist_dump (ffesttImpList list); #endif void ffestt_implist_kill (ffesttImpList list); void ffestt_tokenlist_append (ffesttTokenList list, ffelexToken t); ffesttTokenList ffestt_tokenlist_create (void); ! void ffestt_tokenlist_drive (ffesttTokenList list, void (*fn) ()); #if FFECOM_targetCURRENT == FFECOM_targetFFE void ffestt_tokenlist_dump (ffesttTokenList list); #endif --- 196,209 ---- void ffestt_implist_append (ffesttImpList list, ffelexToken first, ffelexToken last); ffesttImpList ffestt_implist_create (void); ! void ffestt_implist_drive (ffesttImpList list, void (*fn) (ffelexToken, ffelexToken)); #if FFECOM_targetCURRENT == FFECOM_targetFFE void ffestt_implist_dump (ffesttImpList list); #endif void ffestt_implist_kill (ffesttImpList list); void ffestt_tokenlist_append (ffesttTokenList list, ffelexToken t); ffesttTokenList ffestt_tokenlist_create (void); ! void ffestt_tokenlist_drive (ffesttTokenList list, void (*fn) (ffelexToken)); #if FFECOM_targetCURRENT == FFECOM_targetFFE void ffestt_tokenlist_dump (ffesttTokenList list); #endif diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/stu.c gcc-2.95/gcc/f/stu.c *** egcs-1.1.2/gcc/f/stu.c Tue May 19 03:50:35 1998 --- gcc-2.95/gcc/f/stu.c Tue Mar 30 01:23:48 1999 *************** *** 1,6 **** /* stu.c -- Implementation File (module.c template V1.0) Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* stu.c -- Implementation File (module.c template V1.0) Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** the Free Software Foundation, 59 Temple *** 60,66 **** static void ffestu_list_exec_transition_ (ffebld list); static bool ffestu_symter_end_transition_ (ffebld expr); static bool ffestu_symter_exec_transition_ (ffebld expr); ! static bool ffestu_dummies_transition_ (ffesymbol (*symfunc) (), ffebld list); /* Internal macros. */ --- 60,66 ---- static void ffestu_list_exec_transition_ (ffebld list); static bool ffestu_symter_end_transition_ (ffebld expr); static bool ffestu_symter_exec_transition_ (ffebld expr); ! static bool ffestu_dummies_transition_ (ffesymbol (*symfunc) (ffesymbol), ffebld list); /* Internal macros. */ *************** ffestu_sym_end_transition (ffesymbol s) *** 122,128 **** ffeinfoBasictype bt; ffeinfoKindtype kt; bool array; ! char *name = NULL; ffestu_dummies_transition_ (ffecom_sym_end_transition, ffesymbol_dummyargs (s)); --- 122,128 ---- ffeinfoBasictype bt; ffeinfoKindtype kt; bool array; ! const char *name = NULL; ffestu_dummies_transition_ (ffecom_sym_end_transition, ffesymbol_dummyargs (s)); *************** tail: /* :::::::::::::::::::: */ *** 1114,1120 **** Make sure we don't get called recursively ourselves! */ static bool ! ffestu_dummies_transition_ (ffesymbol (*symfunc) (), ffebld list) { static bool in_progress = FALSE; ffebld item; --- 1114,1120 ---- Make sure we don't get called recursively ourselves! */ static bool ! ffestu_dummies_transition_ (ffesymbol (*symfunc) (ffesymbol), ffebld list) { static bool in_progress = FALSE; ffebld item; diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/stu.h gcc-2.95/gcc/f/stu.h *** egcs-1.1.2/gcc/f/stu.h Tue May 19 03:50:36 1998 --- gcc-2.95/gcc/f/stu.h Mon Feb 15 10:17:55 1999 *************** *** 1,6 **** /* stu.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* stu.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/stv.c gcc-2.95/gcc/f/stv.c *** egcs-1.1.2/gcc/f/stv.c Tue May 19 03:50:37 1998 --- gcc-2.95/gcc/f/stv.c Mon Feb 15 10:17:56 1999 *************** *** 1,6 **** /* stv.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* stv.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/stv.h gcc-2.95/gcc/f/stv.h *** egcs-1.1.2/gcc/f/stv.h Tue May 19 03:50:38 1998 --- gcc-2.95/gcc/f/stv.h Mon Feb 15 10:17:57 1999 *************** *** 1,6 **** /* stv.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* stv.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/stw.c gcc-2.95/gcc/f/stw.c *** egcs-1.1.2/gcc/f/stw.c Tue May 19 03:50:39 1998 --- gcc-2.95/gcc/f/stw.c Tue Mar 30 01:23:49 1999 *************** *** 1,6 **** /* stw.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* stw.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** ffestw ffestw_stack_top_ = NULL; *** 74,80 **** ffestw_display_state(); */ void ! ffestw_display_state () { assert (ffestw_stack_top_ != NULL); --- 74,80 ---- ffestw_display_state(); */ void ! ffestw_display_state (void) { assert (ffestw_stack_top_ != NULL); *************** ffestw_kill (ffestw b) *** 320,326 **** b = ffestw_new(); */ ffestw ! ffestw_new () { ffestw b; --- 320,326 ---- b = ffestw_new(); */ ffestw ! ffestw_new (void) { ffestw b; *************** ffestw_new () *** 335,341 **** ffestw_pop(); */ ffestw ! ffestw_pop () { ffestw b; ffestw oldb = ffestw_stack_top_; --- 335,341 ---- ffestw_pop(); */ ffestw ! ffestw_pop (void) { ffestw b; ffestw oldb = ffestw_stack_top_; diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/stw.h gcc-2.95/gcc/f/stw.h *** egcs-1.1.2/gcc/f/stw.h Tue May 19 03:50:40 1998 --- gcc-2.95/gcc/f/stw.h Sat Apr 17 03:58:31 1999 *************** *** 1,6 **** /* stw.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* stw.h -- Private #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** struct _ffestw_ *** 81,86 **** --- 81,87 ---- tree select_texpr_; /* tree for end case. */ bool select_break_; /* TRUE when CASE should start with gen "break;". */ + int ifthen_fake_else_; /* Number of fake `else' introductions. */ #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC*/ }; *************** extern ffestw ffestw_stack_top_; *** 118,128 **** /* Declare functions with prototypes. */ ! void ffestw_display_state (); void ffestw_kill (ffestw block); void ffestw_init_0 (void); ! ffestw ffestw_new (); ! ffestw ffestw_pop (); ffestw ffestw_push (ffestw block); ffestw ffestw_update (ffestw block); ffestw ffestw_use (ffestw block); --- 119,129 ---- /* Declare functions with prototypes. */ ! void ffestw_display_state (void); void ffestw_kill (ffestw block); void ffestw_init_0 (void); ! ffestw ffestw_new (void); ! ffestw ffestw_pop (void); ffestw ffestw_push (ffestw block); ffestw ffestw_update (ffestw block); ffestw ffestw_use (ffestw block); *************** ffestw ffestw_use (ffestw block); *** 137,142 **** --- 138,144 ---- #define ffestw_do_iter_var(b) ((b)->do_iter_var_) #define ffestw_do_iter_var_t(b) ((b)->do_iter_var_t_) #define ffestw_do_tvar(b) ((b)->do_tvar_) + #define ffestw_ifthen_fake_else(b) ((b)->ifthen_fake_else_) #define ffestw_init_1() #define ffestw_init_2() #define ffestw_init_3() *************** ffestw ffestw_use (ffestw block); *** 156,161 **** --- 158,164 ---- #define ffestw_set_do_iter_var(b,v) ((b)->do_iter_var_ = (v)) #define ffestw_set_do_iter_var_t(b,t) ((b)->do_iter_var_t_ = (t)) #define ffestw_set_do_tvar(b,d) ((b)->do_tvar_ = (d)) + #define ffestw_set_ifthen_fake_else(b,e) ((b)->ifthen_fake_else_ = (e)) #define ffestw_set_label(b,l) ((b)->label_ = (l)) #define ffestw_set_line(b,l) ((b)->line_ = (l)) #define ffestw_set_name(b,n) ((b)->name_ = (n)) diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/symbol.c gcc-2.95/gcc/f/symbol.c *** egcs-1.1.2/gcc/f/symbol.c Mon Jun 15 19:23:40 1998 --- gcc-2.95/gcc/f/symbol.c Sat Apr 17 03:58:33 1999 *************** *** 1,6 **** /* Implementation of Fortran symbol manager Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* Implementation of Fortran symbol manager Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** static ffesymbolRetract_ *ffesymbol_retr *** 117,123 **** /* List of state names. */ ! static char *ffesymbol_state_name_[] = { "?", "@", --- 117,123 ---- /* List of state names. */ ! static const char *ffesymbol_state_name_[] = { "?", "@", *************** static char *ffesymbol_state_name_[] = *** 127,133 **** /* List of attribute names. */ ! static char *ffesymbol_attr_name_[] = { #define DEFATTR(ATTR,ATTRS,NAME) NAME, #include "symbol.def" --- 127,133 ---- /* List of attribute names. */ ! static const char *ffesymbol_attr_name_[] = { #define DEFATTR(ATTR,ATTRS,NAME) NAME, #include "symbol.def" *************** ffesymbol_new_ (ffename n) *** 255,260 **** --- 255,261 ---- s->reported = FALSE; s->explicit_where = FALSE; s->namelisted = FALSE; + s->assigned = FALSE; ffename_set_symbol (n, s); *************** ffesymbol_whine_state_ (ffebad bad, ffel *** 316,322 **** /* Returns a string representing the attributes set. */ ! char * ffesymbol_attrs_string (ffesymbolAttrs attrs) { static char string[FFESYMBOL_attr * 12 + 20]; --- 317,323 ---- /* Returns a string representing the attributes set. */ ! const char * ffesymbol_attrs_string (ffesymbolAttrs attrs) { static char string[FFESYMBOL_attr * 12 + 20]; *************** ffesymbol_declare_subrunit (ffelexToken *** 773,779 **** ffesymbol_drive (fn); */ void ! ffesymbol_drive (ffesymbol (*fn) ()) { assert (ffesymbol_sfunc_ == NULL); /* Might be ok, but not for current uses. */ --- 774,780 ---- ffesymbol_drive (fn); */ void ! ffesymbol_drive (ffesymbol (*fn) (ffesymbol)) { assert (ffesymbol_sfunc_ == NULL); /* Might be ok, but not for current uses. */ *************** ffesymbol_drive (ffesymbol (*fn) ()) *** 787,793 **** ffesymbol_drive_sfnames (fn); */ void ! ffesymbol_drive_sfnames (ffesymbol (*fn) ()) { ffename_space_drive_symbol (ffesymbol_sfunc_, fn); } --- 788,794 ---- ffesymbol_drive_sfnames (fn); */ void ! ffesymbol_drive_sfnames (ffesymbol (*fn) (ffesymbol)) { ffename_space_drive_symbol (ffesymbol_sfunc_, fn); } *************** ffesymbol_signal_change (ffesymbol s) *** 1348,1354 **** /* Returns the string based on the state. */ ! char * ffesymbol_state_string (ffesymbolState state) { if (state >= ARRAY_SIZE (ffesymbol_state_name_)) --- 1349,1355 ---- /* Returns the string based on the state. */ ! const char * ffesymbol_state_string (ffesymbolState state) { if (state >= ARRAY_SIZE (ffesymbol_state_name_)) diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/symbol.def gcc-2.95/gcc/f/symbol.def *** egcs-1.1.2/gcc/f/symbol.def Tue May 19 03:50:42 1998 --- gcc-2.95/gcc/f/symbol.def Mon Feb 15 10:18:01 1999 *************** *** 1,6 **** /* Definitions and documentations for attributes used in GNU F77 compiler Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* Definitions and documentations for attributes used in GNU F77 compiler Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/symbol.h gcc-2.95/gcc/f/symbol.h *** egcs-1.1.2/gcc/f/symbol.h Mon Jun 15 19:23:41 1998 --- gcc-2.95/gcc/f/symbol.h Sat Apr 17 03:58:34 1999 *************** *** 1,6 **** /* Interface definitions for Fortran symbol manager Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* Interface definitions for Fortran symbol manager Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** struct _ffesymbol_ *** 151,164 **** away. */ bool explicit_where; /* TRUE if INTRINSIC/EXTERNAL explicit. */ bool namelisted; /* TRUE if in NAMELIST (needs static alloc). */ }; #define ffesymbol_accretes(s) ((s)->accretes) #define ffesymbol_accretion(s) ((s)->accretion) #define ffesymbol_arraysize(s) ((s)->array_size) #define ffesymbol_attr(s,a) ((s)->attrs & ((ffesymbolAttrs) 1 << (a))) #define ffesymbol_attrs(s) ((s)->attrs) ! char *ffesymbol_attrs_string (ffesymbolAttrs attrs); #define ffesymbol_basictype(s) ffeinfo_basictype((s)->info) void ffesymbol_check (ffesymbol s, ffelexToken t, bool maybe_intrin); #define ffesymbol_common(s) ((s)->common) --- 151,166 ---- away. */ bool explicit_where; /* TRUE if INTRINSIC/EXTERNAL explicit. */ bool namelisted; /* TRUE if in NAMELIST (needs static alloc). */ + bool assigned; /* TRUE if ever ASSIGNed to. */ }; #define ffesymbol_accretes(s) ((s)->accretes) #define ffesymbol_accretion(s) ((s)->accretion) #define ffesymbol_arraysize(s) ((s)->array_size) + #define ffesymbol_assigned(s) ((s)->assigned) #define ffesymbol_attr(s,a) ((s)->attrs & ((ffesymbolAttrs) 1 << (a))) #define ffesymbol_attrs(s) ((s)->attrs) ! const char *ffesymbol_attrs_string (ffesymbolAttrs attrs); #define ffesymbol_basictype(s) ffeinfo_basictype((s)->info) void ffesymbol_check (ffesymbol s, ffelexToken t, bool maybe_intrin); #define ffesymbol_common(s) ((s)->common) *************** ffesymbol ffesymbol_declare_sfdummy (ffe *** 177,184 **** ffesymbol ffesymbol_declare_subrunit (ffelexToken t); #define ffesymbol_dims(s) ((s)->dims) #define ffesymbol_dim_syms(s) ((s)->dim_syms) ! void ffesymbol_drive (ffesymbol (*fn) ()); ! void ffesymbol_drive_sfnames (ffesymbol (*fn) ()); #define ffesymbol_dummyargs(s) ((s)->dummy_args) #if FFECOM_targetCURRENT == FFECOM_targetFFE void ffesymbol_dump (ffesymbol s); --- 179,186 ---- ffesymbol ffesymbol_declare_subrunit (ffelexToken t); #define ffesymbol_dims(s) ((s)->dims) #define ffesymbol_dim_syms(s) ((s)->dim_syms) ! void ffesymbol_drive (ffesymbol (*fn) (ffesymbol)); ! void ffesymbol_drive_sfnames (ffesymbol (*fn) (ffesymbol)); #define ffesymbol_dummyargs(s) ((s)->dummy_args) #if FFECOM_targetCURRENT == FFECOM_targetFFE void ffesymbol_dump (ffesymbol s); *************** bool ffesymbol_retractable (void); *** 231,236 **** --- 233,239 ---- #define ffesymbol_set_accretes(s,a) ((s)->accretes = (a)) #define ffesymbol_set_accretion(s,a) ((s)->accretion = (a)) #define ffesymbol_set_arraysize(s,a) ((s)->array_size = (a)) + #define ffesymbol_set_assigned(s,a) ((s)->assigned = (a)) #define ffesymbol_set_attr(s,a) ((s)->attrs |= ((ffesymbolAttrs) 1 << (a))) #define ffesymbol_set_attrs(s,a) ((s)->attrs = (a)) #define ffesymbol_set_common(s,c) ((s)->common = (c)) *************** void ffesymbol_signal_change (ffesymbol *** 269,275 **** #define ffesymbol_specific(s) ((s)->specific) #define ffesymbol_state(s) ((s)->state) #define ffesymbol_state_is_specable(s) ((s) <= FFESYMBOL_stateSEEN) ! char *ffesymbol_state_string (ffesymbolState state); #define ffesymbol_storage(s) ((s)->storage) void ffesymbol_terminate_0 (void); void ffesymbol_terminate_1 (void); --- 272,278 ---- #define ffesymbol_specific(s) ((s)->specific) #define ffesymbol_state(s) ((s)->state) #define ffesymbol_state_is_specable(s) ((s) <= FFESYMBOL_stateSEEN) ! const char *ffesymbol_state_string (ffesymbolState state); #define ffesymbol_storage(s) ((s)->storage) void ffesymbol_terminate_0 (void); void ffesymbol_terminate_1 (void); diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/system.j gcc-2.95/gcc/f/system.j *** egcs-1.1.2/gcc/f/system.j Mon Jun 15 19:23:42 1998 --- gcc-2.95/gcc/f/system.j Mon Feb 15 10:18:03 1999 *************** *** 1,6 **** /* system.j -- Wrapper for GCC's system.h Copyright (C) 1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* system.j -- Wrapper for GCC's system.h Copyright (C) 1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/target.c gcc-2.95/gcc/f/target.c *** egcs-1.1.2/gcc/f/target.c Wed Jul 1 04:00:51 1998 --- gcc-2.95/gcc/f/target.c Sat Mar 27 02:24:05 1999 *************** *** 1,6 **** /* target.c -- Implementation File (module.c template V1.0) Copyright (C) 1995-1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* target.c -- Implementation File (module.c template V1.0) Copyright (C) 1995-1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** ffetarget_iszero_hollerith (ffetargetHol *** 469,475 **** data type info and the number of elements an array (1 for a scalar). */ void ! ffetarget_layout (char *error_text UNUSED, ffetargetAlign *alignment, ffetargetAlign *modulo, ffetargetOffset *size, ffeinfoBasictype bt, ffeinfoKindtype kt, ffetargetCharacterSize charsize, --- 469,475 ---- data type info and the number of elements an array (1 for a scalar). */ void ! ffetarget_layout (const char *error_text UNUSED, ffetargetAlign *alignment, ffetargetAlign *modulo, ffetargetOffset *size, ffeinfoBasictype bt, ffeinfoKindtype kt, ffetargetCharacterSize charsize, diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/target.h gcc-2.95/gcc/f/target.h *** egcs-1.1.2/gcc/f/target.h Tue May 19 03:50:46 1998 --- gcc-2.95/gcc/f/target.h Sat Mar 27 02:24:06 1999 *************** *** 1,6 **** /* target.h -- Public #include File (module.h template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* target.h -- Public #include File (module.h template V1.0) Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** void ffetarget_integer_bad_magical_prece *** 732,738 **** bool ffetarget_iszero_character1 (ffetargetCharacter1 constant); #endif bool ffetarget_iszero_hollerith (ffetargetHollerith constant); ! void ffetarget_layout (char *error_text, ffetargetAlign *alignment, ffetargetAlign *modulo, ffetargetOffset *size, ffeinfoBasictype bt, ffeinfoKindtype kt, ffetargetCharacterSize charsize, --- 732,738 ---- bool ffetarget_iszero_character1 (ffetargetCharacter1 constant); #endif bool ffetarget_iszero_hollerith (ffetargetHollerith constant); ! void ffetarget_layout (const char *error_text, ffetargetAlign *alignment, ffetargetAlign *modulo, ffetargetOffset *size, ffeinfoBasictype bt, ffeinfoKindtype kt, ffetargetCharacterSize charsize, *************** void *ffetarget_memcpy_ (void *dst, void *** 989,995 **** --- 989,999 ---- #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), \ *************** void *ffetarget_memcpy_ (void *dst, void *** 1041,1047 **** --- 1045,1055 ---- #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; \ *************** void *ffetarget_memcpy_ (void *dst, void *** 1111,1120 **** --- 1119,1133 ---- 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) *************** void *ffetarget_memcpy_ (void *dst, void *** 1128,1137 **** --- 1141,1155 ---- 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) \ *************** void *ffetarget_memcpy_ (void *dst, void *** 1238,1245 **** --- 1256,1267 ---- 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) *************** void *ffetarget_memcpy_ (void *dst, void *** 1272,1279 **** --- 1294,1305 ---- 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) \ diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/tconfig.j gcc-2.95/gcc/f/tconfig.j *** egcs-1.1.2/gcc/f/tconfig.j Tue May 19 03:50:47 1998 --- gcc-2.95/gcc/f/tconfig.j Mon Feb 15 10:18:06 1999 *************** *** 1,6 **** /* tconfig.j -- Wrapper for GCC's tconfig.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* tconfig.j -- Wrapper for GCC's tconfig.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/tm.j gcc-2.95/gcc/f/tm.j *** egcs-1.1.2/gcc/f/tm.j Tue May 19 03:50:48 1998 --- gcc-2.95/gcc/f/tm.j Mon Feb 15 10:18:08 1999 *************** *** 1,6 **** /* tm.j -- Wrapper for GCC's tm.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* tm.j -- Wrapper for GCC's tm.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/top.c gcc-2.95/gcc/f/top.c *** egcs-1.1.2/gcc/f/top.c Wed Jul 15 02:54:10 1998 --- gcc-2.95/gcc/f/top.c Wed May 26 02:49:11 1999 *************** *** 1,6 **** /* top.c -- Implementation File (module.c template V1.0) Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* top.c -- Implementation File (module.c template V1.0) Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** bool ffe_is_do_internal_checks_ = FALSE; *** 65,71 **** bool ffe_is_90_ = FFETARGET_defaultIS_90; bool ffe_is_automatic_ = FFETARGET_defaultIS_AUTOMATIC; bool ffe_is_backslash_ = FFETARGET_defaultIS_BACKSLASH; ! bool ffe_is_emulate_complex_ = TRUE; bool ffe_is_underscoring_ = FFETARGET_defaultEXTERNAL_UNDERSCORED || FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED; bool ffe_is_second_underscore_ = FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED; --- 65,71 ---- bool ffe_is_90_ = FFETARGET_defaultIS_90; bool ffe_is_automatic_ = FFETARGET_defaultIS_AUTOMATIC; bool ffe_is_backslash_ = FFETARGET_defaultIS_BACKSLASH; ! bool ffe_is_emulate_complex_ = FALSE; bool ffe_is_underscoring_ = FFETARGET_defaultEXTERNAL_UNDERSCORED || FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED; bool ffe_is_second_underscore_ = FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED; *************** bool ffe_is_dollar_ok_ = FFETARGET_defau *** 74,88 **** bool ffe_is_f2c_ = FFETARGET_defaultIS_F2C; bool ffe_is_f2c_library_ = FFETARGET_defaultIS_F2C_LIBRARY; bool ffe_is_ffedebug_ = FALSE; bool ffe_is_free_form_ = FFETARGET_defaultIS_FREE_FORM; bool ffe_is_globals_ = TRUE; - bool ffe_is_ident_ = TRUE; bool ffe_is_init_local_zero_ = FFETARGET_defaultIS_INIT_LOCAL_ZERO; bool ffe_is_mainprog_; /* TRUE if current prog unit known to be main. */ bool ffe_is_null_version_ = FALSE; bool ffe_is_onetrip_ = FALSE; bool ffe_is_silent_ = TRUE; bool ffe_is_typeless_boz_ = FALSE; bool ffe_is_pedantic_ = FFETARGET_defaultIS_PEDANTIC; bool ffe_is_saveall_; /* TRUE if mainprog or SAVE (no args) seen. */ --- 74,89 ---- bool ffe_is_f2c_ = FFETARGET_defaultIS_F2C; bool ffe_is_f2c_library_ = FFETARGET_defaultIS_F2C_LIBRARY; bool ffe_is_ffedebug_ = FALSE; + bool ffe_is_flatten_arrays_ = FALSE; bool ffe_is_free_form_ = FFETARGET_defaultIS_FREE_FORM; bool ffe_is_globals_ = TRUE; bool ffe_is_init_local_zero_ = FFETARGET_defaultIS_INIT_LOCAL_ZERO; bool ffe_is_mainprog_; /* TRUE if current prog unit known to be main. */ bool ffe_is_null_version_ = FALSE; bool ffe_is_onetrip_ = FALSE; bool ffe_is_silent_ = TRUE; + bool ffe_is_subscript_check_ = FALSE; bool ffe_is_typeless_boz_ = FALSE; bool ffe_is_pedantic_ = FFETARGET_defaultIS_PEDANTIC; bool ffe_is_saveall_; /* TRUE if mainprog or SAVE (no args) seen. */ *************** ffe_is_digit_string_ (char *s) *** 162,168 **** int ffe_decode_option (argc, argv) ! int argc; char **argv; { char *opt = argv[0]; --- 163,169 ---- int ffe_decode_option (argc, argv) ! int argc ATTRIBUTE_UNUSED; char **argv; { char *opt = argv[0]; *************** ffe_decode_option (argc, argv) *** 177,186 **** } else if (strcmp (&opt[2], "null-version") == 0) ffe_set_is_null_version (TRUE); - else if (strcmp (&opt[2], "ident") == 0) - ffe_set_is_ident (TRUE); - else if (strcmp (&opt[2], "no-ident") == 0) - ffe_set_is_ident (FALSE); else if (strcmp (&opt[2], "f66") == 0) { ffe_set_is_onetrip (TRUE); --- 178,183 ---- *************** ffe_decode_option (argc, argv) *** 220,225 **** --- 217,226 ---- ffe_set_is_f2c_library (TRUE); else if (strcmp (&opt[2], "no-f2c-library") == 0) ffe_set_is_f2c_library (FALSE); + else if (strcmp (&opt[2], "flatten-arrays") == 0) + ffe_set_is_flatten_arrays (TRUE); + else if (strcmp (&opt[2], "no-flatten-arrays") == 0) + ffe_set_is_flatten_arrays (FALSE); else if (strcmp (&opt[2], "free-form") == 0) ffe_set_is_free_form (TRUE); else if (strcmp (&opt[2], "no-free-form") == 0) *************** ffe_decode_option (argc, argv) *** 240,257 **** warning ("%s no longer supported -- try -fvxt", opt); else if (strcmp (&opt[2], "f90-not-vxt") == 0) warning ("%s no longer supported -- try -fno-vxt -ff90", opt); - else if (strcmp (&opt[2], "ugly") == 0) - { - warning ("%s is overloaded with meanings and likely to be removed;", opt); - warning ("use only the specific -fugly-* options you need"); - ffe_set_is_ugly_args (TRUE); - ffe_set_is_ugly_assign (TRUE); - ffe_set_is_ugly_assumed (TRUE); - ffe_set_is_ugly_comma (TRUE); - ffe_set_is_ugly_complex (TRUE); - ffe_set_is_ugly_init (TRUE); - ffe_set_is_ugly_logint (TRUE); - } else if (strcmp (&opt[2], "no-ugly") == 0) { ffe_set_is_ugly_args (FALSE); --- 241,246 ---- *************** ffe_decode_option (argc, argv) *** 334,339 **** --- 323,336 ---- ffe_set_is_globals (TRUE); else if (strcmp (&opt[2], "no-globals") == 0) ffe_set_is_globals (FALSE); + else if (strcmp (&opt[2], "bounds-check") == 0) + ffe_set_is_subscript_check (TRUE); + else if (strcmp (&opt[2], "no-bounds-check") == 0) + ffe_set_is_subscript_check (FALSE); + else if (strcmp (&opt[2], "fortran-bounds-check") == 0) + ffe_set_is_subscript_check (TRUE); + else if (strcmp (&opt[2], "no-fortran-bounds-check") == 0) + ffe_set_is_subscript_check (FALSE); else if (strcmp (&opt[2], "typeless-boz") == 0) ffe_set_is_typeless_boz (TRUE); else if (strcmp (&opt[2], "no-typeless-boz") == 0) diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/top.h gcc-2.95/gcc/f/top.h *** egcs-1.1.2/gcc/f/top.h Wed Jul 15 02:54:11 1998 --- gcc-2.95/gcc/f/top.h Sat May 15 08:46:15 1999 *************** *** 1,6 **** /* top.h -- Public #include File (module.h template V1.0) Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* top.h -- Public #include File (module.h template V1.0) Copyright (C) 1995-1997 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** extern bool ffe_is_dollar_ok_; *** 90,103 **** extern bool ffe_is_f2c_; extern bool ffe_is_f2c_library_; extern bool ffe_is_ffedebug_; extern bool ffe_is_free_form_; extern bool ffe_is_globals_; - extern bool ffe_is_ident_; extern bool ffe_is_init_local_zero_; extern bool ffe_is_mainprog_; extern bool ffe_is_null_version_; extern bool ffe_is_onetrip_; extern bool ffe_is_silent_; extern bool ffe_is_typeless_boz_; extern bool ffe_is_pedantic_; extern bool ffe_is_saveall_; --- 90,104 ---- extern bool ffe_is_f2c_; extern bool ffe_is_f2c_library_; extern bool ffe_is_ffedebug_; + extern bool ffe_is_flatten_arrays_; extern bool ffe_is_free_form_; extern bool ffe_is_globals_; extern bool ffe_is_init_local_zero_; extern bool ffe_is_mainprog_; extern bool ffe_is_null_version_; extern bool ffe_is_onetrip_; extern bool ffe_is_silent_; + extern bool ffe_is_subscript_check_; extern bool ffe_is_typeless_boz_; extern bool ffe_is_pedantic_; extern bool ffe_is_saveall_; *************** void ffe_terminate_4 (void); *** 178,186 **** #define ffe_is_f2c() ffe_is_f2c_ #define ffe_is_f2c_library() ffe_is_f2c_library_ #define ffe_is_ffedebug() ffe_is_ffedebug_ #define ffe_is_free_form() ffe_is_free_form_ #define ffe_is_globals() ffe_is_globals_ - #define ffe_is_ident() ffe_is_ident_ #define ffe_is_init_local_zero() ffe_is_init_local_zero_ #define ffe_is_mainprog() ffe_is_mainprog_ #define ffe_is_null_version() ffe_is_null_version_ --- 179,187 ---- #define ffe_is_f2c() ffe_is_f2c_ #define ffe_is_f2c_library() ffe_is_f2c_library_ #define ffe_is_ffedebug() ffe_is_ffedebug_ + #define ffe_is_flatten_arrays() ffe_is_flatten_arrays_ #define ffe_is_free_form() ffe_is_free_form_ #define ffe_is_globals() ffe_is_globals_ #define ffe_is_init_local_zero() ffe_is_init_local_zero_ #define ffe_is_mainprog() ffe_is_mainprog_ #define ffe_is_null_version() ffe_is_null_version_ *************** void ffe_terminate_4 (void); *** 190,195 **** --- 191,197 ---- #define ffe_is_saveall() ffe_is_saveall_ #define ffe_is_second_underscore() ffe_is_second_underscore_ #define ffe_is_silent() ffe_is_silent_ + #define ffe_is_subscript_check() ffe_is_subscript_check_ #define ffe_is_typeless_boz() ffe_is_typeless_boz_ #define ffe_is_ugly_args() ffe_is_ugly_args_ #define ffe_is_ugly_assign() ffe_is_ugly_assign_ *************** void ffe_terminate_4 (void); *** 230,238 **** #define ffe_set_is_f2c(f) (ffe_is_f2c_ = (f)) #define ffe_set_is_f2c_library(f) (ffe_is_f2c_library_ = (f)) #define ffe_set_is_ffedebug(f) (ffe_is_ffedebug_ = (f)) #define ffe_set_is_free_form(f) (ffe_is_free_form_ = (f)) #define ffe_set_is_globals(f) (ffe_is_globals_ = (f)) - #define ffe_set_is_ident(f) (ffe_is_ident_ = (f)) #define ffe_set_is_init_local_zero(f) (ffe_is_init_local_zero_ = (f)) #define ffe_set_is_mainprog(f) (ffe_is_mainprog_ = (f)) #define ffe_set_is_null_version(f) (ffe_is_null_version_ = (f)) --- 232,240 ---- #define ffe_set_is_f2c(f) (ffe_is_f2c_ = (f)) #define ffe_set_is_f2c_library(f) (ffe_is_f2c_library_ = (f)) #define ffe_set_is_ffedebug(f) (ffe_is_ffedebug_ = (f)) + #define ffe_set_is_flatten_arrays(f) (ffe_is_flatten_arrays_ = (f)) #define ffe_set_is_free_form(f) (ffe_is_free_form_ = (f)) #define ffe_set_is_globals(f) (ffe_is_globals_ = (f)) #define ffe_set_is_init_local_zero(f) (ffe_is_init_local_zero_ = (f)) #define ffe_set_is_mainprog(f) (ffe_is_mainprog_ = (f)) #define ffe_set_is_null_version(f) (ffe_is_null_version_ = (f)) *************** void ffe_terminate_4 (void); *** 241,246 **** --- 243,249 ---- #define ffe_set_is_saveall(f) (ffe_is_saveall_ = (f)) #define ffe_set_is_second_underscore(f) (ffe_is_second_underscore_ = (f)) #define ffe_set_is_silent(f) (ffe_is_silent_ = (f)) + #define ffe_set_is_subscript_check(f) (ffe_is_subscript_check_ = (f)) #define ffe_set_is_typeless_boz(f) (ffe_is_typeless_boz_ = (f)) #define ffe_set_is_ugly_args(f) (ffe_is_ugly_args_ = (f)) #define ffe_set_is_ugly_assign(f) (ffe_is_ugly_assign_ = (f)) diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/toplev.j gcc-2.95/gcc/f/toplev.j *** egcs-1.1.2/gcc/f/toplev.j Mon Jun 15 19:23:44 1998 --- gcc-2.95/gcc/f/toplev.j Mon Feb 15 10:18:11 1999 *************** *** 1,6 **** /* toplev.j -- Wrapper for GCC's toplev.h Copyright (C) 1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* toplev.j -- Wrapper for GCC's toplev.h Copyright (C) 1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/tree.j gcc-2.95/gcc/f/tree.j *** egcs-1.1.2/gcc/f/tree.j Tue May 19 03:50:51 1998 --- gcc-2.95/gcc/f/tree.j Mon Feb 15 10:18:12 1999 *************** *** 1,6 **** /* tree.j -- Wrapper for GCC's tree.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* tree.j -- Wrapper for GCC's tree.h Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/type.c gcc-2.95/gcc/f/type.c *** egcs-1.1.2/gcc/f/type.c Tue May 19 03:50:52 1998 --- gcc-2.95/gcc/f/type.c Mon Feb 15 10:18:13 1999 *************** *** 1,6 **** /* Implementation of Fortran type abstraction Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* Implementation of Fortran type abstraction Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/type.h gcc-2.95/gcc/f/type.h *** egcs-1.1.2/gcc/f/type.h Tue May 19 03:50:53 1998 --- gcc-2.95/gcc/f/type.h Mon Feb 15 10:18:14 1999 *************** *** 1,6 **** /* Interface definitions for Fortran type abstraction Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* Interface definitions for Fortran type abstraction Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/version.c gcc-2.95/gcc/f/version.c *** egcs-1.1.2/gcc/f/version.c Sun Feb 14 09:41:29 1999 --- gcc-2.95/gcc/f/version.c Thu Jul 29 02:39:12 1999 *************** *** 1 **** ! char *ffe_version_string = "0.5.24-19981002"; --- 1 ---- ! const char *ffe_version_string = "0.5.25 19990728 (release)"; diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/version.h gcc-2.95/gcc/f/version.h *** egcs-1.1.2/gcc/f/version.h Tue May 19 03:25:05 1998 --- gcc-2.95/gcc/f/version.h Tue Mar 30 01:23:52 1999 *************** *** 1,6 **** #ifndef _H_f_version #define _H_f_version ! extern char *ffe_version_string; #endif --- 1,6 ---- #ifndef _H_f_version #define _H_f_version ! extern const char *ffe_version_string; #endif diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/where.c gcc-2.95/gcc/f/where.c *** egcs-1.1.2/gcc/f/where.c Tue May 19 03:50:54 1998 --- gcc-2.95/gcc/f/where.c Mon Feb 15 10:18:15 1999 *************** *** 1,6 **** /* where.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* where.c -- Implementation File (module.c template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. *************** the Free Software Foundation, 59 Temple *** 38,44 **** struct _ffewhere_line_ ffewhere_unknown_line_ = ! {NULL, NULL, 0, 0, 0}; /* Simple definitions and enumerations. */ --- 38,44 ---- struct _ffewhere_line_ ffewhere_unknown_line_ = ! {NULL, NULL, 0, 0, 0, {0}}; /* Simple definitions and enumerations. */ diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/gcc/f/where.h gcc-2.95/gcc/f/where.h *** egcs-1.1.2/gcc/f/where.h Tue May 19 03:50:55 1998 --- gcc-2.95/gcc/f/where.h Mon Feb 15 10:18:16 1999 *************** *** 1,6 **** /* where.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* where.h -- Public #include File (module.h template V1.0) Copyright (C) 1995 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/ChangeLog gcc-2.95/libf2c/ChangeLog *** egcs-1.1.2/libf2c/ChangeLog Sat Mar 13 18:38:32 1999 --- gcc-2.95/libf2c/ChangeLog Thu Jul 29 02:37:31 1999 *************** *** 1,28 **** ! Sun Mar 14 02:38:07 PST 1999 Jeff Law (law@cygnus.com) ! * egcs-1.1.2 Released. ! 1999-03-05 Craig Burley * libU77/Version.c: Bump version. ! * libU77/vxtidate_.c (G77_vxtidate_0): Truncate ! year to last two digits (i.e. modulo 100), as per ! documentation and Y2K (non-)compliance. ! 1999-02-26 Craig Burley * libU77/Version.c: Bump version. 1999-02-20 Craig Burley From Krister Walfridsson : * libU77/lstat_.c (G77_lstat_0): Kill spurious setting of element 6 to zero, as it undid the previous setting. 1999-02-14 Craig Burley ! * libI77/Version.c: Bump ("update" below) to date of last change. 1999-01-15 Dave Love --- 1,229 ---- ! Wed Jul 28 21:39:31 PDT 1999 Jeff Law (law@cygnus.com) ! * gcc-2.95 Released. ! * libF77/Version.c: No longer a prerelease. ! * libI77/Version.c: No longer a prerelease. ! * libU77/Version.c: No longer a prerelease. ! ! Wed Jul 7 15:58:16 1999 Craig Burley ! ! * libU77/date_.c (G77_date_y2kbug_0): G77_time_0 returns ! longint, not integer, and G77_ctime_0 takes longint, not ! integer, argument. * libU77/Version.c: Bump version. ! Mon Jun 28 10:22:30 1999 Craig Burley ! ! * libI77/rsne.c: Fix NAMELIST bug by applying 19990627 ! Netlib patch to release branch. ! ! Wed Jun 16 11:38:58 1999 Craig Burley ! ! From Ian Watson 1999-06-12: ! * libI77/backspace.c: Reload file descriptor after ! calling t_runc. ! * libI77/Version.c: Bump libg2c version. ! ! Wed May 26 14:26:35 1999 Craig Burley ! ! * libF77/Version.c, libI77/Version.c, libU77/Version.c: ! Use 0.5.24 to designate the version of g77 within GCC 2.95. ! ! Thu May 20 03:20:59 1999 Jeffrey A Law (law@cygnus.com) ! ! * configure.in (AC_EXEEXT): Remove call. ! (compiler_name): Explicitly check with no extension and .exe ! extension. ! * configure: Regenerate. ! Mon May 10 17:33:45 1999 Craig Burley + Update to Netlib version of 1999-05-10: + * changes.netlib, libF77/Version.c, libF77/abort_.c, + libF77/c_log.c, libF77/ef1asc_.c, libF77/s_rnge.c, + libF77/s_stop.c, libI77/Version.c, libI77/open.c, + readme.netlib: See changes.netlib for info. + + Fri May 7 9:33:55 1999 Donn Terry (donn@interix.com) + + * libU77/dtime_.c (G77_dtime_0): Standard-conforming error check. + * libU77/etime_.c (G77_etime_0): Likewise. + + Mon May 3 19:15:07 1999 Craig Burley + + * libU77/u77-test.f (main): Declare ABORT as intrinsic. + + 1999-05-03 Craig Burley + + * libU77/u77-test.f: Reverse order of two arguments to + CTIME_subr, DTIME_subr, ETIME_subr, and TTYNAM_subr. + + Mon May 3 11:21:35 1999 Craig Burley + + * libF77/c_log.c: Cope with partial overlap a la z_log.c. + (Change likely to be made to netlib version shortly.) + + Mon May 3 11:12:38 1999 Craig Burley + + Update to Netlib version of 1999-05-03: + * changes.netlib, libF77/Version.c, libF77/c_cos.c, + libF77/c_exp.c, libF77/c_sin.c, libF77/d_cnjg.c, + libF77/dtime_.c, libF77/etime_.c, libF77/getenv_.c, + libF77/r_cnjg.c, libF77/z_cos.c, libF77/z_exp.c, + libF77/z_log.c, libF77/z_sin.c, libI77/Version.c, + libI77/err.c, libI77/open.c, libI77/rdfmt.c, readme.netlib: + See changes.netlib for info. + + Mon May 3 10:52:53 1999 Craig Burley + + * libF77/c_cos.c, libF77/c_div.c, libF77/c_exp.c, libF77/c_log.c, + libF77/c_sin.c, libF77/c_sqrt.c, libF77/d_cnjg.c, libF77/pow_zi.c, + libF77/r_cnjg.c, libF77/z_cos.c, libF77/z_div.c, libF77/z_exp.c, + libF77/z_log.c, libF77/z_sin.c, libF77/z_sqrt.c: Revert back to + netlib versions as of f2c-19990501. + + Sun May 2 01:38:50 1999 Craig Burley + + * libU77/u77-test.f (main): Declare FTELL as intrinsic. + + Sun May 2 01:13:37 1999 Craig Burley + + * libU77/u77-test.f (main): List libU77 intrinsics + not currently tested. + Add tests for TIME8, CTIME_subr, IARGC, TTYNAM_subr, + GETENV, FDATE_subr, DTIME_subr, ETIME_subr, DATE, ITIME, + FTELL_subr, MCLOCK, MCLOCK8, and CPU_TIME. + Trim blanks off the ends of some printed strings. + + Sun May 2 00:06:45 1999 Craig Burley + + * libU77/u77-test.f (main): Just warn about FSTAT gid + disagreement, as it's expected on some systems. + + Sat May 1 23:57:18 1999 Craig Burley + + * libU77/u77-test.f: Generalize sum-checking to + use a new function, which allows for some slop. + Clean up some commentary. + (issum): The new function. + (sgladd): Deleted subroutine. + + Sat May 1 23:35:18 1999 Craig Burley + + * libU77/u77-test.f: Modify to be more like testsuite + version, bringing patches to that version here. + Add suitable commentary. + + Sat Apr 24 11:02:48 1999 Craig Burley + + * Makefile.in (s-libi77, s-libf77, s-libu77): Revert + the patch from , as per the commentary. + + Sat Apr 17 17:33:30 1999 Craig Burley + + From H.J. Lu : + * Makefile.in (s-libi77): Depend on i77. + (s-libf77): Depend on i77. + (s-libu77): Depend on u77. + + Mon Apr 12 21:38:14 1999 Mumit Khan + + * libF77/getenv_.c: Include stdlib.h. + + Sun Apr 11 23:30:42 1999 Mumit Khan + + * libU77/dtime_.c: Handle all variants of WIN32. + * libU77/etime_.c: Likewise. + + * libU77/aclocal.m4: New file. + * libU77/configure.in (LIBU77_HAVE_STRUCT_TIMEZONE): Add test. + * libU77/acconfig.h (HAVE_STRUCT_TIMEZONE): Add macro. + * libU77/datetime_c.c (G77_date_and_time_0): Use. + * libU77/config.hin: Regenerate. + * libU77/configure: Likewise. + + Wed Mar 31 13:50:24 1999 Kaveh R. Ghazi + + * configure.in (extra_includes): Don't attempt to calculate the + location of the gcc src or obj directories. Instead rely on + precomputed variables, $topsrcdir and $r, to obtain these values. + Set -I flags appropriately. + + 1999-03-28 Dave Love + + * configure: Rebuilt. + + * configure.in: Fix integer size tests: sanity check first; search + toplevel include dir (from Rainer Orth); only mess with ac_cpp + once; use -DIN_GCC -DHAVE_CONFIG_H. + + * configure.in: Use `g77_cv_...', not `f77_cv_...'. + + Wed Mar 24 22:41:28 1999 Mumit Khan + + * configure.in (AC_PREREQ): Update to 2.13. + (AC_EXEEXT): Call to find possible file extension. + (compiler_name): Use. + * configure: Regenerate. + + 1999-03-17 Craig Burley + + Update to Netlib version of 1999-03-17: + * libF77/F77_aloc.c, libF77/README.netlib, libF77/dtime_.c, + libF77/etime_.c, libF77/signal1.h0, libI77/Version.c, + libI77/dfe.c, libI77/endfile.c, libI77/lread.c, + libI77/sfe.c, readme.netlib, changes.netlib: + See changes.netlib for info. + + 1999-03-06 Craig Burley + + Mon Dec 21 23:03:54 1998 Hans-Peter Nilsson : + * libI77/Makefile.in (all *.o except VersionI.o): Added dependence + on respective .c file. + * libF77/Makefile.in (all .o except VersionF.o): Similarly. + * libU77/Makefile.in (date_.o): Added dependence on date_.c + + 1999-03-06 Craig Burley + + Rename non-Y2K-compliant intrinsics: + * Makefile.in (F2CEXT): Now two versions each of + `date' and `vxtidt'. + * f2cext.c (date_, vxtidate_): Split into two versions, + the existing one calling a new "y2kbuggy" routine that + does not exist, and a new one named with "y2kbug" that + calls the newly renamed underlying routine. + * libU77/date_.c (G77_date_y2kbug_0): Rename from G77_date_0. + * libU77/vxtidate_.c (G77_vxtidate_y2kbug_0): Rename from + G77_vxtidate_0. * libU77/Version.c: Bump version. + 1999-03-03 Craig Burley + + * libU77/vxtidate_.c (G77_vxtidate_0): Truncate + year to last two digits (i.e. modulo 100), as per + documentation and (documented) Y2K non-compliance. + 1999-02-20 Craig Burley From Krister Walfridsson : * libU77/lstat_.c (G77_lstat_0): Kill spurious setting of element 6 to zero, as it undid the previous setting. + 1999-02-15 Craig Burley + + * f2c.h: Delete my (old) email address. + 1999-02-14 Craig Burley ! * libU77/Version.c: Bump ("update" below) to date of last change. ! * libI77/Version.c: Bump to date of last change. ! ! Tue Feb 9 18:13:30 GMT 1999 Nathan Sidwell ! ! * Makefile.in (distclean): Move Makefile deletion to end of ! commands. 1999-01-15 Dave Love *************** Sun Mar 14 02:38:07 PST 1999 Jeff Law ( *** 30,42 **** such, not as microseconds. (s_copy): Declare. ! 1998-10-21 Dave Love * libI77/open.c (_XOPEN_SOURCE): Define. ! Fri Oct 2 01:27:50 1998 Kamil Iskra ! * Makefile.in (install): Add missing "else true;". 1998-09-28 Dave Love --- 231,298 ---- such, not as microseconds. (s_copy): Declare. ! 1998-11-26 Manfred Hollstein ! ! * configure.in (compiler_name): Add check to detect if this ! language's compiler has been built. ! * configure: Regenerate. ! ! Mon Nov 23 16:52:22 1998 Kaveh R. Ghazi ! ! * configure.in: Use AC_PREREQ(2.12.1). ! * libF77/configure.in: Likewise. ! * libI77/configure.in: Likewise. ! * libU77/configure.in: Likewise. ! ! 1998-10-24 Dave Love ! ! * configure.in: Touch g2c.h in AC_OUTPUT after multilib ! disturbance. ! ! 1998-10-23 Dave Love ! ! * f2cext.c: Include math.h. ! ! 1998-10-19 Dave Love ! ! * configure: Regenerate. ! ! * configure.in: Use AC_CONFIG_AUX_DIR. ! ! 1998-10-12 Dave Love * libI77/open.c (_XOPEN_SOURCE): Define. ! 1998-10-12 Dave Love ! * Makefile.in (.SUFFIXES): Don't use any. ! (all-unilib): New target, like old all. ! (all): Use it. ! (.PHONY): Add all-unilib. ! ! 1998-10-12 Dave Love ! ! * configure.in: Reorder Makefile, g2c.h in AC_OUTPUT. ! ! Tue Oct 6 21:16:58 1998 Jeffrey A Law (law@cygnus.com) ! ! * Makefile.in: Revert last patch. ! ! Mon Oct 5 01:16:10 1998 H.J. Lu (hjl@gnu.org) ! ! * Makefile.in (s-libi77): Depend on i77. ! (s-libf77): Depend on i77. ! (s-libu77): Depend on u77. ! ! 1998-09-30 Dave Love ! ! * Makefile.in (f2cext.c): Depend on g2c.h. ! ! 1998-09-30 Robert Lipe ! ! * Makefile.in (all): Correct dependencies so --disable-multilibs ! works again. ! (distclean): Correct typo. 1998-09-28 Dave Love *************** Fri Oct 2 01:27:50 1998 Kamil Iskra < *** 48,65 **** * libI77/Version.c: Update. ! Sat Sep 5 23:06:56 1998 Craig Burley * libI77/sfe.c (e_wdfe): Set f__init to avoid spurious recursive i/o error from formatted direct i/o. Tue Sep 1 10:06:06 1998 Craig Burley * libF77/Version.c: Update. * libU77/Version.c: Update. * libI77/Version.c: Update. ! Wed Aug 26 23:20:12 1998 Jeffrey A Law (law@cygnus.com) * Makefile.in (FLAGS_TO_PASS): Fix typo. --- 304,359 ---- * libI77/Version.c: Update. ! Mon Sep 21 12:27:27 1998 Robert Lipe ! ! * Makefile.in (distclean, clean, uninstall, install, all): Add ! multilib support. ! * configure.in: Likewise. ! * configure: Regenerate. ! * libF77/Makefile.in, libU77/Makefile.in, libI77/Makefile.in (clean): ! Explictly remove stamp in parent's directory. ! ! 1998-09-20 Dave Love * libI77/sfe.c (e_wdfe): Set f__init to avoid spurious recursive i/o error from formatted direct i/o. + Thu Sep 10 14:57:25 1998 Kamil Iskra + + * Makefile.in (install): Add missing "else true;". + + 1998-09-09 Craig Burley + + * configure.in: Test $srcdir, not $subdir (probable typo). + Clarify commentary, fix a bit of spacing. + + 1998-09-07 Dave Love + + * ChangeLog.egcs: Deleted. Entries merged here. + + 1998-09-07 Dave Love + + * libI77/sfe.c, libI77/dfe.c: Revert last change. + + 1998-09-06 Dave Love + + From Toon to fix spurious recursive i/o errors: + * libI77/sfe.c (e_wdfe): Set f__init. + + * libI77/dfe.c (c_dfe): Check and set f__init. + (s_rdfe, s_wdfe): Don't check and set f__init. + + Fri Sep 4 18:40:32 1998 Craig Burley + + * libU77/sys_clock_.c (G77_system_clock_0): Fix indentation. + Tue Sep 1 10:06:06 1998 Craig Burley * libF77/Version.c: Update. * libU77/Version.c: Update. * libI77/Version.c: Update. ! Wed Aug 26 23:19:40 1998 Jeffrey A Law (law@cygnus.com) * Makefile.in (FLAGS_TO_PASS): Fix typo. *************** Wed Aug 26 23:20:12 1998 Jeffrey A Law *** 69,76 **** 1998-07-24 Dave Love ! * Makefile.in (s-libe77, ${srcdir}/configure, g2c.h, Makefile, ! config.status, rebuilt): Rely on VPATH, dropping explicit use of $(srcdir) in various places. 1998-07-19 Dave Love --- 363,370 ---- 1998-07-24 Dave Love ! * Makefile.in (s-libe77, ${srcdir}/configure, g2c.h, Makefile) ! (config.status, rebuilt): Rely on VPATH, dropping explicit use of $(srcdir) in various places. 1998-07-19 Dave Love *************** Wed Aug 26 23:20:12 1998 Jeffrey A Law *** 78,83 **** --- 372,402 ---- * Makefile.in (all): Depend on s-libe77, not e77. (.PHONY): Remove e77. + Thu Jul 16 00:58:52 1998 Jeffrey A Law (law@cygnus.com) + + * libU77/Makefile.in: Missed one config.h.in -> config.hin change. + + * g2c.hin: Renamed from g2c.h.in. + * Makefile.in, configure.in: Changed as needed. + * configure: Rebuilt. + + * libU77/config.hin: Renamed from libU77/config.h.in. + * Makefile.in, configure.in: Changed as needed. + * configure: Rebuilt. + + Tue Jul 14 21:35:30 1998 Gerald Pfeifer + + * Makefile.in (all): Invoke $(MAKE) instead of just make. + + Tue Jul 14 02:16:34 1998 Jeffrey A Law (law@cygnus.com) + + * Makefile.in: stamp-lib* -> s-lib*. + * libU77/Makefile.in: Likewise. + * libF77/Makefile.in: Likewise. + * libI77/Makefile.in: Likewise. + + * libU77/Makefile.in (ALL_CFLAGS): Add -I$(F2C_H_DIR). + Mon Jul 13 13:31:03 1998 Craig Burley * libU77/u77-test.f: Double-check ETIME results, just *************** Mon Jul 13 13:31:03 1998 Craig Burley *** 95,102 **** * configure.in: Move much of testing to new configures in subdirs. Tidy up handling of RANLIB etc. ! * stamp-h.in, libF77/configure.in, libI77/configure.in, ! libF77/configure, libI77/configure: New files. * libF77/Makefile.in, libI77/Makefile.in, libU77/Makefile.in: Change in step with libf2c/Makefile.in. --- 414,421 ---- * configure.in: Move much of testing to new configures in subdirs. Tidy up handling of RANLIB etc. ! * stamp-h.in, libF77/configure.in, libI77/configure.in: ! * libF77/configure, libI77/configure: New files. * libF77/Makefile.in, libI77/Makefile.in, libU77/Makefile.in: Change in step with libf2c/Makefile.in. *************** Mon Jul 13 13:31:03 1998 Craig Burley *** 111,116 **** --- 430,440 ---- * libU77/sys_clock_.c: Replace TIMES conditional stuff removed in error by last change. + 1998-07-06 Mike Stump + + * Makefile.in (clean): Don't remove Makefiles, that is done in + distclean. + 1998-07-06 Dave Love * libU77/Makefile.in (lib): Change variable lib to LIBS. *************** Mon Jul 13 13:31:03 1998 Craig Burley *** 149,160 **** previous change. * libI77/rsfe.c (s_rsfe): Likewise. 1998-06-23 Dave Love ! * libI77/backspace.c, libI77/dfe.c, libI77/due.c, libI77/iio.c, ! libI77/lread.c, libI77/ sfe.c, libI77/sue.c, libI77/wsfe.c: Update to Netlib version of 1998-06-18. Sat Jun 13 03:46:40 1998 Craig Burley * Makefile.in (install): Don't install if $(libsubdir) --- 473,513 ---- previous change. * libI77/rsfe.c (s_rsfe): Likewise. + Sat Jun 27 23:04:49 1998 Jeffrey A Law (law@cygnus.com) + + * Makefile.in (FLAGS_TO_PASS, case G2C_H_DIR): Use $(TARGET_SUBDIR) + instead of hardcoding "libraries". + + 1998-06-26 Manfred Hollstein + + * Makefile.in (gcc_version_trigger): Add new macro. + (config.status): Add dependency upon $(gcc_version_trigger). + + * configure.in (gcc_version_trigger): New variable; initialize + using value from toplevel configure; add AC_SUBST for it. + (gcc_version): Change initialization to use this new variable. + * configure: Regenerate. + + 1998-06-24 Manfred Hollstein + + * Makefile.in (version): Rename to gcc_version. + * configure.in (version): Likewise. + (gcc_version): Add code to use an option passed from parent configure. + * configure: Regenerate. + 1998-06-23 Dave Love ! * libI77/backspace.c, libI77/dfe.c, libI77/due.c, libI77/iio.c: ! * libI77/lread.c, libI77/sfe.c, libI77/sue.c, libI77/wsfe.c: Update to Netlib version of 1998-06-18. + 1998-06-21 Dave Love + + * configure.in (version, target_alias): Define. + + * Makefile.in (version, target_alias, libsubdir): Define. + (install): Remove check for libsubdir. + Sat Jun 13 03:46:40 1998 Craig Burley * Makefile.in (install): Don't install if $(libsubdir) *************** Sat Jun 13 03:46:40 1998 Craig Burley *** 163,170 **** * Makefile.in (g2c.h): Rename from f2c.h. ! * Makefile.in, libF77/Makefile.in, libI77/Makefile.in, ! libU77/Makefile.in: Rewrite config and var assignment sections to be even more minimal than before, and to more clearly documented what macros are expected to be set and to what sorts of values. Eliminate CROSS and --- 516,523 ---- * Makefile.in (g2c.h): Rename from f2c.h. ! * Makefile.in, libF77/Makefile.in, libI77/Makefile.in: ! * libU77/Makefile.in: Rewrite config and var assignment sections to be even more minimal than before, and to more clearly documented what macros are expected to be set and to what sorts of values. Eliminate CROSS and *************** Sat Jun 13 03:46:40 1998 Craig Burley *** 208,213 **** --- 561,576 ---- dependencies on f2c.h and g2c.h. (*clean): Remove. + Mon Apr 27 22:52:31 1998 Richard Henderson + + * libU77/ltime_.c: Bounce the ftnint argument through a local time_t. + * libU77/gmtime_.c: Likewise. + + Sun Apr 26 18:07:56 1998 Richard Henderson + + * configure.in: Adjust include paths in F2C_INTEGER and F2C_LONGINT + tests to work out of the build directory. + 1998-05-20 Dave Love * Makefile.in ($(lib)): Use shell loop instead of unportable *************** Sat Feb 28 15:32:15 1998 Craig Burley *** 274,279 **** --- 637,719 ---- * libI77/open.c (f_open): Use sizeof(buf) instead of 256, for the usual reasons. + 1998-02-17 Dave Love + + * libU77/u77-test.f: Tweak some o/p. + + * libU77/Makefile.in (check): Use -L for new directory structure. + + * Makefile.in (check): Run the u77 check. + (config.status, Makefile): New targets. + + Wed Feb 11 01:46:20 1998 Manfred Hollstein + + * Makefile.in ($(lib)): Call $(AR) repeatedly to avoid overflowing + argument size limit on ancious System V. + + Sun Feb 8 00:32:17 1998 Manfred Hollstein + + * Makefile.in: Add `info install-info clean-info check dvi' targets. + + Mon Feb 2 11:08:49 1998 Richard Henderson + + * configure.in: Update F2C_INTEGER and F2C_LONGINT tests + for the new placement in the hierarchy. + + Sun Feb 1 02:36:33 1998 Richard Henderson + + * Previous contents of gcc/f/runtime moved into toplevel + "libf2c" directory. + + Sun Feb 1 01:42:47 1998 Mumit Khan + + * libU77/configure.in (getlogin,getgid,getuid, kill,link,ttyname): + Check. + * libU77/config.h.in (HAVE_GETLOGIN, HAVE_GETGID, HAVE_GETUID, + HAVE_KILL, HAVE_LINK, HAVE_TTYNAME): New defs. + * libU77/getlog_.c: Conditionalize for target platform. Set errno + to ENOSYS if target libc doesn't have the function. + * libU77/getgid_.c: Likewise. + * libU77/getuid_.c: Likewise. + * libU77/kill_.c: Likewise. + * libU77/link_.c: Likewise. + * libU77/ttynam_.c: Likewise. + + Sun Jan 18 20:01:37 1998 Toon Moene + + * libI77/backspace.c: (f_back): Use type `uiolen' to determine size + of record length specifier. + + Sat Jan 17 22:40:31 1998 Mumit Khan + + * libU77/configure.in (sys/param.h,sys/times.h): Check. + (times,alarm): Likewise. + * libU77/config.h.in (HAVE_SYS_PARAM_H, HAVE_SYS_TIMES_H) + (HAVE_ALARM, HAVE_TIMES): New defs. + * libU77/alarm_.c: Conditionalize for target platform. Set errno + to ENOSYS if target libc doesn't have the function. + * libU77/dtime_.c: Likewise. + * libU77/etime_.c: Likewise. + * libU77/sys_clock_.c: Likewise. + + * configure.in (NON_UNIX_STDIO): Define if MINGW32. + (NON_ANSI_RW_MODE): Do not define for CYGWIN32 or MINGW32. + + * libI77/rawio.h: Don't providing conflicting declarations for + read() and write(). MINGW32 header files use "const" quals. + + * libF77/s_paus.c: _WIN32 does not have pause(). + + Mon Apr 27 22:52:31 1998 Richard Henderson + + * libU77/ltime_.c: Bounce the ftnint argument through a local time_t. + * libU77/gmtime_.c: Likewise. + + Sun Apr 26 18:07:56 1998 Richard Henderson + + * configure.in: Adjust include paths in F2C_INTEGER and F2C_LONGINT + tests to work out of the build directory. + Tue Dec 23 22:56:01 1997 Craig Burley * libF77/signal_.c (G77_signal_0): Return type is *************** Tue Dec 23 22:56:01 1997 Craig Burley *** 281,286 **** --- 721,736 ---- handler on 64-bit systems like Alphas. * f2cext.c (signal_): Changed accordingly. + Tue Nov 18 09:49:04 1997 Mumit Khan (khan@xraylith.wisc.edu) + + * libI77/close.c (f_exit): Reset f__init so that f_clos does not + (incorrectly) think there is an I/O recursion when program is + interrupted. + + Sat Nov 1 18:03:42 1997 Jeffrey A Law (law@cygnus.com) + + * libF77/signal_.c: Undo last change until we can fix it right. + Wed Oct 29 01:01:04 1997 Mumit Khan * configure.in: Set CC to CC_FOR_TARGET when cross-compiling. *************** Fri Oct 24 11:15:22 1997 Mumit Khan + * libF77/signal_.c (G77_signal_0): Make return type sig_pf as well. * libI77/fio.h: Include if STDC_HEADERS. * libU77/chmod_.c: Likewise. + Tue Oct 7 18:22:10 1997 Richard Henderson + + * Makefile.in (CGFLAGS): Don't force -g0. + * libF77/Makefile.in, libI77/Makefile.in, libU77/Makefile.in: Likewise. + + Mon Oct 6 14:16:46 1997 Jeffrey A Law (law@cygnus.com) + + * Makefile.in (distclean): Do a better job at cleaning up. + 1997-10-03 Dave Love * configure.in: Check for tempnam (best because it obeys TMPDIR). * libI77/open.c: Use it. * libI77/err.c: New message # 132. + Wed Oct 1 01:46:16 1997 Philippe De Muyter + + * libU77/sys_clock_.c: File renamed from system_clock_.c. + * libU77/Makefile.in, Makefile.in : Reference sys_clock_.*, not + system_clock_.*. + * libU77/dtime_.c (clk_tck): Try also HZ macro. + * libU77/access.c (G77_access_0): Check malloc return value against 0, + not NULL. + * libU77/getlog_.c, libU77/ttynam_.c, libU77/chdir_.c: Ditto. + * libU77/chmod_.c, libU77/rename_.c: Ditto. + Tue Sep 30 00:41:39 1997 Craig Burley Do a better job of printing the offending FORMAT string *************** Mon Sep 29 16:30:31 1997 Craig Burley *** 332,337 **** --- 803,815 ---- * libU77/dtime_.c (G77_dtime_0): Fix types in HAVE_GETRUSAGE case so as not to truncate results to integer values. + * libU77/Version.c: Bump. + + Thu Sep 18 16:58:46 1997 Jeffrey A Law (law@cygnus.com) + + * Makefile.in (stamp-lib): Don't use '$?', explicitly + list the variables containing the object files to include + in libf2c.a Tue Sep 9 00:33:24 1997 Craig Burley *************** Mon Sep 8 19:39:01 1997 Craig Burley *** 343,348 **** --- 821,835 ---- of whether initialization done, so exiting now closes open units again. + Fri Sep 5 00:18:17 1997 Jeffrey A Law (law@cygnus.com) + + * Makefile.in (clean): Don't remove config.cache. + (distclean): Do it here instead. + + Tue Aug 26 20:14:08 1997 Robert Lipe (robertl@dgii.com) + + * hostnm_.c: Include errno.h + Tue Aug 26 01:42:21 1997 Craig Burley From Jim Wilson: *************** Tue Aug 26 01:25:58 1997 Craig Burley *** 359,364 **** --- 846,859 ---- once into libf2c.a, to get the job done a bit faster. Still remove the objects (and libE77 directory) afterward. + Mon Aug 25 23:26:05 1997 H.J. Lu (hjl@gnu.ai.mit.edu) + + * Makefile.in (mostlyclean, clean): Check if Makefile exists + before using it. Remove stamp-*. + (stamp-libi77, stamp-libf77, stamp-libu77): New. + (stamp-lib): Only depend on stamp-libi77 stamp-libf77 + stamp-libu77 + Sun Aug 24 05:04:35 1997 Craig Burley * libU77/rand_.c (G77_rand_0), libU77/dtime_.c (G77_dtime_0), *************** Wed Nov 6 14:17:27 1996 Craig Burley *** 793,799 **** * libF77/Version.c, libI77/Version.c: Restore macro definition of version information. ! * libI77/Makefile.in (OBJ): Add ftell_.o to list of objects. * libI77/uio.c (do_ud): Fix up casts in PAD_UDread case just like they were fixed in the other case. --- 1288,1294 ---- * libF77/Version.c, libI77/Version.c: Restore macro definition of version information. ! * libI77/Makefile.in (OBJ) [foo]: Add ftell_.o to list of objects. * libI77/uio.c (do_ud): Fix up casts in PAD_UDread case just like they were fixed in the other case. *************** Thu Oct 31 22:27:45 1996 Craig Burley *** 807,813 **** 1996-10-19 Dave Love * configure.in: Add check that we have the tools to cross-compile ! if appropriate. (NO_EOF_CHAR_CHECK,Skip_f2c_Undefs): Define. * libF77/Makefile.in (F90BIT): New routines from Netlib. --- 1302,1308 ---- 1996-10-19 Dave Love * configure.in: Add check that we have the tools to cross-compile ! if appropriate. (NO_EOF_CHAR_CHECK,Skip_f2c_Undefs): Define. * libF77/Makefile.in (F90BIT): New routines from Netlib. *************** Tue Aug 20 09:21:43 1996 Dave Love ! * (libF77/qbitshft.c, libF77/qbitbits.c, libF77/lbitshft.c, ! libF77/lbitbits.c): New file from Netlib. qbit... not currently compiled. Sun Jul 7 18:06:33 1996 Dave Love --- 1341,1348 ---- Sat Aug 17 13:00:47 1996 Dave Love ! * libF77/qbitshft.c, libF77/qbitbits.c, libF77/lbitshft.c, ! libF77/lbitbits.c: New file from Netlib. qbit... not currently compiled. Sun Jul 7 18:06:33 1996 Dave Love *************** Tue Mar 19 13:10:02 1996 Craig Burley *** 908,914 **** * Makefile.in (rebuilt): New target. ! * lib[FI]77/Makefile.in: Use $AR_FOR_TARGET, not $AR. Tue Mar 19 12:53:19 1996 Dave Love --- 1403,1410 ---- * Makefile.in (rebuilt): New target. ! * libF77/Makefile.in, libI77/Makefile.in: Use $AR_FOR_TARGET, not ! $AR. Tue Mar 19 12:53:19 1996 Dave Love *************** Fri Dec 29 18:22:01 1995 Craig Burley *** 931,940 **** * Makefile.in: Reorganize the *clean rules to more closely parallel gcc's. ! * lib[FI]77/Makefile.in: Ignore error from $(AR) command, ! in case just doing an install and installer has no write ! access to library (this is a kludge fix -- perhaps install ! targets should never try updating anything?). Sat Nov 18 19:37:22 1995 Craig Burley (burley@gnu.ai.mit.edu) --- 1427,1436 ---- * Makefile.in: Reorganize the *clean rules to more closely parallel gcc's. ! * libF77/Makefile.in, libI77/Makefile.in: Ignore error from $(AR) ! command, in case just doing an install and installer has no write ! access to library (this is a kludge fix -- perhaps install targets ! should never try updating anything?). Sat Nov 18 19:37:22 1995 Craig Burley (burley@gnu.ai.mit.edu) *************** Thu Feb 2 12:22:41 1995 Craig Burley *** 1089,1091 **** --- 1585,1591 ---- * libF77/Makefile.in (libf77): Add rule to .PHONY list. * libI77/Makefile.in (libi77): Add rule to .PHONY list. + + Local Variables: + add-log-time-format: current-time-string + End: diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/ChangeLog.egcs gcc-2.95/libf2c/ChangeLog.egcs *** egcs-1.1.2/libf2c/ChangeLog.egcs Thu Jul 16 14:34:31 1998 --- gcc-2.95/libf2c/ChangeLog.egcs Wed Dec 31 16:00:00 1969 *************** *** 1,200 **** - Thu Jul 16 00:58:52 1998 Jeffrey A Law (law@cygnus.com) - - * libU77/Makefile.in: Missed one config.h.in -> config.hin change. - - * g2c.hin: Renamed from g2c.h.in. - * Makefile.in, configure.in: Changed as needed. - * configure: Rebuilt. - - * libU77/config.hin: Renamed from libU77/config.h.in. - * Makefile.in, configure.in: Changed as needed. - * configure: Rebuilt. - - Tue Jul 14 21:35:30 1998 Gerald Pfeifer - - * Makefile.in (all): Invoke $(MAKE) instead of just make. - - Tue Jul 14 02:16:34 1998 Jeffrey A Law (law@cygnus.com) - - * Makefile.in: stamp-lib* -> s-lib*. - * libU77/Makefile.in: Likewise. - * libF77/Makefile.in: Likewise. - * libI77/Makefile.in: Likewise. - - * libU77/Makefile.in (ALL_CFLAGS): Add -I$(F2C_H_DIR). - - 1998-07-06 Mike Stump - - * Makefile.in (clean): Don't remove Makefiles, that is done in - distclean. - - Sat Jun 27 23:04:49 1998 Jeffrey A Law (law@cygnus.com) - - * Makefile.in (FLAGS_TO_PASS, case G2C_H_DIR): Use $(TARGET_SUBDIR) - instead of hardcoding "libraries". - - 1998-06-26 Manfred Hollstein - - * Makefile.in (gcc_version_trigger): Add new macro. - (config.status): Add dependency upon $(gcc_version_trigger). - - * configure.in (gcc_version_trigger): New variable; initialize - using value from toplevel configure; add AC_SUBST for it. - (gcc_version): Change initialization to use this new variable. - * configure: Regenerate. - - 1998-06-24 Manfred Hollstein - - * Makefile.in (version): Rename to gcc_version. - * configure.in (version): Likewise. - (gcc_version): Add code to use an option passed from parent configure. - * configure: Regenerate. - - 1998-06-21 Dave Love - - * configure.in (version, target_alias): Define. - - * Makefile.in (version, target_alias, libsubdir): Define. - (install): Remove check for libsubdir. - - Mon Apr 27 22:52:31 1998 Richard Henderson - - * libU77/ltime_.c: Bounce the ftnint argument through a local time_t. - * libU77/gmtime_.c: Likewise. - - Sun Apr 26 18:07:56 1998 Richard Henderson - - * configure.in: Adjust include paths in F2C_INTEGER and F2C_LONGINT - tests to work out of the build directory. - - 1998-02-17 Dave Love - - * libU77/u77-test.f: Tweak some o/p. - - * libU77/Makefile.in (check): Use -L for new directory structure. - - * Makefile.in (check): Run the u77 check. - (config.status, Makefile): New targets. - - Wed Feb 11 01:46:20 1998 Manfred Hollstein - - * Makefile.in ($(lib)): Call $(AR) repeatedly to avoid overflowing - argument size limit on ancious System V. - - Sun Feb 8 00:32:17 1998 Manfred Hollstein - - * Makefile.in: Add `info install-info clean-info check dvi' targets. - - Mon Feb 2 11:08:49 1998 Richard Henderson - - * configure.in: Update F2C_INTEGER and F2C_LONGINT tests - for the new placement in the hierarchy. - - Sun Feb 1 02:36:33 1998 Richard Henderson - - * Previous contents of gcc/f/runtime moved into toplevel - "libf2c" directory. - - Sun Feb 1 01:42:47 1998 Mumit Khan - - * libU77/configure.in (getlogin,getgid,getuid, kill,link,ttyname): - Check. - * libU77/config.h.in (HAVE_GETLOGIN, HAVE_GETGID, HAVE_GETUID, - HAVE_KILL, HAVE_LINK, HAVE_TTYNAME): New defs. - * libU77/getlog_.c: Conditionalize for target platform. Set errno - to ENOSYS if target libc doesn't have the function. - * libU77/getgid_.c: Likewise. - * libU77/getuid_.c: Likewise. - * libU77/kill_.c: Likewise. - * libU77/link_.c: Likewise. - * libU77/ttynam_.c: Likewise. - - Sun Jan 18 20:01:37 1998 Toon Moene - - * libI77/backspace.c: (f_back): Use type `uiolen' to determine size - of record length specifier. - - Sat Jan 17 22:40:31 1998 Mumit Khan - - * libU77/configure.in (sys/param.h,sys/times.h): Check. - (times,alarm): Likewise. - * libU77/config.h.in (HAVE_SYS_PARAM_H, HAVE_SYS_TIMES_H, - HAVE_ALARM, HAVE_TIMES): New defs. - * libU77/alarm_.c: Conditionalize for target platform. Set errno - to ENOSYS if target libc doesn't have the function. - * libU77/dtime_.c: Likewise. - * libU77/etime_.c: Likewise. - * libU77/sys_clock_.c: Likewise. - - * configure.in (NON_UNIX_STDIO): Define if MINGW32. - (NON_ANSI_RW_MODE): Do not define for CYGWIN32 or MINGW32. - - * libI77/rawio.h: Don't providing conflicting declarations for - read() and write(). MINGW32 header files use "const" quals. - - * libF77/s_paus.c: _WIN32 does not have pause(). - - Tue Nov 18 09:49:04 1997 Mumit Khan (khan@xraylith.wisc.edu) - - * libI77/close.c (f_exit): Reset f__init so that f_clos does not - (incorrectly) think there is an I/O recursion when program is - interrupted. - - Sat Nov 1 18:03:42 1997 Jeffrey A Law (law@cygnus.com) - - * libF77/signal_.c: Undo last change until we can fix it right. - - Wed Oct 15 10:06:29 1997 Richard Henderson - - * libF77/signal_.c (G77_signal_0): Make return type sig_pf as well. - * libI77/fio.h: Include if STDC_HEADERS. - * libU77/chmod_.c: Likewise. - - Tue Oct 7 18:22:10 1997 Richard Henderson - - * Makefile.in (CGFLAGS): Don't force -g0. - * libF77/Makefile.in, libI77/Makefile.in, libU77/Makefile.in: Likewise. - - Mon Oct 6 14:16:46 1997 Jeffrey A Law (law@cygnus.com) - - * Makefile.in (distclean): Do a better job at cleaning up. - - Wed Oct 1 01:46:16 1997 Philippe De Muyter - - * libU77/sys_clock_.c: File renamed from system_clock_.c. - * libU77/Makefile.in, Makefile.in : Reference sys_clock_.*, not - system_clock_.*. - * libU77/dtime_.c (clk_tck): Try also HZ macro. - * libU77/access.c (G77_access_0): Check malloc return value against 0, - not NULL. - * libU77/getlog_.c, libU77/ttynam_.c, libU77/chdir_.c: Ditto. - * libU77/chmod_.c, libU77/rename_.c: Ditto. - - 1997-09-19 Dave Love - - * libU77/dtime_.c (G77_dtime_0): Fix types in HAVE_GETRUSAGE case - so as not to truncate results to integer values. - * libU77/Version.c: Bump. - - Thu Sep 18 16:58:46 1997 Jeffrey A Law (law@cygnus.com) - - * Makefile.in (stamp-lib): Don't use '$?', explicitly - list the variables containing the object files to include - in libf2c.a - - Fri Sep 5 00:18:17 1997 Jeffrey A Law (law@cygnus.com) - - * Makefile.in (clean): Don't remove config.cache. - (distclean): Do it here instead. - - Tue Aug 26 20:14:08 1997 Robert Lipe (robertl@dgii.com) - - * hostnm_.c: Include errno.h - - Mon Aug 25 23:26:05 1997 H.J. Lu (hjl@gnu.ai.mit.edu) - - * Makefile.in (mostlyclean, clean): Check if Makefile exists - before using it. Remove stamp-*. - (stamp-libi77, stamp-libf77, stamp-libu77): New. - (stamp-lib): Only depend on stamp-libi77 stamp-libf77 - stamp-libu77 --- 0 ---- diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/Makefile.in gcc-2.95/libf2c/Makefile.in *** egcs-1.1.2/libf2c/Makefile.in Thu Oct 1 17:29:06 1998 --- gcc-2.95/libf2c/Makefile.in Sat Apr 24 01:10:00 1999 *************** gcc_version_trigger = @gcc_version_trigg *** 34,39 **** --- 34,47 ---- libdir = $(exec_prefix)/lib libsubdir = $(libdir)/gcc-lib/$(target_alias)/$(gcc_version) + # Multilib support variables. + MULTISRCTOP = + MULTIBUILDTOP = + MULTIDIRS = + MULTISUBDIR = + MULTIDO = true + MULTICLEAN = true + # Not configured per top-level version, since that doesn't get passed # down at configure time, but overrridden by the top-level install # target. *************** SUBDIRS = libI77 libF77 libU77 *** 67,87 **** F2CEXT = abort derf derfc ef1asc ef1cmc erf erfc exit getarg getenv iargc \ signal system flush ftell fseek access besj0 besj1 besjn besy0 besy1 \ ! besyn chdir chmod ctime date dbesj0 dbesj1 dbesjn dbesy0 dbesy1 dbesyn \ dtime etime fdate fgetc fget flush1 fnum fputc fput fstat gerror \ getcwd getgid getlog getpid getuid gmtime hostnm idate ierrno irand \ isatty itime kill link lnblnk lstat ltime mclock perror rand rename \ secnds second sleep srand stat symlnk time ttynam umask unlink \ ! vxtidt vxttim alarm ! # These dependencies can be satisfied in parallel. The [fiu]77 ! # targets update stamp files which the $(LIBG2C) target checks in the ! # sub-make. (Probably only one stamp file is really needed.) ! all: i77 f77 u77 s-libe77 $(MAKE) $(FLAGS_TO_PASS) $(LIBG2C) i77 f77 u77: g2c.h $(LIBG2C): s-libi77 s-libf77 s-libu77 s-libe77 rm -f $(LIBG2C) set -e; \ --- 75,134 ---- F2CEXT = abort derf derfc ef1asc ef1cmc erf erfc exit getarg getenv iargc \ signal system flush ftell fseek access besj0 besj1 besjn besy0 besy1 \ ! besyn chdir chmod ctime dbesj0 dbesj1 dbesjn dbesy0 dbesy1 dbesyn \ dtime etime fdate fgetc fget flush1 fnum fputc fput fstat gerror \ getcwd getgid getlog getpid getuid gmtime hostnm idate ierrno irand \ isatty itime kill link lnblnk lstat ltime mclock perror rand rename \ secnds second sleep srand stat symlnk time ttynam umask unlink \ ! vxttim alarm \ ! date_y2kbuggy date_y2kbug vxtidt_y2kbuggy vxtidt_y2kbug ! ! .SUFFIXES: ! # The logic here is partly dictated by the desire to keep the lib?77 ! # subdirs for compatibility with the Netlib version and because libU77 ! # has a different copyright; then the libe77 bit (EXTERNALly-callable ! # versions) is funny. Given that, as well as keeping things as simple ! # as possible we want (at least) the following: ! # * Allow make to be run at the top level (all-target-libf2c), at this ! # level, or the subdirs of this level. In the latter case we only ! # compile, rather than updating libg2c.a; ! # * A robust set of dependencies, so that we rebuild (as little as ! # possible) if a configuration file, g2c.h or any lib?77/*.c file ! # changes; ! # * Avoid unnecessary running of ar and ranlib; ! # * Expose parallelism where reasonable, but not as a priority. ! ! # The intended top-level target here does a non-multilib build (via ! # the dependency) and then (perhaps) builds multilibs. ! ! all: all-unilib ! $(MULTIDO) $(FLAGS_TO_PASS) multi-do DO="all-unilib" ! ! # `all-unilib' is the overall target in the absence of multilibs, ! # meant to be invoked via multi-do for multilibs. ! ! # Its dependencies can be satisfied in parallel. The [fiu]77 targets ! # update stamp files (see the subdir makefiles) which the $(LIBG2C) ! # target checks in the sub make to decide whether to run ar/ranlib. ! # (Probably only one stamp file is really needed.) The stamp files ! # s-lib[fiu]77 are intentionally not targets, since we're only meant ! # to come in at the level of this target. The [fiu]77 targets always ! # invoke sub makes to check dependencies in the subdirs, else we'd ! # have to maintain them at this level; we live with the overhead of ! # some recursive makes which may do nothing. ! ! all-unilib: i77 f77 u77 s-libe77 $(MAKE) $(FLAGS_TO_PASS) $(LIBG2C) i77 f77 u77: g2c.h + # This target should normally only get invoked via `all-unilib' -- + # after all's well in the subdirs -- actually to assemble the library. + # The stamp file dependencies are just to check whether libg2c.a is + # up-to-date (to avoid running ar regardless) -- the files should + # always have been created by a successful `all-unilib'. + $(LIBG2C): s-libi77 s-libf77 s-libu77 s-libe77 rm -f $(LIBG2C) set -e; \ *************** s-libe77: f2cext.c *** 113,118 **** --- 160,167 ---- done echo timestamp >s-libe77 + f2cext.c: g2c.h + ${srcdir}/configure: configure.in rm -f config.cache cd $(srcdir) && autoconf *************** g2c.h: g2c.hin config.status Makefile *** 128,134 **** # $(srcdir)/../move-if-change g2c.h g2c.x && mv g2c.x g2c.h Makefile: Makefile.in config.status ! # Autoconf doc uses `./config.status'. Is there a good reason to use $(SHELL) config.status config.status: configure $(gcc_version_trigger) --- 177,183 ---- # $(srcdir)/../move-if-change g2c.h g2c.x && mv g2c.x g2c.h Makefile: Makefile.in config.status ! # Autoconf doc uses `./config.status'. Is there a good reason to use $(SHELL)? $(SHELL) config.status config.status: configure $(gcc_version_trigger) *************** check: *** 143,151 **** cd libU77; $(MAKE) G77DIR=../../../gcc/ check install: all ! $(INSTALL_DATA) $(LIBG2C) $(libsubdir)/$(LIBG2C).n ! ( cd $(libsubdir) ; $(RANLIB) $(LIBG2C).n ) ! mv -f $(libsubdir)/$(LIBG2C).n $(libsubdir)/$(LIBG2C) $(INSTALL_DATA) g2c.h $(libsubdir)/include/g2c.h @if [ -f f2c-install-ok -o -f $(srcdir)/f2c-install-ok ]; then \ echo ''; \ --- 192,200 ---- cd libU77; $(MAKE) G77DIR=../../../gcc/ check install: all ! $(INSTALL_DATA) $(LIBG2C) $(libsubdir)/$(MULTISUBDIR)/$(LIBG2C).n ! ( cd $(libsubdir)/$(MULTISUBDIR) ; $(RANLIB) $(LIBG2C).n ) ! mv -f $(libsubdir)/$(MULTISUBDIR)/$(LIBG2C).n $(libsubdir)/$(MULTISUBDIR)/$(LIBG2C) $(INSTALL_DATA) g2c.h $(libsubdir)/include/g2c.h @if [ -f f2c-install-ok -o -f $(srcdir)/f2c-install-ok ]; then \ echo ''; \ *************** install: all *** 156,180 **** echo ' f2c-install-ok in the source or build directory.)'; \ echo ''; \ else true; fi install-strip: $(MAKE) INSTALL_PROGRAM='$(INSTALL_PROGRAM) -s' install uninstall: ! rm -f $(libsubdir)/include/g2c.h $(libsubdir)/$(LIBG2C) mostlyclean: rm -f $(LIBG2C) ! for i in $(SUBDIRS); do (cd $$i && $(MAKE) mostlyclean); done ! rm -fr libE77 clean: mostlyclean rm -f config.log ! for i in $(SUBDIRS); do (cd $$i && $(MAKE) clean); done distclean: clean ! rm -f Makefile config.cache config.status g2c.h s-libe77 ! for i in $(SUBDIRS); do (cd $$i && $(MAKE) distclean); done maintainer-clean: --- 205,235 ---- echo ' f2c-install-ok in the source or build directory.)'; \ echo ''; \ else true; fi + $(MULTIDO) $(FLAGS_TO_PASS) multi-do DO="$@" install-strip: $(MAKE) INSTALL_PROGRAM='$(INSTALL_PROGRAM) -s' install uninstall: ! rm -f $(libsubdir)/$(MULTISUBDIR)/include/g2c.h $(libsubdir)/$(MULTISUBDIR)/$(LIBG2C) ! $(MULTIDO) $(FLAGS_TO_PASS) multi-do DO="$@" mostlyclean: rm -f $(LIBG2C) ! $(MAKE) DO=$@ DODIRS="$(SUBDIRS)" $(FLAGS_TO_PASS) subdir_do; \ ! $(MULTICLEAN) multi-clean DO=$@ ! rm -fr libE77 s-libe77 clean: mostlyclean rm -f config.log ! $(MAKE) DO=$@ DODIRS="$(SUBDIRS)" $(FLAGS_TO_PASS) subdir_do; \ ! $(MULTICLEAN) multi-clean DO=$@ distclean: clean ! rm -f g2c.h s-libe77 ! $(MAKE) DO=$@ DODIRS="$(SUBDIRS)" $(FLAGS_TO_PASS) subdir_do; \ ! $(MULTICLEAN) multi-clean DO=distclean ! rm -f config.cache config.status Makefile maintainer-clean: *************** rebuilt: configure *** 182,185 **** .PHONY: rebuilt mostlyclean clean distclean maintainer-clean all \ i77 f77 u77 check uninstall install-strip dist \ ! installcheck installdirs --- 237,257 ---- .PHONY: rebuilt mostlyclean clean distclean maintainer-clean all \ i77 f77 u77 check uninstall install-strip dist \ ! installcheck installdirs all-unilib ! ! subdir_do: ! @rootpre=`pwd`/; export rootpre; \ ! srcrootpre=`cd $(srcdir); pwd`/; export srcrootpre; \ ! for i in .. $(DODIRS); do \ ! if [ x$$i != x.. ]; then \ ! if [ -f ./$$i/Makefile ]; then \ ! if (cd ./$$i; $(MAKE) $(FLAGS_TO_PASS) $(DO)); then \ ! true; \ ! else \ ! exit 1; \ ! fi; \ ! else true; fi; \ ! else true; fi; \ ! done ! ! # multidoings may be added here by configure. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/changes.netlib gcc-2.95/libf2c/changes.netlib *** egcs-1.1.2/libf2c/changes.netlib Tue Jun 23 07:37:06 1998 --- gcc-2.95/libf2c/changes.netlib Mon May 10 07:40:49 1999 *************** Thu Jun 18 01:22:52 EDT 1998 *** 2927,2929 **** --- 2927,3016 ---- either a decimal point or an exponent field) are treated as errors when they appear as list input for integer data. Compile lread.c with -DALLOW_FLOAT_IN_INTEGER_LIST_INPUT to restore the old behavior. + + Mon Aug 31 10:38:54 EDT 1998 + formatdata.c: if possible, and assuming doubles must be aligned on + double boundaries, use existing holes in DATA for common blocks to + force alignment of the block. For example, + block data + common /abc/ a, b + double precision a + integer b(2) + data b(2)/1/ + end + used to generate + struct { + integer fill_1[3]; + integer e_2; + doublereal e_3; + } abc_ = { {0}, 1, 0. }; + and now generates + struct { + doublereal fill_1[1]; + integer fill_2[1]; + integer e_3; + } abc_ = { {0}, {0}, 1 }; + In the old generated C, e_3 was added to force alignment; in the new C, + fill_1 does this job. + + Mon Sep 7 19:48:51 EDT 1998 + libi77: move e_wdfe from sfe.c to dfe.c, where it was originally. + Why did it ever move to sfe.c? + + Tue Sep 8 10:22:50 EDT 1998 + Treat dreal as a synonym for dble unless -cd is specified on the + command line. + + Sun Sep 13 22:23:41 EDT 1998 + format.c: fix bug in writing prototypes under f2c -A ... *.P: + under some circumstances involving external functions with no known + type, a null pointer was passed to printf. + + Tue Oct 20 23:25:54 EDT 1998 + Comments added to libf2c/README and libF77/README, pointing out + the need to modify signal1.h on some systems. + + Wed Feb 10 22:59:52 EST 1999 + defs.h lex.c: permit long names (up to at least roughly + MAX_SHARPLINE_LEN = 1000 characters long) in #line lines (which only + matters under -g). + fc: add -U option; recognize .so files. + + Sat Feb 13 10:18:27 EST 1999 + libf2c: endfile.c, lread.c, signal1.h0: minor tweaks to make some + (C++) compilers happier; f77_aloc.c: make exit_() visible to C++ + compilers. Version strings not changed. + + Thu Mar 11 23:14:02 EST 1999 + Modify f2c (exec.c, expr.c) to diagnose incorrect mixing of types + when (f2c extended) intrinsic functions are involved, as in + (not(17) .and. 4). Catching this in the first executable statement + is a bit tricky, as some checking must be postponed until all statement + function declarations have been parsed. Thus there is a chance of + today's changes introducing bugs under (let us hope) unusual conditions. + + Sun Mar 28 13:17:44 EST 1999 + lex.c: tweak to get the file name right in error messages caused + by statements just after a # nnn "filename" line emitted by the C + preprocessor. (The trouble is that the line following the # nnn line + must be read to see if it is a continuation of the stuff that preceded + the # nnn line.) When # nnn "filename" lines appear among the lines + for a Fortran statement, the filename reported in an error message for + the statement should now be the file that was current when the first + line of the statement was read. + + Sun May 2 22:38:25 EDT 1999 + libf77, libi77, libf2c.zip: make getenv_() more portable (call + getenv() rather than knowing about char **environ); adjust some + complex intrinsics to work with overlapping arguments (caused by + inappropriate use of equivalence); open.c: get "external" versus + "internal" right in the error message if a file cannot be opened; + err.c: cast a pointer difference to (int) for %d; rdfmt.c: omit + fixed-length buffer that could be overwritten by formats Inn or Lnn + with nn > 83. + + Mon May 3 13:14:07 EDT 1999 + "Invisible" changes to omit a few compiler warnings in f2c and + libf2c; two new casts in libf2c/open.c that matter with 64-bit longs, + and one more tweak (libf2c/c_log.c) for pathological equivalences. + Minor update to "fc" script: new -L flag and comment correction. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/configure gcc-2.95/libf2c/configure *** egcs-1.1.2/libf2c/configure Sun Mar 14 03:13:11 1999 --- gcc-2.95/libf2c/configure Thu Jul 29 05:46:14 1999 *************** *** 1,7 **** #! /bin/sh # Guess values for system-dependent variables and create Makefiles. ! # Generated automatically using autoconf version 2.12.1 # Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. # # This configure script is free software; the Free Software Foundation --- 1,7 ---- #! /bin/sh # Guess values for system-dependent variables and create Makefiles. ! # Generated automatically using autoconf version 2.13 # Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. # # This configure script is free software; the Free Software Foundation *************** EOF *** 333,339 **** verbose=yes ;; -version | --version | --versio | --versi | --vers) ! echo "configure generated by autoconf version 2.12.1" exit 0 ;; -with-* | --with-*) --- 333,339 ---- verbose=yes ;; -version | --version | --versio | --versi | --vers) ! echo "configure generated by autoconf version 2.13" exit 0 ;; -with-* | --with-*) *************** ac_ext=c *** 503,511 **** # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ! ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then --- 503,513 ---- # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ! ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross + ac_exeext= + ac_objext=o if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then *************** fi *** 520,541 **** ! # From configure.in 1.12 # For g77 we'll set CC to point at the built gcc, but this will get it into # the makefiles # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:531: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ! IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" ! for ac_dir in $PATH; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_CC="gcc" --- 522,604 ---- ! if test "${srcdir}" = "." ; then ! if test "${with_target_subdir}" != "." ; then ! topsrcdir=${with_multisrctop}../.. ! else ! topsrcdir=${with_multisrctop}.. ! fi ! else ! topsrcdir=${srcdir}/.. ! fi ! ac_aux_dir= ! for ac_dir in $topsrcdir $srcdir/$topsrcdir; do ! if test -f $ac_dir/install-sh; then ! ac_aux_dir=$ac_dir ! ac_install_sh="$ac_aux_dir/install-sh -c" ! break ! elif test -f $ac_dir/install.sh; then ! ac_aux_dir=$ac_dir ! ac_install_sh="$ac_aux_dir/install.sh -c" ! break ! fi ! done ! if test -z "$ac_aux_dir"; then ! { echo "configure: error: can not find install-sh or install.sh in $topsrcdir $srcdir/$topsrcdir" 1>&2; exit 1; } ! fi ! ac_config_guess=$ac_aux_dir/config.guess ! ac_config_sub=$ac_aux_dir/config.sub ! ac_configure=$ac_aux_dir/configure # This should be Cygnus configure. ! ! ! # If the language specific compiler does not exist, but the "gcc" directory ! # does, we do not build anything. Note, $r is set by the top-level Makefile. ! # Note that when we look for the compiler, we search both with and without ! # extension to handle cross and canadian cross builds. ! compiler_name=f771 ! rm -f skip-this-dir ! echo $ac_n "checking if compiler $compiler_name has been built""... $ac_c" 1>&6 ! echo "configure:562: checking if compiler $compiler_name has been built" >&5 ! if eval "test \"`echo '$''{'g77_cv_compiler_exists'+set}'`\" = set"; then ! echo $ac_n "(cached) $ac_c" 1>&6 ! else ! g77_cv_compiler_exists=yes ! if test -n "$r"; then ! if test -d "$r"/gcc; then ! if test -f "$r"/gcc/$compiler_name \ ! || test -f "$r"/gcc/$compiler_name.exe; then ! true ! else ! g77_cv_compiler_exists=no ! echo "rm -f config.cache config.log multilib.out" > skip-this-dir ! fi ! fi ! fi ! ! fi ! ! echo "$ac_t""$g77_cv_compiler_exists" 1>&6 ! if test x$g77_cv_compiler_exists = xno ! then ! rm -f Makefile conftest* confdefs* core ! exit 0 ! fi # For g77 we'll set CC to point at the built gcc, but this will get it into # the makefiles # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:593: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ! IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ! ac_dummy="$PATH" ! for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_CC="gcc" *************** if test -z "$CC"; then *** 556,571 **** # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:560: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ! IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" ac_prog_rejected=no ! for ac_dir in $PATH; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then --- 619,635 ---- # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:623: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ! IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_prog_rejected=no ! ac_dummy="$PATH" ! for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then *************** else *** 600,624 **** echo "$ac_t""no" 1>&6 fi test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 ! echo "configure:608: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ! ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross ! cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then --- 664,724 ---- echo "$ac_t""no" 1>&6 fi + if test -z "$CC"; then + case "`uname -s`" in + *win32* | *WIN32*) + # Extract the first word of "cl", so it can be a program name with args. + set dummy cl; ac_word=$2 + echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 + echo "configure:674: checking for $ac_word" >&5 + if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 + else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. + else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_CC="cl" + break + fi + done + IFS="$ac_save_ifs" + fi + fi + CC="$ac_cv_prog_CC" + if test -n "$CC"; then + echo "$ac_t""$CC" 1>&6 + else + echo "$ac_t""no" 1>&6 + fi + ;; + esac + fi test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 ! echo "configure:706: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ! ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross ! cat > conftest.$ac_ext << EOF ! ! #line 717 "configure" #include "confdefs.h" + main(){return(0);} EOF ! if { (eval echo configure:722: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then *************** else *** 632,649 **** ac_cv_prog_cc_works=no fi rm -fr conftest* echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 if test $ac_cv_prog_cc_works = no; then { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 ! echo "configure:642: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 ! echo "configure:647: checking whether we are using GNU C" >&5 if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else --- 732,755 ---- ac_cv_prog_cc_works=no fi rm -fr conftest* + ac_ext=c + # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. + ac_cpp='$CPP $CPPFLAGS' + ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' + ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' + cross_compiling=$ac_cv_prog_cc_cross echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 if test $ac_cv_prog_cc_works = no; then { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 ! echo "configure:748: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 ! echo "configure:753: checking whether we are using GNU C" >&5 if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else *************** else *** 652,658 **** yes; #endif EOF ! if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:656: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no --- 758,764 ---- yes; #endif EOF ! if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:762: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no *************** echo "$ac_t""$ac_cv_prog_gcc" 1>&6 *** 663,673 **** if test $ac_cv_prog_gcc = yes; then GCC=yes ! ac_test_CFLAGS="${CFLAGS+set}" ! ac_save_CFLAGS="$CFLAGS" ! CFLAGS= ! echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 ! echo "configure:671: checking whether ${CC-cc} accepts -g" >&5 if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else --- 769,783 ---- if test $ac_cv_prog_gcc = yes; then GCC=yes ! else ! GCC= ! fi ! ! ac_test_CFLAGS="${CFLAGS+set}" ! ac_save_CFLAGS="$CFLAGS" ! CFLAGS= ! echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 ! echo "configure:781: checking whether ${CC-cc} accepts -g" >&5 if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else *************** rm -f conftest* *** 682,697 **** fi echo "$ac_t""$ac_cv_prog_cc_g" 1>&6 ! if test "$ac_test_CFLAGS" = set; then ! CFLAGS="$ac_save_CFLAGS" ! elif test $ac_cv_prog_cc_g = yes; then CFLAGS="-g -O2" else ! CFLAGS="-O2" fi else ! GCC= ! test "${CFLAGS+set}" = set || CFLAGS="-g" fi --- 792,811 ---- fi echo "$ac_t""$ac_cv_prog_cc_g" 1>&6 ! if test "$ac_test_CFLAGS" = set; then ! CFLAGS="$ac_save_CFLAGS" ! elif test $ac_cv_prog_cc_g = yes; then ! if test "$GCC" = yes; then CFLAGS="-g -O2" else ! CFLAGS="-g" fi else ! if test "$GCC" = yes; then ! CFLAGS="-O2" ! else ! CFLAGS= ! fi fi *************** else *** 703,717 **** # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:707: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. else ! IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" ! for ac_dir in $PATH; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_RANLIB="ranlib" --- 817,832 ---- # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:821: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. else ! IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ! ac_dummy="$PATH" ! for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_RANLIB="ranlib" *************** else *** 730,754 **** fi fi - ac_aux_dir= - for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do - if test -f $ac_dir/install-sh; then - ac_aux_dir=$ac_dir - ac_install_sh="$ac_aux_dir/install-sh -c" - break - elif test -f $ac_dir/install.sh; then - ac_aux_dir=$ac_dir - ac_install_sh="$ac_aux_dir/install.sh -c" - break - fi - done - if test -z "$ac_aux_dir"; then - { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; } - fi - ac_config_guess=$ac_aux_dir/config.guess - ac_config_sub=$ac_aux_dir/config.sub - ac_configure=$ac_aux_dir/configure # This should be Cygnus configure. - # Find a good install program. We prefer a C program (faster), # so one script is as good as another. But avoid the broken or # incompatible versions: --- 845,850 ---- *************** ac_configure=$ac_aux_dir/configure # Thi *** 761,772 **** # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" # ./install, which can be erroneously created by make from ./install.sh. echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6 ! echo "configure:765: checking for a BSD compatible install" >&5 if test -z "$INSTALL"; then if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ! IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS="${IFS}:" for ac_dir in $PATH; do # Account for people who put trailing slashes in PATH elements. case "$ac_dir/" in --- 857,868 ---- # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" # ./install, which can be erroneously created by make from ./install.sh. echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6 ! echo "configure:861: checking for a BSD compatible install" >&5 if test -z "$INSTALL"; then if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ! IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":" for ac_dir in $PATH; do # Account for people who put trailing slashes in PATH elements. case "$ac_dir/" in *************** echo "$ac_t""$INSTALL" 1>&6 *** 809,818 **** # It thinks the first close brace ends the variable substitution. test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 ! echo "configure:816: checking whether ${MAKE-make} sets \${MAKE}" >&5 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 --- 905,916 ---- # It thinks the first close brace ends the variable substitution. test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' + test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}' + test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 ! echo "configure:914: checking whether ${MAKE-make} sets \${MAKE}" >&5 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 *************** fi *** 841,847 **** # Sanity check for the cross-compilation case: echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 ! echo "configure:845: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= --- 939,945 ---- # Sanity check for the cross-compilation case: echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 ! echo "configure:943: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= *************** else *** 856,869 **** # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:866: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then : else --- 954,967 ---- # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:964: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : else *************** else *** 873,886 **** rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:883: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then : else --- 971,1001 ---- rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:981: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` ! if test -z "$ac_err"; then ! : ! else ! echo "$ac_err" >&5 ! echo "configure: failed program was:" >&5 ! cat conftest.$ac_ext >&5 ! rm -rf conftest* ! CPP="${CC-cc} -nologo -E" ! cat > conftest.$ac_ext < ! Syntax Error ! EOF ! ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:998: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : else *************** fi *** 893,898 **** --- 1008,1015 ---- rm -f conftest* fi rm -f conftest* + fi + rm -f conftest* ac_cv_prog_CPP="$CPP" fi CPP="$ac_cv_prog_CPP" *************** echo "$ac_t""$CPP" 1>&6 *** 903,920 **** ac_safe=`echo "stdio.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for stdio.h""... $ac_c" 1>&6 ! echo "configure:907: checking for stdio.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:917: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" --- 1020,1037 ---- ac_safe=`echo "stdio.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for stdio.h""... $ac_c" 1>&6 ! echo "configure:1024: checking for stdio.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:1034: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" *************** fi *** 941,961 **** # We have to firkle with the info in hconfig.h to figure out suitable types ! # (via com.h). proj.h and com.h are in $srcdir/.., config.h which they need ! # is in ../.. and the config files are in $srcdir/../../config. echo $ac_n "checking f2c integer type""... $ac_c" 1>&6 ! echo "configure:948: checking f2c integer type" >&5 late_ac_cpp=$ac_cpp ! ac_cpp="$late_ac_cpp -I../../gcc/f -I../../gcc -I../../gcc/config" ! if test "$subdir" != . ; then ! ac_cpp="$ac_cpp -I$srcdir/../gcc/f -I$srcdir/../gcc -I$srcdir/../gcc/config" fi if eval "test \"`echo '$''{'g77_cv_sys_f2cinteger'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ! echo "configure:957: using $ac_cpp" >&5 cat > conftest.$ac_ext <&6 ! echo "configure:1065: checking f2c integer type" >&5 ! # Set this back later below! late_ac_cpp=$ac_cpp ! late_cflags=$CFLAGS ! extra_includes="-I$topsrcdir/gcc/f -I$topsrcdir/gcc -I$topsrcdir/include -I$topsrcdir/gcc/config -I$r/gcc" ! ac_cpp="$late_ac_cpp -DIN_GCC -DHAVE_CONFIG_H $extra_includes" ! ! # The AC_EGREP_CPPs below have been known to fail when the header ! # path is wrong after things have been moved about; the cpp error status ! # counts for nothing. First check that there aren't any errors from ! # the headers. ! CFLAGS="$CFLAGS -DHAVE_CONFIG_H -DIN_GCC $extra_includes" ! cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then ! : ! else ! echo "configure: failed program was:" >&5 ! cat conftest.$ac_ext >&5 ! rm -rf conftest* ! { echo "configure: error: Can't run check for integer sizes -- see config.log" 1>&2; exit 1; } fi + rm -f conftest* + CFLAGS=$late_cflags + if eval "test \"`echo '$''{'g77_cv_sys_f2cinteger'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ! echo "configure:1101: using $ac_cpp" >&5 cat > conftest.$ac_ext <&5 cat > conftest.$ac_ext <&5 cat > conftest.$ac_ext <&6 F2C_INTEGER=$g77_cv_sys_f2cinteger - ac_cpp=$late_ac_cpp echo $ac_n "checking f2c long int type""... $ac_c" 1>&6 ! echo "configure:1018: checking f2c long int type" >&5 ! late_ac_cpp=$ac_cpp ! ac_cpp="$late_ac_cpp -I../../gcc/f -I../../gcc -I../../gcc/config" ! if test "$subdir" != . ; then ! ac_cpp="$ac_cpp -I$srcdir/../gcc/f -I$srcdir/../gcc -I$srcdir/../gcc/config" ! fi if eval "test \"`echo '$''{'g77_cv_sys_f2clongint'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ! echo "configure:1027: using $ac_cpp" >&5 cat > conftest.$ac_ext <&6 F2C_INTEGER=$g77_cv_sys_f2cinteger echo $ac_n "checking f2c long int type""... $ac_c" 1>&6 ! echo "configure:1161: checking f2c long int type" >&5 if eval "test \"`echo '$''{'g77_cv_sys_f2clongint'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ! echo "configure:1165: using $ac_cpp" >&5 cat > conftest.$ac_ext <& *** 1046,1055 **** fi rm -f conftest* if test "$g77_cv_sys_f2clongint" = ""; then ! echo "configure:1051: using $ac_cpp" >&5 cat > conftest.$ac_ext <&5 cat > conftest.$ac_ext <&6 F2C_LONGINT=$g77_cv_sys_f2clongint - ac_cpp=$late_ac_cpp # avoid confusion in case the `makefile's from the f2c distribution have # got put here --- 1219,1226 ---- echo "$ac_t""$g77_cv_sys_f2clongint" 1>&6 F2C_LONGINT=$g77_cv_sys_f2clongint + ac_cpp=$late_ac_cpp # avoid confusion in case the `makefile's from the f2c distribution have # got put here *************** else { echo "configure: error: can not r *** 1128,1134 **** fi echo $ac_n "checking host system type""... $ac_c" 1>&6 ! echo "configure:1132: checking host system type" >&5 host_alias=$host case "$host_alias" in --- 1267,1273 ---- fi echo $ac_n "checking host system type""... $ac_c" 1>&6 ! echo "configure:1271: checking host system type" >&5 host_alias=$host case "$host_alias" in *************** host_os=`echo $host | sed 's/^\([^-]*\)- *** 1149,1155 **** echo "$ac_t""$host" 1>&6 echo $ac_n "checking target system type""... $ac_c" 1>&6 ! echo "configure:1153: checking target system type" >&5 target_alias=$target case "$target_alias" in --- 1288,1294 ---- echo "$ac_t""$host" 1>&6 echo $ac_n "checking target system type""... $ac_c" 1>&6 ! echo "configure:1292: checking target system type" >&5 target_alias=$target case "$target_alias" in *************** target_os=`echo $target | sed 's/^\([^-] *** 1167,1173 **** echo "$ac_t""$target" 1>&6 echo $ac_n "checking build system type""... $ac_c" 1>&6 ! echo "configure:1171: checking build system type" >&5 build_alias=$build case "$build_alias" in --- 1306,1312 ---- echo "$ac_t""$target" 1>&6 echo $ac_n "checking build system type""... $ac_c" 1>&6 ! echo "configure:1310: checking build system type" >&5 build_alias=$build case "$build_alias" in *************** test "$host_alias" != "$target_alias" && *** 1190,1198 **** program_prefix=${target_alias}- - subdirs="libU77 libI77 libF77" trap '' 1 2 15 cat > confcache <<\EOF # This file is a shell script that caches the results of configure --- 1329,1339 ---- program_prefix=${target_alias}- subdirs="libU77 libI77 libF77" + # Do Makefile first since g2c.h depends on it and shouldn't get an + # earlier timestamp. Of course, it does when the multilib gunk below + # edits Makefile, sigh; see additional touch below. trap '' 1 2 15 cat > confcache <<\EOF # This file is a shell script that caches the results of configure *************** EOF *** 1216,1222 **** # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. (set) 2>&1 | ! case `(ac_space=' '; set) 2>&1 | grep ac_space` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote substitution # turns \\\\ into \\, and sed turns \\ into \). --- 1357,1363 ---- # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. (set) 2>&1 | ! case `(ac_space=' '; set | grep ac_space) 2>&1` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote substitution # turns \\\\ into \\, and sed turns \\ into \). *************** do *** 1295,1301 **** echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; -version | --version | --versio | --versi | --vers | --ver | --ve | --v) ! echo "$CONFIG_STATUS generated by autoconf version 2.12.1" exit 0 ;; -help | --help | --hel | --he | --h) echo "\$ac_cs_usage"; exit 0 ;; --- 1436,1442 ---- echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; -version | --version | --versio | --versi | --vers | --ver | --ve | --v) ! echo "$CONFIG_STATUS generated by autoconf version 2.13" exit 0 ;; -help | --help | --hel | --he | --h) echo "\$ac_cs_usage"; exit 0 ;; *************** s%@SHELL@%$SHELL%g *** 1319,1324 **** --- 1460,1466 ---- s%@CFLAGS@%$CFLAGS%g s%@CPPFLAGS@%$CPPFLAGS%g s%@CXXFLAGS@%$CXXFLAGS%g + s%@FFLAGS@%$FFLAGS%g s%@DEFS@%$DEFS%g s%@LDFLAGS@%$LDFLAGS%g s%@LIBS@%$LIBS%g *************** s%@CC@%$CC%g *** 1341,1346 **** --- 1483,1489 ---- s%@AR@%$AR%g s%@RANLIB@%$RANLIB%g s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g + s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g s%@INSTALL_DATA@%$INSTALL_DATA%g s%@SET_MAKE@%$SET_MAKE%g s%@CPP@%$CPP%g *************** rm -f conftest.s* *** 1466,1475 **** EOF cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF ! exit 0 EOF chmod +x $CONFIG_STATUS --- 1609,1634 ---- EOF cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF ! test -z "$CONFIG_HEADERS" || echo timestamp > stamp-h ! if test -n "$CONFIG_FILES"; then ! if test -n "${with_target_subdir}"; then ! # FIXME: We shouldn't need to set ac_file ! ac_file=Makefile ! . ${topsrcdir}/config-ml.in ! touch g2c.h # to keep it more recent than Makefile ! fi ! fi exit 0 EOF chmod +x $CONFIG_STATUS *************** if test "$no_recursion" != yes; then *** 1572,1576 **** --- 1731,1736 ---- cd $ac_popdir done fi + diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/configure.in gcc-2.95/libf2c/configure.in *** egcs-1.1.2/libf2c/configure.in Wed Jul 15 17:10:50 1998 --- gcc-2.95/libf2c/configure.in Wed May 19 19:28:48 1999 *************** *** 1,5 **** # Process this file with autoconf to produce a configure script. ! # Copyright (C) 1995, 1997, 1998 Free Software Foundation, Inc. # Contributed by Dave Love (d.love@dl.ac.uk). # #This file is part of GNU Fortran. --- 1,5 ---- # Process this file with autoconf to produce a configure script. ! # Copyright (C) 1995, 1997, 1998, 1999 Free Software Foundation, Inc. # Contributed by Dave Love (d.love@dl.ac.uk). # #This file is part of GNU Fortran. *************** *** 19,27 **** #the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA #02111-1307, USA. AC_INIT(libF77/Version.c) ! AC_REVISION(1.12) dnl Checks for programs. # For g77 we'll set CC to point at the built gcc, but this will get it into --- 19,67 ---- #the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA #02111-1307, USA. + AC_PREREQ(2.13) AC_INIT(libF77/Version.c) ! if test "${srcdir}" = "." ; then ! if test "${with_target_subdir}" != "." ; then ! topsrcdir=${with_multisrctop}../.. ! else ! topsrcdir=${with_multisrctop}.. ! fi ! else ! topsrcdir=${srcdir}/.. ! fi ! dnl This is needed for a multilibbed build in the source tree so ! dnl that install-sh and config.sub get found. ! AC_CONFIG_AUX_DIR($topsrcdir) ! ! # If the language specific compiler does not exist, but the "gcc" directory ! # does, we do not build anything. Note, $r is set by the top-level Makefile. ! # Note that when we look for the compiler, we search both with and without ! # extension to handle cross and canadian cross builds. ! compiler_name=f771 ! rm -f skip-this-dir ! AC_MSG_CHECKING(if compiler $compiler_name has been built) ! AC_CACHE_VAL(g77_cv_compiler_exists, ! [g77_cv_compiler_exists=yes ! if test -n "$r"; then ! if test -d "$r"/gcc; then ! if test -f "$r"/gcc/$compiler_name \ ! || test -f "$r"/gcc/$compiler_name.exe; then ! true ! else ! g77_cv_compiler_exists=no ! echo "rm -f config.cache config.log multilib.out" > skip-this-dir ! fi ! fi ! fi ! ]) ! AC_MSG_RESULT($g77_cv_compiler_exists) ! if test x$g77_cv_compiler_exists = xno ! then ! rm -f Makefile conftest* confdefs* core ! exit 0 ! fi dnl Checks for programs. # For g77 we'll set CC to point at the built gcc, but this will get it into *************** the G77 runtime system. If necessary, i *** 50,63 **** then the target library, then build with \`LANGUAGES=f77'.])]) # We have to firkle with the info in hconfig.h to figure out suitable types ! # (via com.h). proj.h and com.h are in $srcdir/.., config.h which they need ! # is in ../.. and the config files are in $srcdir/../../config. AC_MSG_CHECKING(f2c integer type) late_ac_cpp=$ac_cpp ! ac_cpp="$late_ac_cpp -I../../gcc/f -I../../gcc -I../../gcc/config" ! if test "$subdir" != . ; then ! ac_cpp="$ac_cpp -I$srcdir/../gcc/f -I$srcdir/../gcc -I$srcdir/../gcc/config" ! fi AC_CACHE_VAL(g77_cv_sys_f2cinteger, echo "configure:__oline__: using $ac_cpp" >&AC_FD_CC AC_EGREP_CPP(F2C_INTEGER=long int, --- 90,115 ---- then the target library, then build with \`LANGUAGES=f77'.])]) # We have to firkle with the info in hconfig.h to figure out suitable types ! # (via com.h). proj.h and com.h are in gcc/f/, config.h which they need ! # is in gcc/ and the config files are in gcc/config/. AC_MSG_CHECKING(f2c integer type) + # Set this back later below! late_ac_cpp=$ac_cpp ! late_cflags=$CFLAGS ! extra_includes="-I$topsrcdir/gcc/f -I$topsrcdir/gcc -I$topsrcdir/include -I$topsrcdir/gcc/config -I$r/gcc" ! ac_cpp="$late_ac_cpp -DIN_GCC -DHAVE_CONFIG_H $extra_includes" ! ! # The AC_EGREP_CPPs below have been known to fail when the header ! # path is wrong after things have been moved about; the cpp error status ! # counts for nothing. First check that there aren't any errors from ! # the headers. ! CFLAGS="$CFLAGS -DHAVE_CONFIG_H -DIN_GCC $extra_includes" ! AC_TRY_COMPILE([#include "proj.h" ! #define FFECOM_DETERMINE_TYPES 1 ! #include "com.h"],,, ! AC_MSG_ERROR([Can't run check for integer sizes -- see config.log])) ! CFLAGS=$late_cflags ! AC_CACHE_VAL(g77_cv_sys_f2cinteger, echo "configure:__oline__: using $ac_cpp" >&AC_FD_CC AC_EGREP_CPP(F2C_INTEGER=long int, *************** fi *** 96,110 **** ) AC_MSG_RESULT($g77_cv_sys_f2cinteger) F2C_INTEGER=$g77_cv_sys_f2cinteger - ac_cpp=$late_ac_cpp AC_SUBST(F2C_INTEGER) AC_MSG_CHECKING(f2c long int type) - late_ac_cpp=$ac_cpp - ac_cpp="$late_ac_cpp -I../../gcc/f -I../../gcc -I../../gcc/config" - if test "$subdir" != . ; then - ac_cpp="$ac_cpp -I$srcdir/../gcc/f -I$srcdir/../gcc -I$srcdir/../gcc/config" - fi AC_CACHE_VAL(g77_cv_sys_f2clongint, echo "configure:__oline__: using $ac_cpp" >&AC_FD_CC AC_EGREP_CPP(F2C_LONGINT=long int, --- 148,156 ---- *************** F2C_LONGINT=long long int *** 120,125 **** --- 166,172 ---- #endif ], g77_cv_sys_f2clongint="long int",) + if test "$g77_cv_sys_f2clongint" = ""; then echo "configure:__oline__: using $ac_cpp" >&AC_FD_CC AC_EGREP_CPP(F2C_LONGINT=long long int, *************** fi *** 143,150 **** ) AC_MSG_RESULT($g77_cv_sys_f2clongint) F2C_LONGINT=$g77_cv_sys_f2clongint - ac_cpp=$late_ac_cpp AC_SUBST(F2C_LONGINT) # avoid confusion in case the `makefile's from the f2c distribution have # got put here --- 190,197 ---- ) AC_MSG_RESULT($g77_cv_sys_f2clongint) F2C_LONGINT=$g77_cv_sys_f2clongint AC_SUBST(F2C_LONGINT) + ac_cpp=$late_ac_cpp # avoid confusion in case the `makefile's from the f2c distribution have # got put here *************** AC_SUBST(gcc_version) *** 165,173 **** AC_SUBST(gcc_version_trigger) AC_CANONICAL_SYSTEM AC_SUBST(target_alias) - AC_CONFIG_SUBDIRS(libU77 libI77 libF77) ! AC_OUTPUT(Makefile g2c.h:g2c.hin) dnl Local Variables: dnl comment-start: "dnl " --- 212,241 ---- AC_SUBST(gcc_version_trigger) AC_CANONICAL_SYSTEM AC_SUBST(target_alias) AC_CONFIG_SUBDIRS(libU77 libI77 libF77) ! # Do Makefile first since g2c.h depends on it and shouldn't get an ! # earlier timestamp. Of course, it does when the multilib gunk below ! # edits Makefile, sigh; see additional touch below. ! AC_OUTPUT(Makefile g2c.h:g2c.hin, ! [test -z "$CONFIG_HEADERS" || echo timestamp > stamp-h ! if test -n "$CONFIG_FILES"; then ! if test -n "${with_target_subdir}"; then ! # FIXME: We shouldn't need to set ac_file ! ac_file=Makefile ! . ${topsrcdir}/config-ml.in ! touch g2c.h # to keep it more recent than Makefile ! fi ! fi], ! srcdir=${srcdir} ! host=${host} ! target=${target} ! with_target_subdir=${with_target_subdir} ! with_multisubdir=${with_multisubdir} ! ac_configure_args="--enable-multilib ${ac_configure_args}" ! CONFIG_SHELL=${CONFIG_SHELL-/bin/sh} ! topsrcdir=${topsrcdir} ! ) ! dnl Local Variables: dnl comment-start: "dnl " diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/f2c.h gcc-2.95/libf2c/f2c.h *** egcs-1.1.2/libf2c/f2c.h Mon Jun 15 00:52:02 1998 --- gcc-2.95/libf2c/f2c.h Mon Feb 15 10:18:19 1999 *************** *** 1,6 **** /* f2c.h file for GNU Fortran run-time library Copyright (C) 1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley (burley@gnu.org). This file is part of GNU Fortran. --- 1,6 ---- /* f2c.h file for GNU Fortran run-time library Copyright (C) 1998 Free Software Foundation, Inc. ! Contributed by James Craig Burley. This file is part of GNU Fortran. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/f2cext.c gcc-2.95/libf2c/f2cext.c *** egcs-1.1.2/libf2c/f2cext.c Mon Jul 6 02:52:26 1998 --- gcc-2.95/libf2c/f2cext.c Fri Mar 5 15:40:08 1999 *************** License along with GNU Fortran; see the *** 16,22 **** not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ ! #include typedef void *sig_proc; /* For now, this will have to do. */ --- 16,22 ---- not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ ! #include /* for j0 et al */ #include typedef void *sig_proc; /* For now, this will have to do. */ *************** void ctime_ (char *chtime, const ftnlen *** 203,212 **** } #endif ! #ifdef Ldate int date_ (char *buf, ftnlen buf_len) { ! extern int G77_date_0 (char *buf, ftnlen buf_len); ! return G77_date_0 (buf, buf_len); } #endif --- 203,225 ---- } #endif ! #ifdef Ldate_y2kbuggy int date_ (char *buf, ftnlen buf_len) { ! /* Fail to link, so user sees attempt to invoke non-Y2K-compliant ! routine. */ ! extern int G77_date_y2kbuggy_0 (char *buf, ftnlen buf_len); ! return G77_date_y2kbuggy_0 (buf, buf_len); ! } ! #endif ! ! #ifdef Ldate_y2kbug ! int date_y2kbug__ (char *buf, ftnlen buf_len) { ! /* If user wants to invoke the non-Y2K-compliant routine via ! an `EXTERNAL' interface, avoiding the warning via g77's ! `INTRINSIC' interface, force coding of "y2kbug" string in ! user's program. */ ! extern int G77_date_y2kbug_0 (char *buf, ftnlen buf_len); ! return G77_date_y2kbug_0 (buf, buf_len); } #endif *************** integer unlink_ (const char *str, const *** 540,549 **** } #endif ! #ifdef Lvxtidt int vxtidate_ (integer *m, integer *d, integer *y) { ! extern int G77_vxtidate_0 (integer *m, integer *d, integer *y); ! return G77_vxtidate_0 (m, d, y); } #endif --- 553,575 ---- } #endif ! #ifdef Lvxtidt_y2kbuggy int vxtidate_ (integer *m, integer *d, integer *y) { ! /* Fail to link, so user sees attempt to invoke non-Y2K-compliant ! routine. */ ! extern int G77_vxtidate_y2kbuggy_0 (integer *m, integer *d, integer *y); ! return G77_vxtidate_y2kbuggy_0 (m, d, y); ! } ! #endif ! ! #ifdef Lvxtidt_y2kbug ! int vxtidate_y2kbug__ (integer *m, integer *d, integer *y) { ! /* If user wants to invoke the non-Y2K-compliant routine via ! an `EXTERNAL' interface, avoiding the warning via g77's ! `INTRINSIC' interface, force coding of "y2kbug" string in ! user's program. */ ! extern int G77_vxtidate_y2kbug_0 (integer *m, integer *d, integer *y); ! return G77_vxtidate_y2kbug_0 (m, d, y); } #endif diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/F77_aloc.c gcc-2.95/libf2c/libF77/F77_aloc.c *** egcs-1.1.2/libf2c/libF77/F77_aloc.c Sat Jan 31 17:37:05 1998 --- gcc-2.95/libf2c/libF77/F77_aloc.c Wed Mar 17 00:21:10 1999 *************** extern void G77_exit_0 (); *** 14,20 **** --- 14,26 ---- F77_aloc(Len, whence) integer Len; char *whence; #else #include + #ifdef __cplusplus + extern "C" { + #endif extern void G77_exit_0 (integer*); + #ifdef __cplusplus + } + #endif char * F77_aloc(integer Len, char *whence) diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/Makefile.in gcc-2.95/libf2c/libF77/Makefile.in *** egcs-1.1.2/libf2c/libF77/Makefile.in Tue Jul 14 13:29:16 1998 --- gcc-2.95/libf2c/libF77/Makefile.in Fri Mar 5 16:02:52 1999 *************** ${srcdir}/configure: configure.in *** 103,108 **** --- 103,230 ---- VersionF.o: Version.c $(CC) -c $(ALL_CFLAGS) -o $@ $(srcdir)/Version.c + F77_aloc.o: F77_aloc.c + main.o: main.c + s_rnge.o: s_rnge.c + abort_.o: abort_.c + getarg_.o: getarg_.c + iargc_.o: iargc_.c + getenv_.o: getenv_.c + signal_.o: signal_.c + s_stop.o: s_stop.c + s_paus.o: s_paus.c + system_.o: system_.c + cabs.o: cabs.c + derf_.o: derf_.c + derfc_.o: derfc_.c + erf_.o: erf_.c + erfc_.o: erfc_.c + sig_die.o: sig_die.c + exit_.o: exit_.c + setarg.o: setarg.c + setsig.o: setsig.c + pow_ci.o: pow_ci.c + pow_dd.o: pow_dd.c + pow_di.o: pow_di.c + pow_hh.o: pow_hh.c + pow_ii.o: pow_ii.c + pow_ri.o: pow_ri.c + pow_zi.o: pow_zi.c + pow_zz.o: pow_zz.c + pow_qq.o: pow_qq.c + c_abs.o: c_abs.c + c_cos.o: c_cos.c + c_div.o: c_div.c + c_exp.o: c_exp.c + c_log.o: c_log.c + c_sin.o: c_sin.c + c_sqrt.o: c_sqrt.c + z_abs.o: z_abs.c + z_cos.o: z_cos.c + z_div.o: z_div.c + z_exp.o: z_exp.c + z_log.o: z_log.c + z_sin.o: z_sin.c + z_sqrt.o: z_sqrt.c + r_abs.o: r_abs.c + r_acos.o: r_acos.c + r_asin.o: r_asin.c + r_atan.o: r_atan.c + r_atn2.o: r_atn2.c + r_cnjg.o: r_cnjg.c + r_cos.o: r_cos.c + r_cosh.o: r_cosh.c + r_dim.o: r_dim.c + r_exp.o: r_exp.c + r_imag.o: r_imag.c + r_int.o: r_int.c + r_lg10.o: r_lg10.c + r_log.o: r_log.c + r_mod.o: r_mod.c + r_nint.o: r_nint.c + r_sign.o: r_sign.c + r_sin.o: r_sin.c + r_sinh.o: r_sinh.c + r_sqrt.o: r_sqrt.c + r_tan.o: r_tan.c + r_tanh.o: r_tanh.c + d_abs.o: d_abs.c + d_acos.o: d_acos.c + d_asin.o: d_asin.c + d_atan.o: d_atan.c + d_atn2.o: d_atn2.c + d_cnjg.o: d_cnjg.c + d_cos.o: d_cos.c + d_cosh.o: d_cosh.c + d_dim.o: d_dim.c + d_exp.o: d_exp.c + d_imag.o: d_imag.c + d_int.o: d_int.c + d_lg10.o: d_lg10.c + d_log.o: d_log.c + d_mod.o: d_mod.c + d_nint.o: d_nint.c + d_prod.o: d_prod.c + d_sign.o: d_sign.c + d_sin.o: d_sin.c + d_sinh.o: d_sinh.c + d_sqrt.o: d_sqrt.c + d_tan.o: d_tan.c + d_tanh.o: d_tanh.c + i_abs.o: i_abs.c + i_dim.o: i_dim.c + i_dnnt.o: i_dnnt.c + i_indx.o: i_indx.c + i_len.o: i_len.c + i_mod.o: i_mod.c + i_nint.o: i_nint.c + i_sign.o: i_sign.c + h_abs.o: h_abs.c + h_dim.o: h_dim.c + h_dnnt.o: h_dnnt.c + h_indx.o: h_indx.c + h_len.o: h_len.c + h_mod.o: h_mod.c + h_nint.o: h_nint.c + h_sign.o: h_sign.c + l_ge.o: l_ge.c + l_gt.o: l_gt.c + l_le.o: l_le.c + l_lt.o: l_lt.c + hl_ge.o: hl_ge.c + hl_gt.o: hl_gt.c + hl_le.o: hl_le.c + hl_lt.o: hl_lt.c + ef1asc_.o: ef1asc_.c + ef1cmc_.o: ef1cmc_.c + s_cat.o: s_cat.c + s_cmp.o: s_cmp.c + s_copy.o: s_copy.c + lbitbits.o: lbitbits.c + lbitshft.o: lbitshft.c + qbitbits.o: qbitbits.c + qbitshft.o: qbitshft.c + # Not quite all these actually do depend on f2c.h... $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) $(HALF) $(CMP) $(EFL) \ $(CHAR) $(F90BIT): $(F2C_H_DIR)/f2c.h $(G2C_H_DIR)/g2c.h *************** mostlyclean: *** 114,119 **** --- 236,242 ---- clean: mostlyclean rm -f config.log + rm -f ../s-libf77 distclean: clean rm -f config.cache config.status Makefile ../s-libf77 configure diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/README.netlib gcc-2.95/libf2c/libF77/README.netlib *** egcs-1.1.2/libf2c/libF77/README.netlib Sat Jan 31 17:37:05 1998 --- gcc-2.95/libf2c/libF77/README.netlib Wed Mar 17 00:21:11 1999 *************** one-line shell script *** 106,108 **** --- 106,112 ---- or (on some systems) exec /usr/bin/ar lts $1 >/dev/null + + If your compiler complains about the signal calls in main.c, s_paus.c, + and signal_.c, you may need to adjust signal1.h suitably. See the + comments in signal1.h. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/Version.c gcc-2.95/libf2c/libF77/Version.c *** egcs-1.1.2/libf2c/libF77/Version.c Tue Sep 1 02:07:45 1998 --- gcc-2.95/libf2c/libF77/Version.c Thu Jul 29 02:37:32 1999 *************** *** 1,9 **** ! static char junk[] = "\n@(#)LIBF77 VERSION 19970919\n"; /* */ ! char __G77_LIBF77_VERSION__[] = "0.5.24"; /* 2.00 11 June 1980. File version.c added to library. --- 1,9 ---- ! static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* */ ! char __G77_LIBF77_VERSION__[] = "0.5.25 19990728 (release)"; /* 2.00 11 June 1980. File version.c added to library. *************** char __G77_LIBF77_VERSION__[] = "0.5.24" *** 55,60 **** --- 55,66 ---- affect systems using gratuitous extra precision). 19 Sept. 1997: [de]time_.c (Unix systems only): change return type to double. + 2 May 1999: getenv_.c: omit environ in favor of getenv(). + c_cos.c, c_exp.c, c_sin.c, d_cnjg.c, r_cnjg.c, + z_cos.c, z_exp.c, z_log.c, z_sin.c: cope fully with + overlapping arguments caused by equivalence. + 3 May 1999: "invisible" tweaks to omit compiler warnings in + abort_.c, ef1asc_.c, s_rnge.c, s_stop.c. */ #include diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/abort_.c gcc-2.95/libf2c/libF77/abort_.c *** egcs-1.1.2/libf2c/libF77/abort_.c Sat Jan 31 17:37:05 1998 --- gcc-2.95/libf2c/libF77/abort_.c Mon May 10 07:40:52 1999 *************** int G77_abort_0 (void) *** 12,18 **** #endif { sig_die("Fortran abort routine called", 1); ! #ifdef __cplusplus ! return 0; ! #endif } --- 12,16 ---- #endif { sig_die("Fortran abort routine called", 1); ! return 0; /* not reached */ } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/c_cos.c gcc-2.95/libf2c/libF77/c_cos.c *** egcs-1.1.2/libf2c/libF77/c_cos.c Sat Jan 31 17:37:05 1998 --- gcc-2.95/libf2c/libF77/c_cos.c Mon May 3 01:35:07 1999 *************** *** 3,21 **** #ifdef KR_headers extern double sin(), cos(), sinh(), cosh(); ! VOID c_cos(resx, z) complex *resx, *z; #else #undef abs ! #include ! void c_cos(complex *resx, complex *z) #endif { ! complex res; ! ! res.r = cos(z->r) * cosh(z->i); ! res.i = - sin(z->r) * sinh(z->i); ! ! resx->r = res.r; ! resx->i = res.i; ! } --- 3,17 ---- #ifdef KR_headers extern double sin(), cos(), sinh(), cosh(); ! VOID c_cos(r, z) complex *r, *z; #else #undef abs ! #include "math.h" ! void c_cos(complex *r, complex *z) #endif { ! double zi = z->i, zr = z->r; ! r->r = cos(zr) * cosh(zi); ! r->i = - sin(zr) * sinh(zi); ! } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/c_div.c gcc-2.95/libf2c/libF77/c_div.c *** egcs-1.1.2/libf2c/libF77/c_div.c Sat Jan 31 17:37:05 1998 --- gcc-2.95/libf2c/libF77/c_div.c Mon May 3 01:33:08 1999 *************** *** 2,40 **** #ifdef KR_headers extern VOID sig_die(); ! VOID c_div(resx, a, b) ! complex *a, *b, *resx; #else extern void sig_die(char*,int); ! void c_div(complex *resx, complex *a, complex *b) #endif { ! double ratio, den; ! double abr, abi; ! complex res; ! if( (abr = b->r) < 0.) ! abr = - abr; ! if( (abi = b->i) < 0.) ! abi = - abi; ! if( abr <= abi ) ! { ! if(abi == 0) ! sig_die("complex division by zero", 1); ! ratio = (double)b->r / b->i ; ! den = b->i * (1 + ratio*ratio); ! res.r = (a->r*ratio + a->i) / den; ! res.i = (a->i*ratio - a->r) / den; ! } ! else ! { ! ratio = (double)b->i / b->r ; ! den = b->r * (1 + ratio*ratio); ! res.r = (a->r + a->i*ratio) / den; ! res.i = (a->i - a->r*ratio) / den; } - - resx->r = res.r; - resx->i = res.i; - } --- 2,37 ---- #ifdef KR_headers extern VOID sig_die(); ! VOID c_div(c, a, b) ! complex *a, *b, *c; #else extern void sig_die(char*,int); ! void c_div(complex *c, complex *a, complex *b) #endif { ! double ratio, den; ! double abr, abi, cr; ! if( (abr = b->r) < 0.) ! abr = - abr; ! if( (abi = b->i) < 0.) ! abi = - abi; ! if( abr <= abi ) ! { ! if(abi == 0) ! sig_die("complex division by zero", 1); ! ratio = (double)b->r / b->i ; ! den = b->i * (1 + ratio*ratio); ! cr = (a->r*ratio + a->i) / den; ! c->i = (a->i*ratio - a->r) / den; ! } ! else ! { ! ratio = (double)b->i / b->r ; ! den = b->r * (1 + ratio*ratio); ! cr = (a->r + a->i*ratio) / den; ! c->i = (a->i - a->r*ratio) / den; ! } ! c->r = cr; } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/c_exp.c gcc-2.95/libf2c/libF77/c_exp.c *** egcs-1.1.2/libf2c/libF77/c_exp.c Sat Jan 31 17:37:05 1998 --- gcc-2.95/libf2c/libF77/c_exp.c Mon May 3 01:35:08 1999 *************** *** 3,23 **** #ifdef KR_headers extern double exp(), cos(), sin(); ! VOID c_exp(resx, z) complex *resx, *z; #else #undef abs ! #include ! void c_exp(complex *resx, complex *z) #endif { ! double expx; ! complex res; ! expx = exp(z->r); ! res.r = expx * cos(z->i); ! res.i = expx * sin(z->i); ! ! resx->r = res.r; ! resx->i = res.i; ! } --- 3,19 ---- #ifdef KR_headers extern double exp(), cos(), sin(); ! VOID c_exp(r, z) complex *r, *z; #else #undef abs ! #include "math.h" ! void c_exp(complex *r, complex *z) #endif { ! double expx, zi = z->i; ! expx = exp(z->r); ! r->r = expx * cos(zi); ! r->i = expx * sin(zi); ! } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/c_log.c gcc-2.95/libf2c/libF77/c_log.c *** egcs-1.1.2/libf2c/libF77/c_log.c Sat Jan 31 17:37:05 1998 --- gcc-2.95/libf2c/libF77/c_log.c Mon May 10 07:40:53 1999 *************** *** 2,21 **** #ifdef KR_headers extern double log(), f__cabs(), atan2(); ! VOID c_log(resx, z) complex *resx, *z; #else #undef abs ! #include extern double f__cabs(double, double); ! void c_log(complex *resx, complex *z) #endif { ! complex res; ! ! res.i = atan2(z->i, z->r); ! res.r = log( f__cabs(z->r, z->i) ); ! ! resx->r = res.r; ! resx->i = res.i; ! } --- 2,17 ---- #ifdef KR_headers extern double log(), f__cabs(), atan2(); ! VOID c_log(r, z) complex *r, *z; #else #undef abs ! #include "math.h" extern double f__cabs(double, double); ! void c_log(complex *r, complex *z) #endif { ! double zi, zr; ! r->i = atan2(zi = z->i, zr = z->r); ! r->r = log( f__cabs(zr, zi) ); ! } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/c_sin.c gcc-2.95/libf2c/libF77/c_sin.c *** egcs-1.1.2/libf2c/libF77/c_sin.c Sat Jan 31 17:37:05 1998 --- gcc-2.95/libf2c/libF77/c_sin.c Mon May 3 01:35:09 1999 *************** *** 3,21 **** #ifdef KR_headers extern double sin(), cos(), sinh(), cosh(); ! VOID c_sin(resx, z) complex *resx, *z; #else #undef abs ! #include ! void c_sin(complex *resx, complex *z) #endif { ! complex res; ! ! res.r = sin(z->r) * cosh(z->i); ! res.i = cos(z->r) * sinh(z->i); ! ! resx->r = res.r; ! resx->i = res.i; ! } --- 3,17 ---- #ifdef KR_headers extern double sin(), cos(), sinh(), cosh(); ! VOID c_sin(r, z) complex *r, *z; #else #undef abs ! #include "math.h" ! void c_sin(complex *r, complex *z) #endif { ! double zi = z->i, zr = z->r; ! r->r = sin(zr) * cosh(zi); ! r->i = cos(zr) * sinh(zi); ! } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/c_sqrt.c gcc-2.95/libf2c/libF77/c_sqrt.c *** egcs-1.1.2/libf2c/libF77/c_sqrt.c Sat Jan 31 17:37:05 1998 --- gcc-2.95/libf2c/libF77/c_sqrt.c Mon May 3 01:33:12 1999 *************** *** 3,38 **** #ifdef KR_headers extern double sqrt(), f__cabs(); ! VOID c_sqrt(resx, z) complex *resx, *z; #else #undef abs ! #include extern double f__cabs(double, double); ! void c_sqrt(complex *resx, complex *z) #endif { ! double mag, t; ! complex res; ! if( (mag = f__cabs(z->r, z->i)) == 0.) ! res.r = res.i = 0.; ! else if(z->r > 0) ! { ! res.r = t = sqrt(0.5 * (mag + z->r) ); ! t = z->i / t; ! res.i = 0.5 * t; } - else - { - t = sqrt(0.5 * (mag - z->r) ); - if(z->i < 0) - t = -t; - res.i = t; - t = z->i / t; - res.r = 0.5 * t; - } - - resx->r = res.r; - resx->i = res.i; - } --- 3,35 ---- #ifdef KR_headers extern double sqrt(), f__cabs(); ! VOID c_sqrt(r, z) complex *r, *z; #else #undef abs ! #include "math.h" extern double f__cabs(double, double); ! void c_sqrt(complex *r, complex *z) #endif { ! double mag, t; ! double zi = z->i, zr = z->r; ! if( (mag = f__cabs(zr, zi)) == 0.) ! r->r = r->i = 0.; ! else if(zr > 0) ! { ! r->r = t = sqrt(0.5 * (mag + zr) ); ! t = zi / t; ! r->i = 0.5 * t; ! } ! else ! { ! t = sqrt(0.5 * (mag - zr) ); ! if(zi < 0) ! t = -t; ! r->i = t; ! t = zi / t; ! r->r = 0.5 * t; ! } } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/configure gcc-2.95/libf2c/libF77/configure *** egcs-1.1.2/libf2c/libF77/configure Sun Mar 14 03:13:11 1999 --- gcc-2.95/libf2c/libF77/configure Thu Jul 29 05:46:14 1999 *************** *** 1,7 **** #! /bin/sh # Guess values for system-dependent variables and create Makefiles. ! # Generated automatically using autoconf version 2.12.1 # Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. # # This configure script is free software; the Free Software Foundation --- 1,7 ---- #! /bin/sh # Guess values for system-dependent variables and create Makefiles. ! # Generated automatically using autoconf version 2.13 # Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. # # This configure script is free software; the Free Software Foundation *************** EOF *** 333,339 **** verbose=yes ;; -version | --version | --versio | --versi | --vers) ! echo "configure generated by autoconf version 2.12.1" exit 0 ;; -with-* | --with-*) --- 333,339 ---- verbose=yes ;; -version | --version | --versio | --versi | --vers) ! echo "configure generated by autoconf version 2.13" exit 0 ;; -with-* | --with-*) *************** ac_ext=c *** 503,511 **** # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ! ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then --- 503,513 ---- # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ! ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross + ac_exeext= + ac_objext=o if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then *************** fi *** 525,539 **** # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:529: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ! IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" ! for ac_dir in $PATH; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_CC="gcc" --- 527,542 ---- # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:531: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ! IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ! ac_dummy="$PATH" ! for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_CC="gcc" *************** if test -z "$CC"; then *** 554,569 **** # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:558: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ! IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" ac_prog_rejected=no ! for ac_dir in $PATH; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then --- 557,573 ---- # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:561: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ! IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_prog_rejected=no ! ac_dummy="$PATH" ! for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then *************** else *** 598,622 **** echo "$ac_t""no" 1>&6 fi test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 ! echo "configure:606: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ! ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross ! cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then --- 602,662 ---- echo "$ac_t""no" 1>&6 fi + if test -z "$CC"; then + case "`uname -s`" in + *win32* | *WIN32*) + # Extract the first word of "cl", so it can be a program name with args. + set dummy cl; ac_word=$2 + echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 + echo "configure:612: checking for $ac_word" >&5 + if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 + else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. + else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_CC="cl" + break + fi + done + IFS="$ac_save_ifs" + fi + fi + CC="$ac_cv_prog_CC" + if test -n "$CC"; then + echo "$ac_t""$CC" 1>&6 + else + echo "$ac_t""no" 1>&6 + fi + ;; + esac + fi test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 ! echo "configure:644: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ! ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross ! cat > conftest.$ac_ext << EOF ! ! #line 655 "configure" #include "confdefs.h" + main(){return(0);} EOF ! if { (eval echo configure:660: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then *************** else *** 630,647 **** ac_cv_prog_cc_works=no fi rm -fr conftest* echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 if test $ac_cv_prog_cc_works = no; then { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 ! echo "configure:640: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 ! echo "configure:645: checking whether we are using GNU C" >&5 if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else --- 670,693 ---- ac_cv_prog_cc_works=no fi rm -fr conftest* + ac_ext=c + # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. + ac_cpp='$CPP $CPPFLAGS' + ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' + ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' + cross_compiling=$ac_cv_prog_cc_cross echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 if test $ac_cv_prog_cc_works = no; then { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 ! echo "configure:686: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 ! echo "configure:691: checking whether we are using GNU C" >&5 if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else *************** else *** 650,656 **** yes; #endif EOF ! if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:654: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no --- 696,702 ---- yes; #endif EOF ! if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:700: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no *************** echo "$ac_t""$ac_cv_prog_gcc" 1>&6 *** 661,671 **** if test $ac_cv_prog_gcc = yes; then GCC=yes ! ac_test_CFLAGS="${CFLAGS+set}" ! ac_save_CFLAGS="$CFLAGS" ! CFLAGS= ! echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 ! echo "configure:669: checking whether ${CC-cc} accepts -g" >&5 if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else --- 707,721 ---- if test $ac_cv_prog_gcc = yes; then GCC=yes ! else ! GCC= ! fi ! ! ac_test_CFLAGS="${CFLAGS+set}" ! ac_save_CFLAGS="$CFLAGS" ! CFLAGS= ! echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 ! echo "configure:719: checking whether ${CC-cc} accepts -g" >&5 if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else *************** rm -f conftest* *** 680,702 **** fi echo "$ac_t""$ac_cv_prog_cc_g" 1>&6 ! if test "$ac_test_CFLAGS" = set; then ! CFLAGS="$ac_save_CFLAGS" ! elif test $ac_cv_prog_cc_g = yes; then CFLAGS="-g -O2" else ! CFLAGS="-O2" fi else ! GCC= ! test "${CFLAGS+set}" = set || CFLAGS="-g" fi test "$AR" || AR=ar echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 ! echo "configure:700: checking whether ${MAKE-make} sets \${MAKE}" >&5 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 --- 730,756 ---- fi echo "$ac_t""$ac_cv_prog_cc_g" 1>&6 ! if test "$ac_test_CFLAGS" = set; then ! CFLAGS="$ac_save_CFLAGS" ! elif test $ac_cv_prog_cc_g = yes; then ! if test "$GCC" = yes; then CFLAGS="-g -O2" else ! CFLAGS="-g" fi else ! if test "$GCC" = yes; then ! CFLAGS="-O2" ! else ! CFLAGS= ! fi fi test "$AR" || AR=ar echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 ! echo "configure:754: checking whether ${MAKE-make} sets \${MAKE}" >&5 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 *************** fi *** 726,732 **** # Sanity check for the cross-compilation case: echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 ! echo "configure:730: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= --- 780,786 ---- # Sanity check for the cross-compilation case: echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 ! echo "configure:784: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= *************** else *** 741,754 **** # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:751: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then : else --- 795,808 ---- # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:805: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : else *************** else *** 758,771 **** rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:768: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then : else --- 812,842 ---- rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:822: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` ! if test -z "$ac_err"; then ! : ! else ! echo "$ac_err" >&5 ! echo "configure: failed program was:" >&5 ! cat conftest.$ac_ext >&5 ! rm -rf conftest* ! CPP="${CC-cc} -nologo -E" ! cat > conftest.$ac_ext < ! Syntax Error ! EOF ! ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:839: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : else *************** fi *** 778,783 **** --- 849,856 ---- rm -f conftest* fi rm -f conftest* + fi + rm -f conftest* ac_cv_prog_CPP="$CPP" fi CPP="$ac_cv_prog_CPP" *************** echo "$ac_t""$CPP" 1>&6 *** 788,805 **** ac_safe=`echo "stdio.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for stdio.h""... $ac_c" 1>&6 ! echo "configure:792: checking for stdio.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:802: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" --- 861,878 ---- ac_safe=`echo "stdio.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for stdio.h""... $ac_c" 1>&6 ! echo "configure:865: checking for stdio.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:875: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" *************** fi *** 826,837 **** echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 ! echo "configure:830: checking for ANSI C header files" >&5 if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include --- 899,910 ---- echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 ! echo "configure:903: checking for ANSI C header files" >&5 if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include *************** else *** 839,846 **** #include EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:843: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* ac_cv_header_stdc=yes --- 912,919 ---- #include EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:916: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* ac_cv_header_stdc=yes *************** rm -f conftest* *** 856,862 **** if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext < EOF --- 929,935 ---- if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext < EOF *************** fi *** 874,880 **** if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext < EOF --- 947,953 ---- if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext < EOF *************** if test "$cross_compiling" = yes; then *** 895,901 **** : else cat > conftest.$ac_ext < #define ISLOWER(c) ('a' <= (c) && (c) <= 'z') --- 968,974 ---- : else cat > conftest.$ac_ext < #define ISLOWER(c) ('a' <= (c) && (c) <= 'z') *************** if (XOR (islower (i), ISLOWER (i)) || to *** 906,912 **** exit (0); } EOF ! if { (eval echo configure:910: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null then : else --- 979,985 ---- exit (0); } EOF ! if { (eval echo configure:983: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then : else *************** fi *** 931,942 **** echo $ac_n "checking for posix""... $ac_c" 1>&6 ! echo "configure:935: checking for posix" >&5 if eval "test \"`echo '$''{'g77_cv_header_posix'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include --- 1004,1015 ---- echo $ac_n "checking for posix""... $ac_c" 1>&6 ! echo "configure:1008: checking for posix" >&5 if eval "test \"`echo '$''{'g77_cv_header_posix'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include *************** echo "$ac_t""$g77_cv_header_posix" 1>&6 *** 962,973 **** # We can rely on the GNU library being posix-ish. I guess checking the # header isn't actually like checking the functions, though... echo $ac_n "checking for GNU library""... $ac_c" 1>&6 ! echo "configure:966: checking for GNU library" >&5 if eval "test \"`echo '$''{'g77_cv_lib_gnu'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #ifdef __GNU_LIBRARY__ --- 1035,1046 ---- # We can rely on the GNU library being posix-ish. I guess checking the # header isn't actually like checking the functions, though... echo $ac_n "checking for GNU library""... $ac_c" 1>&6 ! echo "configure:1039: checking for GNU library" >&5 if eval "test \"`echo '$''{'g77_cv_lib_gnu'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #ifdef __GNU_LIBRARY__ *************** fi *** 990,1001 **** echo "$ac_t""$g77_cv_lib_gnu" 1>&6 echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6 ! echo "configure:994: checking return type of signal handlers" >&5 if eval "test \"`echo '$''{'ac_cv_type_signal'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include --- 1063,1074 ---- echo "$ac_t""$g77_cv_lib_gnu" 1>&6 echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6 ! echo "configure:1067: checking return type of signal handlers" >&5 if eval "test \"`echo '$''{'ac_cv_type_signal'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include *************** int main() { *** 1012,1018 **** int i; ; return 0; } EOF ! if { (eval echo configure:1016: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_type_signal=void else --- 1085,1091 ---- int i; ; return 0; } EOF ! if { (eval echo configure:1089: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_type_signal=void else *************** EOF *** 1033,1044 **** # we'll get atexit by default if test $ac_cv_header_stdc != yes; then echo $ac_n "checking for atexit""... $ac_c" 1>&6 ! echo "configure:1037: checking for atexit" >&5 if eval "test \"`echo '$''{'ac_cv_func_atexit'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&6 ! echo "configure:1110: checking for atexit" >&5 if eval "test \"`echo '$''{'ac_cv_func_atexit'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_atexit=yes" else --- 1134,1140 ---- ; return 0; } EOF ! if { (eval echo configure:1138: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_atexit=yes" else *************** else *** 1086,1097 **** EOF echo $ac_n "checking for onexit""... $ac_c" 1>&6 ! echo "configure:1090: checking for onexit" >&5 if eval "test \"`echo '$''{'ac_cv_func_onexit'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&6 ! echo "configure:1163: checking for onexit" >&5 if eval "test \"`echo '$''{'ac_cv_func_onexit'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_onexit=yes" else --- 1187,1193 ---- ; return 0; } EOF ! if { (eval echo configure:1191: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_onexit=yes" else *************** if eval "test \"`echo '$ac_cv_func_'onex *** 1132,1143 **** else echo "$ac_t""no" 1>&6 echo $ac_n "checking for on_exit""... $ac_c" 1>&6 ! echo "configure:1136: checking for on_exit" >&5 if eval "test \"`echo '$''{'ac_cv_func_on_exit'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&6 echo $ac_n "checking for on_exit""... $ac_c" 1>&6 ! echo "configure:1209: checking for on_exit" >&5 if eval "test \"`echo '$''{'ac_cv_func_on_exit'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_on_exit=yes" else --- 1233,1239 ---- ; return 0; } EOF ! if { (eval echo configure:1237: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_on_exit=yes" else *************** else true *** 1190,1196 **** fi echo $ac_n "checking for drem in -lm""... $ac_c" 1>&6 ! echo "configure:1194: checking for drem in -lm" >&5 ac_lib_var=`echo m'_'drem | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 --- 1263,1269 ---- fi echo $ac_n "checking for drem in -lm""... $ac_c" 1>&6 ! echo "configure:1267: checking for drem in -lm" >&5 ac_lib_var=`echo m'_'drem | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 *************** else *** 1198,1204 **** ac_save_LIBS="$LIBS" LIBS="-lm $LIBS" cat > conftest.$ac_ext < conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else --- 1282,1288 ---- drem() ; return 0; } EOF ! if { (eval echo configure:1286: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else *************** EOF *** 1261,1267 **** # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. (set) 2>&1 | ! case `(ac_space=' '; set) 2>&1 | grep ac_space` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote substitution # turns \\\\ into \\, and sed turns \\ into \). --- 1334,1340 ---- # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. (set) 2>&1 | ! case `(ac_space=' '; set | grep ac_space) 2>&1` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote substitution # turns \\\\ into \\, and sed turns \\ into \). *************** do *** 1340,1346 **** echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; -version | --version | --versio | --versi | --vers | --ver | --ve | --v) ! echo "$CONFIG_STATUS generated by autoconf version 2.12.1" exit 0 ;; -help | --help | --hel | --he | --h) echo "\$ac_cs_usage"; exit 0 ;; --- 1413,1419 ---- echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; -version | --version | --versio | --versi | --vers | --ver | --ve | --v) ! echo "$CONFIG_STATUS generated by autoconf version 2.13" exit 0 ;; -help | --help | --hel | --he | --h) echo "\$ac_cs_usage"; exit 0 ;; *************** s%@SHELL@%$SHELL%g *** 1363,1368 **** --- 1436,1442 ---- s%@CFLAGS@%$CFLAGS%g s%@CPPFLAGS@%$CPPFLAGS%g s%@CXXFLAGS@%$CXXFLAGS%g + s%@FFLAGS@%$FFLAGS%g s%@DEFS@%$DEFS%g s%@LDFLAGS@%$LDFLAGS%g s%@LIBS@%$LIBS%g diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/configure.in gcc-2.95/libf2c/libF77/configure.in *** egcs-1.1.2/libf2c/libF77/configure.in Sat Jul 11 22:00:39 1998 --- gcc-2.95/libf2c/libF77/configure.in Mon Nov 23 05:58:46 1998 *************** *** 19,24 **** --- 19,25 ---- #the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA #02111-1307, USA. + AC_PREREQ(2.12.1) AC_INIT(getarg_.c) dnl Checks for programs. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/d_cnjg.c gcc-2.95/libf2c/libF77/d_cnjg.c *** egcs-1.1.2/libf2c/libF77/d_cnjg.c Sat Jan 31 17:37:05 1998 --- gcc-2.95/libf2c/libF77/d_cnjg.c Mon May 3 01:35:10 1999 *************** *** 2,17 **** VOID #ifdef KR_headers ! d_cnjg(resx, z) doublecomplex *resx, *z; #else ! d_cnjg(doublecomplex *resx, doublecomplex *z) #endif { ! doublecomplex res; ! ! res.r = z->r; ! res.i = - z->i; ! ! resx->r = res.r; ! resx->i = res.i; ! } --- 2,13 ---- VOID #ifdef KR_headers ! d_cnjg(r, z) doublecomplex *r, *z; #else ! d_cnjg(doublecomplex *r, doublecomplex *z) #endif { ! doublereal zi = z->i; ! r->r = z->r; ! r->i = -zi; ! } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/dtime_.c gcc-2.95/libf2c/libF77/dtime_.c *** egcs-1.1.2/libf2c/libF77/dtime_.c Tue May 19 03:50:52 1998 --- gcc-2.95/libf2c/libF77/dtime_.c Mon May 3 01:35:11 1999 *************** *** 1,4 **** --- 1,10 ---- #include "time.h" + + #ifdef MSDOS + #undef USE_CLOCK + #define USE_CLOCK + #endif + #ifndef USE_CLOCK #define _INCLUDE_POSIX_SOURCE /* for HP-UX */ #define _INCLUDE_XOPEN_SOURCE /* for HP-UX */ diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/ef1asc_.c gcc-2.95/libf2c/libF77/ef1asc_.c *** egcs-1.1.2/libf2c/libF77/ef1asc_.c Sat Jan 31 17:37:05 1998 --- gcc-2.95/libf2c/libF77/ef1asc_.c Mon May 10 07:40:54 1999 *************** int G77_ef1asc_0 (ftnint *a, ftnlen *la, *** 15,21 **** #endif { s_copy( (char *)a, (char *)b, EVEN(*la), *lb ); ! #ifdef __cplusplus ! return 0; ! #endif } --- 15,19 ---- #endif { s_copy( (char *)a, (char *)b, EVEN(*la), *lb ); ! return 0; /* ignored return value */ } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/etime_.c gcc-2.95/libf2c/libF77/etime_.c *** egcs-1.1.2/libf2c/libF77/etime_.c Tue May 19 03:50:53 1998 --- gcc-2.95/libf2c/libF77/etime_.c Mon May 3 01:35:12 1999 *************** *** 1,4 **** --- 1,10 ---- #include "time.h" + + #ifdef MSDOS + #undef USE_CLOCK + #define USE_CLOCK + #endif + #ifndef USE_CLOCK #define _INCLUDE_POSIX_SOURCE /* for HP-UX */ #define _INCLUDE_XOPEN_SOURCE /* for HP-UX */ diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/getenv_.c gcc-2.95/libf2c/libF77/getenv_.c *** egcs-1.1.2/libf2c/libF77/getenv_.c Sat Jan 31 17:37:06 1998 --- gcc-2.95/libf2c/libF77/getenv_.c Mon May 3 01:35:13 1999 *************** *** 1,4 **** --- 1,12 ---- #include "f2c.h" + #undef abs + #ifdef KR_headers + extern char *F77_aloc(), *getenv(); + #else + #include + #include + extern char *F77_aloc(ftnlen, char*); + #endif /* * getenv - f77 subroutine to return environment variables *************** *** 13,51 **** */ #ifdef KR_headers ! VOID G77_getenv_0 (fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen; #else ! void G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen) #endif { ! extern char **environ; ! register char *ep, *fp, *flast; ! register char **env = environ; ! flast = fname + flen; ! for(fp = fname ; fp < flast ; ++fp) ! if(*fp == ' ') ! { ! flast = fp; ! break; } ! ! while (ep = *env++) ! { ! for(fp = fname; fp 0) *value++ = *ep++; ! add_blanks: ! while(vlen-- > 0) *value++ = ' '; ! } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/pow_zi.c gcc-2.95/libf2c/libF77/pow_zi.c *** egcs-1.1.2/libf2c/libF77/pow_zi.c Sat Jan 31 17:37:06 1998 --- gcc-2.95/libf2c/libF77/pow_zi.c Mon May 3 01:33:14 1999 *************** *** 1,61 **** #include "f2c.h" #ifdef KR_headers ! VOID pow_zi(resx, a, b) /* p = a**b */ ! doublecomplex *resx, *a; integer *b; #else extern void z_div(doublecomplex*, doublecomplex*, doublecomplex*); ! void pow_zi(doublecomplex *resx, doublecomplex *a, integer *b) /* p = a**b */ #endif { ! integer n; ! unsigned long u; ! double t; ! doublecomplex x; ! doublecomplex res; ! static doublecomplex one = {1.0, 0.0}; ! ! n = *b; ! ! if(n == 0) ! { ! resx->r = 1; ! resx->i = 0; ! return; ! } ! ! res.r = 1; ! res.i = 0; ! ! if(n < 0) ! { ! n = -n; ! z_div(&x, &one, a); ! } ! else ! { ! x.r = a->r; ! x.i = a->i; ! } ! ! for(u = n; ; ) ! { ! if(u & 01) { ! t = res.r * x.r - res.i * x.i; ! res.i = res.r * x.i + res.i * x.r; ! res.r = t; } ! if(u >>= 1) { ! t = x.r * x.r - x.i * x.i; ! x.i = 2 * x.r * x.i; ! x.r = t; } - else - break; - } ! resx->r = res.r; ! resx->i = res.i; ! } --- 1,54 ---- #include "f2c.h" #ifdef KR_headers ! VOID pow_zi(p, a, b) /* p = a**b */ ! doublecomplex *p, *a; integer *b; #else extern void z_div(doublecomplex*, doublecomplex*, doublecomplex*); ! void pow_zi(doublecomplex *p, doublecomplex *a, integer *b) /* p = a**b */ #endif { ! integer n; ! unsigned long u; ! double t; ! doublecomplex q, x; ! static doublecomplex one = {1.0, 0.0}; ! ! n = *b; ! q.r = 1; ! q.i = 0; ! ! if(n == 0) ! goto done; ! if(n < 0) { ! n = -n; ! z_div(&x, &one, a); } ! else { ! x.r = a->r; ! x.i = a->i; } ! for(u = n; ; ) ! { ! if(u & 01) ! { ! t = q.r * x.r - q.i * x.i; ! q.i = q.r * x.i + q.i * x.r; ! q.r = t; ! } ! if(u >>= 1) ! { ! t = x.r * x.r - x.i * x.i; ! x.i = 2 * x.r * x.i; ! x.r = t; ! } ! else ! break; ! } ! done: ! p->i = q.i; ! p->r = q.r; ! } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/r_cnjg.c gcc-2.95/libf2c/libF77/r_cnjg.c *** egcs-1.1.2/libf2c/libF77/r_cnjg.c Sat Jan 31 17:37:06 1998 --- gcc-2.95/libf2c/libF77/r_cnjg.c Mon May 3 01:35:14 1999 *************** *** 1,16 **** #include "f2c.h" #ifdef KR_headers ! VOID r_cnjg(resx, z) complex *resx, *z; #else ! VOID r_cnjg(complex *resx, complex *z) #endif { ! complex res; ! ! res.r = z->r; ! res.i = - z->i; ! ! resx->r = res.r; ! resx->i = res.i; ! } --- 1,12 ---- #include "f2c.h" #ifdef KR_headers ! VOID r_cnjg(r, z) complex *r, *z; #else ! VOID r_cnjg(complex *r, complex *z) #endif { ! real zi = z->i; ! r->r = z->r; ! r->i = -zi; ! } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/s_rnge.c gcc-2.95/libf2c/libF77/s_rnge.c *** egcs-1.1.2/libf2c/libF77/s_rnge.c Sat Jan 31 17:37:06 1998 --- gcc-2.95/libf2c/libF77/s_rnge.c Mon May 10 07:40:55 1999 *************** fprintf(stderr, ".\nAttempt to access th *** 20,26 **** while((i = *varn) && i != ' ') putc(*varn++, stderr); sig_die(".", 1); ! #ifdef __cplusplus ! return 0; ! #endif } --- 20,24 ---- while((i = *varn) && i != ' ') putc(*varn++, stderr); sig_die(".", 1); ! return 0; /* not reached */ } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/s_stop.c gcc-2.95/libf2c/libF77/s_stop.c *** egcs-1.1.2/libf2c/libF77/s_stop.c Sat Jan 31 17:37:06 1998 --- gcc-2.95/libf2c/libF77/s_stop.c Mon May 10 07:40:56 1999 *************** if(n > 0) *** 30,37 **** f_exit(); #endif exit(0); ! #ifdef __cplusplus return 0; /* NOT REACHED */ } ! #endif } --- 30,42 ---- f_exit(); #endif exit(0); ! ! /* We cannot avoid (useless) compiler diagnostics here: */ ! /* some compilers complain if there is no return statement, */ ! /* and others complain that this one cannot be reached. */ ! return 0; /* NOT REACHED */ } ! #ifdef __cplusplus } + #endif diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/signal1.h0 gcc-2.95/libf2c/libF77/signal1.h0 *** egcs-1.1.2/libf2c/libF77/signal1.h0 Tue May 19 03:51:00 1998 --- gcc-2.95/libf2c/libF77/signal1.h0 Wed Mar 17 00:21:15 1999 *************** *** 3,8 **** --- 3,10 ---- /* compiler-dependent. The #define below assumes signal.h declares */ /* type SIG_PF for the signal function's second argument. */ + /* For some C++ compilers, "#define Sigarg_t ..." may be appropriate. */ + #include #ifndef Sigret_t *************** *** 12,22 **** #ifdef KR_headers #define Sigarg_t #else - #ifdef __cplusplus - #define Sigarg_t ... - #else #define Sigarg_t int - #endif #endif #endif /*Sigarg_t*/ --- 14,20 ---- diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/z_cos.c gcc-2.95/libf2c/libF77/z_cos.c *** egcs-1.1.2/libf2c/libF77/z_cos.c Sat Jan 31 17:37:06 1998 --- gcc-2.95/libf2c/libF77/z_cos.c Mon May 3 01:35:15 1999 *************** *** 2,19 **** #ifdef KR_headers double sin(), cos(), sinh(), cosh(); ! VOID z_cos(resx, z) doublecomplex *resx, *z; #else #undef abs ! #include ! void z_cos(doublecomplex *resx, doublecomplex *z) #endif { ! doublecomplex res; ! ! res.r = cos(z->r) * cosh(z->i); ! res.i = - sin(z->r) * sinh(z->i); ! ! resx->r = res.r; ! resx->i = res.i; ! } --- 2,15 ---- #ifdef KR_headers double sin(), cos(), sinh(), cosh(); ! VOID z_cos(r, z) doublecomplex *r, *z; #else #undef abs ! #include "math.h" ! void z_cos(doublecomplex *r, doublecomplex *z) #endif { ! double zi = z->i, zr = z->r; ! r->r = cos(zr) * cosh(zi); ! r->i = - sin(zr) * sinh(zi); ! } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/z_div.c gcc-2.95/libf2c/libF77/z_div.c *** egcs-1.1.2/libf2c/libF77/z_div.c Sat Jan 31 17:37:06 1998 --- gcc-2.95/libf2c/libF77/z_div.c Mon May 3 01:33:17 1999 *************** *** 2,39 **** #ifdef KR_headers extern VOID sig_die(); ! VOID z_div(resx, a, b) doublecomplex *a, *b, *resx; #else extern void sig_die(char*, int); ! void z_div(doublecomplex *resx, doublecomplex *a, doublecomplex *b) #endif { ! double ratio, den; ! double abr, abi; ! doublecomplex res; ! if( (abr = b->r) < 0.) ! abr = - abr; ! if( (abi = b->i) < 0.) ! abi = - abi; ! if( abr <= abi ) ! { ! if(abi == 0) ! sig_die("complex division by zero", 1); ! ratio = b->r / b->i ; ! den = b->i * (1 + ratio*ratio); ! res.r = (a->r*ratio + a->i) / den; ! res.i = (a->i*ratio - a->r) / den; ! } ! else ! { ! ratio = b->i / b->r ; ! den = b->r * (1 + ratio*ratio); ! res.r = (a->r + a->i*ratio) / den; ! res.i = (a->i - a->r*ratio) / den; } - - resx->r = res.r; - resx->i = res.i; - } --- 2,36 ---- #ifdef KR_headers extern VOID sig_die(); ! VOID z_div(c, a, b) doublecomplex *a, *b, *c; #else extern void sig_die(char*, int); ! void z_div(doublecomplex *c, doublecomplex *a, doublecomplex *b) #endif { ! double ratio, den; ! double abr, abi, cr; ! if( (abr = b->r) < 0.) ! abr = - abr; ! if( (abi = b->i) < 0.) ! abi = - abi; ! if( abr <= abi ) ! { ! if(abi == 0) ! sig_die("complex division by zero", 1); ! ratio = b->r / b->i ; ! den = b->i * (1 + ratio*ratio); ! cr = (a->r*ratio + a->i) / den; ! c->i = (a->i*ratio - a->r) / den; ! } ! else ! { ! ratio = b->i / b->r ; ! den = b->r * (1 + ratio*ratio); ! cr = (a->r + a->i*ratio) / den; ! c->i = (a->i - a->r*ratio) / den; ! } ! c->r = cr; } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/z_exp.c gcc-2.95/libf2c/libF77/z_exp.c *** egcs-1.1.2/libf2c/libF77/z_exp.c Sat Jan 31 17:37:06 1998 --- gcc-2.95/libf2c/libF77/z_exp.c Mon May 3 01:35:16 1999 *************** *** 2,21 **** #ifdef KR_headers double exp(), cos(), sin(); ! VOID z_exp(resx, z) doublecomplex *resx, *z; #else #undef abs ! #include ! void z_exp(doublecomplex *resx, doublecomplex *z) #endif { ! double expx; ! doublecomplex res; ! expx = exp(z->r); ! res.r = expx * cos(z->i); ! res.i = expx * sin(z->i); ! ! resx->r = res.r; ! resx->i = res.i; ! } --- 2,17 ---- #ifdef KR_headers double exp(), cos(), sin(); ! VOID z_exp(r, z) doublecomplex *r, *z; #else #undef abs ! #include "math.h" ! void z_exp(doublecomplex *r, doublecomplex *z) #endif { ! double expx, zi = z->i; ! expx = exp(z->r); ! r->r = expx * cos(zi); ! r->i = expx * sin(zi); ! } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/z_log.c gcc-2.95/libf2c/libF77/z_log.c *** egcs-1.1.2/libf2c/libF77/z_log.c Sat Jan 31 17:37:07 1998 --- gcc-2.95/libf2c/libF77/z_log.c Mon May 3 01:35:17 1999 *************** *** 2,20 **** #ifdef KR_headers double log(), f__cabs(), atan2(); ! VOID z_log(resx, z) doublecomplex *resx, *z; #else #undef abs ! #include extern double f__cabs(double, double); ! void z_log(doublecomplex *resx, doublecomplex *z) #endif { ! doublecomplex res; ! ! res.i = atan2(z->i, z->r); ! res.r = log( f__cabs( z->r, z->i ) ); ! ! resx->r = res.r; ! resx->i = res.i; ! } --- 2,16 ---- #ifdef KR_headers double log(), f__cabs(), atan2(); ! VOID z_log(r, z) doublecomplex *r, *z; #else #undef abs ! #include "math.h" extern double f__cabs(double, double); ! void z_log(doublecomplex *r, doublecomplex *z) #endif { ! double zi = z->i, zr = z->r; ! r->i = atan2(zi, zr); ! r->r = log( f__cabs( zr, zi ) ); ! } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/z_sin.c gcc-2.95/libf2c/libF77/z_sin.c *** egcs-1.1.2/libf2c/libF77/z_sin.c Sat Jan 31 17:37:07 1998 --- gcc-2.95/libf2c/libF77/z_sin.c Mon May 3 01:35:18 1999 *************** *** 2,19 **** #ifdef KR_headers double sin(), cos(), sinh(), cosh(); ! VOID z_sin(resx, z) doublecomplex *resx, *z; #else #undef abs ! #include ! void z_sin(doublecomplex *resx, doublecomplex *z) #endif { ! doublecomplex res; ! ! res.r = sin(z->r) * cosh(z->i); ! res.i = cos(z->r) * sinh(z->i); ! ! resx->r = res.r; ! resx->i = res.i; ! } --- 2,15 ---- #ifdef KR_headers double sin(), cos(), sinh(), cosh(); ! VOID z_sin(r, z) doublecomplex *r, *z; #else #undef abs ! #include "math.h" ! void z_sin(doublecomplex *r, doublecomplex *z) #endif { ! double zi = z->i, zr = z->r; ! r->r = sin(zr) * cosh(zi); ! r->i = cos(zr) * sinh(zi); ! } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libF77/z_sqrt.c gcc-2.95/libf2c/libF77/z_sqrt.c *** egcs-1.1.2/libf2c/libF77/z_sqrt.c Sat Jan 31 17:37:07 1998 --- gcc-2.95/libf2c/libF77/z_sqrt.c Mon May 3 01:33:21 1999 *************** *** 2,33 **** #ifdef KR_headers double sqrt(), f__cabs(); ! VOID z_sqrt(resx, z) doublecomplex *resx, *z; #else #undef abs ! #include extern double f__cabs(double, double); ! void z_sqrt(doublecomplex *resx, doublecomplex *z) #endif { ! double mag; ! doublecomplex res; ! if( (mag = f__cabs(z->r, z->i)) == 0.) ! res.r = res.i = 0.; ! else if(z->r > 0) ! { ! res.r = sqrt(0.5 * (mag + z->r) ); ! res.i = z->i / res.r / 2; } - else - { - res.i = sqrt(0.5 * (mag - z->r) ); - if(z->i < 0) - res.i = - res.i; - res.r = z->i / res.i / 2; - } - - resx->r = res.r; - resx->i = res.i; - } --- 2,29 ---- #ifdef KR_headers double sqrt(), f__cabs(); ! VOID z_sqrt(r, z) doublecomplex *r, *z; #else #undef abs ! #include "math.h" extern double f__cabs(double, double); ! void z_sqrt(doublecomplex *r, doublecomplex *z) #endif { ! double mag, zi = z->i, zr = z->r; ! if( (mag = f__cabs(zr, zi)) == 0.) ! r->r = r->i = 0.; ! else if(zr > 0) ! { ! r->r = sqrt(0.5 * (mag + zr) ); ! r->i = zi / r->r / 2; ! } ! else ! { ! r->i = sqrt(0.5 * (mag - zr) ); ! if(zi < 0) ! r->i = - r->i; ! r->r = zi / r->i / 2; ! } } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libI77/Makefile.in gcc-2.95/libf2c/libI77/Makefile.in *** egcs-1.1.2/libf2c/libI77/Makefile.in Tue Jul 14 13:29:17 1998 --- gcc-2.95/libf2c/libI77/Makefile.in Fri Mar 5 16:02:53 1999 *************** ${srcdir}/configure: configure.in *** 84,141 **** VersionI.o: Version.c $(CC) -c $(ALL_CFLAGS) -o $@ $(srcdir)/Version.c ! backspace.o: fio.h ! close.o: fio.h dfe.o: fio.h ! dfe.o: fmt.h ! due.o: fio.h ! endfile.o: fio.h rawio.h ! err.o: fio.h rawio.h fmt.o: fio.h ! fmt.o: fmt.h ! ftell_.o: fio.h iio.o: fio.h ! iio.o: fmt.h ilnw.o: fio.h ! ilnw.o: lio.h ! inquire.o: fio.h lread.o: fio.h lread.o: fmt.h lread.o: lio.h ! lread.o: fp.h lwrite.o: fio.h lwrite.o: fmt.h ! lwrite.o: lio.h ! open.o: fio.h rawio.h rdfmt.o: fio.h rdfmt.o: fmt.h ! rdfmt.o: fp.h ! rewind.o: fio.h rsfe.o: fio.h ! rsfe.o: fmt.h rsli.o: fio.h ! rsli.o: lio.h rsne.o: fio.h ! rsne.o: lio.h ! sfe.o: fio.h ! sue.o: fio.h ! uio.o: fio.h ! util.o: fio.h wref.o: fio.h wref.o: fmt.h ! wref.o: fp.h wrtfmt.o: fio.h ! wrtfmt.o: fmt.h wsfe.o: fio.h ! wsfe.o: fmt.h wsle.o: fio.h wsle.o: fmt.h ! wsle.o: lio.h wsne.o: fio.h ! wsne.o: lio.h xwsne.o: fio.h xwsne.o: lio.h ! xwsne.o: fmt.h # May be pessimistic: $(OBJ): $(F2C_H_DIR)/f2c.h $(G2C_H_DIR)/g2c.h --- 84,144 ---- VersionI.o: Version.c $(CC) -c $(ALL_CFLAGS) -o $@ $(srcdir)/Version.c ! backspace.o: backspace.c fio.h ! close.o: close.c fio.h dfe.o: fio.h ! dfe.o: dfe.c fmt.h ! dolio.o: dolio.c ! due.o: due.c fio.h ! endfile.o: endfile.c fio.h rawio.h ! err.o: err.c fio.h rawio.h fmt.o: fio.h ! fmt.o: fmt.c fmt.h ! fmtlib.o: fmtlib.c ! ftell_.o: ftell_.c fio.h iio.o: fio.h ! iio.o: iio.c fmt.h ilnw.o: fio.h ! ilnw.o: ilnw.c lio.h ! inquire.o: inquire.c fio.h lread.o: fio.h lread.o: fmt.h lread.o: lio.h ! lread.o: lread.c fp.h lwrite.o: fio.h lwrite.o: fmt.h ! lwrite.o: lwrite.c lio.h ! open.o: open.c fio.h rawio.h rdfmt.o: fio.h rdfmt.o: fmt.h ! rdfmt.o: rdfmt.c fp.h ! rewind.o: rewind.c fio.h rsfe.o: fio.h ! rsfe.o: rsfe.c fmt.h rsli.o: fio.h ! rsli.o: rsli.c lio.h rsne.o: fio.h ! rsne.o: rsne.c lio.h ! sfe.o: sfe.c fio.h ! sue.o: sue.c fio.h ! typesize.o: typesize.c ! uio.o: uio.c fio.h ! util.o: util.c fio.h wref.o: fio.h wref.o: fmt.h ! wref.o: wref.c fp.h wrtfmt.o: fio.h ! wrtfmt.o: wrtfmt.c fmt.h wsfe.o: fio.h ! wsfe.o: wsfe.c fmt.h wsle.o: fio.h wsle.o: fmt.h ! wsle.o: wsle.c lio.h wsne.o: fio.h ! wsne.o: wsne.c lio.h xwsne.o: fio.h xwsne.o: lio.h ! xwsne.o: xwsne.c fmt.h # May be pessimistic: $(OBJ): $(F2C_H_DIR)/f2c.h $(G2C_H_DIR)/g2c.h *************** mostlyclean: *** 146,152 **** rm -f *.o clean: mostlyclean ! rm -f config.log distclean: clean rm -f config.cache config.status Makefile ../s-libi77 configure --- 149,155 ---- rm -f *.o clean: mostlyclean ! rm -f config.log ../s-libi77 distclean: clean rm -f config.cache config.status Makefile ../s-libi77 configure diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libI77/Version.c gcc-2.95/libf2c/libI77/Version.c *** egcs-1.1.2/libf2c/libI77/Version.c Sun Feb 14 11:00:26 1999 --- gcc-2.95/libf2c/libI77/Version.c Thu Jul 29 02:37:33 1999 *************** *** 1,9 **** ! static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19980617\n"; /* */ ! char __G77_LIBI77_VERSION__[] = "0.5.24-19981021"; /* 2.01 $ format added --- 1,9 ---- ! static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19990503\n"; /* */ ! char __G77_LIBI77_VERSION__[] = "0.5.25 19990728 (release)"; /* 2.01 $ format added *************** wrtfmt.c: *** 293,298 **** --- 293,306 ---- floating-point numbers (containing either a decimal point or an exponent field) as errors when they appear as list input for integer data. */ + /* 7 Sept. 1998: move e_wdfe from sfe.c to dfe.c, where it was originally. + Why did it ever move to sfe.c? */ + /* 2 May 1999: open.c: set f__external (to get "external" versus "internal" + right in the error message if we cannot open the file). + err.c: cast a pointer difference to (int) for %d. + rdfmt.c: omit fixed-length buffer that could be overwritten + by formats Inn or Lnn with nn > 83. */ + /* 3 May 1999: open.c: insert two casts for machines with 64-bit longs. */ diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libI77/backspace.c gcc-2.95/libf2c/libI77/backspace.c *** egcs-1.1.2/libf2c/libI77/backspace.c Tue Jun 23 07:37:07 1998 --- gcc-2.95/libf2c/libI77/backspace.c Wed Jun 16 02:03:30 1999 *************** integer f_back(alist *a) *** 27,32 **** --- 27,33 ---- } if(b->uwrt) { (void) t_runc(a); + f = b->ufd; /* t_runc might change b->ufd */ if (f__nowreading(b)) err(a->aerr,errno,"backspace"); } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libI77/configure gcc-2.95/libf2c/libI77/configure *** egcs-1.1.2/libf2c/libI77/configure Sun Mar 14 03:13:11 1999 --- gcc-2.95/libf2c/libI77/configure Thu Jul 29 05:46:14 1999 *************** *** 1,7 **** #! /bin/sh # Guess values for system-dependent variables and create Makefiles. ! # Generated automatically using autoconf version 2.12.1 # Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. # # This configure script is free software; the Free Software Foundation --- 1,7 ---- #! /bin/sh # Guess values for system-dependent variables and create Makefiles. ! # Generated automatically using autoconf version 2.13 # Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. # # This configure script is free software; the Free Software Foundation *************** EOF *** 333,339 **** verbose=yes ;; -version | --version | --versio | --versi | --vers) ! echo "configure generated by autoconf version 2.12.1" exit 0 ;; -with-* | --with-*) --- 333,339 ---- verbose=yes ;; -version | --version | --versio | --versi | --vers) ! echo "configure generated by autoconf version 2.13" exit 0 ;; -with-* | --with-*) *************** ac_ext=c *** 503,511 **** # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ! ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then --- 503,513 ---- # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ! ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross + ac_exeext= + ac_objext=o if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then *************** fi *** 525,539 **** # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:529: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ! IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" ! for ac_dir in $PATH; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_CC="gcc" --- 527,542 ---- # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:531: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ! IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ! ac_dummy="$PATH" ! for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_CC="gcc" *************** if test -z "$CC"; then *** 554,569 **** # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:558: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ! IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" ac_prog_rejected=no ! for ac_dir in $PATH; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then --- 557,573 ---- # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:561: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ! IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_prog_rejected=no ! ac_dummy="$PATH" ! for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then *************** else *** 598,622 **** echo "$ac_t""no" 1>&6 fi test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 ! echo "configure:606: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ! ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross ! cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then --- 602,662 ---- echo "$ac_t""no" 1>&6 fi + if test -z "$CC"; then + case "`uname -s`" in + *win32* | *WIN32*) + # Extract the first word of "cl", so it can be a program name with args. + set dummy cl; ac_word=$2 + echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 + echo "configure:612: checking for $ac_word" >&5 + if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 + else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. + else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_CC="cl" + break + fi + done + IFS="$ac_save_ifs" + fi + fi + CC="$ac_cv_prog_CC" + if test -n "$CC"; then + echo "$ac_t""$CC" 1>&6 + else + echo "$ac_t""no" 1>&6 + fi + ;; + esac + fi test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 ! echo "configure:644: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ! ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross ! cat > conftest.$ac_ext << EOF ! ! #line 655 "configure" #include "confdefs.h" + main(){return(0);} EOF ! if { (eval echo configure:660: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then *************** else *** 630,647 **** ac_cv_prog_cc_works=no fi rm -fr conftest* echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 if test $ac_cv_prog_cc_works = no; then { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 ! echo "configure:640: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 ! echo "configure:645: checking whether we are using GNU C" >&5 if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else --- 670,693 ---- ac_cv_prog_cc_works=no fi rm -fr conftest* + ac_ext=c + # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. + ac_cpp='$CPP $CPPFLAGS' + ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' + ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' + cross_compiling=$ac_cv_prog_cc_cross echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 if test $ac_cv_prog_cc_works = no; then { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 ! echo "configure:686: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 ! echo "configure:691: checking whether we are using GNU C" >&5 if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else *************** else *** 650,656 **** yes; #endif EOF ! if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:654: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no --- 696,702 ---- yes; #endif EOF ! if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:700: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no *************** echo "$ac_t""$ac_cv_prog_gcc" 1>&6 *** 661,671 **** if test $ac_cv_prog_gcc = yes; then GCC=yes ! ac_test_CFLAGS="${CFLAGS+set}" ! ac_save_CFLAGS="$CFLAGS" ! CFLAGS= ! echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 ! echo "configure:669: checking whether ${CC-cc} accepts -g" >&5 if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else --- 707,721 ---- if test $ac_cv_prog_gcc = yes; then GCC=yes ! else ! GCC= ! fi ! ! ac_test_CFLAGS="${CFLAGS+set}" ! ac_save_CFLAGS="$CFLAGS" ! CFLAGS= ! echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 ! echo "configure:719: checking whether ${CC-cc} accepts -g" >&5 if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else *************** rm -f conftest* *** 680,702 **** fi echo "$ac_t""$ac_cv_prog_cc_g" 1>&6 ! if test "$ac_test_CFLAGS" = set; then ! CFLAGS="$ac_save_CFLAGS" ! elif test $ac_cv_prog_cc_g = yes; then CFLAGS="-g -O2" else ! CFLAGS="-O2" fi else ! GCC= ! test "${CFLAGS+set}" = set || CFLAGS="-g" fi test "$AR" || AR=ar echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 ! echo "configure:700: checking whether ${MAKE-make} sets \${MAKE}" >&5 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 --- 730,756 ---- fi echo "$ac_t""$ac_cv_prog_cc_g" 1>&6 ! if test "$ac_test_CFLAGS" = set; then ! CFLAGS="$ac_save_CFLAGS" ! elif test $ac_cv_prog_cc_g = yes; then ! if test "$GCC" = yes; then CFLAGS="-g -O2" else ! CFLAGS="-g" fi else ! if test "$GCC" = yes; then ! CFLAGS="-O2" ! else ! CFLAGS= ! fi fi test "$AR" || AR=ar echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 ! echo "configure:754: checking whether ${MAKE-make} sets \${MAKE}" >&5 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 *************** fi *** 726,732 **** # Sanity check for the cross-compilation case: echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 ! echo "configure:730: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= --- 780,786 ---- # Sanity check for the cross-compilation case: echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 ! echo "configure:784: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= *************** else *** 741,754 **** # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:751: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then : else --- 795,808 ---- # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:805: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : else *************** else *** 758,771 **** rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:768: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then : else --- 812,842 ---- rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:822: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` ! if test -z "$ac_err"; then ! : ! else ! echo "$ac_err" >&5 ! echo "configure: failed program was:" >&5 ! cat conftest.$ac_ext >&5 ! rm -rf conftest* ! CPP="${CC-cc} -nologo -E" ! cat > conftest.$ac_ext < ! Syntax Error ! EOF ! ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:839: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : else *************** fi *** 778,783 **** --- 849,856 ---- rm -f conftest* fi rm -f conftest* + fi + rm -f conftest* ac_cv_prog_CPP="$CPP" fi CPP="$ac_cv_prog_CPP" *************** echo "$ac_t""$CPP" 1>&6 *** 788,805 **** ac_safe=`echo "stdio.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for stdio.h""... $ac_c" 1>&6 ! echo "configure:792: checking for stdio.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:802: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" --- 861,878 ---- ac_safe=`echo "stdio.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for stdio.h""... $ac_c" 1>&6 ! echo "configure:865: checking for stdio.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:875: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" *************** fi *** 826,837 **** echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 ! echo "configure:830: checking for ANSI C header files" >&5 if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include --- 899,910 ---- echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 ! echo "configure:903: checking for ANSI C header files" >&5 if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include *************** else *** 839,846 **** #include EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:843: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* ac_cv_header_stdc=yes --- 912,919 ---- #include EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:916: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* ac_cv_header_stdc=yes *************** rm -f conftest* *** 856,862 **** if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext < EOF --- 929,935 ---- if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext < EOF *************** fi *** 874,880 **** if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext < EOF --- 947,953 ---- if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext < EOF *************** if test "$cross_compiling" = yes; then *** 895,901 **** : else cat > conftest.$ac_ext < #define ISLOWER(c) ('a' <= (c) && (c) <= 'z') --- 968,974 ---- : else cat > conftest.$ac_ext < #define ISLOWER(c) ('a' <= (c) && (c) <= 'z') *************** if (XOR (islower (i), ISLOWER (i)) || to *** 906,912 **** exit (0); } EOF ! if { (eval echo configure:910: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null then : else --- 979,985 ---- exit (0); } EOF ! if { (eval echo configure:983: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then : else *************** fi *** 931,942 **** echo $ac_n "checking for posix""... $ac_c" 1>&6 ! echo "configure:935: checking for posix" >&5 if eval "test \"`echo '$''{'g77_cv_header_posix'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include --- 1004,1015 ---- echo $ac_n "checking for posix""... $ac_c" 1>&6 ! echo "configure:1008: checking for posix" >&5 if eval "test \"`echo '$''{'g77_cv_header_posix'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include *************** echo "$ac_t""$g77_cv_header_posix" 1>&6 *** 962,973 **** # We can rely on the GNU library being posix-ish. I guess checking the # header isn't actually like checking the functions, though... echo $ac_n "checking for GNU library""... $ac_c" 1>&6 ! echo "configure:966: checking for GNU library" >&5 if eval "test \"`echo '$''{'g77_cv_lib_gnu'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #ifdef __GNU_LIBRARY__ --- 1035,1046 ---- # We can rely on the GNU library being posix-ish. I guess checking the # header isn't actually like checking the functions, though... echo $ac_n "checking for GNU library""... $ac_c" 1>&6 ! echo "configure:1039: checking for GNU library" >&5 if eval "test \"`echo '$''{'g77_cv_lib_gnu'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #ifdef __GNU_LIBRARY__ *************** echo "$ac_t""$g77_cv_lib_gnu" 1>&6 *** 991,1002 **** # Apparently cygwin needs to be special-cased. echo $ac_n "checking for cyg\`win'32""... $ac_c" 1>&6 ! echo "configure:995: checking for cyg\`win'32" >&5 if eval "test \"`echo '$''{'g77_cv_sys_cygwin32'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&6 ! echo "configure:1068: checking for cyg\`win'32" >&5 if eval "test \"`echo '$''{'g77_cv_sys_cygwin32'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&6 *** 1019,1030 **** # ditto for mingw32. echo $ac_n "checking for mingw32""... $ac_c" 1>&6 ! echo "configure:1023: checking for mingw32" >&5 if eval "test \"`echo '$''{'g77_cv_sys_mingw32'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&6 ! echo "configure:1096: checking for mingw32" >&5 if eval "test \"`echo '$''{'g77_cv_sys_mingw32'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&6 *** 1048,1065 **** ac_safe=`echo "fcntl.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for fcntl.h""... $ac_c" 1>&6 ! echo "configure:1052: checking for fcntl.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:1062: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" --- 1121,1138 ---- ac_safe=`echo "fcntl.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for fcntl.h""... $ac_c" 1>&6 ! echo "configure:1125: checking for fcntl.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:1135: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" *************** fi *** 1091,1102 **** echo $ac_n "checking for working const""... $ac_c" 1>&6 ! echo "configure:1095: checking for working const" >&5 if eval "test \"`echo '$''{'ac_cv_c_const'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&6 ! echo "configure:1168: checking for working const" >&5 if eval "test \"`echo '$''{'ac_cv_c_const'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_const=yes else --- 1218,1224 ---- ; return 0; } EOF ! if { (eval echo configure:1222: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_const=yes else *************** EOF *** 1166,1177 **** fi echo $ac_n "checking for size_t""... $ac_c" 1>&6 ! echo "configure:1170: checking for size_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #if STDC_HEADERS --- 1239,1250 ---- fi echo $ac_n "checking for size_t""... $ac_c" 1>&6 ! echo "configure:1243: checking for size_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #if STDC_HEADERS *************** else *** 1180,1186 **** #endif EOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | ! egrep "size_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then rm -rf conftest* ac_cv_type_size_t=yes else --- 1253,1259 ---- #endif EOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | ! egrep "(^|[^a-zA-Z_0-9])size_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then rm -rf conftest* ac_cv_type_size_t=yes else *************** fi *** 1204,1215 **** # Apparently positive result on cygwin loses re. NON_UNIX_STDIO # (as of cygwin b18). Likewise on mingw. echo $ac_n "checking for fstat""... $ac_c" 1>&6 ! echo "configure:1208: checking for fstat" >&5 if eval "test \"`echo '$''{'ac_cv_func_fstat'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&6 ! echo "configure:1281: checking for fstat" >&5 if eval "test \"`echo '$''{'ac_cv_func_fstat'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_fstat=yes" else --- 1305,1311 ---- ; return 0; } EOF ! if { (eval echo configure:1309: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_fstat=yes" else *************** else *** 1252,1258 **** fi echo $ac_n "checking need for NON_UNIX_STDIO""... $ac_c" 1>&6 ! echo "configure:1256: checking need for NON_UNIX_STDIO" >&5 if test $g77_cv_sys_cygwin32 = yes \ || test $g77_cv_sys_mingw32 = yes \ || test $ac_cv_func_fstat = no; then --- 1325,1331 ---- fi echo $ac_n "checking need for NON_UNIX_STDIO""... $ac_c" 1>&6 ! echo "configure:1329: checking need for NON_UNIX_STDIO" >&5 if test $g77_cv_sys_cygwin32 = yes \ || test $g77_cv_sys_mingw32 = yes \ || test $ac_cv_func_fstat = no; then *************** fi *** 1268,1279 **** for ac_func in tempnam do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 ! echo "configure:1272: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&6 ! echo "configure:1345: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else --- 1369,1375 ---- ; return 0; } EOF ! if { (eval echo configure:1373: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else *************** done *** 1326,1344 **** # However, on my sunos4/gcc setup unistd.h leads us wrongly to believe # we're posix-conformant, so always do the test. echo $ac_n "checking for ansi/posix sprintf result""... $ac_c" 1>&6 ! echo "configure:1330: checking for ansi/posix sprintf result" >&5 if test "$cross_compiling" = yes; then g77_cv_sys_sprintf_ansi=no else cat > conftest.$ac_ext < /* does sprintf return the number of chars transferred? */ main () {char foo[2]; (sprintf(foo, "1") == 1) ? exit(0) : exit(1);} EOF ! if { (eval echo configure:1342: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null then g77_cv_sys_sprintf_ansi=yes else --- 1399,1417 ---- # However, on my sunos4/gcc setup unistd.h leads us wrongly to believe # we're posix-conformant, so always do the test. echo $ac_n "checking for ansi/posix sprintf result""... $ac_c" 1>&6 ! echo "configure:1403: checking for ansi/posix sprintf result" >&5 if test "$cross_compiling" = yes; then g77_cv_sys_sprintf_ansi=no else cat > conftest.$ac_ext < /* does sprintf return the number of chars transferred? */ main () {char foo[2]; (sprintf(foo, "1") == 1) ? exit(0) : exit(1);} EOF ! if { (eval echo configure:1415: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then g77_cv_sys_sprintf_ansi=yes else *************** fi *** 1369,1377 **** # define NON_ANSI_RW_MODES on unix (can't hurt) echo $ac_n "checking NON_ANSI_RW_MODES""... $ac_c" 1>&6 ! echo "configure:1373: checking NON_ANSI_RW_MODES" >&5 cat > conftest.$ac_ext <&6 ! echo "configure:1446: checking NON_ANSI_RW_MODES" >&5 cat > conftest.$ac_ext <&1 | ! case `(ac_space=' '; set) 2>&1 | grep ac_space` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote substitution # turns \\\\ into \\, and sed turns \\ into \). --- 1516,1522 ---- # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. (set) 2>&1 | ! case `(ac_space=' '; set | grep ac_space) 2>&1` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote substitution # turns \\\\ into \\, and sed turns \\ into \). *************** do *** 1522,1528 **** echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; -version | --version | --versio | --versi | --vers | --ver | --ve | --v) ! echo "$CONFIG_STATUS generated by autoconf version 2.12.1" exit 0 ;; -help | --help | --hel | --he | --h) echo "\$ac_cs_usage"; exit 0 ;; --- 1595,1601 ---- echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; -version | --version | --versio | --versi | --vers | --ver | --ve | --v) ! echo "$CONFIG_STATUS generated by autoconf version 2.13" exit 0 ;; -help | --help | --hel | --he | --h) echo "\$ac_cs_usage"; exit 0 ;; *************** s%@SHELL@%$SHELL%g *** 1545,1550 **** --- 1618,1624 ---- s%@CFLAGS@%$CFLAGS%g s%@CPPFLAGS@%$CPPFLAGS%g s%@CXXFLAGS@%$CXXFLAGS%g + s%@FFLAGS@%$FFLAGS%g s%@DEFS@%$DEFS%g s%@LDFLAGS@%$LDFLAGS%g s%@LIBS@%$LIBS%g diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libI77/configure.in gcc-2.95/libf2c/libI77/configure.in *** egcs-1.1.2/libf2c/libI77/configure.in Sat Jul 11 22:00:39 1998 --- gcc-2.95/libf2c/libI77/configure.in Mon Nov 23 05:58:47 1998 *************** *** 19,24 **** --- 19,25 ---- #the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA #02111-1307, USA. + AC_PREREQ(2.12.1) AC_INIT(ftell_.c) dnl Checks for programs. diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libI77/dfe.c gcc-2.95/libf2c/libI77/dfe.c *** egcs-1.1.2/libf2c/libI77/dfe.c Tue Jun 23 07:37:08 1998 --- gcc-2.95/libf2c/libI77/dfe.c Wed Mar 17 00:21:17 1999 *************** c_dfe(cilist *a) *** 81,87 **** f__fmtbuf=a->cifmt; if(a->cirec <= 0) err(a->cierr,130,"dfe"); ! fseek(f__cf,(long)f__curunit->url * (a->cirec-1),SEEK_SET); f__curunit->uend = 0; return(0); } --- 81,87 ---- f__fmtbuf=a->cifmt; if(a->cirec <= 0) err(a->cierr,130,"dfe"); ! (void) fseek(f__cf,(long)f__curunit->url * (a->cirec-1),SEEK_SET); f__curunit->uend = 0; return(0); } *************** integer e_rdfe(Void) *** 137,140 **** --- 137,146 ---- f__init = 1; en_fio(); return(0); + } + + integer e_wdfe(Void) + { + f__init = 1; + return en_fio(); } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libI77/endfile.c gcc-2.95/libf2c/libI77/endfile.c *** egcs-1.1.2/libf2c/libI77/endfile.c Tue May 19 03:51:05 1998 --- gcc-2.95/libf2c/libI77/endfile.c Wed Mar 17 00:21:18 1999 *************** t_runc(alist *a) *** 87,93 **** --- 87,95 ---- } if (!(bf = fopen(b->ufnm, f__r_mode[0])) || !(tf = tmpfile())) { + #ifdef NON_UNIX_STDIO bad: + #endif rc = 1; goto done; } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libI77/err.c gcc-2.95/libf2c/libI77/err.c *** egcs-1.1.2/libf2c/libI77/err.c Tue May 19 03:51:06 1998 --- gcc-2.95/libf2c/libI77/err.c Mon May 3 01:35:20 1999 *************** f__fatal(int n, char *s) *** 163,169 **** dead = 1; if (f__init & 1) { if (f__curunit) { ! fprintf(stderr,"apparent state: unit %d ",f__curunit-f__units); fprintf(stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n", f__curunit->ufnm); } --- 163,170 ---- dead = 1; if (f__init & 1) { if (f__curunit) { ! fprintf(stderr,"apparent state: unit %d ", ! (int)(f__curunit-f__units)); fprintf(stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n", f__curunit->ufnm); } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libI77/lread.c gcc-2.95/libf2c/libI77/lread.c *** egcs-1.1.2/libf2c/libI77/lread.c Tue Jun 23 07:37:11 1998 --- gcc-2.95/libf2c/libI77/lread.c Wed Mar 17 00:21:19 1999 *************** int (*f__lioproc)(), (*l_getc)(), (*l_un *** 24,36 **** #undef min #undef max #include - int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint), (*l_getc)(void), - (*l_ungetc)(int,FILE*); #endif #include "fmt.h" #include "lio.h" #include "fp.h" int l_eof; --- 24,39 ---- #undef min #undef max #include #endif #include "fmt.h" #include "lio.h" #include "fp.h" + + #ifndef KR_headers + int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint), (*l_getc)(void), + (*l_ungetc)(int,FILE*); + #endif int l_eof; diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libI77/open.c gcc-2.95/libf2c/libI77/open.c *** egcs-1.1.2/libf2c/libI77/open.c Mon Nov 23 01:14:14 1998 --- gcc-2.95/libf2c/libI77/open.c Mon May 10 07:40:59 1999 *************** integer f_open(olist *a) *** 141,146 **** --- 141,147 ---- int n; #endif if(f__init != 1) f_init(); + f__external = 1; if(a->ounit>=MXUNIT || a->ounit<0) err(a->oerr,101,"open"); f__curunit = b = &f__units[a->ounit]; *************** integer f_open(olist *a) *** 186,192 **** opnerr(a->oerr,107,"open"); } else ! sprintf(buf, "fort.%ld", a->ounit); b->uscrtch = 0; b->uend=0; b->uwrt = 0; --- 187,193 ---- opnerr(a->oerr,107,"open"); } else ! sprintf(buf, "fort.%ld", (long)a->ounit); b->uscrtch = 0; b->uend=0; b->uwrt = 0; *************** fk_open(int seq, int fmt, ftnint n) *** 280,286 **** int rtn; int save_init; ! (void) sprintf(nbuf,"fort.%ld",n); a.oerr=1; a.ounit=n; a.ofnm=nbuf; --- 281,287 ---- int rtn; int save_init; ! (void) sprintf(nbuf,"fort.%ld",(long)n); a.oerr=1; a.ounit=n; a.ofnm=nbuf; diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libI77/rdfmt.c gcc-2.95/libf2c/libI77/rdfmt.c *** egcs-1.1.2/libf2c/libI77/rdfmt.c Sat Jan 31 17:37:07 1998 --- gcc-2.95/libf2c/libI77/rdfmt.c Mon May 3 01:35:22 1999 *************** rd_I(n,w,len, base) Uint *n; int w; ftnl *** 99,157 **** #else rd_I(Uint *n, int w, ftnlen len, register int base) #endif ! { longint x; ! int sign,ch; ! char s[84], *ps; ! ps=s; x=0; ! while (w) ! { GET(ch); ! if (ch==',' || ch=='\n') break; ! *ps=ch; ps++; w--; ! } ! *ps='\0'; ! ps=s; ! while (*ps==' ') ps++; ! if (*ps=='-') { sign=1; ps++; } ! else { sign=0; if (*ps=='+') ps++; } ! loop: while (*ps>='0' && *ps<='9') { x=x*base+(*ps-'0'); ps++; } ! if (*ps==' ') {if (f__cblank) x *= base; ps++; goto loop;} ! if(sign) x = -x; ! if(len==sizeof(integer)) n->il=x; ! else if(len == sizeof(char)) n->ic = (char)x; #ifdef Allow_TYQUAD ! else if (len == sizeof(longint)) n->ili = x; #endif ! else n->is = (short)x; ! if (*ps) return(errno=115); else return(0); } static int #ifdef KR_headers rd_L(n,w,len) ftnint *n; ftnlen len; #else rd_L(ftnint *n, int w, ftnlen len) #endif ! { int ch, lv; ! char s[84], *ps; ! ps=s; ! while (w) { GET(ch); ! if (ch==','||ch=='\n') break; ! *ps=ch; ! ps++; w--; ! } ! *ps='\0'; ! ps=s; while (*ps==' ') ps++; ! if (*ps=='.') ps++; ! if (*ps=='t' || *ps == 'T') lv = 1; ! else if (*ps == 'f' || *ps == 'F') lv = 0; ! else return(errno=116); switch(len) { case sizeof(char): *(char *)n = (char)lv; break; case sizeof(short): *(short *)n = (short)lv; break; default: *n = lv; } return 0; } --- 99,222 ---- #else rd_I(Uint *n, int w, ftnlen len, register int base) #endif ! { ! int bad, ch, sign; ! longint x = 0; ! ! if (w <= 0) ! goto have_x; ! for(;;) { GET(ch); ! if (ch != ' ') ! break; ! if (!--w) ! goto have_x; ! } ! sign = 0; ! switch(ch) { ! case ',': ! case '\n': ! w = 0; ! goto have_x; ! case '-': ! sign = 1; ! case '+': ! break; ! default: ! if (ch >= '0' && ch <= '9') { ! x = ch - '0'; ! break; ! } ! goto have_x; ! } ! while(--w) { ! GET(ch); ! if (ch >= '0' && ch <= '9') { ! x = x*base + ch - '0'; ! continue; ! } ! if (ch != ' ') { ! if (ch == '\n' || ch == ',') ! w = 0; ! break; ! } ! if (f__cblank) ! x *= base; ! } ! if (sign) ! x = -x; ! have_x: ! if(len == sizeof(integer)) ! n->il=x; ! else if(len == sizeof(char)) ! n->ic = (char)x; #ifdef Allow_TYQUAD ! else if (len == sizeof(longint)) ! n->ili = x; #endif ! else ! n->is = (short)x; ! if (w) { ! while(--w) ! GET(ch); ! return errno = 115; ! } ! return 0; } + static int #ifdef KR_headers rd_L(n,w,len) ftnint *n; ftnlen len; #else rd_L(ftnint *n, int w, ftnlen len) #endif ! { int ch, dot, lv; ! ! if (w <= 0) ! goto bad; ! for(;;) { GET(ch); ! --w; ! if (ch != ' ') ! break; ! if (!w) ! goto bad; ! } ! dot = 0; ! retry: ! switch(ch) { ! case '.': ! if (dot++ || !w) ! goto bad; ! GET(ch); ! --w; ! goto retry; ! case 't': ! case 'T': lv = 1; ! break; ! case 'f': ! case 'F': lv = 0; ! break; ! default: ! bad: ! for(; w > 0; --w) ! GET(ch); ! /* no break */ ! case ',': ! case '\n': ! return errno = 116; ! } switch(len) { case sizeof(char): *(char *)n = (char)lv; break; case sizeof(short): *(short *)n = (short)lv; break; default: *n = lv; + } + while(w-- > 0) { + GET(ch); + if (ch == ',' || ch == '\n') + break; } return 0; } diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libI77/rsne.c gcc-2.95/libf2c/libI77/rsne.c *** egcs-1.1.2/libf2c/libI77/rsne.c Sat Jan 31 17:37:07 1998 --- gcc-2.95/libf2c/libI77/rsne.c Mon Jun 28 19:26:14 1999 *************** x_rsne(cilist *a) *** 530,539 **** no1 = (ivae - iva)/size; if (no1 > f__lcount) no1 = f__lcount; - iva += no1 * dn0->delta; if (k = l_read(&no1, vaddr + iva, size, type)) return k; } } mustend: --- 530,539 ---- no1 = (ivae - iva)/size; if (no1 > f__lcount) no1 = f__lcount; if (k = l_read(&no1, vaddr + iva, size, type)) return k; + iva += no1 * dn0->delta; } } mustend: diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libI77/sfe.c gcc-2.95/libf2c/libI77/sfe.c *** egcs-1.1.2/libf2c/libI77/sfe.c Sat Sep 5 15:14:46 1998 --- gcc-2.95/libf2c/libI77/sfe.c Wed Mar 17 00:21:20 1999 *************** integer e_wsfe(Void) *** 32,40 **** f__fmtbuf=NULL; return n; } - - integer e_wdfe(Void) - { - f__init = 1; - return en_fio(); - } --- 32,34 ---- diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libU77/Makefile.in gcc-2.95/libf2c/libU77/Makefile.in *** egcs-1.1.2/libf2c/libU77/Makefile.in Thu Jul 16 14:34:32 1998 --- gcc-2.95/libf2c/libU77/Makefile.in Fri Mar 5 16:02:54 1999 *************** rename_.o: rename_.c *** 164,169 **** --- 164,170 ---- fputc_.o: fputc_.c fgetc_.o: fgetc_.c sys_clock_.o: sys_clock_.c + date_.o: date_.c umask_.o: umask_.c flush1_.o: flush1_.c mclock_.o: mclock_.c *************** mostlyclean: *** 180,186 **** rm -f *.o a.out clean: mostlyclean ! rm -f config.log distclean: clean rm -f config.cache config.status Makefile config.h stamp.h \ --- 181,187 ---- rm -f *.o a.out clean: mostlyclean ! rm -f config.log ../s-libu77 distclean: clean rm -f config.cache config.status Makefile config.h stamp.h \ diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libU77/Version.c gcc-2.95/libf2c/libU77/Version.c *** egcs-1.1.2/libf2c/libU77/Version.c Fri Mar 5 02:17:10 1999 --- gcc-2.95/libf2c/libU77/Version.c Thu Jul 29 02:37:34 1999 *************** *** 1,6 **** static char junk[] = "\n@(#) LIBU77 VERSION 19980709\n"; ! char __G77_LIBU77_VERSION__[] = "0.5.24-19990305"; #include --- 1,6 ---- static char junk[] = "\n@(#) LIBU77 VERSION 19980709\n"; ! char __G77_LIBU77_VERSION__[] = "0.5.25 19990728 (release)"; #include diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libU77/acconfig.h gcc-2.95/libf2c/libU77/acconfig.h *** egcs-1.1.2/libf2c/libU77/acconfig.h Sat Jan 31 17:37:07 1998 --- gcc-2.95/libf2c/libU77/acconfig.h Sun Apr 11 15:35:13 1999 *************** *** 1,2 **** --- 1,6 ---- /* Define as the path of the `chmod' program. */ #undef CHMOD_PATH + + /* Define if your sys/time.h defines struct timezone. */ + #undef HAVE_STRUCT_TIMEZONE + diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libU77/aclocal.m4 gcc-2.95/libf2c/libU77/aclocal.m4 *** egcs-1.1.2/libf2c/libU77/aclocal.m4 Wed Dec 31 16:00:00 1969 --- gcc-2.95/libf2c/libU77/aclocal.m4 Sun Apr 11 18:26:16 1999 *************** *** 0 **** --- 1,16 ---- + dnl See whether we have struct timezone + dnl LIBU77_HAVE_STRUCT_TIMEZONE + AC_DEFUN(LIBU77_HAVE_STRUCT_TIMEZONE, + [AC_MSG_CHECKING([whether struct timezone exists]) + AC_CACHE_VAL(libu77_cv_have_struct_timezone, + [AC_TRY_COMPILE([#include ], + [struct timezone tz;], + libu77_ac_have_struct_timezone=yes, libu77_ac_have_struct_timezone=no)]) + if test $libu77_ac_have_struct_timezone = yes; then + AC_MSG_RESULT(yes) + AC_DEFINE_UNQUOTED(HAVE_STRUCT_TIMEZONE) + else + AC_MSG_RESULT(no) + fi + ])dnl + diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libU77/config.hin gcc-2.95/libf2c/libU77/config.hin *** egcs-1.1.2/libf2c/libU77/config.hin Sun Mar 14 03:13:11 1999 --- gcc-2.95/libf2c/libU77/config.hin Sun Apr 11 15:35:14 1999 *************** *** 33,38 **** --- 33,41 ---- /* Define as the path of the `chmod' program. */ #undef CHMOD_PATH + /* Define if your sys/time.h defines struct timezone. */ + #undef HAVE_STRUCT_TIMEZONE + /* Define if you have the alarm function. */ #undef HAVE_ALARM diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libU77/configure gcc-2.95/libf2c/libU77/configure *** egcs-1.1.2/libf2c/libU77/configure Sun Mar 14 03:13:11 1999 --- gcc-2.95/libf2c/libU77/configure Thu Jul 29 05:46:14 1999 *************** *** 1,7 **** #! /bin/sh # Guess values for system-dependent variables and create Makefiles. ! # Generated automatically using autoconf version 2.12.1 # Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. # # This configure script is free software; the Free Software Foundation --- 1,7 ---- #! /bin/sh # Guess values for system-dependent variables and create Makefiles. ! # Generated automatically using autoconf version 2.13 # Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. # # This configure script is free software; the Free Software Foundation *************** EOF *** 333,339 **** verbose=yes ;; -version | --version | --versio | --versi | --vers) ! echo "configure generated by autoconf version 2.12.1" exit 0 ;; -with-* | --with-*) --- 333,339 ---- verbose=yes ;; -version | --version | --versio | --versi | --vers) ! echo "configure generated by autoconf version 2.13" exit 0 ;; -with-* | --with-*) *************** ac_ext=c *** 503,511 **** # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ! ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then --- 503,513 ---- # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ! ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross + ac_exeext= + ac_objext=o if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then *************** fi *** 526,540 **** # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:530: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ! IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" ! for ac_dir in $PATH; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_CC="gcc" --- 528,543 ---- # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:532: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ! IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ! ac_dummy="$PATH" ! for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_CC="gcc" *************** if test -z "$CC"; then *** 555,570 **** # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:559: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ! IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" ac_prog_rejected=no ! for ac_dir in $PATH; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then --- 558,574 ---- # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:562: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ! IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_prog_rejected=no ! ac_dummy="$PATH" ! for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then *************** else *** 599,623 **** echo "$ac_t""no" 1>&6 fi test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 ! echo "configure:607: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ! ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross ! cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then --- 603,663 ---- echo "$ac_t""no" 1>&6 fi + if test -z "$CC"; then + case "`uname -s`" in + *win32* | *WIN32*) + # Extract the first word of "cl", so it can be a program name with args. + set dummy cl; ac_word=$2 + echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 + echo "configure:613: checking for $ac_word" >&5 + if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 + else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. + else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_CC="cl" + break + fi + done + IFS="$ac_save_ifs" + fi + fi + CC="$ac_cv_prog_CC" + if test -n "$CC"; then + echo "$ac_t""$CC" 1>&6 + else + echo "$ac_t""no" 1>&6 + fi + ;; + esac + fi test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 ! echo "configure:645: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ! ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross ! cat > conftest.$ac_ext << EOF ! ! #line 656 "configure" #include "confdefs.h" + main(){return(0);} EOF ! if { (eval echo configure:661: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then *************** else *** 631,648 **** ac_cv_prog_cc_works=no fi rm -fr conftest* echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 if test $ac_cv_prog_cc_works = no; then { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 ! echo "configure:641: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 ! echo "configure:646: checking whether we are using GNU C" >&5 if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else --- 671,694 ---- ac_cv_prog_cc_works=no fi rm -fr conftest* + ac_ext=c + # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. + ac_cpp='$CPP $CPPFLAGS' + ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' + ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' + cross_compiling=$ac_cv_prog_cc_cross echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 if test $ac_cv_prog_cc_works = no; then { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 ! echo "configure:687: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 ! echo "configure:692: checking whether we are using GNU C" >&5 if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else *************** else *** 651,657 **** yes; #endif EOF ! if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:655: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no --- 697,703 ---- yes; #endif EOF ! if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:701: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no *************** echo "$ac_t""$ac_cv_prog_gcc" 1>&6 *** 662,672 **** if test $ac_cv_prog_gcc = yes; then GCC=yes ! ac_test_CFLAGS="${CFLAGS+set}" ! ac_save_CFLAGS="$CFLAGS" ! CFLAGS= ! echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 ! echo "configure:670: checking whether ${CC-cc} accepts -g" >&5 if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else --- 708,722 ---- if test $ac_cv_prog_gcc = yes; then GCC=yes ! else ! GCC= ! fi ! ! ac_test_CFLAGS="${CFLAGS+set}" ! ac_save_CFLAGS="$CFLAGS" ! CFLAGS= ! echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 ! echo "configure:720: checking whether ${CC-cc} accepts -g" >&5 if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else *************** rm -f conftest* *** 681,696 **** fi echo "$ac_t""$ac_cv_prog_cc_g" 1>&6 ! if test "$ac_test_CFLAGS" = set; then ! CFLAGS="$ac_save_CFLAGS" ! elif test $ac_cv_prog_cc_g = yes; then CFLAGS="-g -O2" else ! CFLAGS="-O2" fi else ! GCC= ! test "${CFLAGS+set}" = set || CFLAGS="-g" fi if test "$CROSS";then --- 731,750 ---- fi echo "$ac_t""$ac_cv_prog_cc_g" 1>&6 ! if test "$ac_test_CFLAGS" = set; then ! CFLAGS="$ac_save_CFLAGS" ! elif test $ac_cv_prog_cc_g = yes; then ! if test "$GCC" = yes; then CFLAGS="-g -O2" else ! CFLAGS="-g" fi else ! if test "$GCC" = yes; then ! CFLAGS="-O2" ! else ! CFLAGS= ! fi fi if test "$CROSS";then *************** fi *** 702,708 **** test "$AR" || AR=ar echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 ! echo "configure:706: checking whether ${MAKE-make} sets \${MAKE}" >&5 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 --- 756,762 ---- test "$AR" || AR=ar echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 ! echo "configure:760: checking whether ${MAKE-make} sets \${MAKE}" >&5 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 *************** fi *** 732,738 **** # Extract the first word of "chmod", so it can be a program name with args. set dummy chmod; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:736: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_path_ac_cv_prog_chmod'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else --- 786,792 ---- # Extract the first word of "chmod", so it can be a program name with args. set dummy chmod; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:790: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_path_ac_cv_prog_chmod'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else *************** else *** 744,751 **** ac_cv_path_ac_cv_prog_chmod="$ac_cv_prog_chmod" # Let the user override the test with a dos path. ;; *) ! IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" ! for ac_dir in $PATH; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_path_ac_cv_prog_chmod="$ac_dir/$ac_word" --- 798,806 ---- ac_cv_path_ac_cv_prog_chmod="$ac_cv_prog_chmod" # Let the user override the test with a dos path. ;; *) ! IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ! ac_dummy="$PATH" ! for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_path_ac_cv_prog_chmod="$ac_dir/$ac_word" *************** else *** 775,781 **** fi echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 ! echo "configure:779: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= --- 830,836 ---- fi echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 ! echo "configure:834: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= *************** else *** 790,803 **** # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:800: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then : else --- 845,858 ---- # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:855: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : else *************** else *** 807,820 **** rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:817: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then : else --- 862,892 ---- rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:872: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` ! if test -z "$ac_err"; then ! : ! else ! echo "$ac_err" >&5 ! echo "configure: failed program was:" >&5 ! cat conftest.$ac_ext >&5 ! rm -rf conftest* ! CPP="${CC-cc} -nologo -E" ! cat > conftest.$ac_ext < ! Syntax Error ! EOF ! ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:889: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : else *************** fi *** 827,832 **** --- 899,906 ---- rm -f conftest* fi rm -f conftest* + fi + rm -f conftest* ac_cv_prog_CPP="$CPP" fi CPP="$ac_cv_prog_CPP" *************** fi *** 836,847 **** echo "$ac_t""$CPP" 1>&6 echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 ! echo "configure:840: checking for ANSI C header files" >&5 if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include --- 910,921 ---- echo "$ac_t""$CPP" 1>&6 echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 ! echo "configure:914: checking for ANSI C header files" >&5 if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include *************** else *** 849,856 **** #include EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:853: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* ac_cv_header_stdc=yes --- 923,930 ---- #include EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:927: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* ac_cv_header_stdc=yes *************** rm -f conftest* *** 866,872 **** if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext < EOF --- 940,946 ---- if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext < EOF *************** fi *** 884,890 **** if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext < EOF --- 958,964 ---- if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext < EOF *************** if test "$cross_compiling" = yes; then *** 905,911 **** : else cat > conftest.$ac_ext < #define ISLOWER(c) ('a' <= (c) && (c) <= 'z') --- 979,985 ---- : else cat > conftest.$ac_ext < #define ISLOWER(c) ('a' <= (c) && (c) <= 'z') *************** if (XOR (islower (i), ISLOWER (i)) || to *** 916,922 **** exit (0); } EOF ! if { (eval echo configure:920: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null then : else --- 990,996 ---- exit (0); } EOF ! if { (eval echo configure:994: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then : else *************** fi *** 941,952 **** echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6 ! echo "configure:945: checking whether time.h and sys/time.h may both be included" >&5 if eval "test \"`echo '$''{'ac_cv_header_time'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include --- 1015,1026 ---- echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6 ! echo "configure:1019: checking whether time.h and sys/time.h may both be included" >&5 if eval "test \"`echo '$''{'ac_cv_header_time'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include *************** int main() { *** 955,961 **** struct tm *tp; ; return 0; } EOF ! if { (eval echo configure:959: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_header_time=yes else --- 1029,1035 ---- struct tm *tp; ; return 0; } EOF ! if { (eval echo configure:1033: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_header_time=yes else *************** for ac_hdr in limits.h unistd.h sys/time *** 980,997 **** do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 ! echo "configure:984: checking for $ac_hdr" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:994: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" --- 1054,1071 ---- do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 ! echo "configure:1058: checking for $ac_hdr" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:1068: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ! ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" *************** done *** 1018,1029 **** echo $ac_n "checking for working const""... $ac_c" 1>&6 ! echo "configure:1022: checking for working const" >&5 if eval "test \"`echo '$''{'ac_cv_c_const'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&6 ! echo "configure:1096: checking for working const" >&5 if eval "test \"`echo '$''{'ac_cv_c_const'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_const=yes else --- 1146,1152 ---- ; return 0; } EOF ! if { (eval echo configure:1150: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_const=yes else *************** EOF *** 1093,1104 **** fi echo $ac_n "checking for size_t""... $ac_c" 1>&6 ! echo "configure:1097: checking for size_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #if STDC_HEADERS --- 1167,1178 ---- fi echo $ac_n "checking for size_t""... $ac_c" 1>&6 ! echo "configure:1171: checking for size_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #if STDC_HEADERS *************** else *** 1107,1113 **** #endif EOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | ! egrep "size_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then rm -rf conftest* ac_cv_type_size_t=yes else --- 1181,1187 ---- #endif EOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | ! egrep "(^|[^a-zA-Z_0-9])size_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then rm -rf conftest* ac_cv_type_size_t=yes else *************** EOF *** 1126,1137 **** fi echo $ac_n "checking for mode_t""... $ac_c" 1>&6 ! echo "configure:1130: checking for mode_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_mode_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #if STDC_HEADERS --- 1200,1211 ---- fi echo $ac_n "checking for mode_t""... $ac_c" 1>&6 ! echo "configure:1204: checking for mode_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_mode_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #if STDC_HEADERS *************** else *** 1140,1146 **** #endif EOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | ! egrep "mode_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then rm -rf conftest* ac_cv_type_mode_t=yes else --- 1214,1220 ---- #endif EOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | ! egrep "(^|[^a-zA-Z_0-9])mode_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then rm -rf conftest* ac_cv_type_mode_t=yes else *************** fi *** 1160,1171 **** echo $ac_n "checking for pid_t""... $ac_c" 1>&6 ! echo "configure:1164: checking for pid_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_pid_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #if STDC_HEADERS --- 1234,1245 ---- echo $ac_n "checking for pid_t""... $ac_c" 1>&6 ! echo "configure:1238: checking for pid_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_pid_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #if STDC_HEADERS *************** else *** 1174,1180 **** #endif EOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | ! egrep "pid_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then rm -rf conftest* ac_cv_type_pid_t=yes else --- 1248,1254 ---- #endif EOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | ! egrep "(^|[^a-zA-Z_0-9])pid_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then rm -rf conftest* ac_cv_type_pid_t=yes else *************** EOF *** 1193,1204 **** fi echo $ac_n "checking for st_blksize in struct stat""... $ac_c" 1>&6 ! echo "configure:1197: checking for st_blksize in struct stat" >&5 if eval "test \"`echo '$''{'ac_cv_struct_st_blksize'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include --- 1267,1278 ---- fi echo $ac_n "checking for st_blksize in struct stat""... $ac_c" 1>&6 ! echo "configure:1271: checking for st_blksize in struct stat" >&5 if eval "test \"`echo '$''{'ac_cv_struct_st_blksize'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include *************** int main() { *** 1206,1212 **** struct stat s; s.st_blksize; ; return 0; } EOF ! if { (eval echo configure:1210: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_st_blksize=yes else --- 1280,1286 ---- struct stat s; s.st_blksize; ; return 0; } EOF ! if { (eval echo configure:1284: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_st_blksize=yes else *************** EOF *** 1227,1238 **** fi echo $ac_n "checking for st_blocks in struct stat""... $ac_c" 1>&6 ! echo "configure:1231: checking for st_blocks in struct stat" >&5 if eval "test \"`echo '$''{'ac_cv_struct_st_blocks'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include --- 1301,1312 ---- fi echo $ac_n "checking for st_blocks in struct stat""... $ac_c" 1>&6 ! echo "configure:1305: checking for st_blocks in struct stat" >&5 if eval "test \"`echo '$''{'ac_cv_struct_st_blocks'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include *************** int main() { *** 1240,1246 **** struct stat s; s.st_blocks; ; return 0; } EOF ! if { (eval echo configure:1244: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_st_blocks=yes else --- 1314,1320 ---- struct stat s; s.st_blocks; ; return 0; } EOF ! if { (eval echo configure:1318: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_st_blocks=yes else *************** if test $ac_cv_struct_st_blocks = yes; t *** 1259,1274 **** EOF else ! LIBOBJS="$LIBOBJS fileblocks.o" fi echo $ac_n "checking for st_rdev in struct stat""... $ac_c" 1>&6 ! echo "configure:1267: checking for st_rdev in struct stat" >&5 if eval "test \"`echo '$''{'ac_cv_struct_st_rdev'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include --- 1333,1348 ---- EOF else ! LIBOBJS="$LIBOBJS fileblocks.${ac_objext}" fi echo $ac_n "checking for st_rdev in struct stat""... $ac_c" 1>&6 ! echo "configure:1341: checking for st_rdev in struct stat" >&5 if eval "test \"`echo '$''{'ac_cv_struct_st_rdev'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include *************** int main() { *** 1276,1282 **** struct stat s; s.st_rdev; ; return 0; } EOF ! if { (eval echo configure:1280: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_st_rdev=yes else --- 1350,1356 ---- struct stat s; s.st_rdev; ; return 0; } EOF ! if { (eval echo configure:1354: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_st_rdev=yes else *************** EOF *** 1297,1308 **** fi echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6 ! echo "configure:1301: checking whether struct tm is in sys/time.h or time.h" >&5 if eval "test \"`echo '$''{'ac_cv_struct_tm'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include --- 1371,1382 ---- fi echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6 ! echo "configure:1375: checking whether struct tm is in sys/time.h or time.h" >&5 if eval "test \"`echo '$''{'ac_cv_struct_tm'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include *************** int main() { *** 1310,1316 **** struct tm *tp; tp->tm_sec; ; return 0; } EOF ! if { (eval echo configure:1314: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_tm=time.h else --- 1384,1390 ---- struct tm *tp; tp->tm_sec; ; return 0; } EOF ! if { (eval echo configure:1388: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_tm=time.h else *************** fi *** 1332,1338 **** echo $ac_n "checking for gethostname in -lsocket""... $ac_c" 1>&6 ! echo "configure:1336: checking for gethostname in -lsocket" >&5 ac_lib_var=`echo socket'_'gethostname | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 --- 1406,1412 ---- echo $ac_n "checking for gethostname in -lsocket""... $ac_c" 1>&6 ! echo "configure:1410: checking for gethostname in -lsocket" >&5 ac_lib_var=`echo socket'_'gethostname | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 *************** else *** 1340,1346 **** ac_save_LIBS="$LIBS" LIBS="-lsocket $LIBS" cat > conftest.$ac_ext < conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else --- 1425,1431 ---- gethostname() ; return 0; } EOF ! if { (eval echo configure:1429: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else *************** for ac_func in symlink getcwd getwd lsta *** 1378,1389 **** gettimeofday do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 ! echo "configure:1382: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&6 ! echo "configure:1456: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else --- 1480,1486 ---- ; return 0; } EOF ! if { (eval echo configure:1484: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else *************** test $ac_cv_func_gethostname = yes && MA *** 1436,1441 **** --- 1510,1550 ---- test $ac_cv_func_clock = yes && MAYBES="$MAYBES mclock_.o" + echo $ac_n "checking whether struct timezone exists""... $ac_c" 1>&6 + echo "configure:1515: checking whether struct timezone exists" >&5 + if eval "test \"`echo '$''{'libu77_cv_have_struct_timezone'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 + else + cat > conftest.$ac_ext < + int main() { + struct timezone tz; + ; return 0; } + EOF + if { (eval echo configure:1527: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + libu77_ac_have_struct_timezone=yes + else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + libu77_ac_have_struct_timezone=no + fi + rm -f conftest* + fi + + if test $libu77_ac_have_struct_timezone = yes; then + echo "$ac_t""yes" 1>&6 + cat >> confdefs.h <&6 + fi + *************** EOF *** 1463,1469 **** # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. (set) 2>&1 | ! case `(ac_space=' '; set) 2>&1 | grep ac_space` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote substitution # turns \\\\ into \\, and sed turns \\ into \). --- 1572,1578 ---- # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. (set) 2>&1 | ! case `(ac_space=' '; set | grep ac_space) 2>&1` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote substitution # turns \\\\ into \\, and sed turns \\ into \). *************** do *** 1530,1536 **** echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; -version | --version | --versio | --versi | --vers | --ver | --ve | --v) ! echo "$CONFIG_STATUS generated by autoconf version 2.12.1" exit 0 ;; -help | --help | --hel | --he | --h) echo "\$ac_cs_usage"; exit 0 ;; --- 1639,1645 ---- echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; -version | --version | --versio | --versi | --vers | --ver | --ve | --v) ! echo "$CONFIG_STATUS generated by autoconf version 2.13" exit 0 ;; -help | --help | --hel | --he | --h) echo "\$ac_cs_usage"; exit 0 ;; *************** s%@SHELL@%$SHELL%g *** 1553,1558 **** --- 1662,1668 ---- s%@CFLAGS@%$CFLAGS%g s%@CPPFLAGS@%$CPPFLAGS%g s%@CXXFLAGS@%$CXXFLAGS%g + s%@FFLAGS@%$FFLAGS%g s%@DEFS@%$DEFS%g s%@LDFLAGS@%$LDFLAGS%g s%@LIBS@%$LIBS%g diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libU77/configure.in gcc-2.95/libf2c/libU77/configure.in *** egcs-1.1.2/libf2c/libU77/configure.in Wed Jul 15 17:10:56 1998 --- gcc-2.95/libf2c/libU77/configure.in Sun Apr 11 15:35:16 1999 *************** *** 19,24 **** --- 19,25 ---- #to Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, #USA. + AC_PREREQ(2.12.1) AC_INIT(access_.c) AC_CONFIG_HEADER(config.h:config.hin) *************** test $ac_cv_func_gethostname = yes && MA *** 93,98 **** --- 94,100 ---- test $ac_cv_func_clock = yes && MAYBES="$MAYBES mclock_.o" AC_SUBST(MAYBES) + LIBU77_HAVE_STRUCT_TIMEZONE AC_SUBST(CROSS) AC_SUBST(RANLIB) diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libU77/date_.c gcc-2.95/libf2c/libU77/date_.c *** egcs-1.1.2/libf2c/libU77/date_.c Sat Jan 31 17:37:08 1998 --- gcc-2.95/libf2c/libU77/date_.c Thu Jul 8 05:19:58 1999 *************** *** 9,19 **** static integer c__5 = 5; ! /* Subroutine */ int G77_date_0 (char *buf, ftnlen buf_len) { /* System generated locals */ address a__1[5]; ! integer i__1, i__2[5]; char ch__1[24]; /* Builtin functions */ --- 9,20 ---- static integer c__5 = 5; ! /* Subroutine */ int G77_date_y2kbug_0 (char *buf, ftnlen buf_len) { /* System generated locals */ address a__1[5]; ! longint i__1; ! integer i__2[5]; char ch__1[24]; /* Builtin functions */ *************** static integer c__5 = 5; *** 21,27 **** /* Local variables */ static char cbuf[24]; ! extern integer G77_time_0 (); extern /* Character */ VOID G77_ctime_0 (); i__1 = G77_time_0 (); --- 22,28 ---- /* Local variables */ static char cbuf[24]; ! extern longint G77_time_0 (); extern /* Character */ VOID G77_ctime_0 (); i__1 = G77_time_0 (); diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libU77/datetime_.c gcc-2.95/libf2c/libU77/datetime_.c *** egcs-1.1.2/libf2c/libU77/datetime_.c Fri Feb 26 05:04:17 1999 --- gcc-2.95/libf2c/libU77/datetime_.c Sun Apr 11 15:35:17 1999 *************** *** 1,4 **** ! /* Copyright (C) 1997, 1998 Free Software Foundation, Inc. This file is part of GNU Fortran libU77 library. This library is free software; you can redistribute it and/or modify it --- 1,4 ---- ! /* Copyright (C) 1997, 1998, 1999 Free Software Foundation, Inc. This file is part of GNU Fortran libU77 library. This library is free software; you can redistribute it and/or modify it *************** int G77_date_and_time_0 (char *date, cha *** 62,69 **** --- 62,77 ---- #if HAVE_GETTIMEOFDAY { struct timeval tp; + #if HAVE_STRUCT_TIMEZONE struct timezone tzp; + /* This is still not strictly correct on some systems such as HPUX, + which does have struct timezone, but gettimeofday takes void* as + the 2nd arg. However, the effect of passing anything other than a null + pointer is unspecified on HPUX. */ if (! gettimeofday (&tp, &tzp)) + #else + if (! gettimeofday (&tp, (void *) 0)) + #endif vals[7] = tp.tv_usec/1000; } #endif diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libU77/dtime_.c gcc-2.95/libf2c/libU77/dtime_.c *** egcs-1.1.2/libf2c/libU77/dtime_.c Sat Jan 31 17:37:08 1998 --- gcc-2.95/libf2c/libU77/dtime_.c Sun May 9 13:03:19 1999 *************** Boston, MA 02111-1307, USA. */ *** 33,38 **** --- 33,43 ---- # include # include #endif + #if defined (_WIN32) + # include + # undef min + # undef max + #endif #include /* for ENOSYS */ #include "f2c.h" *************** double G77_dtime_0 (tarray) *** 50,56 **** double G77_dtime_0 (real tarray[2]) #endif { ! #if defined (HAVE_GETRUSAGE) || defined (HAVE_TIMES) /* The getrusage version is only the default for convenience. */ #ifdef HAVE_GETRUSAGE float utime, stime; --- 55,127 ---- double G77_dtime_0 (real tarray[2]) #endif { ! #if defined (_WIN32) ! static int win32_platform = -1; ! ! if (win32_platform == -1) ! { ! OSVERSIONINFO osv; ! osv.dwOSVersionInfoSize = sizeof (osv); ! GetVersionEx (&osv); ! win32_platform = osv.dwPlatformId; ! } ! ! /* We need to use this hack on non-NT platforms, where the first call ! returns 0.0 and subsequent ones return the correct value. */ ! if (win32_platform != VER_PLATFORM_WIN32_NT) ! { ! static unsigned long long clock_freq; ! static unsigned long long old_count; ! unsigned long long count; ! double delta; ! LARGE_INTEGER counter_val; ! ! if (clock_freq == 0) ! { ! LARGE_INTEGER freq; ! if (! QueryPerformanceFrequency (&freq)) ! { ! errno = ENOSYS; ! return 0.0; ! } ! else ! { ! clock_freq = ((unsigned long long) freq.HighPart << 32) ! + ((unsigned) freq.LowPart); ! } ! } ! ! if (! QueryPerformanceCounter (&counter_val)) ! return -1.0; ! ! count = ((unsigned long long) counter_val.HighPart << 32) ! + (unsigned) counter_val.LowPart; ! delta = ((double) (count - old_count)) / clock_freq; ! tarray[0] = (float) delta; ! tarray[1] = 0.0; ! old_count = count; ! } ! else ! { ! static unsigned long long old_utime, old_stime; ! unsigned long long utime, stime; ! FILETIME creation_time, exit_time, kernel_time, user_time; ! ! GetProcessTimes (GetCurrentProcess (), &creation_time, &exit_time, ! &kernel_time, &user_time); ! utime = ((unsigned long long) user_time.dwHighDateTime << 32) ! + (unsigned) user_time.dwLowDateTime; ! stime = ((unsigned long long) kernel_time.dwHighDateTime << 32) ! + (unsigned) kernel_time.dwLowDateTime; ! ! tarray[0] = (utime - old_utime) / 1.0e7; ! tarray[1] = (stime - old_stime) / 1.0e7; ! old_utime = utime; ! old_stime = stime; ! } ! return tarray[0] + tarray[1]; ! ! #elif defined (HAVE_GETRUSAGE) || defined (HAVE_TIMES) /* The getrusage version is only the default for convenience. */ #ifdef HAVE_GETRUSAGE float utime, stime; *************** double G77_dtime_0 (real tarray[2]) *** 84,90 **** # else #error Dont know clock tick length # endif ! if (times(&buffer) < 0) return -1.0; utime = buffer.tms_utime; stime = buffer.tms_stime; tarray[0] = ((float)(utime - old_utime)) / (float)clk_tck; tarray[1] = ((float)(stime - old_stime)) / (float)clk_tck; --- 155,161 ---- # else #error Dont know clock tick length # endif ! if (times(&buffer) == (clock_t)-1) return -1.0; utime = buffer.tms_utime; stime = buffer.tms_stime; tarray[0] = ((float)(utime - old_utime)) / (float)clk_tck; tarray[1] = ((float)(stime - old_stime)) / (float)clk_tck; diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libU77/etime_.c gcc-2.95/libf2c/libU77/etime_.c *** egcs-1.1.2/libf2c/libU77/etime_.c Sat Jan 31 17:37:08 1998 --- gcc-2.95/libf2c/libU77/etime_.c Sun May 9 13:03:20 1999 *************** Boston, MA 02111-1307, USA. */ *** 33,38 **** --- 33,43 ---- # include # include #endif + #if defined (_WIN32) + # include + # undef min + # undef max + #endif #include /* for ENOSYS */ #include "f2c.h" *************** double G77_etime_0 (tarray) *** 50,56 **** double G77_etime_0 (real tarray[2]) #endif { ! #if defined (HAVE_GETRUSAGE) || defined (HAVE_TIMES) /* The getrusage version is only the default for convenience. */ #ifdef HAVE_GETRUSAGE struct rusage rbuff; --- 55,126 ---- double G77_etime_0 (real tarray[2]) #endif { ! #if defined (_WIN32) ! static int win32_platform = -1; ! double usertime, systime; ! ! if (win32_platform == -1) ! { ! OSVERSIONINFO osv; ! osv.dwOSVersionInfoSize = sizeof (osv); ! GetVersionEx (&osv); ! win32_platform = osv.dwPlatformId; ! } ! ! /* non-NT platforms don't have a clue as to how long a process has ! been running, so simply return the uptime. Bad judgement call? */ ! if (win32_platform != VER_PLATFORM_WIN32_NT) ! { ! static unsigned long long clock_freq; ! static unsigned long long old_count; ! unsigned long long count; ! LARGE_INTEGER counter_val; ! ! if (clock_freq == 0) ! { ! LARGE_INTEGER freq; ! if (! QueryPerformanceFrequency (&freq)) ! { ! errno = ENOSYS; ! return 0.0; ! } ! else ! { ! clock_freq = ((unsigned long long) freq.HighPart << 32) ! + ((unsigned) freq.LowPart); ! if (! QueryPerformanceCounter (&counter_val)) ! return -1.0; ! old_count = ((unsigned long long) counter_val.HighPart << 32) ! + (unsigned) counter_val.LowPart; ! } ! } ! ! if (! QueryPerformanceCounter (&counter_val)) ! return -1.0; ! ! count = ((unsigned long long) counter_val.HighPart << 32) ! + (unsigned) counter_val.LowPart; ! tarray[0] = usertime = (double) (count - old_count) / clock_freq; ! tarray[1] = systime = 0.0; ! } ! else ! { ! FILETIME creation_time, exit_time, kernel_time, user_time; ! unsigned long long utime, stime; ! ! GetProcessTimes (GetCurrentProcess (), &creation_time, &exit_time, ! &kernel_time, &user_time); ! utime = ((unsigned long long) user_time.dwHighDateTime << 32) ! + (unsigned) user_time.dwLowDateTime; ! stime = ((unsigned long long) kernel_time.dwHighDateTime << 32) ! + (unsigned) kernel_time.dwLowDateTime; ! ! tarray[0] = usertime = utime / 1.0e7; ! tarray[1] = systime = stime / 1.0e7; ! } ! return usertime + systime; ! ! #elif defined (HAVE_GETRUSAGE) || defined (HAVE_TIMES) /* The getrusage version is only the default for convenience. */ #ifdef HAVE_GETRUSAGE struct rusage rbuff; *************** double G77_etime_0 (real tarray[2]) *** 78,84 **** # else #error Dont know clock tick length # endif ! if (times(&buffer) < 0) return -1.0; tarray[0] = (float) buffer.tms_utime / (float)clk_tck; tarray[1] = (float) buffer.tms_stime / (float)clk_tck; #endif /* HAVE_GETRUSAGE */ --- 148,154 ---- # else #error Dont know clock tick length # endif ! if (times(&buffer) == (clock_t)-1) return -1.0; tarray[0] = (float) buffer.tms_utime / (float)clk_tck; tarray[1] = (float) buffer.tms_stime / (float)clk_tck; #endif /* HAVE_GETRUSAGE */ diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libU77/sys_clock_.c gcc-2.95/libf2c/libU77/sys_clock_.c *** egcs-1.1.2/libf2c/libU77/sys_clock_.c Wed Jul 8 20:40:06 1998 --- gcc-2.95/libf2c/libU77/sys_clock_.c Sat Sep 5 03:47:11 1998 *************** int G77_system_clock_0 (integer *count, *** 57,63 **** #elif defined CLK_TCK *count_rate = CLK_TCK; #elif defined HZ ! *count_rate = HZ; #else #error Dont know clock tick length #endif --- 57,63 ---- #elif defined CLK_TCK *count_rate = CLK_TCK; #elif defined HZ ! *count_rate = HZ; #else #error Dont know clock tick length #endif diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libU77/u77-test.f gcc-2.95/libf2c/libU77/u77-test.f *** egcs-1.1.2/libf2c/libU77/u77-test.f Mon Jul 13 05:13:54 1998 --- gcc-2.95/libf2c/libU77/u77-test.f Mon May 3 09:20:04 1999 *************** *** 2,36 **** * hard to test things where you can't guarantee the result. Have a * good squint at what it prints, though detected errors will cause * starred messages. implicit none integer i, j, k, ltarray (9), idat (3), count, rate, count_max, + pid, mask ! real tarray1(2), tarray2(2), r1, r2, sum ! intrinsic getpid, getuid, getgid, ierrno, gerror, ! + fnum, isatty, getarg, access, unlink, fstat, ! + stat, lstat, getcwd, gmtime, hostnm, etime, chmod, + chdir, fgetc, fputc, system_clock, second, idate, secnds, ! + time, ctime, fdate, ttynam, date_and_time ! external lenstr integer lenstr logical l character gerr*80, c*1 character ctim*25, line*80, lognam*20, wd*100, line2*80, ddate*8, ! + ttime*10, zone*5 integer fstatb (13), statb (13) integer *2 i2zero integer values(8) ! ctim = ctime(time()) ! WRITE (6,'(A/)') '1 GNU libU77 test at: ' // ctim write (6,'(A,I3,'', '',I3)') + ' Logical units 5 and 6 correspond (FNUM) to' + // ' Unix i/o units ', fnum(5), fnum(6) if (lnblnk('foo ').ne.3 .or. len_trim('foo ').ne.3) then print *, 'LNBLNK or LEN_TRIM failed' ! call exit(1) end if l= isatty(6) line2 = ttynam(6) if (l) then --- 2,103 ---- * hard to test things where you can't guarantee the result. Have a * good squint at what it prints, though detected errors will cause * starred messages. + * + * Currently not tested: + * ALARM + * CHDIR (func) + * CHMOD (func) + * FGET (func/subr) + * FGETC (func) + * FPUT (func/subr) + * FPUTC (func) + * FSTAT (subr) + * GETCWD (subr) + * HOSTNM (subr) + * IRAND + * KILL + * LINK (func) + * LSTAT (subr) + * RENAME (func/subr) + * SIGNAL (subr) + * SRAND + * STAT (subr) + * SYMLNK (func/subr) + * UMASK (func) + * UNLINK (func) + * + * NOTE! This is the libU77 version, so it should be a bit more + * "interactive" than the testsuite version, which is in + * gcc/testsuite/g77.f-torture/execute/u77-test.f. + * This version purposely exits with a "failure" status, to test + * returning of non-zero status, and it doesn't call the ABORT + * intrinsic (it substitutes an EXTERNAL stub, so the code can be + * kept nearly the same in both copies). Also, it goes ahead and + * tests the HOSTNM intrinsic. Please keep the other copy up-to-date when + * you modify this one. implicit none + + * external hostnm + intrinsic hostnm + integer hostnm + integer i, j, k, ltarray (9), idat (3), count, rate, count_max, + pid, mask ! real tarray1(2), tarray2(2), r1, r2 ! double precision d1 ! integer(kind=2) bigi ! logical issum ! intrinsic getpid, getuid, getgid, ierrno, gerror, time8, ! + fnum, isatty, getarg, access, unlink, fstat, iargc, ! + stat, lstat, getcwd, gmtime, etime, chmod, itime, date, + chdir, fgetc, fputc, system_clock, second, idate, secnds, ! + time, ctime, fdate, ttynam, date_and_time, mclock, mclock8, ! + cpu_time, dtime, ftell, abort ! external lenstr, ctrlc integer lenstr logical l character gerr*80, c*1 character ctim*25, line*80, lognam*20, wd*100, line2*80, ddate*8, ! + ttime*10, zone*5, ctim2*25 integer fstatb (13), statb (13) integer *2 i2zero integer values(8) + integer(kind=7) sigret ! i = time () ! ctim = ctime (i) ! WRITE (6,'(A/)') '1 GNU libU77 test at: ' // ctim(:lenstr (ctim)) write (6,'(A,I3,'', '',I3)') + ' Logical units 5 and 6 correspond (FNUM) to' + // ' Unix i/o units ', fnum(5), fnum(6) if (lnblnk('foo ').ne.3 .or. len_trim('foo ').ne.3) then print *, 'LNBLNK or LEN_TRIM failed' ! call abort ! end if ! ! bigi = time8 () ! ! call ctime (i, ctim2) ! if (ctim .ne. ctim2) then ! write (6, *) '*** CALL CTIME disagrees with CTIME(): ', ! + ctim2(:lenstr (ctim2)), ' vs. ', ctim(:lenstr (ctim)) ! call doabort end if + + j = time () + if (i .gt. bigi .or. bigi .gt. j) then + write (6, *) '*** TIME/TIME8/TIME sequence failures: ', + + i, bigi, j + call doabort + end if + + print *, 'Command-line arguments: ', iargc () + do i = 0, iargc () + call getarg (i, line) + print *, 'Arg ', i, ' is: ', line(:lenstr (line)) + end do + l= isatty(6) line2 = ttynam(6) if (l) then *************** *** 39,44 **** --- 106,120 ---- line = 'and 6 isn''t a tty device (ISATTY)' end if write (6,'(1X,A)') line(:lenstr(line)) + call ttynam (6, line) + if (line .ne. line2) then + print *, '*** CALL TTYNAM disagrees with TTYNAM: ', + + line(:lenstr (line)) + call doabort + end if + + * regression test for compiler crash fixed by JCB 1998-08-04 com.c + sigret = signal(2, ctrlc) pid = getpid() WRITE (6,'(A,I10)') ' Process id (GETPID): ', pid *************** *** 49,71 **** call flush(6) CALL SYSTEM ('echo " " `id`') call flush lognam = 'blahblahblah' call getlog (lognam) ! write (6,*) 'Login name (GETLOG): ', lognam call umask(0, mask) write(6,*) 'UMASK returns', mask call umask(mask) ctim = fdate() ! write (6,*) 'FDATE returns: ', ctim j=time() call ltime (j, ltarray) write (6,'(1x,a,9i4)') 'LTIME returns:', ltarray call gmtime (j, ltarray) write (6,'(1x,a,9i4)') 'GMTIME returns:', ltarray call system_clock(count) ! omitting optional args call system_clock(count, rate, count_max) write(6,*) 'SYSTEM_CLOCK returns: ', count, rate, count_max call date_and_time(ddate) ! omitting optional args call date_and_time(ddate, ttime, zone, values) write(6, *) 'DATE_AND_TIME returns: ', ddate, ' ', ttime, ' ', --- 125,158 ---- call flush(6) CALL SYSTEM ('echo " " `id`') call flush + lognam = 'blahblahblah' call getlog (lognam) ! write (6,*) 'Login name (GETLOG): ', lognam(:lenstr (lognam)) ! ! wd = 'blahblahblah' ! call getenv ('LOGNAME', wd) ! write (6,*) 'Login name (GETENV of LOGNAME): ', wd(:lenstr (wd)) ! call umask(0, mask) write(6,*) 'UMASK returns', mask call umask(mask) ctim = fdate() ! write (6,*) 'FDATE returns: ', ctim(:lenstr (ctim)) ! call fdate (ctim) ! write (6,*) 'CALL FDATE returns: ', ctim(:lenstr (ctim)) ! j=time() call ltime (j, ltarray) write (6,'(1x,a,9i4)') 'LTIME returns:', ltarray call gmtime (j, ltarray) write (6,'(1x,a,9i4)') 'GMTIME returns:', ltarray + call system_clock(count) ! omitting optional args call system_clock(count, rate, count_max) write(6,*) 'SYSTEM_CLOCK returns: ', count, rate, count_max + call date_and_time(ddate) ! omitting optional args call date_and_time(ddate, ttime, zone, values) write(6, *) 'DATE_AND_TIME returns: ', ddate, ' ', ttime, ' ', *************** *** 76,96 **** c consistency-check etime vs. dtime for first call r1 = etime (tarray1) - if (r1.ne.tarray1(1)+tarray1(2)) - + write (6,*) '*** ETIME didn''t return sum of the array: ', - + r1, ' /= ', tarray1(1), '+', tarray1(2) r2 = dtime (tarray2) ! if (abs (r1-r2).gt.1.0) write (6,*) ! + 'Results of ETIME and DTIME differ by more than a second:', ! + r1, r2 ! call sgladd (sum, tarray1(1), tarray1(2)) ! if (r1 .ne. sum) ! + write (6,*) '*** ETIME didn''t return sum of the array: ', ! + r1, ' /= ', tarray1(1), '+', tarray1(2) ! call sgladd (sum, tarray2(1), tarray2(2)) ! if (r2 .ne. sum) ! + write (6,*) '*** DTIME didn''t return sum of the array: ', ! + r2, ' /= ', tarray2(1), '+', tarray2(2) write (6, '(A,3F10.3)') + ' Elapsed total, user, system time (ETIME): ', + r1, tarray1 --- 163,185 ---- c consistency-check etime vs. dtime for first call r1 = etime (tarray1) r2 = dtime (tarray2) ! if (abs (r1-r2).gt.1.0) then ! write (6,*) ! + 'Results of ETIME and DTIME differ by more than a second:', ! + r1, r2 ! call doabort ! end if ! if (.not. issum (r1, tarray1(1), tarray1(2))) then ! write (6,*) '*** ETIME didn''t return sum of the array: ', ! + r1, ' /= ', tarray1(1), '+', tarray1(2) ! call doabort ! end if ! if (.not. issum (r2, tarray2(1), tarray2(2))) then ! write (6,*) '*** DTIME didn''t return sum of the array: ', ! + r2, ' /= ', tarray2(1), '+', tarray2(2) ! call doabort ! end if write (6, '(A,3F10.3)') + ' Elapsed total, user, system time (ETIME): ', + r1, tarray1 *************** c now try to get times to change enough *** 100,117 **** do i = 1,1000 do j = 1,1000 end do ! r2 = dtime (tarray2) if (tarray2(1) .ne. 0. .or. tarray2(2) .ne. 0.) exit end do ! r1 = etime (tarray1) ! call sgladd (sum, tarray1(1), tarray1(2)) ! if (r1 .ne. sum) ! + write (6,*) '*** ETIME didn''t return sum of the array: ', ! + r1, ' /= ', tarray1(1), '+', tarray1(2) ! call sgladd (sum, tarray2(1), tarray2(2)) ! if (r2 .ne. sum) ! + write (6,*) '*** DTIME didn''t return sum of the array: ', ! + r2, ' /= ', tarray2(1), '+', tarray2(2) write (6, '(A,3F10.3)') + ' Differences in total, user, system time (DTIME): ', + r2, tarray2 --- 189,208 ---- do i = 1,1000 do j = 1,1000 end do ! call dtime (tarray2, r2) if (tarray2(1) .ne. 0. .or. tarray2(2) .ne. 0.) exit end do ! call etime (tarray1, r1) ! if (.not. issum (r1, tarray1(1), tarray1(2))) then ! write (6,*) '*** ETIME didn''t return sum of the array: ', ! + r1, ' /= ', tarray1(1), '+', tarray1(2) ! call doabort ! end if ! if (.not. issum (r2, tarray2(1), tarray2(2))) then ! write (6,*) '*** DTIME didn''t return sum of the array: ', ! + r2, ' /= ', tarray2(1), '+', tarray2(2) ! call doabort ! end if write (6, '(A,3F10.3)') + ' Differences in total, user, system time (DTIME): ', + r2, tarray2 *************** c now try to get times to change enough *** 122,150 **** call idate (i,j,k) call idate (idat) ! write (6,*) 'IDATE d,m,y: ',idat ! print *, '... and the VXT version: ', i,j,k call time(line(:8)) print *, 'TIME: ', line(:8) write (6,*) 'SECNDS(0.0) returns: ',secnds(0.0) write (6,*) 'SECOND returns: ', second() call dumdum(r1) call second(r1) write (6,*) 'CALL SECOND returns: ', r1 i = getcwd(wd) if (i.ne.0) then call perror ('*** getcwd') else write (6,*) 'Current directory is "'//wd(:lenstr(wd))//'"' end if call chdir ('.',i) ! if (i.ne.0) write (6,*) '***CHDIR to ".": ', i i=hostnm(wd) if(i.ne.0) then call perror ('*** hostnm') else write (6,*) 'Host name is ', wd(:lenstr(wd)) end if i = access('/dev/null ', 'rw') if (i.ne.0) write (6,*) '***Read/write ACCESS to /dev/null: ', i write (6,*) 'Creating file "foo" for testing...' --- 213,268 ---- call idate (i,j,k) call idate (idat) ! write (6,*) 'IDATE (date,month,year): ',idat ! print *, '... and the VXT version (month,date,year): ', i,j,k ! if (i/=idat(2) .or. j/=idat(1) .or. k/=mod(idat(3),100)) then ! print *, '*** VXT and U77 versions don''t agree' ! call doabort ! end if ! ! call date (ctim) ! write (6,*) 'DATE (dd-mmm-yy): ', ctim(:lenstr (ctim)) ! ! call itime (idat) ! write (6,*) 'ITIME (hour,minutes,seconds): ', idat ! call time(line(:8)) print *, 'TIME: ', line(:8) + write (6,*) 'SECNDS(0.0) returns: ',secnds(0.0) + write (6,*) 'SECOND returns: ', second() call dumdum(r1) call second(r1) write (6,*) 'CALL SECOND returns: ', r1 + + * compiler crash fixed by 1998-10-01 com.c change + if (rand(0).lt.0.0 .or. rand(0).gt.1.0) then + write (6,*) '*** rand(0) error' + call doabort() + end if + i = getcwd(wd) if (i.ne.0) then call perror ('*** getcwd') + call doabort else write (6,*) 'Current directory is "'//wd(:lenstr(wd))//'"' end if call chdir ('.',i) ! if (i.ne.0) then ! write (6,*) '***CHDIR to ".": ', i ! call doabort ! end if ! i=hostnm(wd) if(i.ne.0) then call perror ('*** hostnm') + call doabort else write (6,*) 'Host name is ', wd(:lenstr(wd)) end if + i = access('/dev/null ', 'rw') if (i.ne.0) write (6,*) '***Read/write ACCESS to /dev/null: ', i write (6,*) 'Creating file "foo" for testing...' *************** C the better to test with, my dear! *** 160,201 **** call fseek(3,0,0,*10) go to 20 10 write(6,*) '***FSEEK failed' 20 call fgetc(3, c,i) ! if (i.ne.0) write(6,*) '***FGETC: ', i ! if (c.ne.'c') write(6,*) '***FGETC read the wrong thing: ', ! + ichar(c) i= ftell(3) ! if (i.ne.1) write(6,*) '***FTELL offset: ', i call chmod ('foo', 'a+w',i) ! if (i.ne.0) write (6,*) '***CHMOD of "foo": ', i i = fstat (3, fstatb) ! if (i.ne.0) write (6,*) '***FSTAT of "foo": ', i i = stat ('foo', statb) ! if (i.ne.0) write (6,*) '***STAT of "foo": ', i write (6,*) ' with stat array ', statb ! if (statb(5).ne.getuid () .or. statb(6).ne.getgid() .or. statb(4) ! + .ne. 1) write (6,*) '*** FSTAT uid, gid or nlink is wrong' do i=1,13 ! if (fstatb (i) .ne. statb (i)) ! + write (6,*) '*** FSTAT and STAT don''t agree on '// ' ! + array element ', i, ' value ', fstatb (i), statb (i) end do i = lstat ('foo', fstatb) do i=1,13 ! if (fstatb (i) .ne. statb (i)) ! + write (6,*) '*** LSTAT and STAT don''t agree on '// ' ! + array element ', i, ' value ', fstatb (i), statb (i) end do C in case it exists already: call unlink ('bar',i) call link ('foo ', 'bar ',i) ! if (i.ne.0) ! + write (6,*) '***LINK "foo" to "bar" failed: ', i call unlink ('foo',i) ! if (i.ne.0) write (6,*) '***UNLINK "foo" failed: ', i call unlink ('foo',i) ! if (i.eq.0) write (6,*) '***UNLINK "foo" again: ', i call gerror (gerr) i = ierrno() write (6,'(A,I3,A/1X,A)') ' The current error number is: ', --- 278,360 ---- call fseek(3,0,0,*10) go to 20 10 write(6,*) '***FSEEK failed' + call doabort 20 call fgetc(3, c,i) ! if (i.ne.0) then ! write(6,*) '***FGETC: ', i ! call doabort ! end if ! if (c.ne.'c') then ! write(6,*) '***FGETC read the wrong thing: ', ichar(c) ! call doabort ! end if i= ftell(3) ! if (i.ne.1) then ! write(6,*) '***FTELL offset: ', i ! call doabort ! end if ! call ftell(3, i) ! if (i.ne.1) then ! write(6,*) '***CALL FTELL offset: ', i ! call doabort ! end if call chmod ('foo', 'a+w',i) ! if (i.ne.0) then ! write (6,*) '***CHMOD of "foo": ', i ! call doabort ! end if i = fstat (3, fstatb) ! if (i.ne.0) then ! write (6,*) '***FSTAT of "foo": ', i ! call doabort ! end if i = stat ('foo', statb) ! if (i.ne.0) then ! write (6,*) '***STAT of "foo": ', i ! call doabort ! end if write (6,*) ' with stat array ', statb ! if (statb(6) .ne. getgid ()) then ! write (6,*) 'Note: FSTAT gid wrong (happens on some systems).' ! end if ! if (statb(5) .ne. getuid () .or. statb(4) .ne. 1) then ! write (6,*) '*** FSTAT uid or nlink is wrong' ! call doabort ! end if do i=1,13 ! if (fstatb (i) .ne. statb (i)) then ! write (6,*) '*** FSTAT and STAT don''t agree on '// ' ! + array element ', i, ' value ', fstatb (i), statb (i) ! call doabort ! end if end do i = lstat ('foo', fstatb) do i=1,13 ! if (fstatb (i) .ne. statb (i)) then ! write (6,*) '*** LSTAT and STAT don''t agree on '// ! + 'array element ', i, ' value ', fstatb (i), statb (i) ! call doabort ! end if end do C in case it exists already: call unlink ('bar',i) call link ('foo ', 'bar ',i) ! if (i.ne.0) then ! write (6,*) '***LINK "foo" to "bar" failed: ', i ! call doabort ! end if call unlink ('foo',i) ! if (i.ne.0) then ! write (6,*) '***UNLINK "foo" failed: ', i ! call doabort ! end if call unlink ('foo',i) ! if (i.eq.0) then ! write (6,*) '***UNLINK "foo" again: ', i ! call doabort ! end if ! call gerror (gerr) i = ierrno() write (6,'(A,I3,A/1X,A)') ' The current error number is: ', *************** C in case it exists already: *** 205,231 **** call getarg (0, line) call perror (line (:lenstr (line))) call unlink ('bar') WRITE (6,*) 'You should see exit status 1' CALL EXIT(1) 99 END integer function lenstr (str) ! C return length of STR not including trailing blanks, but always ! C return >0 ! character *(*) str if (str.eq.' ') then lenstr=1 else lenstr = lnblnk (str) end if end ! * just make sure SECOND() doesn't "magically" work the second time. subroutine dumdum(r) r = 3.14159 end ! * do an add that is most likely to be done in single precision. ! subroutine sgladd(sum,left,right) implicit none ! real sum,left,right ! sum = left+right end --- 364,415 ---- call getarg (0, line) call perror (line (:lenstr (line))) call unlink ('bar') + + print *, 'MCLOCK returns ', mclock () + print *, 'MCLOCK8 returns ', mclock8 () + + call cpu_time (d1) + print *, 'CPU_TIME returns ', d1 + WRITE (6,*) 'You should see exit status 1' CALL EXIT(1) 99 END + * Return length of STR not including trailing blanks, but always > 0. integer function lenstr (str) ! character*(*) str if (str.eq.' ') then lenstr=1 else lenstr = lnblnk (str) end if end ! ! * Just make sure SECOND() doesn't "magically" work the second time. subroutine dumdum(r) r = 3.14159 end ! ! * Test whether sum is approximately left+right. ! logical function issum (sum, left, right) implicit none ! real sum, left, right ! real mysum, delta, width ! mysum = left + right ! delta = abs (mysum - sum) ! width = abs (left) + abs (right) ! issum = (delta .le. .0001 * width) ! end ! ! * Signal handler ! subroutine ctrlc ! print *, 'Got ^C' ! call doabort ! end ! ! * A problem has been noticed, so maybe abort the test. ! subroutine doabort ! * For this version, print out all problems noticed. ! * intrinsic abort ! * call abort end diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/libU77/vxtidate_.c gcc-2.95/libf2c/libU77/vxtidate_.c *** egcs-1.1.2/libf2c/libU77/vxtidate_.c Fri Mar 5 02:17:11 1999 --- gcc-2.95/libf2c/libU77/vxtidate_.c Fri Mar 5 15:40:12 1999 *************** Boston, MA 02111-1307, USA. */ *** 38,47 **** /* Subroutine */ #ifdef KR_headers ! int G77_vxtidate_0 (m, d, y) integer *y, *m, *d; #else ! int G77_vxtidate_0 (integer *m, integer *d, integer *y) #endif { struct tm *lt; --- 38,47 ---- /* Subroutine */ #ifdef KR_headers ! int G77_vxtidate_y2kbug_0 (m, d, y) integer *y, *m, *d; #else ! int G77_vxtidate_y2kbug_0 (integer *m, integer *d, integer *y) #endif { struct tm *lt; diff -x de.gmo -x fr.gmo -Nrc3p egcs-1.1.2/libf2c/readme.netlib gcc-2.95/libf2c/readme.netlib *** egcs-1.1.2/libf2c/readme.netlib Thu Jul 16 15:50:59 1998 --- gcc-2.95/libf2c/readme.netlib Mon May 10 07:40:50 1999 *************** either a decimal point or an exponent fi *** 619,668 **** when they appear as list input for integer data. Compile lread.c with -DALLOW_FLOAT_IN_INTEGER_LIST_INPUT to restore the old behavior. Current timestamps of files in "all from f2c/src", sorted by time, appear below (mm/dd/year hh:mm:ss). To bring your source up to date, obtain source files with a timestamp later than the time shown in your version.c. Note that the time shown in the current version.c is the timestamp of the source module that immediately follows version.c below: ! 5/16/1998 19:07:45 xsum0.out ! 5/16/1998 17:17:01 f2c.1 ! 5/16/1998 17:16:53 f2c.1t ! 5/16/1998 16:56:15 version.c 5/16/1998 16:55:49 output.c 4/03/1998 17:15:05 gram.c 4/03/1998 17:14:59 gram.dcl 3/09/1998 0:30:23 putpcc.c 2/25/1998 8:18:04 makefile - 12/04/1997 17:44:11 format.c 12/04/1997 17:44:11 niceprintf.c - 12/04/1997 17:14:05 lex.c 8/05/1997 10:31:26 malloc.c 7/24/1997 17:10:55 README 7/24/1997 16:06:19 Notice 7/21/1997 12:58:44 proc.c 2/11/1997 23:39:14 vax.c 12/04/1996 13:07:53 gram.exec - 10/01/1996 14:36:18 defs.h - 10/01/1996 14:36:18 init.c - 10/01/1996 14:36:17 data.c - 9/17/1996 17:29:44 expr.c 9/12/1996 12:12:46 equiv.c - 8/27/1996 8:30:32 intr.c 8/26/1996 9:41:13 sysdep.c 7/09/1996 10:40:45 names.c - 7/04/1996 9:58:31 formatdata.c 7/04/1996 9:55:45 sysdep.h 7/04/1996 9:55:43 put.c 7/04/1996 9:55:41 pread.c 7/04/1996 9:55:40 parse_args.c - 7/04/1996 9:55:40 p1output.c - 7/04/1996 9:55:37 misc.c - 7/04/1996 9:55:36 memset.c 7/04/1996 9:55:36 mem.c 7/04/1996 9:55:35 main.c - 7/04/1996 9:55:33 io.c - 7/04/1996 9:55:30 exec.c 7/04/1996 9:55:29 error.c 7/04/1996 9:55:27 cds.c 7/03/1996 15:47:49 xsum.c --- 619,763 ---- when they appear as list input for integer data. Compile lread.c with -DALLOW_FLOAT_IN_INTEGER_LIST_INPUT to restore the old behavior. + Mon Aug 31 10:38:54 EDT 1998 + formatdata.c: if possible, and assuming doubles must be aligned on + double boundaries, use existing holes in DATA for common blocks to + force alignment of the block. For example, + block data + common /abc/ a, b + double precision a + integer b(2) + data b(2)/1/ + end + used to generate + struct { + integer fill_1[3]; + integer e_2; + doublereal e_3; + } abc_ = { {0}, 1, 0. }; + and now generates + struct { + doublereal fill_1[1]; + integer fill_2[1]; + integer e_3; + } abc_ = { {0}, {0}, 1 }; + In the old generated C, e_3 was added to force alignment; in the new C, + fill_1 does this job. + + Mon Sep 7 19:48:51 EDT 1998 + libi77: move e_wdfe from sfe.c to dfe.c, where it was originally. + Why did it ever move to sfe.c? + + Tue Sep 8 10:22:50 EDT 1998 + Treat dreal as a synonym for dble unless -cd is specified on the + command line. + + Sun Sep 13 22:23:41 EDT 1998 + format.c: fix bug in writing prototypes under f2c -A ... *.P: + under some circumstances involving external functions with no known + type, a null pointer was passed to printf. + + Tue Oct 20 23:25:54 EDT 1998 + Comments added to libf2c/README and libF77/README, pointing out + the need to modify signal1.h on some systems. + + Thu Nov 12 15:34:09 EST 1998 + libf77, libf2c.zip: minor tweaks to [de]time_.c and the makefiles, + so makefile.sy, makefile.vc, and makefile.wat deal with [de]time_.c. + + Wed Feb 10 22:59:52 EST 1999 + defs.h lex.c: permit long names (up to at least roughly + MAX_SHARPLINE_LEN = 1000 characters long) in #line lines (which only + matters under -g). + fc: add -U option; recognize .so files. + + Sat Feb 13 10:18:27 EST 1999 + libf2c: endfile.c, lread.c, signal1.h0: minor tweaks to make some + (C++) compilers happier; f77_aloc.c: make exit_() visible to C++ + compilers. Version strings not changed. + + Thu Mar 11 23:14:02 EST 1999 + Modify f2c (exec.c, expr.c) to diagnose incorrect mixing of types + when (f2c extended) intrinsic functions are involved, as in + (not(17) .and. 4). Catching this in the first executable statement + is a bit tricky, as some checking must be postponed until all statement + function declarations have been parsed. Thus there is a chance of + today's changes introducing bugs under (let us hope) unusual conditions. + + Sun Mar 28 13:17:44 EST 1999 + lex.c: tweak to get the file name right in error messages caused + by statements just after a # nnn "filename" line emitted by the C + preprocessor. (The trouble is that the line following the # nnn line + must be read to see if it is a continuation of the stuff that preceded + the # nnn line.) When # nnn "filename" lines appear among the lines + for a Fortran statement, the filename reported in an error message for + the statement should now be the file that was current when the first + line of the statement was read. + + Sun May 2 22:38:25 EDT 1999 + libf77, libi77, libf2c.zip: make getenv_() more portable (call + getenv() rather than knowing about char **environ); adjust some + complex intrinsics to work with overlapping arguments (caused by + inappropriate use of equivalence); open.c: get "external" versus + "internal" right in the error message if a file cannot be opened; + err.c: cast a pointer difference to (int) for %d; rdfmt.c: omit + fixed-length buffer that could be overwritten by formats Inn or Lnn + with nn > 83. + + Mon May 3 13:14:07 EDT 1999 + "Invisible" changes to omit a few compiler warnings in f2c and + libf2c; two new casts in libf2c/open.c that matter with 64-bit longs, + and one more tweak (libf2c/c_log.c) for pathological equivalences. + Minor update to "fc" script: new -L flag and comment correction. + + Tue May 4 10:06:26 EDT 1999 + libf77, libf2c.zip: forgot to copy yesterday's latest updates to + netlib. + Current timestamps of files in "all from f2c/src", sorted by time, appear below (mm/dd/year hh:mm:ss). To bring your source up to date, obtain source files with a timestamp later than the time shown in your version.c. Note that the time shown in the current version.c is the timestamp of the source module that immediately follows version.c below: ! 5/03/1999 12:46:15 version.c ! 5/03/1999 12:39:35 formatdata.c ! 5/03/1999 12:31:14 format.c ! 5/03/1999 12:27:17 p1output.c ! 5/03/1999 12:27:17 data.c ! 5/03/1999 10:01:12 xsum0.out ! 5/03/1999 9:59:36 io.c ! 5/03/1999 9:59:36 misc.c ! 5/03/1999 9:59:36 init.c ! 3/26/1999 23:18:11 lex.c ! 3/11/1999 16:44:17 expr.c ! 3/11/1999 16:42:42 exec.c ! 2/10/1999 17:43:01 defs.h ! 9/08/1998 10:16:51 f2c.1 ! 9/08/1998 10:16:48 f2c.1t ! 9/08/1998 10:14:53 intr.c 5/16/1998 16:55:49 output.c 4/03/1998 17:15:05 gram.c 4/03/1998 17:14:59 gram.dcl 3/09/1998 0:30:23 putpcc.c 2/25/1998 8:18:04 makefile 12/04/1997 17:44:11 niceprintf.c 8/05/1997 10:31:26 malloc.c 7/24/1997 17:10:55 README 7/24/1997 16:06:19 Notice 7/21/1997 12:58:44 proc.c 2/11/1997 23:39:14 vax.c 12/04/1996 13:07:53 gram.exec 9/12/1996 12:12:46 equiv.c 8/26/1996 9:41:13 sysdep.c 7/09/1996 10:40:45 names.c 7/04/1996 9:55:45 sysdep.h 7/04/1996 9:55:43 put.c 7/04/1996 9:55:41 pread.c 7/04/1996 9:55:40 parse_args.c 7/04/1996 9:55:36 mem.c + 7/04/1996 9:55:36 memset.c 7/04/1996 9:55:35 main.c 7/04/1996 9:55:29 error.c 7/04/1996 9:55:27 cds.c 7/03/1996 15:47:49 xsum.c