diff -rcp2N g77-0.5.15/README.g77 g77-0.5.16/README.g77 *** g77-0.5.15/README.g77 Fri May 19 11:44:58 1995 --- g77-0.5.16/README.g77 Thu Aug 10 02:47:58 1995 *************** *** 1,5 **** ! 950519 ! This directory contains the version 0.5.15 release of the GNU Fortran compiler. The GNU Fortran compiler is free software. See the file COPYING.g77 for copying permission. --- 1,5 ---- ! 950810 ! This directory contains the version 0.5.16 release of the GNU Fortran compiler. The GNU Fortran compiler is free software. See the file COPYING.g77 for copying permission. *************** contains all of the Fortran files. *** 16,20 **** * To build GNU Fortran, you must have a recent gcc distribution, ! such as version 2.6.2 or 2.6.3. If you have just unpacked the g77 distribution, before proceeding, --- 16,30 ---- * To build GNU Fortran, you must have a recent gcc distribution, ! such as version 2.6.3 or 2.7.0. Do not attempt to use any version ! of gcc prior to 2.6.2 or at or beyond 2.8.0 (or 3.0, etc.), because ! this version of g77 is designed to work only with gcc versions 2.6.x ! and 2.7.x. ! ! * Note that you must have source copies of these gcc distributions!! ! You cannot build g77 just using binaries of gcc. Also, unless you ! are an expert, avoid using any distribution of gcc not identical to ! the one distributed by the FSF -- for example, using a special version ! modified to produce better code for the Pentium (sometimes labeled ! gcc-i2.6.3 -- note the `i') will not work with this distribution of g77. If you have just unpacked the g77 distribution, before proceeding, *************** If you have just unpacked the g77 distri *** 21,25 **** you must merge the contents of the g77 distribution with the appropriate gcc distribution on your system before proceeding. Using sample ! versions of 2.6.3 for gcc and 0.5.15 for g77, the process of unpacking and merging both distributions would be done as follows (where # is the shell prompt): --- 31,35 ---- you must merge the contents of the g77 distribution with the appropriate gcc distribution on your system before proceeding. Using sample ! versions of 2.6.3 for gcc and 0.5.16 for g77, the process of unpacking and merging both distributions would be done as follows (where # is the shell prompt): *************** shell prompt): *** 26,32 **** # tar xf gcc-2.6.3.tar # Creates ./gcc-2.6.3/ ! # tar xf g77-0.5.15.tar # Creates ./g77-0.5.15/ ! * # mv g77-0.5.15/* gcc-2.6.3/ # Merges gcc and g77 into ./gcc-2.6.3/ ! # rmdir g77-0.5.15 # Remove empty ./g77-0.5.15/ Another approach is to do the following: --- 36,42 ---- # tar xf gcc-2.6.3.tar # Creates ./gcc-2.6.3/ ! # tar xf g77-0.5.16.tar # Creates ./g77-0.5.16/ ! * # mv g77-0.5.16/* gcc-2.6.3/ # Merges gcc and g77 into ./gcc-2.6.3/ ! # rmdir g77-0.5.16 # Remove empty ./g77-0.5.16/ Another approach is to do the following: *************** Another approach is to do the following: *** 33,38 **** # tar xf gcc-2.6.3.tar # Creates ./gcc-2.6.3/ ! # ln -s gcc-2.6.3 g77-0.5.15 # Make g77-0.5.15 a link to gcc-2.6.3 ! # tar xf g77-0.5.15.tar # Unpacks g77 into gcc-2.6.3 The latter approach leaves the symbolic link, which might help others --- 43,48 ---- # tar xf gcc-2.6.3.tar # Creates ./gcc-2.6.3/ ! # ln -s gcc-2.6.3 g77-0.5.16 # Make g77-0.5.16 a link to gcc-2.6.3 ! # tar xf g77-0.5.16.tar # Unpacks g77 into gcc-2.6.3 The latter approach leaves the symbolic link, which might help others *************** problem occurs using one of the above me *** 46,50 **** The resulting directory layout is as follows, where gcc/ might be, ! for example, gcc-0.5.15/: gcc/ Non-Fortran files in gcc (not part of g77*.tar) --- 56,60 ---- The resulting directory layout is as follows, where gcc/ might be, ! for example, gcc-0.5.16/: gcc/ Non-Fortran files in gcc (not part of g77*.tar) *************** to g77 to improve it in various ways. *** 119,125 **** If you want to get into the FFE code, which lives entirely in gcc/f/, here ! are a few clues. The file parse.c is the source file for main() for a ! stand-alone FFE and yyparse() for g77. The file top.c contains the top-level FFE function ffe_file and it (along with top.h) define all ffe_[a-z].*, ffe[A-Z].*, and FFE_[A-Za-z].* symbols. --- 129,140 ---- If you want to get into the FFE code, which lives entirely in gcc/f/, here ! are a few clues. The file g77.c is the stand-alone source file for the ! `g77' command driver only -- this just invokes the `gcc' command, so it has ! nothing to do with the rest of the code in g77. Most of the code ! ends up in an executable named `f771', which does the actual compiling, ! so it has the FFE merged with the gcc back end. + The file parse.c is the source file for main() for a stand-alone FFE and + yyparse() for f771. (Stand-alone building of the FFE doesn't work these days.) The file top.c contains the top-level FFE function ffe_file and it (along with top.h) define all ffe_[a-z].*, ffe[A-Z].*, and FFE_[A-Za-z].* symbols. diff -rcp2N g77-0.5.15/f/BUGS g77-0.5.16/f/BUGS *** g77-0.5.15/f/BUGS Wed Apr 12 10:03:06 1995 --- g77-0.5.16/f/BUGS Wed Aug 30 16:01:47 1995 *************** *** 1,4 **** ! 950315 1. g77 statically assumes INTEGER constants range from -2**31 to 2**31-1, instead of determining their range from the actual range of the INTEGER --- 1,10 ---- ! This file documents known bugs in the GNU Fortran system. ! Copyright (C) 1995 Free Software Foundation, Inc. You may copy, ! distribute, and modify it freely as long as you preserve this copyright ! notice and permission notice. Contributed by James Craig Burley ! (burley@gnu.ai.mit.edu). + 1995-08-30 + 1. g77 statically assumes INTEGER constants range from -2**31 to 2**31-1, instead of determining their range from the actual range of the INTEGER *************** *** 28,34 **** local EQUIVALENCE areas, so that has been disabled as well. ! 4. When debugging, user must currently set a breakpoint at MAIN__ (or ! MAIN___ or MAIN_ if MAIN__ doesn't exist) and run the program until ! it hits the breakpoint before the main program unit is activated. 5. The current external-interface design, which includes naming of --- 34,44 ---- local EQUIVALENCE areas, so that has been disabled as well. ! 4. 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 MAIN__ (or MAIN___ or MAIN_ if 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 ! executable statement, but that's the state in which the debugger should ! start up, as is the case for languages like C. 5. The current external-interface design, which includes naming of *************** *** 44,50 **** with popular existing compilers. ! 6. g77 currently inserts needless padding for things like "COMMON J,I" ! where J is INTEGER*2 and I is INTEGER*4 on machines like x86, because ! the back end insists that I be aligned to a 4-byte boundary, but the processor has no such requirement (though it's good for performance). --- 54,60 ---- with popular existing compilers. ! 6. g77 currently inserts needless padding for things like "COMMON A,IPAD" ! where A is CHARACTER*1 and IPAD is INTEGER*4 on machines like x86, because ! the back end insists that IPAD be aligned to a 4-byte boundary, but the processor has no such requirement (though it's good for performance). *************** *** 51,55 **** 7. g77 currently requires application of a patch file to the gcc compiler ! tree (at least up through gcc version 2.6.3). The necessary patches should be folded in to the mainline gcc distribution. --- 61,65 ---- 7. g77 currently requires application of a patch file to the gcc compiler ! tree (at least up through gcc version 2.7). The necessary patches should be folded in to the mainline gcc distribution. *************** *** 65,70 **** interim fix. ! 11. RS/6000 support is not complete as of the gcc 2.6.3 back end. ! ! 12. The -I and related -i command-line options do not affect INCLUDE ! statements. --- 75,131 ---- interim fix. ! 11. RS/6000 support is not complete as of the gcc 2.6.3 back end. The ! 2.7.0 back end appears to fix this problem, or at least mitigate ! it significantly, but there is at least one known problem that is ! likely to be a code-generation bug in gcc-2.7.0+g77-0.5.16. This ! problem shows up only when compiling the Fortran program with -O. ! ! 12. There's a problem similar to the one mentioned in #11 above that ! shows up on SGI machines. This problem shows up only when ! compiling the Fortran program with -O. ! ! 13. g77 doesn't work on 64-bit configurations such as the Alpha. The ! problem is not yet adequately investigated. As of 0.5.16, g77 issues ! a warning diagnostic whenever it is run after being built to ! generate code for such a system. ! ! 14. There are some known problems when using gdb on code compiled by g77. ! Inadequate investigation as of the release of 0.5.16 results in not ! knowing which productds are the culprit, but gdb-4.14 definitely ! crashes when, for example, an attempt is made to print the contents ! of a COMPLEX*16 dummy array, on at least some Linux machines, plus ! some others. ! ! 15. g77 sometimes gives the wrong info for messages like "In file ! included from...:". In fact, so does gcc, though due to linguistic ! differences, the problem is more likely to show up when using g77. ! ! This is a bug in the gcc back end, actually. The patch to fix this ! follows (apply via "patch -p1 -d gcc-2.7.0 -V t < gcc/f/BUGS", for ! example): ! ! Tue Aug 22 10:08:08 1995 Craig Burley (burley@gnu.ai.mit.edu) ! ! * toplev.c (report_error_function): Don't attempt to use input ! file stack to identify nesting of #include's if the file ! name (pointer) of the location being diagnosed is not the ! same as input_filename, since in that case the contents ! of the file stack are irrelevant -- they apply to only the ! current file. ! ! *** gcc-2.7.0/toplev.c Thu Jun 15 08:09:51 1995 ! --- g77-new/toplev.c Tue Aug 22 09:56:54 1995 ! *************** report_error_function (file) ! *** 1049,1053 **** ! ! if (input_file_stack && input_file_stack->next != 0 ! ! && input_file_stack_tick != last_error_tick) ! { ! fprintf (stderr, "In file included"); ! --- 1049,1054 ---- ! ! if (input_file_stack && input_file_stack->next != 0 ! ! && input_file_stack_tick != last_error_tick ! ! && file == input_filename) ! { ! fprintf (stderr, "In file included"); diff -rcp2N g77-0.5.15/f/CREDITS g77-0.5.16/f/CREDITS *** g77-0.5.15/f/CREDITS Wed Feb 22 16:20:08 1995 --- g77-0.5.16/f/CREDITS Mon Aug 21 16:08:48 1995 *************** *** 1,3 **** ! 950216 The front end for GNU Fortran ("g77"), which is almost all of the source --- 1,3 ---- ! 1995-02-16 The front end for GNU Fortran ("g77"), which is almost all of the source diff -rcp2N g77-0.5.15/f/ChangeLog g77-0.5.16/f/ChangeLog *** g77-0.5.15/f/ChangeLog Fri May 19 11:17:26 1995 --- g77-0.5.16/f/ChangeLog Wed Aug 30 15:58:59 1995 *************** *** 1,4 **** --- 1,391 ---- + 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 *************** Tue Feb 21 19:01:18 1995 Dave Love )" and the like. See the answer for ! not supporting STRUCTURE, UNION, RECORD, and MAP. ! ! *OPEN QUESTIONS* ! ! Please consider offering useful answers to these! ! ! - g77 treats constants like Z'ABCD' and 'ABCD'Z as typeless. It seems ! like maybe the prefix-letter form, Z'ABCD', should be INTEGER ! instead. Perhaps this will be changed for 0.6. ! ! - LOC() and other intrinsics are probably somewhat misclassified. Is ! the a need for more precise classification of intrinsics, and if so, ! what are the appropriate groupings? Is there a need to individually ! enable/disable/delete/hide intrinsics from the command line? ! ! *INTERFACING, DEBUGGING, ETC.* ! ! GNU Fortran currently generates code that is object-compatible with ! the f2c converter. Also, it avoids limitations in the current GNU ! Back End (GBE), such as the inability to generate a procedure with ! multiple entry points, by generating code that is structured ! differently (in terms of procedure names, scopes, arguments, and ! so on) than might be expected. ! ! As a result, writing code in other languages that calls on, is ! called by, or shares in-memory data with g77-compiled code generally ! requires some understanding of the way g77 compiles code for ! various constructs. Similarly, using a debugger to debug g77-compiled ! code, even if that debugger supports native Fortran debugging, generally ! requires this sort of information. ! ! This section describes some of the basic information on how ! g77 compiles code for constructs involving interfaces to other ! languages and to debuggers. ! ! NOTE: Much or all of this information pertains to only the current ! release of g77, sometimes even to using certain compiler options ! with g77 (such as -fno-f2c). Do not write code that depends on this ! information without clearly marking said code as nonportable and ! subject to review for every new release of g77. This information ! is provided primarily to make debugging of code generated by this ! particular release of g77 easier for the user, and partly to make ! writing (generally nonportable) interface code easier. Both of these ! activities require tracking changes in new version of g77 as they ! are installed, because new versions can change the behaviors ! described in this section. ! ! Names ! ----- ! ! Fortran permits each implementation to decide how to represent ! names as far as how they're seen in other contexts, such as debuggers ! and when interfacing to other languages, and especially as far ! as how casing is handled. ! ! External names -- names of entities that are public, i.e. accessible ! to all modules in a program -- normally have an underscore (_) ! appended by g77, to generate code that is compatible with f2c. ! External names include names of Fortran things like common blocks, ! external procedures (subroutines and functions, but not including ! statement functions, which are internal procedures), and entry point ! names. However, use of the -fno-underscoring command-line option ! disables this kind of transformation of external names (though inhibiting ! the transformation certainly improves the chances of colliding with ! incompatible externals written in other languages -- but that ! might be intentional). ! ! When -funderscoring is in force, any name (external or local) that already ! has at least one underscore in it is implemented by g77 by appending two ! underscores. External names are changed this way for f2c compatibility. ! Local names are changed this way to avoid collisions with external names ! that are different in the source code -- f2c does the same thing, but ! there's no compatibility issue there except for user expectations while ! debugging. ! ! Therefore, given ! ! Max_Cost = 0 ! ! a user would, in the debugger, refer to this variable using the ! name `max_cost__' (or `MAX_COST__' or `Max_Cost__', as described ! below). (We hope to improve g77 in this regard in the future -- ! don't write scripts depending on this behavior! Also, consider ! experimenting with the `-fno-underscoring' option to try out ! debugging without having to massage names by hand like this.) ! ! g77 provides a number of command-line options that allow the user ! to control how case mapping is handled for source files. The default ! is the traditional UNIX model -- names are mapped to lower case. ! Other command-line options can be specified to map names to upper ! case, or to leave them exactly as written in the source file. ! ! For example, given the statement ! ! Foo = 3.14159 ! ! it is normally the case that the variable assigned will be named ! `foo'. This would be the name to enter when using a debugger to ! access the variable, for example. ! ! However, depending on the command-line options specified, the ! name implemented by g77 might instead be `FOO' or even `Foo', ! thus affecting how debugging is done. ! ! Also, ! ! Call Foo ! ! would normally call a procedure that, if it were in a separate C program, ! be defined starting with the line: ! ! void foo_() ! ! However, g77 command-line options could be used to change the casing ! of names, resulting in the name `FOO_' or `Foo_' being given to the ! procedure instead of `foo_', and the -fno-underscoring option could be used ! to inhibit the appending of the underscore to the name. ! ! Main Program Unit (The PROGRAM Statement) ! ----------------------------------------- ! ! When g77 compiles a main program unit, it gives it the public ! procedure name `MAIN__'. The libf2c library has the actual ! `main()' procedure as is typical of C-based environments, and ! it is this procedure that performs some initial start-up ! activity and then calls MAIN__. ! ! Generally, g77 and libf2c are designed so that you need not ! include a main program unit written in Fortran in your program -- ! it can be written in C or some other language. Especially for ! I/O handling, this is the case, although g77-0.5.16 includes ! a bug fix for libf2c that solved a problem with using the ! OPEN statement as the first Fortran I/O activity in a program ! without a Fortran main program unit. ! ! However, if you don't intend to use g77 (or f2c) to compile your ! main program unit -- that is, if you intend to compile a `main()' ! procedure using some other language -- you should carefully ! examine the code for main() in libf2c, found in the source ! file gcc/f/runtime/libF77/main.c, to see what kinds of things ! might need to be done by your main() in order to provide the ! Fortran environment your Fortran code is expecting. ! ! For example, libf2c's main() sets up the information used by ! the IARGC() and GETARG() intrinsics. Bypassing libf2c's main() ! without providing a substitute for this activity would mean ! that invoking IARGC() and GETARG() would produce undefined ! results. ! ! When debugging, one implication of the fact that main(), which ! is the place where the debugged program "starts" from the ! debugger's point of view, is in libf2c is that you won't be ! starting your Fortran program at a point you recognize as your ! Fortran code. ! ! 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 MAIN__, and then run the program. ! ! After doing this, the debugger will see the current execution ! point of the program as at the beginning of the main program ! unit of your program. ! ! 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 MAIN__, that should work fine. ! ! Arrays (The DIMENSION Statement) ! -------------------------------- ! ! Fortran uses "column-major ordering" in its arrays. This differs ! from other languages, such as C, which use "row-major ordering". ! The difference is that, with Fortran, array elements ajacent to ! each other in memory differ in the _first_ subscript instead of ! the last; A(5,10,20) immediately follows A(4,10,20), whereas with ! row-major ordering it would follow A(5,10,19). This consideration ! affects not only interfacing with and debugging Fortran code, ! it can greatly affect how code is designed and written, especially ! when code speed and size is a concern. ! ! Fortran also differs from C, a popular language for interfacing and ! to support directly in debuggers, in the way arrays are treated. ! In C, arrays are single-dimensional and have interesting relationships ! to pointers, neither of which is true for Fortran. As a result, ! dealing with Fortran arrays from within an environment limited to ! C concepts can be challenging. ! ! For example, accessing the array element A(5,10,20) is easy enough ! in Fortran (use `A(5,10,20)'), but in C some difficult machinations ! are needed. First, C would treat the A array as a single-dimension ! array. Second, C does not understand low bounds for arrays as ! does Fortran. Third, C assumes a low bound of zero (0), while Fortran ! defaults to a low bound of one (1). Therefore, calculations must be done ! to determine what the C equivalent of A(5,10,20) would be, and these ! calculations require knowing the dimensions of A. ! ! For DIMENSION A(2:11,21,0:29), the calculation of the offset of ! A(5,10,20) would be: ! ! (5-2) ! + (10-1)*(11-2+1) ! + (20-0)*(11-2+1)*(21-1+1) ! = 4293 ! ! So the C equivalent in this case would be a[4293]. ! ! When using a debugger directly on Fortran code, the C equivalent ! might not work, because some debuggers cannot understand the notion ! of low bounds other than zero. However, unlike f2c, g77 does ! inform the GBE that a multi-dimensional array (like A in the above ! example) is really multi-dimensional, rather than a single- ! dimensional array, so at least the dimensionality of the array ! is preserved. ! ! Debuggers that understand Fortran should have no trouble with ! non-zero low bounds, but for non-Fortran debuggers, especially ! C debuggers, the above example might have a C equivalent of ! a[4305]. This calculation is arrived at by eliminating the subtraction ! of the lower bound in the first parenthesized expression on each ! line -- that is, for (5-2) substitute (5), for (10-1) substitute ! (10), and for (20-0) substitute (20). Actually, the implication of ! this can be that the expression `*(&a[2][1][0] + 4293)' works fine, but ! that `a[20][10][5]' produces the equivalent of `*(&a[0][0][0] + 4305)' ! because of the missing lower bounds. Come to think of it, perhaps ! the behavior is due to the debugger internally compensating for ! the lower bounds by offsetting the base address of a, leaving ! `&a' set lower, in this case, than `&a[2][1][0]' (the address of ! its first element as identified by subscripts equal to the ! corresponding lower bounds). ! ! You know, maybe nobody really needs to use arrays. ! ! Procedures (The SUBROUTINE, FUNCTION, and ENTRY Statements) ! ----------------------------------------------------------- ! ! Procedures that accept CHARACTER arguments are implemented by ! g77 so that each CHARACTER argument has two actual arguments. ! The first argument occupies the expected position in the ! argument list and has the user-specified name. This argument ! is a pointer to an array of characters, passed by the caller. ! The second argument is appended to the end of the user-specified ! calling sequence and is named `__g77_length_X', where X is ! the user-specified name. This argument is of the C type `ftnlen' ! (see gcc/f/runtime/f2c.h.in for information on that type) and ! is the number of characters the caller has allocated in the ! array pointed to by the first argument. (A procedure will ! ignore the `__g77_length_X' argument if X is not declared ! CHARACTER*(*), because for other declarations, it knows the ! length. Not all callers necessarily know this, however, which ! is why they all pass the extra argument.) ! ! The contents of the CHARACTER argument are specified by the ! address passed in the first argument (named after it). The ! procedure can read or write these contents as appropriate. ! ! When more than one CHARACTER argument is present in the argument ! list, the `__g77_length_X' arguments are appended in the order ! they appear. So "CALL FOO('HI','THERE')" is implemented in ! C as `foo("hi","there",2,5);', ignoring the fact that g77 ! does not provide the trailing null bytes on the constant ! strings (f2c does provide them, but they are unnecessary in ! a Fortran environment, and you should not expect them to be ! there). ! ! Note that this discussion applies to CHARACTER variables and ! arrays _only_. It does _not_ apply to external CHARACTER ! functions or to intrinsic CHARACTER functions. That is, no ! second `__g77_length_X' argument is passed to FOO in this case: ! ! CHARACTER X ! EXTERNAL X ! CALL FOO(X) ! ! Nor does FOO expect such an argument in this case: ! ! SUBROUTINE FOO(X) ! CHARACTER X ! EXTERNAL X ! ! Because of this implementation detail, if a program has a bug ! such that there is disagreement as to whether an argument is ! a procedure, and the type of the argument is CHARACTER, subtle ! symptoms might appear. ! ! Adjustable Arrays (The DIMENSION Statement) ! ------------------------------------------- ! ! Adjustable arrays in Fortran require the implementation (in this ! case, the g77 compiler) to "memorize" the expressions that ! dimension the arrays each time the procedure is invoked. ! This is so that subsequent changes to variables used in those ! expressions, made during execution of the procedure, do not ! have any effect on the dimensions of those adjustable arrays. ! ! For example, given ! ! REAL ARRAY(5) ! DATA ARRAY/5*2/ ! CALL X(ARRAY,5) ! END ! SUBROUTINE X(A,N) ! DIMENSION A(N) ! N = 20 ! PRINT *,N,A ! END ! ! the implementation should, when running the program, print something ! like: ! ! 20 2. 2. 2. 2. 2. ! ! Note that this shows that while the value of N was successfully ! changed, the size of the A array remained at 5 elements. ! ! To support this, g77 generates code that executes before any user ! code (and before the internally generated computed GOTO to handle ! alternate entry points, as described below) that evaluates each ! (nonconstant) expression in the list of subscripts for an adjustable ! array, and saves the result of each such evaluation to be used when ! determining the size of the array (instead of re-evaluating the ! expressions). ! ! So, in the above example, when X is first invoked, code is ! executed that copies the value of N to a temporary. And that ! same temporary serves as the actual high bound for the single ! dimension of the A array (the low bound being the constant 1). ! Since the user program cannot (legitimately) change the value ! of the temporary during execution of the procedure, the size ! of the array remains constant during each invocation. ! ! For alternate entry points, the code g77 generates takes into ! account the possibility that the adjustable array is not actually ! passed to the actual entry point being invoked at that time. ! In that case, the public procedure implementing the entry point ! passes to the master private procedure implementing all the ! code for the entry points a NULL pointer where a pointer to that ! adjustable array would be expected. The g77-generated code ! doesn't attempt to evaluate any of the expressions in the subscripts ! for an array if the pointer to that array is NULL at run time in ! such cases. (Don't depend on this particular implementation ! by writing code that purposely passes NULL pointers where the ! callee expects adjustable arrays, even if you know the callee ! won't reference the arrays -- nor should you pass NULL pointers ! for any dummy arguments used in calculating the bounds of such ! arrays or leave undefined any values used for that purpose in ! COMMON -- because the way g77 implements these things might ! well change in the future!) ! ! Subroutines (The SUBROUTINE and ENTRY Statements) ! ------------------------------------------------- ! ! Subroutines with alternate returns (e.g. "SUBROUTINE X(*)" and ! "CALL X(*50)") are implemented by g77 as functions returning ! the C `int' type. The actual alternate-return arguments are ! omitted from the calling sequence. Instead, the caller uses ! the return value to do a rough equivalent of the Fortran ! computed-GOTO statement, as in "GOTO (50), X()" in the ! example above (where X is quietly declared as an INTEGER ! function), and the callee just returns whatever integer ! is specified in the RETURN statement for the subroutine ! (e.g. "RETURN 1" is implemented as "X = 1" followed by "RETURN" ! in C, and "RETURN" by itself is "X = 0" and "RETURN"). ! ! Functions (The FUNCTION and ENTRY Statements) ! --------------------------------------------- ! ! g77 handles in a special way functions that return the following ! types: ! ! - CHARACTER ! - COMPLEX (and DOUBLE COMPLEX) ! - REAL ! ! For CHARACTER, g77 implements a subroutine (a C function returning `void') ! with two arguments prepended: `__g77_result', which the caller passes ! as a pointer to a `char' array expected to hold the return value, ! and `__g77_length', which the caller passes as an `ftnlen' value ! specifying the length of the return value as declared in the calling ! program. For CHARACTER*(*), the called function uses `__g77_length' ! to determine the size of the array that `__g77_result' points to; ! otherwise, it ignores that argument. ! ! For COMPLEX and DOUBLE COMPLEX, when -ff2c is in force, g77 implements ! a subroutine with one argument prepended: `__g77_result', which the ! caller passes as a pointer to a variable of the type of the function. ! The called function writes the return value into this variable instead ! of returning it as a function value. When -fno-f2c is in force, ! g77 implements gcc's `__complex__ float /* or double */' function, ! returning the result of the function in the same way as gcc would. ! ! For REAL, when -ff2c is in force, g77 implements a function that actually ! returns DOUBLE PRECISION (usually C's `double' type). When -fno-f2c ! is in force, REAL functions return `float'. ! ! Common Blocks (The COMMON Statement) ! ------------------------------------ ! ! g77 names and lays out COMMON areas the same way f2c does, ! for compatibility with f2c. ! ! Currently, g77 does not emit any debugging information for ! items in a COMMON area, due to an apparent bug in the GBE. ! ! Moreover, g77 will implement a COMMON area such that its ! type will be an array of the C `char' data type. ! ! So, when debugging, you must know the offset into a COMMON area ! for a particular item in that area, and you have to take into ! account the appropriate multiplier for the respective sizes ! of the types (as declared in your code) for the items preceding ! the item in question as compared to the size of the `char' type. ! ! For example, using default implicit typing, the statement ! ! COMMON I(15),R(20),T ! ! will result in a public 144-byte `char' array named `_BLNK__' ! with I placed at _BLNK__[0], R at _BLNK__[60], and T at ! _BLNK__[140]. (This is assuming that the target machine for ! the compilation has 4-byte INTEGER and REAL types.) ! ! Local Equivalence Areas (The EQUIVALENCE Statement) ! --------------------------------------------------- ! ! g77 treats equivalence areas involving a COMMON block as explained ! in the section on common blocks. ! ! A local EQUIVALENCE area is a collection of variables and arrays ! connected to each other in any way via EQUIVALENCE, none of which are ! listed in a COMMON statement. ! ! Currently, g77 does not emit any debugging information for ! items in a local EQUIVALENCE area, due to an apparent bug in the GBE. ! ! Moreover, g77 will implement a local EQUIVALENCE area such that its ! type will be an array of the C `char' data type. ! ! The name g77 gives this array of `char' type is `__g77_equiv_X', ! where X is the name of the first item listed in the EQUIVALENCE ! statements for that area that is placed at the beginning (offset 0) ! of this array. ! ! When debugging, you must therefore access members of EQUIVALENCE ! areas by specifying the appropriate __g77_equiv_X array section with ! the appropriate offset. See the explanation of debugging COMMON blocks ! for info applicable to debugging local EQUIVALENCE areas. ! ! (NOTE: g77 version 0.5.16 fixed a bug in how certain EQUIVALENCE cases ! were handled. The bug caused the debugger to not know the size of the ! array if any variable or array in the EQUIVALENCE was given an initial ! value via DATA or similar.) ! ! Alternate Entry Points (The ENTRY Statement) ! -------------------------------------------- ! ! The GNU Back End (GBE) does not understand the general concept of ! alternate entry points as Fortran provides via the ENTRY statement. ! g77 gets around this by using an approach to compiling procedures ! having at least one ENTRY statement that is almost identical to the ! approach used by f2c. (An alternate approach could be used that ! would probably generate faster, but larger, code that would also ! be a bit easier to debug.) ! ! Information on how g77 implements ENTRY is provided for those ! trying to debug such code. The choice of implementation seems ! unlikely to affect code (compiled in other languages) that interfaces ! to such code. ! ! g77 compiles exactly one public procedure for the primary entry ! point of a procedure plus each ENTRY point it specifies, as usual. ! That is, in terms of the public interface, there is no difference ! between ! ! SUBROUTINE X ! END ! SUBROUTINE Y ! END ! ! and: ! ! SUBROUTINE X ! ENTRY Y ! END ! ! The difference between the above two cases lies in the code compiled ! for the X and Y procedures themselves, plus the fact that for the ! second case an extra internal procedure is compiled. ! ! For every Fortran procedure with at least one ENTRY statement, g77 ! compiles an extra procedure named `__g77_masterfun_X', where X is ! the name of the primary entry point (which, in the above case, ! using the standard compiler options, would be `x'). ! ! This extra procedure is compiled as a private procedure -- that is, ! a procedure not accessible by name to separately compiled modules. ! It contains all the code in the program unit, including the code ! for the primary entry point plus for every entry point. (The code ! for each public procedure is quite short, and explained later.) ! ! The extra procedure has some other interesting characteristics. ! ! The argument list for this procedure is invented by g77. It contains ! a single integer argument named `__g77_which_entrypoint', ! passed by value (as in Fortran's %VAL() intrinsic), specifying the ! entry point index -- 0 for the primary entry point, 1 for the ! first entry point (the first ENTRY statement encountered), 2 for ! the second entry point, and so on. ! ! It also contains, for functions returning CHARACTER and (when -ff2c ! is in effect) COMPLEX functions, and for functions returning ! different types among the ENTRY statements (e.g. REAL FUNCTION R() ! containing ENTRY I()), an argument named `__g77_result' that ! is expected at run time to contain a pointer to where to store ! the result of the entry point. For CHARACTER functions, this ! storage area is an array of the appropriate number of characters; ! for COMPLEX functions, it is the appropriate area for the return ! type (currently either COMPLEX or DOUBLE COMPLEX); for multiple- ! return-type functions, it is a union of all the supported return ! types (which cannot include CHARACTER, since combining CHARACTER ! and non-character return types via ENTRY in a single function ! is not supported by g77). ! ! For CHARACTER functions, the `__g77_result' argument is followed ! by yet another argument named `__g77_length' that, at run time, ! specifies the caller's expected length of the returned value. ! Note that only CHARACTER*(*) functions and entry points actually ! make use of this argument, even though it is always passed by ! all callers of public CHARACTER functions (since the caller does not ! generally know whether such a function is CHARACTER*(*) or whether ! there are any other callers that don't have that information). ! ! The rest of the argument list is the union of all the arguments ! specified for all the entry points (in their usual forms, e.g. ! CHARACTER arguments have extra length arguments, all appended at ! the end of this list). This is considered the "master list" of ! arguments. ! ! The code for this procedure has, before the code for the first ! executable statement, code much like that for the following Fortran ! statement: ! ! GOTO (100000,100001,100002), __g77_which_entrypoint ! 100000 ...code for primary entry point... ! 100001 ...code immediately following first ENTRY statement... ! 100002 ...code immediately following second ENTRY statement... ! ! (Note that invalid Fortran statement labels and variable names ! are used in the above example to highlight the fact that it ! represents code generated by the g77 internals, not code to be ! written by the user.) ! ! It is this code that, when the procedure is called, picks which ! entry point to start executing. ! ! Getting back to the public procedures (X and Y in the original ! example), those procedures are fairly simple. Their interfaces ! are just like they would be if they were self-contained procedures ! (without ENTRY), of course, since that is what the callers ! expect. Their code consists of simply calling the private ! procedure, described above, with the appropriate extra arguments ! (the entry point index, and perhaps a pointer to a multiple-type- ! return variable, local to the public procedure, that contains ! all the supported returnable non-character types). For arguments ! that are not listed for a given entry point that are listed for ! other entry points, and therefore that are in the "master list" ! for the private procedure, null pointers (in C, the NULL macro) ! are passed. Also, for entry points that are part of a multiple-type- ! returning function, code is compiled after the call of the private ! procedure to extract from the multi-type union the appropriate result, ! depending on the type of the entry point in question, returning ! that result to the original caller. ! ! When debugging a procedure containing alternate entry points, you ! can either set a break point on the public procedure itself (e.g. ! a break point on X or Y) or on the private procedure that ! contains most of the pertinent code (e.g. __g77_masterfun_x). ! If you do the former, you should use the debugger's command to ! "step into" the called procedure to get to the actual code; with ! the latter approach, the break point leaves you right at the ! actual code, skipping over the public entry point and its call ! to the private procedure (unless you have set a break point there ! as well, of course). ! ! Further, the list of dummy arguments that is visible when the ! private procedure is active is going to be the expanded version ! of the list for whichever particular entry point is active, ! as explained above, and the way in which return values are ! handled might well be different from how they would be handled ! for an equivalent single-entry FUNCTION. ! ! Assigned Statement Labels (The ASSIGN and GOTO Statements) ! ---------------------------------------------------------- ! ! For portability to machines where a pointer (such as to a label, ! which is how g77 implements ASSIGN and its cousin, the assigned ! GOTO) is wider (bitwise) than an INTEGER, g77 does not use ! the same memory location to hold the ASSIGNed value of an variable ! as it does the numerical value in that variable. ! ! In particular, while g77 will implement ! ! I = 10 ! ! as, in C notation, "i = 10;", it will implement ! ! ASSIGN 10 TO I ! ! as, in GNU's extended C notation (for the label syntax), ! "__g77_ASSIGN_I = &&L10;" (where L10 is just a massaging ! of the Fortran label 10 to make the syntax C-like; g77 doesn't ! actually generate the name "L10" or any other name like that, ! since debuggers cannot access labels anyway). ! ! While this currently means that an ASSIGN statement will not ! overwrite the numeric contents of its target variable, _do not_ ! write any code depending on this feature. g77 might well ! change this implementation in a future version. This ! information is provided only to make debugging Fortran programs ! compiled with the current version of g77 somewhat easier. diff -rcp2N g77-0.5.15/f/INSTALL g77-0.5.16/f/INSTALL *** g77-0.5.15/f/INSTALL Fri Apr 28 05:35:09 1995 --- g77-0.5.16/f/INSTALL Mon Aug 28 09:41:25 1995 *************** *** 1,3 **** ! This file documents the installation of the GNU Fortran compiler. Copyright (C) 1995 Free Software Foundation, Inc. You may copy, distribute, and modify it freely as long as you preserve this copyright --- 1,3 ---- ! This file describes the installation of the GNU Fortran compiler. Copyright (C) 1995 Free Software Foundation, Inc. You may copy, distribute, and modify it freely as long as you preserve this copyright *************** notice and permission notice. Contribut *** 5,169 **** (burley@gnu.ai.mit.edu). ! 950428 ! Here are the steps that seem important to take before doing any builds: ! 1. The g77 sources are intended to live in a subdirectory "f" of a ! gcc source tree. For example, the g77 sources for g77-2.6.3-0.5.14 ! are intended to have names such as gcc-2.6.3/f/proj.h. Ensure ! that you have a gcc source tree with an "f" directory containing ! the g77 sources (such as this file, named INSTALL). ! ! 2. Read the file f/gbe/README, if it exists, and apply the appropriate ! patch file for the version of the GNU CC compiler you have, if ! that exists. If the directory exists but the appropriate file ! does not exist, it is possible all the necessary patches to the ! GNU compiler's common back end have been integrated into the ! release you are using -- or, perhaps you are using a release that ! is in advance of the release corresponding to the version of g77 ! you have. If the information in f/gbe/README doesn't provide ! adequate information, the latter is more likely, and you should ! contact g77 and/or gcc maintainers for information on necessary ! back-end patches. ! ! NOTE: As of 0.5.5, g77's configuration file gcc/f/config-lang.in ! tries to detect whether at least one necessary patch "hunk" has been ! applied and, if not, aborts the configuration with an explanation. ! PLEASE do not try to fool this code by applying just the patch ! hunk it looks for, because then g77 might well appear to build ! and install correctly, and even appear to compile correctly, ! but could easily produce broken code. (If someone does this and ! reports a bug that takes time to track down to this kind of ! incident, g77 developers will have to waste further time ! by adding more code to g77 to ensure all the patches have been ! made, instead of using that time to improve g77! So behave.) ! ! 3. Follow the directions in the INSTALL file in the gcc source ! tree (such as running ./configure, doing "make", and so on -- ! you MUST run ./configure 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!!). ! ! WARNING: If you follow the procedure to build successive "stages" ! and you compare the object files produced by various stages, ! the file f/zzz.o WILL be different. That is because it ! contains a string with an expansion of the __TIME__ macro, ! which expands to the current time of day. It is nothing ! to worry about, since f/zzz.c doesn't contain any actual code. ! ! NOTE: Configuring with the --srcdir argument is only known ! to work with GNU make. Irix5.2 and SunOS4.1 makes definitely ! won't work outside the source directory at present. ! ! ALSO NOTE: The f2c library gets installed in the gcc $(libsubdir) ! directory (see the top-level Makefile). If you already have ! one in $(libdir) (typically /usr/local/lib) that gcc will ! find, it must be consistent with the one that gets built. You ! should probably remove it or install the newly-built one in ! its place. `make install' will check for this situation and ! stop (unless you define the make variable F2CLIBOK -- be ! careful). Similarly, if you intend to compile C code that ! uses f2c.h for linking to g77-compiled code, make sure you ! pick up the one from $(libsubdir)/include, not from ! $(includedir). ! ! ALSO**2 NOTE: If you have gcc 2.6.2 or greater already installed ! on your system, doing ! ! make -k CC=gcc LANGUAGES=f77 g77 install install-libf77 ! ! or, if you already have libf2c.a installed and know you're willing ! to overwrite it, ! ! make -k CC=gcc LANGUAGES=f77 F2CLIBOK=1 g77 install install-libf77 ! ! should suffice to build and install just g77 and gcc, without building ! any of the other GNU compilers. HOWEVER, if this approach fails ! miserably, you should be able to do the installation by following ! the usual gcc installation method. (The install-libf77 target ! shouldn't have to be separately specified, but it might need to be ! when using non-GNU versions of make. We don't know why this is, ! yet.) Using the "-k" option makes it easy to get around installation ! problems like not having makeinfo installed on your system, and the ! "g77" target ensures that the g77 command driver is built and thus ! installed. ! ! ALSO**3 NOTE: The "bootstrap" target in gcc's Makefile doesn't ! quite work right for subdirectory-resident languages in all cases. ! The solution is to do the stages by hand, and put absolute, not ! relative, pathnames in the definition for CC. ! ! ALSO**4 NOTE: It seems that building g77 might require bison and ! makeinfo to be installed. g77 itself has no need for these, but ! other portions of gcc might, so before you start building gcc or ! g77, make sure bison and makeinfo are installed. ! ! IF YOU CANNOT INSTALL bison: make sure you start with a _fresh_ ! distribution of gcc 2.6.2 or 2.6.3, do _not_ do "make realclean", ! and to be safe, type these commands to convince make not to try ! rebuilding them from the bison input files: ! ! cd gcc-2.6.2 # or 2.6.3 ! touch bi-parser.c bi-parser.h c-parse.c c-parse.h cexp.c ! touch cp/parse.c cp/parse.h objc-parse.c ! ! IF YOU CANNOT INSTALL makeinfo: either use the -k option when ! invoking make to specify the install or install-libf77 targets, ! or specify "MAKEINFO=echo" on the make command line. If you fail ! to do one of these, some things like libf2c.a will fail to be ! installed after the attempt to use makeinfo fails. ! ! ALSO**5 NOTE: The g77 author uses the "-Wall" option when ! compiling the code in gcc/f/*.c, so you should feel free to use ! that option if you work on that code. There are still a couple ! of warnings emitted, but they have been verified as inconsequential. ! There are some prototype declarations in gcc/f/com.h that get ! around the lack of them in the back-end code in gcc/*.c, but ! turning on strict checking of prototypes and such has not yet ! been tried. ! ! ALSO**6 NOTE: g77 currently requires GNU C, not just ANSI C, to ! build it. This is expected to be fixed in 0.6. If you use a ! non-GNU C compiler, syntax errors are likely to be reported for ! source files like gcc/f/expr.c. ! ! ALSO**7 NOTE: g77 _does_ require a working ANSI C environment ! to build it. In particular, some systems are missing strtoul(), ! bsearch(), etc in their libraries. See gcc/f/proj.h for information ! on how to temporarily work around the bugs on these systems. ! (These are emphatically _not_ g77 bugs. DO NOT REPORT THEM ! TO THE g77 AUTHOR!!!) ! ! Remember to look through f/BUGS and f/PROJECTS carefully to get an idea ! of where g77 is in terms of meeting various needs and having various features, ! and what seems important to do right away vs. later. Feel free to ! suggest changes in that list as indicated in the file. ! ! Bug reporting: For now, send email to fortran@gnu.ai.mit.edu. Include ! information on your configuration (output of "sh config.status" in gcc/), ! version numbers of gcc and g77, and whatever else you can think of. ! IMPORTANT ABOUT BUG REPORTING: We are completely unable to guess at ! the kind of response g77 will receive at this time. In case we are ! swamped with bug reports, comments, &c., please don't be too concerned ! if we don't respond to bug reports in any way. We'll certainly save ! everything we get, and try to prioritize and address everything, but ! actually responding to email, while we think it's generally a great ! idea, might conceivably have to be suspended if there is too much other ! work to do. ! ! NOTE: g77 sources (the FFE, in particular) require compiling using a Standard ! (ANSI) C compiler and libraries. You might be able to get around the lack ! of Standard C libraries (especially system header files that don't conform), ! but don't even try to build g77 without a Standard C compiler. The FFE ! uses prototypes and all sorts of other stuff (Standard C preprocessor ! features, concatenation of neighboring constant strings, etc), and you won't ! be productive if you try to "clean" that stuff out of the FFE. (The ! FFE will be brought more into line with GNU Coding Guidelines, but that ! work will _not_ include lowering the code to K&R C.) (Also note that, ! temporarily, g77 in fact requires _GNU_ C, not just ANSI C.) ! ! Your help testing g77 is greatly appreciated...and remember, ! you should feel free to help not only with testing, debugging, ! fixing, and coding, but with documentation and installation notes ! as well! --- 5,347 ---- (burley@gnu.ai.mit.edu). ! 1995-08-22 ! Please read all of this information before configuring, building, ! and installing g77. ! Contents: ! *BUILDING GNU FORTRAN* ! *BUILDING BINARIES FOR DISTRIBUTION* ! *OBSCURE CONFIGURATION INFORMATION* ! ! *BUILDING GNU FORTRAN* ! ! 1. The g77 sources are intended to live in a subdirectory "f" of a ! gcc source tree. For example, the g77 sources for g77-2.6.3-0.5.14 ! are intended to have names such as gcc-2.6.3/f/proj.h. Ensure ! that you have a gcc source tree with an "f" directory containing ! the g77 sources (such as this file, named INSTALL). ! ! Please use only gcc and g77 source trees as distributed by the FSF. ! Use of modified versions, such as the Pentium-specific-optimization ! port of gcc, is likely to result in problems that appear to be ! in the g77 code but in fact is 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. ! ! 2. Read the file f/gbe/README, if it exists, and apply the appropriate ! patch file for the version of the GNU CC compiler you have, if ! that exists. If the directory exists but the appropriate file ! does not exist, you are using either too old a release, or one that ! is in advance of the release corresponding to the version of g77 ! you have. If the information in f/gbe/README doesn't provide ! adequate information, the latter is more likely, and you should wait ! for a new release of g77 that provides explicit support for the ! new version. Note that a new version of gcc that differs only ! in the third field from a version g77 already supports is likely ! to be well-supported by g77 using that supported version. So, ! for example, if g77 has support for versions 2.7.0 and 2.7.1, it ! is likely that gcc-2.7.2 would work well with g77 by using the ! 2.7.1 patch file provided with g77 (aside from some offsets ! reported by `patch'). However, gcc-2.8.0 would almost certainly ! not work with that version of g77 no matter which patch file was ! used, so a new version of g77 would be needed (and you should ! wait for it rather than bothering the author!). ! ! NOTE: g77's configuration file gcc/f/config-lang.in tries to ! detect whether at least one necessary patch "hunk" has been ! applied and, if not, aborts the configuration with an explanation. ! PLEASE do not try to fool this code by applying just the patch ! hunk it looks for, because then g77 might well appear to build ! and install correctly, and even appear to compile correctly, ! but could easily produce broken code. (If someone does this and ! reports a bug that takes time to track down to this kind of ! incident, g77 developers will have to waste further time ! by adding more code to g77 to ensure all the patches have been ! made, instead of using that time to improve g77! So behave.) ! ! ALSO NOTE: If you don't have `patch', you can obtain it from ! the usual GNU distribution sites. You can also apply the ! patches by hand -- patch files were originally designed for ! humans to read them, because the tool that creates them, ! `diff', existed before `patch'. `diff -rcp2N' is typically ! used to create the patch files, if that helps. ! ! 3. Decide whether you want installation of g77 to also install ! an `f77' command. On systems with a native f77, this is not ! normally desired, so g77 as shipped does not do this. ! ! If you want `f77' installed, create the file `f77-install-ok' ! (e.g. via the UNIX command `touch f77-install-ok') in the ! source or build top-level directory (the same directory in ! which the g77 `f' directory resides, not the `f' directory ! itself), or edit gcc/f/Make-lang.in and change the definition ! of the F77_INSTALL_FLAG macro appropriately. ! ! When you enable installation of `f77', either a link to or a ! direct copy of the `g77' command is made. No attempt is made ! to install a program (like a shell script) that provides ! compatibility with any other f77 programs. ! ! Note that invoking the `uninstall' target also tests this ! macro/file at that time to determine whether to delete the ! installed copy of `f77'. ! ! 4. Decide how installation of g77 should affect any existing installation ! of f2c on your system. ! ! If you do not have f2c on your system (e.g. no /usr/bin/f2c, no ! /usr/include/f2c.h, and no /usr/lib/libf2c.a, /usr/lib/libF77.a, ! or /usr/lib/libI77.a), you don't need to be concerned with this ! item. ! ! If you do have f2c on your system, you need to decide how users ! of f2c will be affected by your installing g77. Since g77 is ! currently designed to be object-code-compatible with f2c (with ! very few, clear exceptions), users of f2c might want to combine ! f2c-compiled object files with g77-compiled object files in a ! single executable. ! ! To do this, users of f2c should use the same copies of f2c.h and ! libf2c.a that g77 uses (and that get built as part of g77). ! ! If you do nothing here, the g77 installation process will not ! overwrite the include/f2c.h and lib/libf2c.a files with its ! own versions, and in fact will not even install libf2c.a for use ! with the newly installed versions of gcc and g77 if it sees ! that lib/libf2c.a exists -- instead, it will print an explanatory ! message and skip this part of the installation. ! ! To install g77's versions of f2c.h and libf2c.a in the appropriate ! places, create the file `f2c-install-ok' (e.g. via the UNIX ! command `touch f2c-install-ok') in the source or build top-level ! directory (the same directory in which the g77 `f' directory ! resides, not the `f' directory itself), or edit gcc/f/Make-lang.in ! and change the definition of the F2C_INSTALL_FLAG macro appropriately. ! ! Make sure that when you enable the overwriting of f2c.h and libf2c.a ! as used by f2c, you have a recent and properly configured version of ! bin/f2c so that it generates code that is compatible with g77. ! ! If you don't want installation of g77 to overwrite f2c's existing ! installation, but you do want g77 installation to proceed with ! installation of its own versions of f2c.h and libf2c.a in places ! where gcc/g77 will pick them up (even when linking f2c-compiled ! object files -- which might lead to incompatibilities), create ! the file `f2c-exists-ok' (e.g. via the UNIX command ! `touch f2c-exists-ok') in the source or build top-level directory, ! or edit gcc/f/Make-lang.in and change the definition of the ! F2CLIBOK macro appropriately. ! ! 5. Follow the directions in the INSTALL file in the gcc source ! tree (such as running ./configure, doing "make ...", and so on -- ! you MUST run ./configure 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!!). ! ! Because the `gcc' command is necessarily modified by the GNU ! Fortran patches, so that it recognizes Fortran source files, ! make sure the configuration you select will result in the ! proper installation of `gcc'. For example, if `gcc' ! lives in `/usr/bin/gcc' on your system, you have to make sure ! installation of GNU Fortran causes that old version of `gcc' ! to get overwritten by the new one, by doing: ! ! ./configure --prefix=/usr ! ! You might want to back up your existing copy of `bin/gcc', and ! perhaps even the entire `lib/gcc-lib' directory, first. These ! typically are found in `/usr' or `/usr/local'. 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 /dev/null -xc /dev/null -xnone ! ! Just building GNU Fortran should not overwrite any installed ! programs -- but obviously after you build g77, you will want ! to install it, so backing up anything it might overwrite is ! a good idea (for any package, not just g77, though in this case ! it is intentional that g77 overwrites gcc if it is already ! installed). ! ! WARNING: If you follow the procedure to build successive "stages" ! and you compare the object files produced by various stages, ! the file f/zzz.o WILL be different. That is because it ! contains a string with an expansion of the __TIME__ macro, ! which expands to the current time of day. It is nothing ! to worry about, since f/zzz.c doesn't contain any actual code. ! This file does allow you to override its use of __DATE__ and ! __TIME__ by defining macros for the compilation -- see the ! source code for details. ! ! NOTE: Configuring with the --srcdir argument is only known ! to work with GNU make. Irix5.2 and SunOS4.1 makes definitely ! won't work outside the source directory at present. g77's ! portion of the `configure' script issues a warning message ! about this (when you configure for building binaries outside ! the source directory). ! ! ALSO NOTE: If you have the appropriate version of gcc ! already installed on your system, doing ! ! make -k CC=gcc LANGUAGES=f77 g77 install ! ! should suffice to build and install just g77 and gcc, without building ! any of the other GNU compilers. HOWEVER, if this approach fails ! miserably, you should be able to do the installation by following ! the usual gcc installation method. (If libf2c.a is not installed ! as expected, try specifying the install-libf77 and install-f2c-all ! targets explicitly. These shouldn't have to be separately specified, ! but might need to be when using non-GNU versions of make. We don't ! know why this is, yet.) Using the "-k" option makes it continue after ! installation problems like not having makeinfo installed on your system, ! and the `g77' target ensures that the g77 command driver is built and ! thus installed. ! ! ALSO**2 NOTE: It seems that building g77 might require bison and ! makeinfo to be installed. g77 itself has no need for these, but ! other portions of gcc might, so before you start building gcc or ! g77, make sure bison and makeinfo are installed. ! ! IF YOU CANNOT INSTALL bison: make sure you start with a _fresh_ ! distribution of gcc, do _not_ do "make realclean", and to be safe, ! type these commands to convince make not to try rebuilding them ! from the bison input files: ! ! cd gcc-2.6.2 # or 2.6.3 ! touch bi-parser.c bi-parser.h c-parse.c c-parse.h cexp.c ! touch cp/parse.c cp/parse.h objc-parse.c ! ! IF YOU CANNOT INSTALL makeinfo: either use the -k option when ! invoking make to specify the install or install-libf77 targets, ! or specify "MAKEINFO=echo" on the make command line. If you fail ! to do one of these, some things like libf2c.a will fail to be ! installed after the attempt to use makeinfo fails. ! ! ALSO**3 NOTE: Most of gcc/f/*.c is compiled using the `-W -Wall' ! options. There are some prototype declarations in gcc/f/com.h that ! get around the lack of them in the back-end code in gcc/*.c, but ! turning on strict checking of prototypes and such has not yet ! been tried. ! ! ALSO**4 NOTE: g77 currently requires GNU C, not just ANSI C, to ! build it. This is expected to be fixed in 0.6. If you use a ! non-GNU C compiler, syntax errors are likely to be reported for ! source files like gcc/f/expr.c. As of 0.5.16, an explicit ! `#error' directive is used to catch use of a non-gcc compiler ! in a friendlier, self-documenting way. ! ! ALSO**5 NOTE: g77 _does_ require a working ANSI C environment ! to build it. In particular, some systems are missing strtoul(), ! bsearch(), etc in their libraries. See gcc/f/proj.h for information ! on how to temporarily work around the bugs on these systems. ! (These are emphatically _not_ g77 bugs. DO NOT REPORT THEM ! TO THE g77 AUTHOR!!!) ! ! *BUILDING BINARIES FOR DISTRIBUTION* ! ! 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 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. E.g. 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' -- just make an empty file named `f77-install-ok' in ! the source or build directory (the one in which the `f' directory ! resides, not the `f' directory itself) when you specify one of the ! `install' or `uninstall' targets in a `make' command. ! ! For a system that might already have f2c installed, you definitely ! will want to make another empty file (in the same directory) named ! either `f2c-exists-ok' or `f2c-install-ok'. Use the former if you ! don't want your distribution to overwrite f2c-related files in existing ! systems; use the latter 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. ! ! 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 copy of g77 named `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 not only the `g77' and `f771' ! executables in bin/, plus the `libf2c.a' library in lib/, but ! the new (updated) version of the `gcc' executable in bin/. ! 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, and it is possible ! they'll fix back-end bugs that can be demonstrated using front ! ends other than GNU Fortran's. Please assure users that unless ! their version of the `gcc' command is older than, say, 2.6.2, ! they are unlikely to experience any problems by overwriting ! it with your version -- though they could certainly protect ! themselves by making backup copies first! ! ! Further, PLEASE find a way to include the `gcc/f/DOC' and ! `gcc/f/BUGS' files in your distribution, so users have some way ! to read the documentation. There is a `g77.1' file for ! installation in man/, but this is incredibly incomplete. There ! is plenty of room for improvement in g77 documentation, but ! at least the DOC and BUGS files have important information even ! though in a primitive form (straight text). If you can help out ! the GNU Fortran project by converting these files (plus this ! one, INSTALL) into canonical GNU documentation formats (.texi, ! info, whatever), please offer this to `fortran@gnu.ai.mit.edu'. ! ! 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. ! `fortran@gnu.ai.mit.edu' has received a fair amount 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. ! ! *OBSCURE CONFIGURATION INFORMATION* ! ! g77 now, on most machines, puts more 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). ! ! The g77 build will crash if an attempt is made to build it as a cross-compiler ! for a target when g77 cannot reliably determine the bit pattern of ! floating-point constants for the target. Planned improvements for g77-0.6 ! will give it the capabilities it needs to not have to crash the build ! but rather generate correct code for the target. (Currently, g77 ! would generate bad code under such circumstances if it didn't crash ! during the build, e.g. when compiling a source file that does ! something like EQUIVALENCE (I,R) and DATA R/3.1415926535/.) ! ! A warning message is issued when g77 sees code that provides ! initial values (e.g. via DATA) to an aggregate area (COMMON or ! EQUIVALENCE, or even a large enough array or CHARACTER variable) ! that is large enough to increase g77's compile time by roughly ! a factor of 10. This size is currently quite small, since g77 ! currently has a known bug (see f/BUGS) requiring too much memory ! and time to handle such cases. See f/data.c macro ! FFEDATA_sizeTOO_BIG_INIT_ for the minimum size (in storage units, ! which can be bytes, words, or whatever, on a case-by-case basis). ! ! As of 0.5.16, g77 warns when it is used to compile Fortran code ! for a target configuration that is not basically a 32-bit ! machine (e.g. an Alpha). This is because g77 is known to not work ! properly on such configurations. This is expected to be fixed ! at 0.6, at which point the warning would be dropped. diff -rcp2N g77-0.5.15/f/Make g77-0.5.16/f/Make *** g77-0.5.15/f/Make Wed Feb 15 16:58:42 1995 --- g77-0.5.16/f/Make Wed Aug 30 15:53:38 1995 *************** *** 17,21 **** #You should have received a copy of the GNU General Public License #along with GNU Fortran; see the file COPYING. If not, write to ! #the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. objs=\ --- 17,22 ---- #You should have received a copy of the GNU General Public License #along with GNU Fortran; see the file COPYING. If not, write to ! #the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! #02111-1307, USA. objs=\ diff -rcp2N g77-0.5.15/f/Make-lang.in g77-0.5.16/f/Make-lang.in *** g77-0.5.15/f/Make-lang.in Fri Apr 28 05:42:31 1995 --- g77-0.5.16/f/Make-lang.in Wed Aug 30 15:53:38 1995 *************** *** 1,3 **** ! # Top level makefile fragment for GNU C++. # Copyright (C) 1995 Free Software Foundation, Inc. --- 1,3 ---- ! # Top level makefile fragment for GNU Fortran. # Copyright (C) 1995 Free Software Foundation, Inc. *************** *** 16,20 **** #You should have received a copy of the GNU General Public License #along with GNU Fortran; see the file COPYING. If not, write to ! #the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. # This file provides the language dependent support in the main Makefile. --- 16,21 ---- #You should have received a copy of the GNU General Public License #along with GNU Fortran; see the file COPYING. If not, write to ! #the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! #02111-1307, USA. # This file provides the language dependent support in the main Makefile. *************** *** 25,30 **** # foo.install-normal, foo.install-common, foo.install-info, foo.install-man, # foo.uninstall, foo.distdir, ! # foo.mostlyclean, foo.clean, foo.distclean, foo.extraclean, foo.realclean, ! # foo.stage1, foo.stage2, foo.stage3, foo.stage4 # # where `foo' is the name of the language. --- 26,31 ---- # foo.install-normal, foo.install-common, foo.install-info, foo.install-man, # foo.uninstall, foo.distdir, ! # foo.mostlyclean, foo.clean, foo.distclean, foo.extraclean, ! # foo.maintainer-clean, foo.stage1, foo.stage2, foo.stage3, foo.stage4 # # where `foo' is the name of the language. *************** *** 32,36 **** # It should also provide rules for: # ! # - making any compiler driver (eg: g++) # - the compiler proper (eg: f771) # - define the names for selecting the language in LANGUAGES. --- 33,37 ---- # It should also provide rules for: # ! # - making any compiler driver (eg: g77) # - the compiler proper (eg: f771) # - define the names for selecting the language in LANGUAGES. *************** F77_FLAGS_TO_PASS = \ *** 65,75 **** # "F77_FOR_TARGET=$(F77_FOR_TARGET)" # Actual names to use when installing a native compiler. ! # F77_INSTALL_NAME = f77 ! G77_INSTALL_NAME = g77 # Actual names to use when installing a cross-compiler. ! F77_CROSS_NAME = $(target)-f77 ! G77_CROSS_NAME = $(target)-g77 --- 66,94 ---- # "F77_FOR_TARGET=$(F77_FOR_TARGET)" + # This flag controls whether to install (overwrite) f77 on this system, + # and also whether to uninstall it when using the uninstall target. + # As shipped, the flag is a test of whether the `f77_install_ok' + # flag exists in the build or source directories (top level), but + # you can just change it here if you like. + F77_INSTALL_FLAG = [ -f f77-install-ok -o -f $(srcdir)/f77-install-ok ] + + # This flag is similar to F77_INSTALL_FLAG, but controls whether + # to install (ovewrite) f2c-related items on this system. Currently + # these are `include/f2c.h' and `lib/libf2c.a', though at some point + # `bin/f2c' itself might be added to the g77 distribution. + F2C_INSTALL_FLAG = [ -f f2c-install-ok -o -f $(srcdir)/f2c-install-ok ] + + # This flag controls whether it is safe to install gcc's libf2c.a + # even when there's already a lib/libf2c.a installed (which, unless + # F2C_INSTALL_FLAG is set, will be left alone). + F2CLIBOK = [ -f f2c-exists-ok -o -f $(srcdir)/f2c-exists-ok ] + # Actual names to use when installing a native compiler. ! F77_INSTALL_NAME = `t='$(program_transform_name)'; echo f77 | sed $$t` ! G77_INSTALL_NAME = `t='$(program_transform_name)'; echo g77 | sed $$t` # Actual names to use when installing a cross-compiler. ! F77_CROSS_NAME = `t='$(program_transform_cross_name)'; echo f77 | sed $$t` ! G77_CROSS_NAME = `t='$(program_transform_cross_name)'; echo g77 | sed $$t` *************** G77_CROSS_NAME = $(target)-g77 *** 80,90 **** F77 f77: f771 f77-runtime # Create the compiler driver for g77. g77: $(srcdir)/f/g77.c $(CONFIG_H) $(LIBDEPS) ! $(CC) $(ALL_CFLAGS) $(INCLUDES) $(LDFLAGS) -o g77 $(srcdir)/f/g77.c $(LIBS) # Create a version of the g77 driver which calls the cross-compiler. ! g77-cross: $(srcdir)/f/g77.c ! $(CC) $(ALL_CFLAGS) $(INCLUDES) $(LDFLAGS) -o g77-cross \ -DGCC_NAME=\"$(GCC_CROSS_NAME)\" $(srcdir)/f/g77.c version.o $(LIBS) --- 99,118 ---- F77 f77: f771 f77-runtime + # Tell GNU make to ignore these if they exist. + .PHONY: F77 f77 f77-runtime f77-runtime-unsafe f77.all.build f77.all.cross \ + f77.start.encap f77.rest.encap f77.info f77.dvi maybe-f2c \ + f77.install-normal install-libf77 install-f2c-all install-f2c-header \ + install-f2c-lib f77.install-common f77.install-info f77.install-man \ + f77.uninstall f77.mostlyclean f77.clean f77.distclean f77.extraclean \ + f77.maintainer-clean f77.realclean f77.stage1 f77.stage2 f77.stage3 \ + f77.stage4 f77.distdir + # Create the compiler driver for g77. g77: $(srcdir)/f/g77.c $(CONFIG_H) $(LIBDEPS) ! $(CC) $(ALL_CFLAGS) $(INCLUDES) $(LDFLAGS) -o $@ $(srcdir)/f/g77.c $(LIBS) # Create a version of the g77 driver which calls the cross-compiler. ! g77-cross: $(srcdir)/f/g77.c version.o $(LIBDEPS) ! $(CC) $(ALL_CFLAGS) $(INCLUDES) $(LDFLAGS) -o $@ \ -DGCC_NAME=\"$(GCC_CROSS_NAME)\" $(srcdir)/f/g77.c version.o $(LIBS) *************** F77_SRCS = \ *** 118,121 **** --- 146,150 ---- $(srcdir)/f/implic.c \ $(srcdir)/f/implic.h \ + $(srcdir)/f/input.j \ $(srcdir)/f/info-b.def \ $(srcdir)/f/info-k.def \ *************** F77_SRCS = \ *** 193,197 **** f771: $(P) $(F77_SRCS) $(LIBDEPS) stamp-objlist f/Makefile ! $(MAKE) -f f/Makefile $(FLAGS_TO_PASS) VPATH=$(srcdir) srcdir=$(srcdir)/f f771 f/Makefile: $(srcdir)/f/Makefile.in $(srcdir)/configure --- 222,226 ---- f771: $(P) $(F77_SRCS) $(LIBDEPS) stamp-objlist f/Makefile ! $(MAKE) -f f/Makefile $(FLAGS_TO_PASS) VPATH=$(srcdir) srcdir=$(srcdir)/f f771$(exeext) f/Makefile: $(srcdir)/f/Makefile.in $(srcdir)/configure *************** f77-runtime: f/runtime/Makefile include *** 209,220 **** *f77*) top=`pwd`; \ cd f/runtime && $(MAKE) \ ! GCC_FOR_TARGET="`case '$(GCC_FOR_TARGET)' in \ ! './xgcc -B./') echo $${top}/xgcc -B$${top}/;; \ ! *) echo '$(GCC_FOR_TARGET)';; esac`" \ ! GCC_FLAGS="$(GCC_FLAGS)" $(F77_FLAGS_TO_PASS) \ ! all ;; \ ! esac ! # This one doesn't depend on cc1 etc. but f2c.h may not be found, # in particular, at present... f77-runtime-unsafe: --- 238,249 ---- *f77*) top=`pwd`; \ cd f/runtime && $(MAKE) \ ! GCC_FOR_TARGET="`case '$(GCC_FOR_TARGET)' in \ ! './xgcc -B./') echo $${top}/xgcc -B$${top}/;; \ ! *) echo '$(GCC_FOR_TARGET)';; esac`" \ ! GCC_FLAGS="$(GCC_FLAGS)" $(F77_FLAGS_TO_PASS) \ ! all ;; \ ! esac ! # This one doesn't depend on cc1 etc. but f2c.h may not be found, # in particular, at present... f77-runtime-unsafe: *************** f77-runtime-unsafe: *** 226,241 **** # NB, sh uses the *first* value of $a from `a=fred a=joe prog'. include/f2c.h f/runtime/Makefile: $(srcdir)/f/runtime/f2c.h.in \ ! $(srcdir)/f/com.h f/proj.h \ ! $(srcdir)/f/runtime/Makefile.in $(GCC_PARTS) \ ! $(srcdir)/config/$(xmake_file) $(srcdir)/config/$(tmake_file) # The make "stage?" in compiler spec. is fully qualified as above top=`pwd`; \ src=`cd $(srcdir); pwd`; \ ! cd f/runtime; \ ! CC="`case '$(GCC_FOR_TARGET)' in \ ! './xgcc -B./') echo $${top}/xgcc -B$${top}/;; \ ! *) echo '$(GCC_FOR_TARGET)';; esac`" \ ! $(F77_FLAGS_TO_PASS) CONFIG_SITE=/dev/null $(SHELL) \ ! $${src}/f/runtime/configure --srcdir=$${src}/f/runtime #For now, omit f2c stuff. -- burley --- 255,269 ---- # NB, sh uses the *first* value of $a from `a=fred a=joe prog'. include/f2c.h f/runtime/Makefile: $(srcdir)/f/runtime/f2c.h.in \ ! $(srcdir)/f/com.h f/proj.h $(srcdir)/f/runtime/Makefile.in $(GCC_PARTS) \ ! $(srcdir)/config/$(xmake_file) $(srcdir)/config/$(tmake_file) # The make "stage?" in compiler spec. is fully qualified as above top=`pwd`; \ src=`cd $(srcdir); pwd`; \ ! cd f/runtime; \ ! CC="`case '$(GCC_FOR_TARGET)' in \ ! './xgcc -B./') echo $${top}/xgcc -B$${top}/;; \ ! *) echo '$(GCC_FOR_TARGET)';; esac`" \ ! $(F77_FLAGS_TO_PASS) CONFIG_SITE=/dev/null $(SHELL) \ ! $${src}/f/runtime/configure --srcdir=$${src}/f/runtime #For now, omit f2c stuff. -- burley *************** maybe-f2c: *** 268,272 **** # f771 is installed elsewhere as part of $(COMPILERS). ! f77.install-normal: install-libf77 # Install the F77 run time library. --- 296,300 ---- # f771 is installed elsewhere as part of $(COMPILERS). ! f77.install-normal: install-libf77 install-f2c-all # Install the F77 run time library. *************** install-libf77: f77-runtime *** 274,279 **** # Check for the presence of other versions of the library and includes. # Test libf2c.* in case of a shared version, for instance. ! @if test "`echo $(libdir)/libf2c.*`" != "$(libdir)/libf2c.*" && \ ! test -z "$(F2CLIBOK)" ; then \ echo ; \ echo 'You already have a version of libf2c installed as' $(libdir)/libf2c.*; \ --- 302,308 ---- # Check for the presence of other versions of the library and includes. # Test libf2c.* in case of a shared version, for instance. ! @if test -z "$(F2CLIBOK)" && \ ! test -z "$(F2C_INSTALL_FLAG)" && \ ! test "`echo $(libdir)/libf2c.*`" != "$(libdir)/libf2c.*"; then \ echo ; \ echo 'You already have a version of libf2c installed as' $(libdir)/libf2c.*; \ *************** install-libf77: f77-runtime *** 296,313 **** else true; fi # Install the driver program as $(target)-g77 # and also as either g77 (if native) or $(tooldir)/bin/g77. f77.install-common: ! -if [ -f f771 ] ; then \ ! if [ -f g77-cross ] ; then \ ! rm -f $(bindir)/$(G77_CROSS_NAME); \ ! $(INSTALL_PROGRAM) g77-cross $(bindir)/$(G77_CROSS_NAME); \ ! chmod a+x $(bindir)/$(G77_CROSS_NAME); \ ! rm -f $(bindir)/$(F77_CROSS_NAME); \ ! ln $(bindir)/$(G77_CROSS_NAME) $(bindir)/$(F77_CROSS_NAME); \ else \ ! rm -f $(bindir)/$(G77_INSTALL_NAME); \ ! $(INSTALL_PROGRAM) g77 $(bindir)/$(G77_INSTALL_NAME); \ ! chmod a+x $(bindir)/$(G77_INSTALL_NAME); \ fi ; \ else true; fi --- 325,371 ---- else true; fi + # Install the f2c-related stuff in the directories + # where f2c and vanilla ld might look for them. + + install-f2c-all: install-f2c-header install-f2c-lib + + install-f2c-header: + -if test -n "$(F2C_INSTALL_FLAG)" && test -f include/f2c.h; then \ + $(INSTALL_DATA) include/f2c.h $(includedir)/f2c.h; \ + chmod a+r $(includedir)/f2c.h; \ + else true; fi + + install-f2c-lib: + -if test -n "$(F2C_INSTALL_FLAG)" && test -f libf2c.a; then \ + $(INSTALL_DATA) libf2c.a $(libdir)/libf2c.a; \ + if $(RANLIB_TEST) ; then \ + (cd $(libdir); $(RANLIB) libf2c.a); else true; fi; \ + chmod a-x $(libdir)/libf2c.a; \ + else true; fi + # Install the driver program as $(target)-g77 # and also as either g77 (if native) or $(tooldir)/bin/g77. f77.install-common: ! -if [ -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); \ ! chmod a+x $(bindir)/$(G77_CROSS_NAME)$(exeext); \ ! if $(F77_INSTALL_FLAG) ; then \ ! rm -f $(bindir)/$(F77_CROSS_NAME)$(exeext); \ ! ln $(bindir)/$(G77_CROSS_NAME)$(exeext) $(bindir)/$(F77_CROSS_NAME)$(exeext) \ ! > /dev/null 2>&1 \ ! || cp $(bindir)/$(G77_CROSS_NAME)$(exeext) $(bindir)/$(F77_CROSS_NAME)$(exeext) ; \ ! fi ; \ else \ ! rm -f $(bindir)/$(G77_INSTALL_NAME)$(exeext); \ ! $(INSTALL_PROGRAM) g77$(exeext) $(bindir)/$(G77_INSTALL_NAME)$(exeext); \ ! chmod a+x $(bindir)/$(G77_INSTALL_NAME)$(exeext); \ ! if $(F77_INSTALL_FLAG) ; then \ ! rm -f $(bindir)/$(F77_INSTALL_NAME)$(exeext); \ ! ln $(bindir)/$(G77_INSTALL_NAME)$(exeext) $(bindir)/$(F77_INSTALL_NAME)$(exeext) \ ! > /dev/null 2>&1 \ ! || cp $(bindir)/$(G77_INSTALL_NAME)$(exeext) $(bindir)/$(F77_INSTALL_NAME)$(exeext) ; \ ! fi ; \ fi ; \ else true; fi *************** f77.install-info: *** 316,330 **** f77.install-man: $(srcdir)/f/g77.1 ! -if [ -f f771 ] ; then \ ! $(INSTALL_DATA) $(srcdir)/f/g77.1 $(mandir)/g77$(manext) ; \ ! chmod a-x $(mandir)/g77$(manext) ; \ else true; fi f77.uninstall: ! -rm -rf $(bindir)/$(F77_CROSS_NAME) ! -rm -rf $(bindir)/$(G77_INSTALL_NAME) ! -rm -rf $(bindir)/$(G77_CROSS_NAME) ! -rm -rf $(mandir)/g77$(manext) -rm -rf $(libsubdir)/libf2c.a # Clean hooks: --- 374,403 ---- f77.install-man: $(srcdir)/f/g77.1 ! -if [ -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: ! -if $(F77_INSTALL_FLAG) ; then \ ! rm -rf $(bindir)/$(F77_INSTALL_NAME)$(exeext) ; \ ! rm -rf $(bindir)/$(F77_CROSS_NAME)$(exeext) ; \ ! fi ! -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 $(libsubdir)/libf2c.a + -if $(F2C_INSTALL_FLAG) ; then \ + rm -rf include/f2c.h ; \ + rm -rf $(libdir)/libf2c.a ; \ + fi # Clean hooks: *************** f77.uninstall: *** 333,337 **** f77.mostlyclean: ! -rm -f f/*.o -cd f/runtime; $(MAKE) mostlyclean f77.clean: f77.mostlyclean --- 406,410 ---- f77.mostlyclean: ! -rm -f f/*$(objext) -cd f/runtime; $(MAKE) mostlyclean f77.clean: f77.mostlyclean *************** f77.distclean: f77.clean *** 340,344 **** -rm -f f/fini f/f771 f/stamp-str f/str-*.h f/str-*.j -cd f/runtime; $(MAKE) distclean ! f77.extraclean f77.realclean: f77.distclean # Stage hooks: --- 413,418 ---- -rm -f f/fini f/f771 f/stamp-str f/str-*.h f/str-*.j -cd f/runtime; $(MAKE) distclean ! # realclean is the pre-2.7.0 name for maintainer-clean ! f77.extraclean f77.maintainer-clean f77.realclean: f77.distclean # Stage hooks: *************** f77.extraclean f77.realclean: f77.distcl *** 345,358 **** # The main makefile has already created stage?/f. ! G77STAGESTUFF = f/*.o f/fini f/stamp-str f/str-*.h f/str-*.j f77.stage1: -mv $(G77STAGESTUFF) stage1/f f77.stage2: -mv $(G77STAGESTUFF) stage2/f f77.stage3: -mv $(G77STAGESTUFF) stage3/f f77.stage4: -mv $(G77STAGESTUFF) stage4/f # Maintenance hooks: --- 419,448 ---- # The main makefile has already created stage?/f. ! G77STAGESTUFF = f/*$(objext) f/fini f/stamp-str f/str-*.h f/str-*.j ! RUNTIMESTAGESTUFF = f/runtime/config.cache f/runtime/config.log \ ! f/runtime/config.status f/runtime/Makefile ! LIBF77STAGESTUFF = f/runtime/libF77/*$(objext) f/runtime/libF77/Makefile ! LIBI77STAGESTUFF = f/runtime/libI77/*$(objext) f/runtime/libI77/Makefile f77.stage1: -mv $(G77STAGESTUFF) stage1/f + -mv $(RUNTIMESTAGESTUFF) stage1/f/runtime + -mv $(LIBF77STAGESTUFF) stage1/f/runtime/libF77 + -mv $(LIBI77STAGESTUFF) stage1/f/runtime/libI77 f77.stage2: -mv $(G77STAGESTUFF) stage2/f + -mv $(RUNTIMESTAGESTUFF) stage2/f/runtime + -mv $(LIBF77STAGESTUFF) stage2/f/runtime/libF77 + -mv $(LIBI77STAGESTUFF) stage2/f/runtime/libI77 f77.stage3: -mv $(G77STAGESTUFF) stage3/f + -mv $(RUNTIMESTAGESTUFF) stage3/f/runtime + -mv $(LIBF77STAGESTUFF) stage3/f/runtime/libF77 + -mv $(LIBI77STAGESTUFF) stage3/f/runtime/libI77 f77.stage4: -mv $(G77STAGESTUFF) stage4/f + -mv $(RUNTIMESTAGESTUFF) stage4/f/runtime + -mv $(LIBF77STAGESTUFF) stage4/f/runtime/libF77 + -mv $(LIBI77STAGESTUFF) stage4/f/runtime/libI77 # Maintenance hooks: diff -rcp2N g77-0.5.15/f/Makefile.in g77-0.5.16/f/Makefile.in *** g77-0.5.15/f/Makefile.in Fri Apr 28 05:46:50 1995 --- g77-0.5.16/f/Makefile.in Wed Aug 30 15:53:38 1995 *************** *** 16,20 **** #You should have received a copy of the GNU General Public License #along with GNU Fortran; see the file COPYING. If not, write to ! #the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. # The makefile built from this file lives in the language subdirectory. --- 16,21 ---- #You should have received a copy of the GNU General Public License #along with GNU Fortran; see the file COPYING. If not, write to ! #the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! #02111-1307, USA. # The makefile built from this file lives in the language subdirectory. *************** *** 39,43 **** ALLOCA = ! # Various ways of specifying flags for compilations: # CFLAGS is for the user to override to, e.g., do a bootstrap with -O2. # BOOT_CFLAGS is the value of CFLAGS to pass --- 40,44 ---- ALLOCA = ! # Various ways of specifying flags for compilations: # CFLAGS is for the user to override to, e.g., do a bootstrap with -O2. # BOOT_CFLAGS is the value of CFLAGS to pass *************** TEXI2DVI = texi2dvi *** 67,71 **** # Define this as & to perform parallel make on a Sequent. ! # Note that this has some bugs, and it seems currently necessary # to compile all the gen* files first by hand to avoid erroneous results. P = --- 68,72 ---- # Define this as & to perform parallel make on a Sequent. ! # Note that this has some bugs, and it seems currently necessary # to compile all the gen* files first by hand to avoid erroneous results. P = *************** tmake_file= ... `configure' substitutes *** 91,95 **** # Directory where sources are, from where we are. ! # Note that this should be overridden when building f771, which happens # at the top level, not in f. Likewise for VPATH (if added). srcdir = . --- 92,96 ---- # Directory where sources are, from where we are. ! # Note that this should be overridden when building f771, which happens # at the top level, not in f. Likewise for VPATH (if added). srcdir = . *************** INTERNAL_CFLAGS = $(CROSS) -DIN_GCC *** 132,136 **** # This is the variable actually used when we compile. ! ALL_CFLAGS = $(INTERNAL_CFLAGS) $(X_CFLAGS) $(T_CFLAGS) $(CFLAGS) $(XCFLAGS) # Likewise. --- 133,137 ---- # This is the variable actually used when we compile. ! ALL_CFLAGS = $(INTERNAL_CFLAGS) $(X_CFLAGS) $(T_CFLAGS) $(CFLAGS) $(XCFLAGS) -W -Wall # Likewise. *************** FLAGS_TO_PASS = \ *** 188,195 **** .c.o: $(CC) -c $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) $< -o $@ - - # This tells GNU make version 3 not to export all the variables - # defined in this file into the environment. - .NOEXPORT: # Lists of files for various purposes. --- 189,192 ---- *************** compiler: f771 *** 244,248 **** # This is now meant to be built in the top level directory, not `f': f771: $(P) f/Makefile $(F77_OBJS) $(OBJDEPS) $(LIBDEPS) ! $(CC) $(ALL_CFLAGS) $(LDFLAGS) $(F771_LDFLAGS) -o f771 \ $(F77_OBJS) $(OBJS) $(LIBS) --- 241,246 ---- # This is now meant to be built in the top level directory, not `f': f771: $(P) f/Makefile $(F77_OBJS) $(OBJDEPS) $(LIBDEPS) ! rm -f ../f771$(exeext) ! $(CC) $(ALL_CFLAGS) $(LDFLAGS) $(F771_LDFLAGS) -o $@ \ $(F77_OBJS) $(OBJS) $(LIBS) *************** f771: $(P) f/Makefile $(F77_OBJS) $(OBJD *** 249,253 **** # Check in case anyone expects to build in this directory: f/Makefile: ! if test ! -f f/Makefile ; \ then echo "Build f771 only at the top level." 2>&1; exit 1; \ else true; fi --- 247,251 ---- # Check in case anyone expects to build in this directory: f/Makefile: ! @if test ! -f f/Makefile ; \ then echo "Build f771 only at the top level." 2>&1; exit 1; \ else true; fi *************** FLAGS_H = $(srcdir)/flags.j $(srcdir)/.. *** 277,280 **** --- 275,279 ---- GLIMITS_H = $(srcdir)/glimits.j $(srcdir)/../glimits.h HCONFIG_H = $(srcdir)/hconfig.j hconfig.h + INPUT_H = $(srcdir)/input.j $(srcdir)/../input.h RTL_H = $(srcdir)/rtl.j $(srcdir)/../rtl.h $(srcdir)/../rtl.def \ $(srcdir)/../machmode.h $(srcdir)/../machmode.def *************** f/lex.o: f/lex.c f/proj.h $(ASSERT_H) f/ *** 354,358 **** f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/lex.h f/type.h \ f/intrin.h f/intrin.def f/lab.h f/symbol.h f/symbol.def f/equiv.h f/storag.h \ ! f/global.h f/name.h f/src.h $(CONFIG_H) f/malloc.o: f/malloc.c f/proj.h $(ASSERT_H) f/malloc.h f/name.o: f/name.c f/proj.h $(ASSERT_H) f/bad.h f/bad.def f/where.h $(GLIMITS_H) \ --- 353,357 ---- f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/lex.h f/type.h \ f/intrin.h f/intrin.def f/lab.h f/symbol.h f/symbol.def f/equiv.h f/storag.h \ ! f/global.h f/name.h f/src.h $(CONFIG_H) $(FLAGS_H) $(INPUT_H) f/malloc.o: f/malloc.c f/proj.h $(ASSERT_H) f/malloc.h f/name.o: f/name.c f/proj.h $(ASSERT_H) f/bad.h f/bad.def f/where.h $(GLIMITS_H) \ *************** f/top.o: f/top.c f/proj.h $(ASSERT_H) f/ *** 454,458 **** f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/lex.h f/type.h \ f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h \ ! f/intrin.h f/intrin.def f/data.h f/expr.h f/implic.h f/src.h f/st.h flags.h f/type.o: f/type.c f/proj.h $(ASSERT_H) f/type.h f/malloc.h f/where.o: f/where.c f/proj.h $(ASSERT_H) f/where.h $(GLIMITS_H) f/top.h f/malloc.h \ --- 453,457 ---- f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/lex.h f/type.h \ f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h \ ! f/intrin.h f/intrin.def f/data.h f/expr.h f/implic.h f/src.h f/st.h $(FLAGS_H) f/type.o: f/type.c f/proj.h $(ASSERT_H) f/type.h f/malloc.h f/where.o: f/where.c f/proj.h $(ASSERT_H) f/where.h $(GLIMITS_H) f/top.h f/malloc.h \ *************** f/str-ot.h f/str-ot.j: f/fini f/str-ot.f *** 489,493 **** f/fini: f/fini.o f/proj.o ! $(HOST_CC) $(HOST_CFLAGS) $(HOST_LDFLAGS) -o f/fini f/fini.o f/proj.o # Other than str-*.j, the *.j files are dummy #include files --- 488,492 ---- f/fini: f/fini.o f/proj.o ! $(HOST_CC) $(HOST_CFLAGS) -W -Wall $(HOST_LDFLAGS) -o f/fini f/fini.o f/proj.o # Other than str-*.j, the *.j files are dummy #include files *************** deps-kinda: *** 517,520 **** --- 516,520 ---- -e 's: \([.]/\)*f/glimits[.]j: $$(GLIMITS_H):g' \ -e 's: \([.]/\)*f/hconfig[.]j: $$(HCONFIG_H):g' \ + -e 's: \([.]/\)*f/input[.]j: $$(INPUT_H):g' \ -e 's: \([.]/\)*f/rtl[.]j: $$(RTL_H):g' \ -e 's: \([.]/\)*f/tconfig[.]j: $$(TCONFIG_H):g' \ *************** TAGS: force *** 536,540 **** etags -a ../*.h ../*.c; ! .PHONY: TAGS force: --- 536,540 ---- etags -a ../*.h ../*.c; ! .PHONY: all all.indirect compiler native deps-kinda TAGS force: diff -rcp2N g77-0.5.15/f/NEWS g77-0.5.16/f/NEWS *** g77-0.5.15/f/NEWS Fri May 19 11:17:26 1995 --- g77-0.5.16/f/NEWS Wed Aug 30 14:27:16 1995 *************** *** 1,2 **** --- 1,106 ---- + This file lists recent changes to the GNU Fortran compiler. + Copyright (C) 1995 Free Software Foundation, Inc. You may copy, + distribute, and modify it freely as long as you preserve this copyright + notice and permission notice. Contributed by James Craig Burley + (burley@gnu.ai.mit.edu). + + 1995-08-30 + + Changes 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 950816, 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 + vis-a-vis f2c|gcc (but apparently only when using gcc-2.7.0 or + later) + Fix a code-generation bug involving invocation of [DOUBLE] COMPLEX + FUNCTIONs and doing [DOUBLE] COMPLEX divides when the result + of the invocation/divide is assigned directly to a variable + that overlaps one or more of the arguments to the invocation/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 etc.) + 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 compiler (e.g. when -E is specified) + Fix diagnostic to point to right source line when it immediately + follows an INCLUDE statement + Support more compiler options in gcc/g77 when compiling Fortran files + (such as -p, -pg, -aux-info, -P, correct setting of version- + number macros for preprocessing, full recognition of -O0, + 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 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 vars used as + statement-function dummy arguments or DATA implied-DO iteration + variables, even though strictly speaking these are not uses + of the local vars 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 0.6 -- see gcc/f/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 + Changes in 0.5.15: Fix bad code generation involving X**I and temporary, internal variables *************** Changes in 0.5.13: *** 144,152 **** beyond being treated as real code unless a tab was present, instead of the other way 'round (fixed-form source) ! Unless -pedantic, don't complain about "SAVE" by itself conflicting with any other occurrence of SAVE as statement or attribute, since there are solid reasons to write such code even though it is strictly non-standard-conforming (and only warn if ! -pedantic) Changes in 0.5.12: --- 248,256 ---- beyond being treated as real code unless a tab was present, instead of the other way 'round (fixed-form source) ! Unless -fpedantic, don't complain about "SAVE" by itself conflicting with any other occurrence of SAVE as statement or attribute, since there are solid reasons to write such code even though it is strictly non-standard-conforming (and only warn if ! -fpedantic) Changes in 0.5.12: *************** Changes in 0.5.9: *** 183,185 **** Support ASSIGN on any machine gcc supports Don't put build files in source directory when separate - --- 287,288 ---- diff -rcp2N g77-0.5.15/f/PROJECTS g77-0.5.16/f/PROJECTS *** g77-0.5.15/f/PROJECTS Wed Apr 12 10:03:07 1995 --- g77-0.5.16/f/PROJECTS Wed Aug 23 15:51:57 1995 *************** *** 1,4 **** ! 9502317 0. Improved efficiency. --- 1,10 ---- ! This file lists projects still to be done for the GNU Fortran system. ! Copyright (C) 1995 Free Software Foundation, Inc. You may copy, ! distribute, and modify it freely as long as you preserve this copyright ! notice and permission notice. Contributed by James Craig Burley ! (burley@gnu.ai.mit.edu). + 1995-08-21 + 0. Improved efficiency. *************** them show up only given certain kinds of *** 56,60 **** * Get the back end to produce at least as good code involving array ! references as does f2c+gcc. * Do the equivalent of the trick of putting "extern inline" in front --- 62,72 ---- * Get the back end to produce at least as good code involving array ! references as does f2c+gcc. (NOTE: 0.5.16 seems to have improved ! this, at least based on preliminary feedback during alpha testing. ! Please provide detailed information on cases where it doesn't, for ! possible future improvements. Apparently the improvement works ! only as of gcc-2.7.0; it doesn't kick in for 2.6.3, for example. ! Further analysis shows that cases where the improvement doesn't ! occur include those involving 3-dimensional arrays, for example.) * Do the equivalent of the trick of putting "extern inline" in front *************** them show up only given certain kinds of *** 61,65 **** of every function definition in libf2c and #include'ing the resulting file in f2c+gcc -- that is, inline all run-time-library functions ! that are at all worth inlining. * Provide some way, a la gcc, for Fortran code to specify assembler --- 73,78 ---- of every function definition in libf2c and #include'ing the resulting file in f2c+gcc -- that is, inline all run-time-library functions ! that are at all worth inlining. (Some of this has already been ! done, e.g. for integral exponentiation.) * Provide some way, a la gcc, for Fortran code to specify assembler *************** them show up only given certain kinds of *** 68,72 **** * When doing CHAR_VAR = CHAR_FUNC(...), and it's clear that types line up and CHAR_VAR is addressable or not a VAR_DECL, make CHAR_VAR, not a ! temporary, be the receiver for CHAR_FUNC. * Design and implement Fortran-specific optimizations that don't --- 81,86 ---- * When doing CHAR_VAR = CHAR_FUNC(...), and it's clear that types line up and CHAR_VAR is addressable or not a VAR_DECL, make CHAR_VAR, not a ! temporary, be the receiver for CHAR_FUNC. (This is now done for ! COMPLEX variables.) * Design and implement Fortran-specific optimizations that don't *************** them show up only given certain kinds of *** 155,159 **** tabbed fixed-form line, treating a line with the first non-blank character starting with column 6 being a digit as a continuation line (to effect ! the "1continuationline..." behavior in "pure visual" mode). * Intrinsics in constant expressions. This, plus F90 intrinsics such --- 169,174 ---- tabbed fixed-form line, treating a line with the first non-blank character starting with column 6 being a digit as a continuation line (to effect ! the "1continuationline..." behavior in "pure visual" mode -- ! actually, g77 already does this). * Intrinsics in constant expressions. This, plus F90 intrinsics such *************** them show up only given certain kinds of *** 161,166 **** portable code. - * Provide more intrinsics for system services like EXIT. - * A FLUSH statement that does what many systems provide via CALL FLUSH, but that supports * as the unit designator (same unit as for PRINT). --- 176,179 ---- *************** them show up only given certain kinds of *** 176,180 **** else might come along. ! * Allow DATA VAR/.../ to come before COMMON /.../ ...,VAR,.... * Character-type selector/cases for SELECT CASE. --- 189,199 ---- else might come along. ! * Allow DATA VAR/.../ to come before COMMON /.../ ...,VAR,.... Then again, ! maybe it is better to have g77 always require placement of DATA so that ! it can possibly immediately write constants to the output file, thus ! saving time and space? That is, DATA A/1000000*1/ should perhaps always ! be immediately writable to canonical assembler, unless it's already known ! to be in a COMMON area following as-yet-uninitialized stuff, and to do ! this it cannot be followed by COMMON A. * Character-type selector/cases for SELECT CASE. *************** them show up only given certain kinds of *** 182,186 **** * Option to initialize everything not explicitly initialized to "weird" (machine-dependent) values, e.g. NANs, bad (non-NULL) pointers, and ! "-0" integers. * Add run-time bounds-checking of array/subscript references a la f2c. --- 201,206 ---- * Option to initialize everything not explicitly initialized to "weird" (machine-dependent) values, e.g. NANs, bad (non-NULL) pointers, and ! "-0" integers. Right now, only -finit-local-zero is supported, which ! initializes local vars to binary zeros. * Add run-time bounds-checking of array/subscript references a la f2c. *************** them show up only given certain kinds of *** 191,197 **** * Provide necessary g77/gdb support to make better native Fortran-language ! debugging. In the meantime, see item about writing a file named CALLING, ! which would help users understand how various Fortran features are ! implemented at the debugger-visible level. * Support the POSIX standard for Fortran. --- 211,215 ---- * Provide necessary g77/gdb support to make better native Fortran-language ! debugging. * Support the POSIX standard for Fortran. *************** them show up only given certain kinds of *** 205,211 **** recently, at least one version of DEC Fortran was enhanced to provide the g77 behavior when a command-line option is specified, apparently due ! to demand from readers of the USENET group comp.lang.fortran) ! ! * Implement # directives in f771 so preprocessing works better. * Consider a preprocessor designed specifically for Fortran to replace --- 223,228 ---- recently, at least one version of DEC Fortran was enhanced to provide the g77 behavior when a command-line option is specified, apparently due ! to demand from readers of the USENET group comp.lang.fortran. It'd ! be nice to return the favor!) * Consider a preprocessor designed specifically for Fortran to replace *************** them show up only given certain kinds of *** 225,229 **** * Support STRUCTURE/UNION/MAP/RECORD fully. Currently no support at all for %FILL in STRUCTURE and related syntax, whereas the rest of the ! stuff has at least some parsing support. * F90 and g77 probably disagree about label scoping relative to INTERFACE/ --- 242,247 ---- * Support STRUCTURE/UNION/MAP/RECORD fully. Currently no support at all for %FILL in STRUCTURE and related syntax, whereas the rest of the ! stuff has at least some parsing support. This requires either major ! changes to libf2c or its replacement. * F90 and g77 probably disagree about label scoping relative to INTERFACE/ *************** them show up only given certain kinds of *** 264,268 **** 5. Useful warnings. ! * Support -pedantic more thoroughly, and use it only to generate warnings instead of rejecting constructs outright. Have it warn: if a variable that dimensions an array is not a dummy or placed --- 282,286 ---- 5. Useful warnings. ! * Support -fpedantic more thoroughly, and use it only to generate warnings instead of rejecting constructs outright. Have it warn: if a variable that dimensions an array is not a dummy or placed *************** them show up only given certain kinds of *** 285,296 **** feature were actually more useful than just fixing the source). ! 6. Better documentation of how GCC works and how to port it. ! * Write CALLING, a text file that describes rules for how g77 passes ! arguments to subroutines and functions, handles COMPLEX return values, ! handles alternate returns, and so on. ! * Develop and maintain a list of gcc compiler options supported for .f ! files. 7. Better internals. --- 303,312 ---- feature were actually more useful than just fixing the source). ! 6. Better documentation. ! * Convert existing documentation into the format(s) used by gcc, for ! all the right reasons. ! * Better info on how g77 works and how to port it. 7. Better internals. *************** them show up only given certain kinds of *** 370,380 **** numbers, such as '123'O. ! * For diagnostics, would be nice to say "In procedure XYZ:" or something ! like that (see what gcc does, etc), perhaps even the line number within ! the procedure would be appropriate? ! ! * -fflag-ugly, -fflag-automatic, -fflag-vxt-not-f90 (syn. -fflag-f90-not-vxt), ! -fflag-f90 all should flag places (via diagnostics) where ambiguities are found. * When FUNCTION and ENTRY point types disagree (CHARACTER lengths, --- 386,396 ---- numbers, such as '123'O. ! * -Wugly*, -Wautomatic, -Wvxt-not-f90 (syn. -Wf90-not-vxt), -Wf90, and so ! on all should flag places (via diagnostics) where ambiguities are found. + + * -Wconversion and related should flag places where non-standard + conversions are found. Perhaps much of this would be part of + -Wugly*. * When FUNCTION and ENTRY point types disagree (CHARACTER lengths, diff -rcp2N g77-0.5.15/f/README g77-0.5.16/f/README *** g77-0.5.15/f/README Wed Feb 15 16:11:08 1995 --- g77-0.5.16/f/README Mon Aug 21 16:08:50 1995 *************** *** 1,3 **** ! 950215 This directory is the f/ subdirectory, which is designed to --- 1,3 ---- ! 1995-02-15 This directory is the f/ subdirectory, which is designed to diff -rcp2N g77-0.5.15/f/README.NEXTSTEP g77-0.5.16/f/README.NEXTSTEP *** g77-0.5.15/f/README.NEXTSTEP Thu Feb 16 20:22:02 1995 --- g77-0.5.16/f/README.NEXTSTEP Mon Aug 28 09:41:25 1995 *************** *** 1,30 **** ! 950216 This file contributed by Toon Moene (toon@moene.indiv.nluug.nl). ! Developers of FORTRAN code on NEXTSTEP (all architectures) have to ! watch out for the following problem when writing programs with ! large, statically allocated (i.e. non-stack based) data structures (common blocks, saved arrays). ! Due to the way the native loader ('/bin/ld') on NEXTSTEP lays out ! data structures in virtual memory, it is very easy to create an ! executable wherein the '__DATA' segment overlaps (has addresses in common) with the 'UNIX STACK' segment. ! This leads to all sorts of trouble, from the executable simply 'not ! being executable' to Bus errors. The NEXTSTEP command line tool 'ebadexec' points to the problem as follows: % /bin/ebadexec a.out ! /bin/ebadexec: __LINKEDIT segment (truncated address = 0x3de000 ! rounded size = 0x2a000) of executable file: a.out overlaps with UNIX ! STACK segment (truncated address = 0x400000 rounded size = 0x3c00000) of executable file: a.out ! (in this case it is the '__LINKEDIT' segment which overlaps the ! stack segment). This can be cured by assigning the '__DATA' segment ! (virtual) addresses beyond the stack segment. A conservative ! estimate for this is from address 6000000 (hexadecimal) onwards - this has always worked for me [Toon Moene]: --- 1,30 ---- ! 1995-02-16 This file contributed by Toon Moene (toon@moene.indiv.nluug.nl). ! Developers of FORTRAN code on NEXTSTEP (all architectures) have to ! watch out for the following problem when writing programs with ! large, statically allocated (i.e. non-stack based) data structures (common blocks, saved arrays). ! Due to the way the native loader ('/bin/ld') on NEXTSTEP lays out ! data structures in virtual memory, it is very easy to create an ! executable wherein the '__DATA' segment overlaps (has addresses in common) with the 'UNIX STACK' segment. ! This leads to all sorts of trouble, from the executable simply 'not ! being executable' to Bus errors. The NEXTSTEP command line tool 'ebadexec' points to the problem as follows: % /bin/ebadexec a.out ! /bin/ebadexec: __LINKEDIT segment (truncated address = 0x3de000 ! rounded size = 0x2a000) of executable file: a.out overlaps with UNIX ! STACK segment (truncated address = 0x400000 rounded size = 0x3c00000) of executable file: a.out ! (in this case it is the '__LINKEDIT' segment which overlaps the ! stack segment). This can be cured by assigning the '__DATA' segment ! (virtual) addresses beyond the stack segment. A conservative ! estimate for this is from address 6000000 (hexadecimal) onwards - this has always worked for me [Toon Moene]: *************** this has always worked for me [Toon Moen *** 33,38 **** ebadexec: file: a.out appears to be executable ! Browsing through the Makefile in the f/ directory in your gcc ! distribution, you will find that linking f771 itself also has to be ! done with these flags - it apparently has large statically allocated data structures. --- 33,38 ---- ebadexec: file: a.out appears to be executable ! Browsing through the Makefile in the f/ directory in your gcc ! distribution, you will find that linking f771 itself also has to be ! done with these flags - it apparently has large statically allocated data structures. diff -rcp2N g77-0.5.15/f/assert.j g77-0.5.16/f/assert.j *** g77-0.5.15/f/assert.j Fri Apr 28 05:42:00 1995 --- g77-0.5.16/f/assert.j Wed Aug 30 15:53:38 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef MAKING_DEPENDENCIES --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #ifndef MAKING_DEPENDENCIES diff -rcp2N g77-0.5.15/f/bad.c g77-0.5.16/f/bad.c *** g77-0.5.15/f/bad.c Fri Apr 28 05:26:07 1995 --- g77-0.5.16/f/bad.c Wed Aug 30 15:53:38 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** ffebad_start_ (bool lex_override, ffebad *** 220,224 **** } } ! #endif ffebad_is_temp_inhibited_ = FALSE; --- 221,225 ---- } } ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ ffebad_is_temp_inhibited_ = FALSE; *************** ffebad_here (ffebadIndex index, ffewhere *** 258,270 **** assert (index < FFEBAD_MAX_); ! if (ffewhere_line_is_unknown (line)) { - ffebad_here_[index].line = line; - ffebad_here_[index].col = ffewhere_column_unknown (); ffebad_here_[index].tag = FFEBAD_MAX_; return; } - ffebad_here_[index].line = ffewhere_line_use (line); - ffebad_here_[index].col = ffewhere_column_use (col); ffebad_here_[index].tag = 0; /* For now, though it shouldn't matter. */ --- 259,270 ---- assert (index < FFEBAD_MAX_); ! ffebad_here_[index].line = ffewhere_line_use (line); ! ffebad_here_[index].col = ffewhere_column_use (col); ! if (ffewhere_line_is_unknown (line) ! || ffewhere_column_is_unknown (col)) { ffebad_here_[index].tag = FFEBAD_MAX_; return; } ffebad_here_[index].tag = 0; /* For now, though it shouldn't matter. */ *************** ffebad_finish () *** 422,425 **** --- 422,428 ---- if (bi != 0) fputc ('\n', stderr); + #if FFECOM_targetCURRENT == FFECOM_targetGCC + report_error_function (fn); + #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ fprintf (stderr, #if 0 *************** ffebad_finish () *** 439,443 **** last_line_num = ln; last_col_num = cn; ! s = "(continued:)"; } else --- 442,446 ---- last_line_num = ln; last_col_num = cn; ! s = "(continued):"; } else *************** ffebad_finish () *** 453,464 **** if (ffebad_places_ == 0) { - char c; - /* Didn't output "warning:" string, capitalize it for message. */ ! if ((s != NULL) && isalpha (s[0]) && islower (s[0])) ! c = toupper (s[0]); ! else ! c = s[0]; ! fprintf (stderr, "%c%s ", c, &s[1]); } else --- 456,469 ---- if (ffebad_places_ == 0) { /* Didn't output "warning:" string, capitalize it for message. */ ! if ((s[0] != '\0') && isalpha (s[0]) && islower (s[0])) ! { ! char c; ! ! c = toupper (s[0]); ! fprintf (stderr, "%c%s ", c, &s[1]); ! } ! else if (s[0] != '\0') ! fprintf (stderr, "%s ", s); } else diff -rcp2N g77-0.5.15/f/bad.def g77-0.5.16/f/bad.def *** g77-0.5.15/f/bad.def Fri Apr 28 05:26:08 1995 --- g77-0.5.16/f/bad.def Wed Aug 30 15:53:38 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/bad.h g77-0.5.16/f/bad.h *** g77-0.5.15/f/bad.h Fri Apr 28 05:26:08 1995 --- g77-0.5.16/f/bad.h Wed Aug 30 15:53:38 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/bit.c g77-0.5.16/f/bit.c *** g77-0.5.15/f/bit.c Tue Feb 21 13:38:20 1995 --- g77-0.5.16/f/bit.c Wed Aug 30 15:53:38 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: diff -rcp2N g77-0.5.15/f/bit.h g77-0.5.16/f/bit.h *** g77-0.5.15/f/bit.h Tue Feb 21 13:38:20 1995 --- g77-0.5.16/f/bit.h Wed Aug 30 15:53:38 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/bld-op.def g77-0.5.16/f/bld-op.def *** g77-0.5.15/f/bld-op.def Wed Feb 15 16:58:42 1995 --- g77-0.5.16/f/bld-op.def Wed Aug 30 15:53:38 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/bld.c g77-0.5.16/f/bld.c *** g77-0.5.15/f/bld.c Fri May 19 11:17:27 1995 --- g77-0.5.16/f/bld.c Wed Aug 30 15:53:38 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** static char *ffebld_op_string_[] *** 222,244 **** #define realdouble_ CATX(real,FFETARGET_ktREALDOUBLE) #define realquad_ CATX(real,FFETARGET_ktREALQUAD) - - #define FFEBLD_whereconstPROGUNIT_ 0 - #define FFEBLD_whereconstFILE_ 1 - - #if FFECOM_targetCURRENT == FFECOM_targetFFE - #define FFEBLD_whereconstCURRENT_ FFEBLD_whereconstPROGUNIT_ - #else - #if FFECOM_targetCURRENT == FFECOM_targetGCC - #define FFEBLD_whereconstCURRENT_ FFEBLD_whereconstFILE_ - #endif - #endif - - #if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_ - #define FFEBLD_CONSTANT_POOL_ ffe_pool_program_unit() - #else - #if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstFILE_ - #define FFEBLD_CONSTANT_POOL_ ffe_pool_file() - #endif - #endif /* ffebld_constant_cmp -- Compare two constants a la strcmp --- 223,226 ---- *************** ffebld_constant_new_character1 (ffelexTo *** 1047,1051 **** ffetargetCharacter1 val; ! ffetarget_character1 (&val, t, FFEBLD_CONSTANT_POOL_); return ffebld_constant_new_character1_val (val); } --- 1029,1033 ---- ffetargetCharacter1 val; ! ffetarget_character1 (&val, t, ffebld_constant_pool()); return ffebld_constant_new_character1_val (val); } *************** ffebld_constant_new_character1_val (ffet *** 1064,1067 **** --- 1046,1051 ---- int cmp; + ffetarget_verify_character1 (ffebld_constant_pool(), val); + for (c = (ffebldConstant) &ffebld_constant_character1_; c->next != NULL; *************** ffebld_constant_new_character1_val (ffet *** 1068,1072 **** c = c->next) { ! cmp = ffetarget_cmp_character1 (val, ffebld_constant_character1 (c->next)); if (cmp == 0) return c->next; --- 1052,1062 ---- c = c->next) { ! malloc_verify_kp (ffebld_constant_pool(), ! c->next, ! sizeof (*(c->next))); ! ffetarget_verify_character1 (ffebld_constant_pool(), ! ffebld_constant_character1 (c->next)); ! cmp = ffetarget_cmp_character1 (val, ! ffebld_constant_character1 (c->next)); if (cmp == 0) return c->next; *************** ffebld_constant_new_character1_val (ffet *** 1075,1079 **** } ! nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constCHARACTER1", sizeof (*nc)); nc->next = c->next; --- 1065,1070 ---- } ! nc = malloc_new_kp (ffebld_constant_pool(), ! "FFEBLD_constCHARACTER1", sizeof (*nc)); nc->next = c->next; *************** ffebld_constant_new_complex1_val (ffetar *** 1132,1136 **** } ! nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constCOMPLEX1", sizeof (*nc)); nc->next = c->next; nc->consttype = FFEBLD_constCOMPLEX1; --- 1123,1129 ---- } ! nc = malloc_new_kp (ffebld_constant_pool(), ! "FFEBLD_constCOMPLEX1", ! sizeof (*nc)); nc->next = c->next; nc->consttype = FFEBLD_constCOMPLEX1; *************** ffebld_constant_new_complex2_val (ffetar *** 1188,1192 **** } ! nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constCOMPLEX2", sizeof (*nc)); nc->next = c->next; nc->consttype = FFEBLD_constCOMPLEX2; --- 1181,1187 ---- } ! nc = malloc_new_kp (ffebld_constant_pool(), ! "FFEBLD_constCOMPLEX2", ! sizeof (*nc)); nc->next = c->next; nc->consttype = FFEBLD_constCOMPLEX2; *************** ffebld_constant_new_hollerith (ffelexTok *** 1210,1214 **** ffetargetHollerith val; ! ffetarget_hollerith (&val, t, FFEBLD_CONSTANT_POOL_); return ffebld_constant_new_hollerith_val (val); } --- 1205,1209 ---- ffetargetHollerith val; ! ffetarget_hollerith (&val, t, ffebld_constant_pool()); return ffebld_constant_new_hollerith_val (val); } *************** ffebld_constant_new_hollerith_val (ffeta *** 1236,1240 **** } ! nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constHOLLERITH", sizeof (*nc)); nc->next = c->next; --- 1231,1236 ---- } ! nc = malloc_new_kp (ffebld_constant_pool(), ! "FFEBLD_constHOLLERITH", sizeof (*nc)); nc->next = c->next; *************** ffebld_constant_new_integer1_val (ffetar *** 1292,1296 **** } ! nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constINTEGER1", sizeof (*nc)); nc->next = c->next; nc->consttype = FFEBLD_constINTEGER1; --- 1288,1294 ---- } ! nc = malloc_new_kp (ffebld_constant_pool(), ! "FFEBLD_constINTEGER1", ! sizeof (*nc)); nc->next = c->next; nc->consttype = FFEBLD_constINTEGER1; *************** ffebld_constant_new_integer2_val (ffetar *** 1328,1332 **** } ! nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constINTEGER2", sizeof (*nc)); nc->next = c->next; nc->consttype = FFEBLD_constINTEGER2; --- 1326,1332 ---- } ! nc = malloc_new_kp (ffebld_constant_pool(), ! "FFEBLD_constINTEGER2", ! sizeof (*nc)); nc->next = c->next; nc->consttype = FFEBLD_constINTEGER2; *************** ffebld_constant_new_integer3_val (ffetar *** 1364,1368 **** } ! nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constINTEGER3", sizeof (*nc)); nc->next = c->next; nc->consttype = FFEBLD_constINTEGER3; --- 1364,1370 ---- } ! nc = malloc_new_kp (ffebld_constant_pool(), ! "FFEBLD_constINTEGER3", ! sizeof (*nc)); nc->next = c->next; nc->consttype = FFEBLD_constINTEGER3; *************** ffebld_constant_new_logical1_val (ffetar *** 1436,1440 **** } ! nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constLOGICAL1", sizeof (*nc)); nc->next = c->next; nc->consttype = FFEBLD_constLOGICAL1; --- 1438,1444 ---- } ! nc = malloc_new_kp (ffebld_constant_pool(), ! "FFEBLD_constLOGICAL1", ! sizeof (*nc)); nc->next = c->next; nc->consttype = FFEBLD_constLOGICAL1; *************** ffebld_constant_new_logical2_val (ffetar *** 1472,1476 **** } ! nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constLOGICAL2", sizeof (*nc)); nc->next = c->next; nc->consttype = FFEBLD_constLOGICAL2; --- 1476,1482 ---- } ! nc = malloc_new_kp (ffebld_constant_pool(), ! "FFEBLD_constLOGICAL2", ! sizeof (*nc)); nc->next = c->next; nc->consttype = FFEBLD_constLOGICAL2; *************** ffebld_constant_new_logical3_val (ffetar *** 1508,1512 **** } ! nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constLOGICAL3", sizeof (*nc)); nc->next = c->next; nc->consttype = FFEBLD_constLOGICAL3; --- 1514,1520 ---- } ! nc = malloc_new_kp (ffebld_constant_pool(), ! "FFEBLD_constLOGICAL3", ! sizeof (*nc)); nc->next = c->next; nc->consttype = FFEBLD_constLOGICAL3; *************** ffebld_constant_new_real1_val (ffetarget *** 1562,1566 **** } ! nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constREAL1", sizeof (*nc)); nc->next = c->next; nc->consttype = FFEBLD_constREAL1; --- 1570,1576 ---- } ! nc = malloc_new_kp (ffebld_constant_pool(), ! "FFEBLD_constREAL1", ! sizeof (*nc)); nc->next = c->next; nc->consttype = FFEBLD_constREAL1; *************** ffebld_constant_new_real2_val (ffetarget *** 1616,1620 **** } ! nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constREAL2", sizeof (*nc)); nc->next = c->next; nc->consttype = FFEBLD_constREAL2; --- 1626,1632 ---- } ! nc = malloc_new_kp (ffebld_constant_pool(), ! "FFEBLD_constREAL2", ! sizeof (*nc)); nc->next = c->next; nc->consttype = FFEBLD_constREAL2; *************** ffebld_constant_new_typeless_val (ffebld *** 1780,1784 **** } ! nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constTYPELESS", sizeof (*nc)); nc->next = c->next; nc->consttype = type; --- 1792,1798 ---- } ! nc = malloc_new_kp (ffebld_constant_pool(), ! "FFEBLD_constTYPELESS", ! sizeof (*nc)); nc->next = c->next; nc->consttype = type; *************** ffebld_constantarray_new (ffeinfoBasicty *** 2189,2194 **** #if FFETARGET_okINTEGER1 case FFEINFO_kindtypeINTEGER1: ! ptr.integer1 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetInteger1), 0); break; #endif --- 2203,2210 ---- #if FFETARGET_okINTEGER1 case FFEINFO_kindtypeINTEGER1: ! ptr.integer1 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetInteger1), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2196,2201 **** #if FFETARGET_okINTEGER2 case FFEINFO_kindtypeINTEGER2: ! ptr.integer2 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetInteger2), 0); break; #endif --- 2212,2219 ---- #if FFETARGET_okINTEGER2 case FFEINFO_kindtypeINTEGER2: ! ptr.integer2 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetInteger2), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2203,2208 **** #if FFETARGET_okINTEGER3 case FFEINFO_kindtypeINTEGER3: ! ptr.integer3 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetInteger3), 0); break; #endif --- 2221,2228 ---- #if FFETARGET_okINTEGER3 case FFEINFO_kindtypeINTEGER3: ! ptr.integer3 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetInteger3), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2210,2215 **** #if FFETARGET_okINTEGER4 case FFEINFO_kindtypeINTEGER4: ! ptr.integer4 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetInteger4), 0); break; #endif --- 2230,2237 ---- #if FFETARGET_okINTEGER4 case FFEINFO_kindtypeINTEGER4: ! ptr.integer4 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetInteger4), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2217,2222 **** #if FFETARGET_okINTEGER5 case FFEINFO_kindtypeINTEGER5: ! ptr.integer5 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetInteger5), 0); break; #endif --- 2239,2246 ---- #if FFETARGET_okINTEGER5 case FFEINFO_kindtypeINTEGER5: ! ptr.integer5 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetInteger5), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2224,2229 **** #if FFETARGET_okINTEGER6 case FFEINFO_kindtypeINTEGER6: ! ptr.integer6 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetInteger6), 0); break; #endif --- 2248,2255 ---- #if FFETARGET_okINTEGER6 case FFEINFO_kindtypeINTEGER6: ! ptr.integer6 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetInteger6), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2231,2236 **** #if FFETARGET_okINTEGER7 case FFEINFO_kindtypeINTEGER7: ! ptr.integer7 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetInteger7), 0); break; #endif --- 2257,2264 ---- #if FFETARGET_okINTEGER7 case FFEINFO_kindtypeINTEGER7: ! ptr.integer7 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetInteger7), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2238,2243 **** #if FFETARGET_okINTEGER8 case FFEINFO_kindtypeINTEGER8: ! ptr.integer8 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetInteger8), 0); break; #endif --- 2266,2273 ---- #if FFETARGET_okINTEGER8 case FFEINFO_kindtypeINTEGER8: ! ptr.integer8 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetInteger8), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2254,2259 **** #if FFETARGET_okLOGICAL1 case FFEINFO_kindtypeLOGICAL1: ! ptr.logical1 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetLogical1), 0); break; #endif --- 2284,2291 ---- #if FFETARGET_okLOGICAL1 case FFEINFO_kindtypeLOGICAL1: ! ptr.logical1 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetLogical1), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2261,2266 **** #if FFETARGET_okLOGICAL2 case FFEINFO_kindtypeLOGICAL2: ! ptr.logical2 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetLogical2), 0); break; #endif --- 2293,2300 ---- #if FFETARGET_okLOGICAL2 case FFEINFO_kindtypeLOGICAL2: ! ptr.logical2 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetLogical2), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2268,2273 **** #if FFETARGET_okLOGICAL3 case FFEINFO_kindtypeLOGICAL3: ! ptr.logical3 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetLogical3), 0); break; #endif --- 2302,2309 ---- #if FFETARGET_okLOGICAL3 case FFEINFO_kindtypeLOGICAL3: ! ptr.logical3 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetLogical3), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2275,2280 **** #if FFETARGET_okLOGICAL4 case FFEINFO_kindtypeLOGICAL4: ! ptr.logical4 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetLogical4), 0); break; #endif --- 2311,2318 ---- #if FFETARGET_okLOGICAL4 case FFEINFO_kindtypeLOGICAL4: ! ptr.logical4 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetLogical4), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2282,2287 **** #if FFETARGET_okLOGICAL5 case FFEINFO_kindtypeLOGICAL5: ! ptr.logical5 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetLogical5), 0); break; #endif --- 2320,2327 ---- #if FFETARGET_okLOGICAL5 case FFEINFO_kindtypeLOGICAL5: ! ptr.logical5 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetLogical5), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2289,2294 **** #if FFETARGET_okLOGICAL6 case FFEINFO_kindtypeLOGICAL6: ! ptr.logical6 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetLogical6), 0); break; #endif --- 2329,2336 ---- #if FFETARGET_okLOGICAL6 case FFEINFO_kindtypeLOGICAL6: ! ptr.logical6 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetLogical6), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2296,2301 **** #if FFETARGET_okLOGICAL7 case FFEINFO_kindtypeLOGICAL7: ! ptr.logical7 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetLogical7), 0); break; #endif --- 2338,2345 ---- #if FFETARGET_okLOGICAL7 case FFEINFO_kindtypeLOGICAL7: ! ptr.logical7 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetLogical7), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2303,2308 **** #if FFETARGET_okLOGICAL8 case FFEINFO_kindtypeLOGICAL8: ! ptr.logical8 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetLogical8), 0); break; #endif --- 2347,2354 ---- #if FFETARGET_okLOGICAL8 case FFEINFO_kindtypeLOGICAL8: ! ptr.logical8 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetLogical8), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2319,2324 **** #if FFETARGET_okREAL1 case FFEINFO_kindtypeREAL1: ! ptr.real1 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetReal1), 0); break; #endif --- 2365,2372 ---- #if FFETARGET_okREAL1 case FFEINFO_kindtypeREAL1: ! ptr.real1 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetReal1), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2326,2331 **** #if FFETARGET_okREAL2 case FFEINFO_kindtypeREAL2: ! ptr.real2 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetReal2), 0); break; #endif --- 2374,2381 ---- #if FFETARGET_okREAL2 case FFEINFO_kindtypeREAL2: ! ptr.real2 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetReal2), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2333,2338 **** #if FFETARGET_okREAL3 case FFEINFO_kindtypeREAL3: ! ptr.real3 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetReal3), 0); break; #endif --- 2383,2390 ---- #if FFETARGET_okREAL3 case FFEINFO_kindtypeREAL3: ! ptr.real3 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetReal3), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2340,2345 **** #if FFETARGET_okREAL4 case FFEINFO_kindtypeREAL4: ! ptr.real4 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetReal4), 0); break; #endif --- 2392,2399 ---- #if FFETARGET_okREAL4 case FFEINFO_kindtypeREAL4: ! ptr.real4 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetReal4), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2347,2352 **** #if FFETARGET_okREAL5 case FFEINFO_kindtypeREAL5: ! ptr.real5 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetReal5), 0); break; #endif --- 2401,2408 ---- #if FFETARGET_okREAL5 case FFEINFO_kindtypeREAL5: ! ptr.real5 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetReal5), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2354,2359 **** #if FFETARGET_okREAL6 case FFEINFO_kindtypeREAL6: ! ptr.real6 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetReal6), 0); break; #endif --- 2410,2417 ---- #if FFETARGET_okREAL6 case FFEINFO_kindtypeREAL6: ! ptr.real6 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetReal6), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2361,2366 **** #if FFETARGET_okREAL7 case FFEINFO_kindtypeREAL7: ! ptr.real7 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetReal7), 0); break; #endif --- 2419,2426 ---- #if FFETARGET_okREAL7 case FFEINFO_kindtypeREAL7: ! ptr.real7 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetReal7), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2368,2373 **** #if FFETARGET_okREAL8 case FFEINFO_kindtypeREAL8: ! ptr.real8 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetReal8), 0); break; #endif --- 2428,2435 ---- #if FFETARGET_okREAL8 case FFEINFO_kindtypeREAL8: ! ptr.real8 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetReal8), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2384,2389 **** #if FFETARGET_okCOMPLEX1 case FFEINFO_kindtypeREAL1: ! ptr.complex1 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetComplex1), 0); break; #endif --- 2446,2453 ---- #if FFETARGET_okCOMPLEX1 case FFEINFO_kindtypeREAL1: ! ptr.complex1 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetComplex1), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2391,2396 **** #if FFETARGET_okCOMPLEX2 case FFEINFO_kindtypeREAL2: ! ptr.complex2 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetComplex2), 0); break; #endif --- 2455,2462 ---- #if FFETARGET_okCOMPLEX2 case FFEINFO_kindtypeREAL2: ! ptr.complex2 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetComplex2), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2398,2403 **** #if FFETARGET_okCOMPLEX3 case FFEINFO_kindtypeREAL3: ! ptr.complex3 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetComplex3), 0); break; #endif --- 2464,2471 ---- #if FFETARGET_okCOMPLEX3 case FFEINFO_kindtypeREAL3: ! ptr.complex3 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetComplex3), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2405,2410 **** #if FFETARGET_okCOMPLEX4 case FFEINFO_kindtypeREAL4: ! ptr.complex4 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetComplex4), 0); break; #endif --- 2473,2480 ---- #if FFETARGET_okCOMPLEX4 case FFEINFO_kindtypeREAL4: ! ptr.complex4 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetComplex4), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2412,2417 **** #if FFETARGET_okCOMPLEX5 case FFEINFO_kindtypeREAL5: ! ptr.complex5 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetComplex5), 0); break; #endif --- 2482,2489 ---- #if FFETARGET_okCOMPLEX5 case FFEINFO_kindtypeREAL5: ! ptr.complex5 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetComplex5), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2419,2424 **** #if FFETARGET_okCOMPLEX6 case FFEINFO_kindtypeREAL6: ! ptr.complex6 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetComplex6), 0); break; #endif --- 2491,2498 ---- #if FFETARGET_okCOMPLEX6 case FFEINFO_kindtypeREAL6: ! ptr.complex6 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetComplex6), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2426,2431 **** #if FFETARGET_okCOMPLEX7 case FFEINFO_kindtypeREAL7: ! ptr.complex7 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetComplex7), 0); break; #endif --- 2500,2507 ---- #if FFETARGET_okCOMPLEX7 case FFEINFO_kindtypeREAL7: ! ptr.complex7 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetComplex7), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2433,2438 **** #if FFETARGET_okCOMPLEX8 case FFEINFO_kindtypeREAL8: ! ptr.complex8 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetComplex8), 0); break; #endif --- 2509,2516 ---- #if FFETARGET_okCOMPLEX8 case FFEINFO_kindtypeREAL8: ! ptr.complex8 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size *= sizeof (ffetargetComplex8), ! 0); break; #endif *************** ffebld_constantarray_new (ffeinfoBasicty *** 2449,2454 **** #if FFETARGET_okCHARACTER1 case FFEINFO_kindtypeCHARACTER1: ! ptr.character1 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetCharacterUnit1), 0); break; --- 2527,2534 ---- #if FFETARGET_okCHARACTER1 case FFEINFO_kindtypeCHARACTER1: ! ptr.character1 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size ! *= sizeof (ffetargetCharacterUnit1), 0); break; *************** ffebld_constantarray_new (ffeinfoBasicty *** 2457,2462 **** #if FFETARGET_okCHARACTER2 case FFEINFO_kindtypeCHARACTER2: ! ptr.character2 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetCharacterUnit2), 0); break; --- 2537,2544 ---- #if FFETARGET_okCHARACTER2 case FFEINFO_kindtypeCHARACTER2: ! ptr.character2 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size ! *= sizeof (ffetargetCharacterUnit2), 0); break; *************** ffebld_constantarray_new (ffeinfoBasicty *** 2465,2470 **** #if FFETARGET_okCHARACTER3 case FFEINFO_kindtypeCHARACTER3: ! ptr.character3 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetCharacterUnit3), 0); break; --- 2547,2554 ---- #if FFETARGET_okCHARACTER3 case FFEINFO_kindtypeCHARACTER3: ! ptr.character3 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size ! *= sizeof (ffetargetCharacterUnit3), 0); break; *************** ffebld_constantarray_new (ffeinfoBasicty *** 2473,2478 **** #if FFETARGET_okCHARACTER4 case FFEINFO_kindtypeCHARACTER4: ! ptr.character4 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetCharacterUnit4), 0); break; --- 2557,2564 ---- #if FFETARGET_okCHARACTER4 case FFEINFO_kindtypeCHARACTER4: ! ptr.character4 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size ! *= sizeof (ffetargetCharacterUnit4), 0); break; *************** ffebld_constantarray_new (ffeinfoBasicty *** 2481,2486 **** #if FFETARGET_okCHARACTER5 case FFEINFO_kindtypeCHARACTER5: ! ptr.character5 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetCharacterUnit5), 0); break; --- 2567,2574 ---- #if FFETARGET_okCHARACTER5 case FFEINFO_kindtypeCHARACTER5: ! ptr.character5 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size ! *= sizeof (ffetargetCharacterUnit5), 0); break; *************** ffebld_constantarray_new (ffeinfoBasicty *** 2489,2494 **** #if FFETARGET_okCHARACTER6 case FFEINFO_kindtypeCHARACTER6: ! ptr.character6 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetCharacterUnit6), 0); break; --- 2577,2584 ---- #if FFETARGET_okCHARACTER6 case FFEINFO_kindtypeCHARACTER6: ! ptr.character6 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size ! *= sizeof (ffetargetCharacterUnit6), 0); break; *************** ffebld_constantarray_new (ffeinfoBasicty *** 2497,2502 **** #if FFETARGET_okCHARACTER7 case FFEINFO_kindtypeCHARACTER7: ! ptr.character7 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetCharacterUnit7), 0); break; --- 2587,2594 ---- #if FFETARGET_okCHARACTER7 case FFEINFO_kindtypeCHARACTER7: ! ptr.character7 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size ! *= sizeof (ffetargetCharacterUnit7), 0); break; *************** ffebld_constantarray_new (ffeinfoBasicty *** 2505,2510 **** #if FFETARGET_okCHARACTER8 case FFEINFO_kindtypeCHARACTER8: ! ptr.character8 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_, ! "ffebldConstantArray", size *= sizeof (ffetargetCharacterUnit8), 0); break; --- 2597,2604 ---- #if FFETARGET_okCHARACTER8 case FFEINFO_kindtypeCHARACTER8: ! ptr.character8 = malloc_new_zkp (ffebld_constant_pool(), ! "ffebldConstantArray", ! size ! *= sizeof (ffetargetCharacterUnit8), 0); break; diff -rcp2N g77-0.5.15/f/bld.h g77-0.5.16/f/bld.h *** g77-0.5.15/f/bld.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/bld.h Wed Aug 30 15:53:37 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: *************** typedef struct _ffebld_pool_stack_ *ffeb *** 121,124 **** --- 122,136 ---- #include "target.h" + #define FFEBLD_whereconstPROGUNIT_ 1 + #define FFEBLD_whereconstFILE_ 2 + + #if FFECOM_targetCURRENT == FFECOM_targetFFE + #define FFEBLD_whereconstCURRENT_ FFEBLD_whereconstPROGUNIT_ + #elif FFECOM_targetCURRENT == FFECOM_targetGCC + #define FFEBLD_whereconstCURRENT_ FFEBLD_whereconstFILE_ + #else + #error + #endif + /* Structure definitions. */ *************** ffetargetCharacterSize ffebld_size_max ( *** 722,726 **** #define ffebld_arrter_set_size(b,s) ((b)->u.arrter.size = (s)) #define ffebld_arrter_size(b) ((b)->u.arrter.size) ! #define ffebld_constant_character_pool() ffe_pool_program_unit() #define ffebld_constant_character1(c) ((c)->u.character1) #define ffebld_constant_character2(c) ((c)->u.character2) --- 734,744 ---- #define ffebld_arrter_set_size(b,s) ((b)->u.arrter.size = (s)) #define ffebld_arrter_size(b) ((b)->u.arrter.size) ! #if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_ ! #define ffebld_constant_pool() ffe_pool_program_unit() ! #elif FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstFILE_ ! #define ffebld_constant_pool() ffe_pool_file() ! #else ! #error ! #endif #define ffebld_constant_character1(c) ((c)->u.character1) #define ffebld_constant_character2(c) ((c)->u.character2) diff -rcp2N g77-0.5.15/f/com-rt.def g77-0.5.16/f/com-rt.def *** g77-0.5.15/f/com-rt.def Fri Apr 28 05:26:08 1995 --- g77-0.5.16/f/com-rt.def Wed Aug 30 15:53:37 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: *************** DEFGFRT (FFECOM_gfrtFEND, "f_end", FFECO *** 92,95 **** --- 93,97 ---- DEFGFRT (FFECOM_gfrtFREW, "f_rew", FFECOM_rttypeINTEGER_, FALSE, FALSE) + DEFGFRT (FFECOM_gfrtABORT, "abort_", FFECOM_rttypeVOID_, TRUE, FALSE) DEFGFRT (FFECOM_gfrtABS, "r_abs", FFECOM_rttypeDOUBLE_, FALSE, FALSE) DEFGFRT (FFECOM_gfrtACOS, "r_acos", FFECOM_rttypeDOUBLE_, FALSE, FALSE) *************** DEFGFRT (FFECOM_gfrtDCOS, "d_cos", FFECO *** 120,123 **** --- 122,127 ---- DEFGFRT (FFECOM_gfrtDCOSH, "d_cosh", FFECOM_rttypeDOUBLE_, FALSE, FALSE) DEFGFRT (FFECOM_gfrtDDIM, "d_dim", FFECOM_rttypeDOUBLE_, FALSE, FALSE) + DEFGFRT (FFECOM_gfrtDERF, "derf_", FFECOM_rttypeDOUBLE_, FALSE, FALSE) + DEFGFRT (FFECOM_gfrtDERFC, "derfc_", FFECOM_rttypeDOUBLE_, FALSE, FALSE) DEFGFRT (FFECOM_gfrtDEXP, "d_exp", FFECOM_rttypeDOUBLE_, FALSE, FALSE) DEFGFRT (FFECOM_gfrtDIM, "r_dim", FFECOM_rttypeDOUBLE_, FALSE, FALSE) *************** DEFGFRT (FFECOM_gfrtDSQRT, "d_sqrt", FFE *** 134,139 **** --- 138,150 ---- DEFGFRT (FFECOM_gfrtDTAN, "d_tan", FFECOM_rttypeDOUBLE_, FALSE, FALSE) DEFGFRT (FFECOM_gfrtDTANH, "d_tanh", FFECOM_rttypeDOUBLE_, FALSE, FALSE) + DEFGFRT (FFECOM_gfrtERF, "erf_", FFECOM_rttypeDOUBLE_, FALSE, FALSE) + DEFGFRT (FFECOM_gfrtERFC, "erfc_", FFECOM_rttypeDOUBLE_, FALSE, FALSE) + DEFGFRT (FFECOM_gfrtEXIT, "exit_", FFECOM_rttypeVOID_, TRUE, FALSE) DEFGFRT (FFECOM_gfrtEXP, "r_exp", FFECOM_rttypeDOUBLE_, FALSE, FALSE) + DEFGFRT (FFECOM_gfrtFLUSH, "flush_", FFECOM_rttypeVOID_, FALSE, FALSE) + DEFGFRT (FFECOM_gfrtGETARG, "getarg_", FFECOM_rttypeVOID_, FALSE, FALSE) + DEFGFRT (FFECOM_gfrtGETENV, "getenv_", FFECOM_rttypeVOID_, FALSE, FALSE) DEFGFRT (FFECOM_gfrtIABS, "i_abs", FFECOM_rttypeINTEGER_, FALSE, FALSE) + DEFGFRT (FFECOM_gfrtIARGC, "iargc_", FFECOM_rttypeINTEGER_, FALSE, FALSE) DEFGFRT (FFECOM_gfrtIDIM, "i_dim", FFECOM_rttypeINTEGER_, FALSE, FALSE) DEFGFRT (FFECOM_gfrtIDNINT, "i_dnnt", FFECOM_rttypeINTEGER_, FALSE, FALSE) *************** DEFGFRT (FFECOM_gfrtMOD, "i_mod", FFECOM *** 148,154 **** --- 159,167 ---- DEFGFRT (FFECOM_gfrtNINT, "i_nint", FFECOM_rttypeINTEGER_, FALSE, FALSE) DEFGFRT (FFECOM_gfrtSIGN, "r_sign", FFECOM_rttypeDOUBLE_, FALSE, FALSE) + DEFGFRT (FFECOM_gfrtSIGNAL, "signal_", FFECOM_rttypeINTEGER_, FALSE, FALSE) DEFGFRT (FFECOM_gfrtSIN, "r_sin", FFECOM_rttypeDOUBLE_, FALSE, FALSE) DEFGFRT (FFECOM_gfrtSINH, "r_sinh", FFECOM_rttypeDOUBLE_, FALSE, FALSE) DEFGFRT (FFECOM_gfrtSQRT, "r_sqrt", FFECOM_rttypeDOUBLE_, FALSE, FALSE) + DEFGFRT (FFECOM_gfrtSYSTEM, "system_", FFECOM_rttypeINTEGER_, FALSE, FALSE) DEFGFRT (FFECOM_gfrtTAN, "r_tan", FFECOM_rttypeDOUBLE_, FALSE, FALSE) DEFGFRT (FFECOM_gfrtTANH, "r_tanh", FFECOM_rttypeDOUBLE_, FALSE, FALSE) *************** DEFGFRT (FFECOM_gfrtL_ATAN2, "atan2", FF *** 168,171 **** --- 181,186 ---- DEFGFRT (FFECOM_gfrtL_COS, "__builtin_cos", FFECOM_rttypeDOUBLE_, FALSE, FALSE) DEFGFRT (FFECOM_gfrtL_COSH, "cosh", FFECOM_rttypeDOUBLE_, FALSE, FALSE) + DEFGFRT (FFECOM_gfrtL_ERF, "erf", FFECOM_rttypeDOUBLE_, FALSE, FALSE) + DEFGFRT (FFECOM_gfrtL_ERFC, "erfc", FFECOM_rttypeDOUBLE_, FALSE, FALSE) DEFGFRT (FFECOM_gfrtL_EXP, "exp", FFECOM_rttypeDOUBLE_, FALSE, FALSE) DEFGFRT (FFECOM_gfrtL_FLOOR, "floor", FFECOM_rttypeDOUBLE_, FALSE, FALSE) diff -rcp2N g77-0.5.15/f/com.c g77-0.5.16/f/com.c *** g77-0.5.15/f/com.c Fri May 19 11:17:28 1995 --- g77-0.5.16/f/com.c Wed Aug 30 15:53:37 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** the Free Software Foundation, 675 Mass A *** 91,95 **** #include "tree.j" #include "convert.j" ! #endif /* GCC */ #define FFECOM_GCC_INCLUDE 1 /* Enable -I. */ --- 92,96 ---- #include "tree.j" #include "convert.j" ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ #define FFECOM_GCC_INCLUDE 1 /* Enable -I. */ *************** the Free Software Foundation, 675 Mass A *** 97,106 **** /* BEGIN stuff from gcc/cccp.c. */ /* This defines "errno" properly for VMS, and gives us EACCES. */ #include /* VMS-specific definitions */ #ifdef VMS - #include #include #define O_RDONLY 0 /* Open arg for Read/Only */ --- 98,167 ---- /* BEGIN stuff from gcc/cccp.c. */ + /* The following symbols should be autoconfigured: + HAVE_FCNTL_H + HAVE_STDLIB_H + HAVE_SYS_TIME_H + HAVE_UNISTD_H + STDC_HEADERS + TIME_WITH_SYS_TIME + In the mean time, we'll get by with approximations based + on existing GCC configuration symbols. */ + + #ifdef POSIX + # ifndef HAVE_STDLIB_H + # define HAVE_STDLIB_H 1 + # endif + # ifndef HAVE_UNISTD_H + # define HAVE_UNISTD_H 1 + # endif + # ifndef STDC_HEADERS + # define STDC_HEADERS 1 + # endif + #endif /* defined (POSIX) */ + + #if defined (POSIX) || (defined (USG) && !defined (VMS)) + # ifndef HAVE_FCNTL_H + # define HAVE_FCNTL_H 1 + # endif + #endif + + #ifndef RLIMIT_STACK + # include + #else + # if TIME_WITH_SYS_TIME + # include + # include + # else + # if HAVE_SYS_TIME_H + # include + # else + # include + # endif + # endif + # include + #endif + + #if HAVE_FCNTL_H + # include + #endif + /* This defines "errno" properly for VMS, and gives us EACCES. */ #include + #if HAVE_STDLIB_H + # include + #else + char *getenv (); + #endif + + char *index (); + char *rindex (); + + #if HAVE_UNISTD_H + # include + #endif + /* VMS-specific definitions */ #ifdef VMS #include #define O_RDONLY 0 /* Open arg for Read/Only */ *************** the Free Software Foundation, 675 Mass A *** 112,115 **** --- 173,178 ---- #define freopen(fname,mode,ofile) VMS_freopen (fname,mode,ofile) #define strncat(dst,src,cnt) VMS_strncat (dst,src,cnt) + #define fstat(fd,stbuf) VMS_fstat (fd,stbuf) + static int VMS_fstat (), VMS_stat (); static char * VMS_strncat (); static int VMS_read (); *************** typedef struct { unsigned :16, :16, :16; *** 126,132 **** #endif /* __GNUC__ */ #endif /* VMS */ - - extern char *index (); - extern char *rindex (); #ifndef O_RDONLY --- 189,192 ---- *************** static tree complex_long_double_type_nod *** 207,210 **** --- 267,274 ---- tree string_type_node; + static tree double_ftype_double; + static tree float_ftype_float; + static tree ldouble_ftype_ldouble; + /* The rest of these are inventions for g77, though there might be similar things in the C front end. As they are found, these *************** tree string_type_node; *** 214,218 **** static tree ffecom_tree_fun_type_void; static tree ffecom_tree_ptr_to_fun_type_void; - static tree ffecom_tree_fun_type_double; tree ffecom_integer_type_node; /* Abbrev for _tree_type[blah][blah]. */ --- 278,281 ---- *************** static tree ffecom_tree_ptr_to_subr_type *** 231,234 **** --- 294,299 ---- static tree ffecom_tree_blockdata_type; + static tree ffecom_tree_xargc_; + ffecomSymbol ffecom_symbol_null_ = *************** tree ffecom_f2c_ptr_to_ftnlen_type_node; *** 255,259 **** tree ffecom_f2c_ftnint_type_node; tree ffecom_f2c_ptr_to_ftnint_type_node; ! #endif /* Simple definitions and enumerations. */ --- 320,324 ---- tree ffecom_f2c_ftnint_type_node; tree ffecom_f2c_ptr_to_ftnint_type_node; ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Simple definitions and enumerations. */ *************** typedef enum *** 276,279 **** --- 341,345 ---- { FFECOM_rttypeVOID_, + FFECOM_rttypeINT_, /* C's `int' type, for libF77/system_.c? */ FFECOM_rttypeINTEGER_, FFECOM_rttypeLOGICAL_, *************** typedef enum *** 280,284 **** FFECOM_rttypeREAL_, FFECOM_rttypeCOMPLEX_, ! FFECOM_rttypeDOUBLE_, /* C's double type. */ FFECOM_rttypeDOUBLEREAL_, FFECOM_rttypeDBLCMPLX_, --- 346,350 ---- FFECOM_rttypeREAL_, FFECOM_rttypeCOMPLEX_, ! FFECOM_rttypeDOUBLE_, /* C's `double' type. */ FFECOM_rttypeDOUBLEREAL_, FFECOM_rttypeDBLCMPLX_, *************** typedef enum *** 291,295 **** typedef struct _ffecom_concat_list_ ffecomConcatList_; typedef struct _ffecom_temp_ *ffecomTemp_; ! #endif /* Private include files. */ --- 357,361 ---- typedef struct _ffecom_concat_list_ ffecomConcatList_; typedef struct _ffecom_temp_ *ffecomTemp_; ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Private include files. */ *************** struct _ffecom_temp_ *** 319,323 **** }; ! #endif /* Static functions (internal). */ --- 385,389 ---- }; ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Static functions (internal). */ *************** struct _ffecom_temp_ *** 324,327 **** --- 390,399 ---- #if FFECOM_targetCURRENT == FFECOM_targetGCC + static bool ffecom_overlap_ (tree dest_decl, tree dest_offset, + tree dest_size, tree source_tree, + ffebld source, bool scalar_arg); + 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, *************** static tree ffecom_call_ (tree fn, ffein *** 328,337 **** bool is_f2c_complex, tree type, tree args, tree dest_tree, ! ffeinfo dest_info, bool *dest_used); static tree ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, tree type, ffebld left, ffebld right, ! tree dest_tree, ffeinfo dest_info, ! bool *dest_used); static void ffecom_char_args_ (tree *xitem, tree *length, ffebld expr); --- 400,411 ---- 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_ (tree *xitem, tree *length, ffebld expr); *************** static ffecomConcatList_ ffecom_concat_l *** 346,353 **** static void ffecom_do_entry_ (ffesymbol fn, int entrynum); static tree ffecom_expr_ (ffebld expr, tree dest_tree, ! ffeinfo dest_info, bool *dest_used, bool assignp); static tree ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree, ! ffeinfo dest_info, bool *dest_used); static tree ffecom_expr_power_integer_ (ffebld left, ffebld right); static void ffecom_expr_transform_ (ffebld expr); --- 420,427 ---- 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); 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_set_lio_code_ (ff *** 357,368 **** static ffeglobal ffecom_finish_global_ (ffeglobal global); static ffesymbol ffecom_finish_symbol_transform_ (ffesymbol s); - #if FFETARGET_isEXTERNAL_UNDERSCORED || FFETARGET_isUNDERSCORED_EXTERNAL_UNDERSCORED static tree ffecom_get_appended_identifier_ (char us, char *text); ! static tree ffecom_get_external_identifier_ (char *text); static tree ffecom_get_identifier_ (char *text); - #else - #define ffecom_get_external_identifier_(name) get_identifier (name) - #define ffecom_get_identifier_(name) get_identifier (name) - #endif static tree ffecom_gen_sfuncdef_ (ffesymbol s, ffeinfoBasictype bt, --- 431,437 ---- 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, *************** static void ffecom_transform_common_ (ff *** 391,396 **** static void ffecom_transform_equiv_ (ffestorag st); static tree ffecom_transform_namelist_ (ffesymbol s); static tree ffecom_tree_divide_ (tree tree_type, tree left, tree right, ! tree dest_tree, ffeinfo dest_info, bool *dest_used); static tree ffecom_type_localvar_ (ffesymbol s, --- 460,469 ---- static void ffecom_transform_equiv_ (ffestorag st); static tree ffecom_transform_namelist_ (ffesymbol s); + static void ffecom_tree_canonize_ptr_ (tree *decl, tree *offset, + tree t); + static void ffecom_tree_canonize_ref_ (tree *decl, tree *offset, + 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, *************** static tree ffecom_vardesc_ (ffebld expr *** 405,409 **** static tree ffecom_vardesc_array_ (ffesymbol s); static tree ffecom_vardesc_dims_ (ffesymbol s); ! #endif /* These are static functions that parallel those found in the C front --- 478,482 ---- 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 *************** static void store_parm_decls (int is_mai *** 430,434 **** static tree start_decl (tree decl, bool is_top_level); static void start_function (tree name, tree type, int nested, int public); ! #endif #if FFECOM_GCC_INCLUDE static void ffecom_file_ (char *name); --- 503,507 ---- static tree start_decl (tree decl, bool is_top_level); static void start_function (tree name, tree type, int nested, int public); ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ #if FFECOM_GCC_INCLUDE static void ffecom_file_ (char *name); *************** static FILE *ffecom_open_include_ (char *** 443,446 **** --- 516,520 ---- static ffesymbol ffecom_primary_entry_ = NULL; + static ffesymbol ffecom_nested_entry_ = NULL; static ffeinfoKind ffecom_primary_entry_kind_; static bool ffecom_primary_entry_is_proc_; *************** static tree ffecom_which_entrypoint_decl *** 451,455 **** static ffecomTemp_ ffecom_latest_temp_; static int ffecom_pending_calls_ = 0; - static int ffecom_no_new_tempvars_ = 0; static tree ffecom_float_zero_ = NULL_TREE; static tree ffecom_float_half_ = NULL_TREE; --- 525,528 ---- *************** static ffecomRttype_ ffecom_gfrt_type_[F *** 529,533 **** static ffeinfoBasictype ffecom_gfrt_kt_[FFECOM_gfrt]; ! #endif /* Internal macros. */ --- 602,606 ---- static ffeinfoBasictype ffecom_gfrt_kt_[FFECOM_gfrt]; ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Internal macros. */ *************** static tree shadowed_labels; *** 659,662 **** --- 732,968 ---- #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ + + /* Check whether dest and source might overlap. ffebld versions of these + might or might not be passed, will be NULL if not. + + The test is really whether source_tree is modifiable and, if modified, + might overlap destination such that the value(s) in the destination might + change before it is finally modified. dest_* are the canonized + destination itself. */ + + #if FFECOM_targetCURRENT == FFECOM_targetGCC + static bool + ffecom_overlap_ (tree dest_decl, tree dest_offset, tree dest_size, + tree source_tree, ffebld source UNUSED, + bool scalar_arg) + { + tree source_decl; + tree source_offset; + tree source_size; + tree t; + + if (source_tree == NULL_TREE) + return FALSE; + + switch (TREE_CODE (source_tree)) + { + case ERROR_MARK: + case IDENTIFIER_NODE: + case INTEGER_CST: + case REAL_CST: + case COMPLEX_CST: + case STRING_CST: + case CONST_DECL: + case VAR_DECL: + case RESULT_DECL: + case FIELD_DECL: + 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: + return FALSE; + + case COMPOUND_EXPR: + return ffecom_overlap_ (dest_decl, dest_offset, dest_size, + TREE_OPERAND (source_tree, 1), NULL, + scalar_arg); + + case MODIFY_EXPR: + return ffecom_overlap_ (dest_decl, dest_offset, dest_size, + TREE_OPERAND (source_tree, 0), NULL, + scalar_arg); + + case CONVERT_EXPR: + case NOP_EXPR: + case NON_LVALUE_EXPR: + case PLUS_EXPR: + if (TREE_CODE (TREE_TYPE (source_tree)) != POINTER_TYPE) + return TRUE; + + ffecom_tree_canonize_ptr_ (&source_decl, &source_offset, + source_tree); + source_size = TYPE_SIZE (TREE_TYPE (TREE_TYPE (source_tree))); + break; + + case COND_EXPR: + return + ffecom_overlap_ (dest_decl, dest_offset, dest_size, + TREE_OPERAND (source_tree, 1), NULL, + scalar_arg) + || ffecom_overlap_ (dest_decl, dest_offset, dest_size, + TREE_OPERAND (source_tree, 2), NULL, + scalar_arg); + + + case ADDR_EXPR: + ffecom_tree_canonize_ref_ (&source_decl, &source_offset, + &source_size, + TREE_OPERAND (source_tree, 0)); + break; + + case PARM_DECL: + if (TREE_CODE (TREE_TYPE (source_tree)) != POINTER_TYPE) + return TRUE; + + source_decl = source_tree; + source_offset = size_zero_node; + source_size = TYPE_SIZE (TREE_TYPE (TREE_TYPE (source_tree))); + break; + + case SAVE_EXPR: + case REFERENCE_EXPR: + case PREDECREMENT_EXPR: + case PREINCREMENT_EXPR: + case POSTDECREMENT_EXPR: + case POSTINCREMENT_EXPR: + case INDIRECT_REF: + case ARRAY_REF: + case CALL_EXPR: + default: + return TRUE; + } + + /* Come here when source_decl, source_offset, and source_size filled + in appropriately. */ + + if (source_decl == NULL_TREE) + return FALSE; /* No decl involved, so no overlap. */ + + if (source_decl != dest_decl) + return FALSE; /* Different decl, no overlap. */ + + if (TREE_CODE (dest_size) == ERROR_MARK) + return TRUE; /* Assignment into entire assumed-size + array? Shouldn't happen.... */ + + t = ffecom_2 (LE_EXPR, integer_type_node, + ffecom_2 (PLUS_EXPR, TREE_TYPE (dest_offset), + dest_offset, + convert (TREE_TYPE (dest_offset), + dest_size)), + convert (TREE_TYPE (dest_offset), + source_offset)); + + if (integer_onep (t)) + return FALSE; /* Destination precedes source. */ + + if (!scalar_arg + || (source_size == NULL_TREE) + || (TREE_CODE (source_size) == ERROR_MARK) + || integer_zerop (source_size)) + return TRUE; /* No way to tell if dest follows source. */ + + t = ffecom_2 (LE_EXPR, integer_type_node, + ffecom_2 (PLUS_EXPR, TREE_TYPE (source_offset), + source_offset, + convert (TREE_TYPE (source_offset), + source_size)), + convert (TREE_TYPE (source_offset), + dest_offset)); + + if (integer_onep (t)) + return FALSE; /* Destination follows source. */ + + return TRUE; /* Destination and source overlap. */ + } + #endif + + /* Check whether dest might overlap any of a list of arguments or is + in a COMMON area the callee might know about (and thus modify). */ + + #if FFECOM_targetCURRENT == FFECOM_targetGCC + static bool + ffecom_args_overlapping_ (tree dest_tree, ffebld dest UNUSED, + tree args, tree callee_commons, + bool scalar_args) + { + tree arg; + tree dest_decl; + tree dest_offset; + tree dest_size; + + ffecom_tree_canonize_ref_ (&dest_decl, &dest_offset, &dest_size, + dest_tree); + + if (dest_decl == NULL_TREE) + return FALSE; /* Seems unlikely! */ + + /* If the decl cannot be determined reliably, or if its in COMMON + and the callee isn't known to not futz with COMMON via other + means, overlap might happen. */ + + if ((TREE_CODE (dest_decl) == ERROR_MARK) + || ((callee_commons != NULL_TREE) + && TREE_PUBLIC (dest_decl))) + return TRUE; + + for (; args != NULL_TREE; args = TREE_CHAIN (args)) + { + if (((arg = TREE_VALUE (args)) != NULL_TREE) + && ffecom_overlap_ (dest_decl, dest_offset, dest_size, + arg, NULL, scalar_args)) + return TRUE; + } + + return FALSE; + } + #endif + /* Build a string for a variable name as used by NAMELIST. This means that if we're using the f2c library, we build an uppercase string, since *************** ffecom_build_f2c_string_ (int i, char *s *** 677,681 **** tree t; ! if (i > ARRAY_SIZE (space)) tmp = malloc_new_ks (malloc_pool_image (), "f2c_string", i); else --- 983,987 ---- tree t; ! if (((size_t) i) > ARRAY_SIZE (space)) tmp = malloc_new_ks (malloc_pool_image (), "f2c_string", i); else *************** ffecom_build_f2c_string_ (int i, char *s *** 688,692 **** t = build_string (i, tmp); ! if (i > ARRAY_SIZE (space)) malloc_kill_ks (malloc_pool_image (), tmp, i); --- 994,998 ---- t = build_string (i, tmp); ! if (((size_t) i) > ARRAY_SIZE (space)) malloc_kill_ks (malloc_pool_image (), tmp, i); *************** static tree *** 705,709 **** ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, tree type, tree args, tree dest_tree, ! ffeinfo dest_info, bool *dest_used) { tree item; --- 1011,1016 ---- 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; *************** ffecom_call_ (tree fn, ffeinfoKindtype k *** 716,722 **** { if ((dest_used == NULL) ! || (ffeinfo_basictype (dest_info) != FFEINFO_basictypeCOMPLEX) ! || (ffeinfo_kindtype (dest_info) != kt) ! || ((type != NULL_TREE) && (TREE_TYPE (dest_tree) != type))) { tempvar = ffecom_push_tempvar (ffecom_tree_type --- 1023,1034 ---- { if ((dest_used == NULL) ! || (dest == NULL) ! || (ffeinfo_basictype (ffebld_info (dest)) ! != FFEINFO_basictypeCOMPLEX) ! || (ffeinfo_kindtype (ffebld_info (dest)) != kt) ! || ((type != NULL_TREE) && (TREE_TYPE (dest_tree) != type)) ! || ffecom_args_overlapping_ (dest_tree, dest, args, ! callee_commons, ! scalar_args)) { tempvar = ffecom_push_tempvar (ffecom_tree_type *************** static tree *** 763,767 **** ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, tree type, ffebld left, ffebld right, ! tree dest_tree, ffeinfo dest_info, bool *dest_used) { tree left_tree; --- 1075,1080 ---- 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; *************** ffecom_call_binop_ (tree fn, ffeinfoKind *** 795,799 **** return ffecom_call_ (fn, kt, is_f2c_complex, type, left_tree, ! dest_tree, dest_info, dest_used); } #endif --- 1108,1113 ---- return ffecom_call_ (fn, kt, is_f2c_complex, type, left_tree, ! dest_tree, dest, dest_used, callee_commons, ! scalar_args); } #endif *************** ffecom_char_args_ (tree *xitem, tree *le *** 816,819 **** --- 1130,1134 ---- { tree item; + tree high; ffetargetCharacter1 val; *************** ffecom_char_args_ (tree *xitem, tree *le *** 824,827 **** --- 1139,1145 ---- *length = build_int_2 (ffetarget_length_character1 (val), 0); TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node; + high = build_int_2 (ffetarget_length_character1 (val), + 0); + TREE_TYPE (high) = ffecom_f2c_ftnlen_type_node; item = build_string (ffetarget_length_character1 (val), ffetarget_text_character1 (val)); *************** ffecom_char_args_ (tree *xitem, tree *le *** 828,840 **** TREE_TYPE (item) = build_type_variant ! (build_array_type ! (char_type_node, ! build_range_type ! (ffecom_f2c_ftnlen_type_node, ! ffecom_f2c_ftnlen_one_node, ! build_int_2 ! (ffetarget_length_character1 (val), ! 0))), ! 1, 0); TREE_CONSTANT (item) = 1; TREE_STATIC (item) = 1; --- 1146,1156 ---- TREE_TYPE (item) = 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 (item) = 1; TREE_STATIC (item) = 1; *************** ffecom_char_args_ (tree *xitem, tree *le *** 1018,1022 **** { /* Invocation of an intrinsic. */ item = ffecom_expr_intrinsic_ (expr, NULL_TREE, ! ffeinfo_new_null (), NULL); break; } --- 1334,1338 ---- { /* Invocation of an intrinsic. */ item = ffecom_expr_intrinsic_ (expr, NULL_TREE, ! NULL, NULL); break; } *************** ffecom_char_enhance_arg_ (tree *xtype, f *** 1146,1152 **** else { ! tlen = ffecom_get_invented_identifier ("__g77_length_%s", ! ffesymbol_text (s), 0); tlen = build_decl (PARM_DECL, tlen, ffecom_f2c_ftnlen_type_node); } --- 1462,1475 ---- else { ! 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; + #endif } *************** ffecom_do_entry_ (ffesymbol fn, int entr *** 1445,1449 **** ffecom_do_entrypoint (which calls this fn). */ ! start_function (ffecom_get_external_identifier_ (ffesymbol_text (fn)), type, 0, /* nested/inline */ --- 1768,1772 ---- ffecom_do_entrypoint (which calls this fn). */ ! start_function (ffecom_get_external_identifier_ (fn), type, 0, /* nested/inline */ *************** ffecom_do_entry_ (ffesymbol fn, int entr *** 1481,1486 **** type = ffecom_tree_type[FFEINFO_basictypeCOMPLEX][kt]; ! result = ffecom_get_invented_identifier ("__g77_result_%s", ! ffesymbol_text (fn), 0); /* Make length arg _and_ enhance type info for CHAR arg itself. */ --- 1804,1809 ---- 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. */ *************** ffecom_do_entry_ (ffesymbol fn, int entr *** 1698,1702 **** static tree ffecom_expr_ (ffebld expr, tree dest_tree, ! ffeinfo dest_info, bool *dest_used, bool assignp) { --- 2021,2025 ---- static tree ffecom_expr_ (ffebld expr, tree dest_tree, ! ffebld dest, bool *dest_used, bool assignp) { *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 1745,1748 **** --- 2068,2073 ---- } + item = build_int_2 (ffebld_arrter_size (expr), 0); + TREE_TYPE (item) = ffecom_integer_type_node; item = build_array_type *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 1750,1757 **** build_range_type (ffecom_integer_type_node, ffecom_integer_one_node, ! convert (ffecom_integer_type_node, ! build_int_2 (ffebld_arrter_size ! (expr), ! 0)))); list = build (CONSTRUCTOR, item, NULL_TREE, list); TREE_CONSTANT (list) = 1; --- 2075,2079 ---- build_range_type (ffecom_integer_type_node, ffecom_integer_one_node, ! item)); list = build (CONSTRUCTOR, item, NULL_TREE, list); TREE_CONSTANT (list) = 1; *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 1829,1834 **** i >= 0; --i, array = TYPE_MAIN_VARIANT (TREE_TYPE (array))) ! t ! = ffecom_2 (PLUS_EXPR, build_pointer_type (TREE_TYPE (array)), t, --- 2151,2155 ---- i >= 0; --i, array = TYPE_MAIN_VARIANT (TREE_TYPE (array))) ! t = ffecom_2 (PLUS_EXPR, build_pointer_type (TREE_TYPE (array)), t, *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 1890,1894 **** ffecom_expr (ffebld_left (expr)), ffecom_expr (ffebld_right (expr)), ! dest_tree, dest_info, dest_used); case FFEBLD_opPOWER: --- 2211,2215 ---- ffecom_expr (ffebld_left (expr)), ffecom_expr (ffebld_right (expr)), ! dest_tree, dest, dest_used); case FFEBLD_opPOWER: *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 1974,1981 **** return ffecom_call_binop_ (ffecom_gfrt_tree_ (code), ffecom_gfrt_kind_type_ (code), ! ffe_is_f2c_library () ! && ffecom_gfrt_complex_[code], tree_type, left, right, ! dest_tree, dest_info, dest_used); } --- 2295,2303 ---- return ffecom_call_binop_ (ffecom_gfrt_tree_ (code), ffecom_gfrt_kind_type_ (code), ! (ffe_is_f2c_library () ! && ffecom_gfrt_complex_[code]), tree_type, left, right, ! dest_tree, dest, dest_used, ! NULL_TREE, FALSE); } *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 2011,2015 **** == FFEINFO_whereINTRINSIC) { /* Invocation of an intrinsic. */ ! item = ffecom_expr_intrinsic_ (expr, dest_tree, dest_info, dest_used); return item; --- 2333,2337 ---- == FFEINFO_whereINTRINSIC) { /* Invocation of an intrinsic. */ ! item = ffecom_expr_intrinsic_ (expr, dest_tree, dest, dest_used); return item; *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 2044,2048 **** tree_type, args, ! dest_tree, dest_info, dest_used); TREE_SIDE_EFFECTS (item) = 1; return item; --- 2366,2371 ---- tree_type, args, ! dest_tree, dest, dest_used, ! error_mark_node, FALSE); TREE_SIDE_EFFECTS (item) = 1; return item; *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 2451,2455 **** static tree ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree, ! ffeinfo dest_info, bool *dest_used) { tree expr_tree; --- 2774,2778 ---- static tree ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree, ! ffebld dest, bool *dest_used) { tree expr_tree; *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 2467,2471 **** ffebld arg3; ffecomGfrt ix; - bool returns_complex = FALSE; assert (ffebld_op (ffebld_left (expr)) == FFEBLD_opSYMTER); --- 2790,2793 ---- *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 2477,2480 **** --- 2799,2804 ---- kt = ffeinfo_kindtype (ffebld_info (expr)); tree_type = ffecom_tree_type[bt][kt]; + if (tree_type == NULL_TREE) + tree_type = void_type_node; /* For SUBROUTINEs. */ if (list != NULL) *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 2540,2547 **** switch (ffebld_symter_implementation (ffebld_left (expr))) { - case FFEINTRIN_impNONE: - assert ("No specific intrinsic to invoke!" == NULL); - break; /* Use wrapper. */ - case FFEINTRIN_impABS: /* r__1 = (doublereal)(( r1 ) >= 0 ? ( r1 ) : -( r1 )) ; */ --- 2864,2867 ---- *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 2594,2598 **** case FFEINTRIN_impALOG10: /* r__1 = r_lg10(&r1); */ ! break; /* Use wrapper. */ case FFEINTRIN_impAMAX0: --- 2914,2918 ---- case FFEINTRIN_impALOG10: /* r__1 = r_lg10(&r1); */ ! break; case FFEINTRIN_impAMAX0: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 2663,2669 **** /* r__1 = r_mod(&r1, &r2); */ /* Ideally we'd have a handy operator to do this, but we don't, and we ! don't want to do it in the integer domain or we might lose precision ! or range, so just call the r_mod function. */ ! break; /* Use wrapper. */ case FFEINTRIN_impANINT: --- 2983,2989 ---- /* r__1 = r_mod(&r1, &r2); */ /* Ideally we'd have a handy operator to do this, but we don't, and we ! don't want to do it in the integer domain or we might lose precision ! or range, so just call the r_mod function. */ ! break; case FFEINTRIN_impANINT: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 2734,2740 **** /* r__1 = c_abs(&c1); */ #if 0 return ffecom_1 (ABS_EXPR, tree_type, ffecom_expr (arg1)); #else ! break; /* Use wrapper. */ #endif --- 3054,3063 ---- /* r__1 = c_abs(&c1); */ #if 0 + /* This and other gcc back end ops are not implemented to use + sufficient precision, so don't use gcc's implementation -- + use the run-time library instead. */ return ffecom_1 (ABS_EXPR, tree_type, ffecom_expr (arg1)); #else ! break; #endif *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 2742,2747 **** case FFEINTRIN_impCDCOS: /* c_cos(&q__1, &c1); */ ! returns_complex = TRUE; ! break; /* Use wrapper. */ case FFEINTRIN_impCEXP: --- 3065,3069 ---- case FFEINTRIN_impCDCOS: /* c_cos(&q__1, &c1); */ ! break; case FFEINTRIN_impCEXP: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 2748,2753 **** case FFEINTRIN_impCDEXP: /* c_exp(&q__1, &c1); */ ! returns_complex = TRUE; ! break; /* Use wrapper. */ case FFEINTRIN_impCHAR: --- 3070,3074 ---- case FFEINTRIN_impCDEXP: /* c_exp(&q__1, &c1); */ ! break; case FFEINTRIN_impCHAR: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 2776,2781 **** case FFEINTRIN_impCDLOG: /* c_log(&q__1, &c1); */ ! returns_complex = TRUE; ! break; /* Use wrapper. */ case FFEINTRIN_impCONJG: --- 3097,3101 ---- case FFEINTRIN_impCDLOG: /* c_log(&q__1, &c1); */ ! break; case FFEINTRIN_impCONJG: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 2782,2787 **** case FFEINTRIN_impDCONJG: /* r_cnjg(&q__1, &c1); */ ! returns_complex = TRUE; ! break; /* Use wrapper. */ case FFEINTRIN_impCOS: --- 3102,3106 ---- case FFEINTRIN_impDCONJG: /* r_cnjg(&q__1, &c1); */ ! break; case FFEINTRIN_impCOS: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 2798,2803 **** case FFEINTRIN_impCDSIN: /* c_sin(&q__1, &c1); */ ! returns_complex = TRUE; ! break; /* Use wrapper. */ case FFEINTRIN_impCSQRT: --- 3117,3121 ---- case FFEINTRIN_impCDSIN: /* c_sin(&q__1, &c1); */ ! break; case FFEINTRIN_impCSQRT: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 2804,2809 **** case FFEINTRIN_impCDSQRT: /* c_sqrt(&q__1, &c1); */ ! returns_complex = TRUE; ! break; /* Use wrapper. */ case FFEINTRIN_impDABS: --- 3122,3126 ---- case FFEINTRIN_impCDSQRT: /* c_sqrt(&q__1, &c1); */ ! break; case FFEINTRIN_impDABS: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 2909,2913 **** case FFEINTRIN_impDLOG10: /* d__1 = d_lg10(&d1); */ ! break; /* Use wrapper. */ case FFEINTRIN_impDMAX1: --- 3226,3230 ---- case FFEINTRIN_impDLOG10: /* d__1 = d_lg10(&d1); */ ! break; case FFEINTRIN_impDMAX1: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 2945,2949 **** case FFEINTRIN_impDMOD: /* d__1 = d_mod(&d1, &d2); */ ! break; /* Use wrapper. */ case FFEINTRIN_impDNINT: --- 3262,3266 ---- case FFEINTRIN_impDMOD: /* d__1 = d_mod(&d1, &d2); */ ! break; case FFEINTRIN_impDNINT: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3055,3061 **** /* i__1 = *a1; */ #if 0 /* The simple approach. */ - ffecom_push_calltemps (); ffecom_char_args_ (&expr_tree, &saved_expr1 /* Ignored */ , arg1); - ffecom_pop_calltemps (); expr_tree = ffecom_1 (INDIRECT_REF, --- 3372,3376 ---- *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3117,3121 **** case FFEINTRIN_impINDEX: /* i__1 = i_indx(a1, a2, 10L, 10L); */ ! break; /* Use wrapper. */ case FFEINTRIN_impISIGN: --- 3432,3436 ---- case FFEINTRIN_impINDEX: /* i__1 = i_indx(a1, a2, 10L, 10L); */ ! break; case FFEINTRIN_impISIGN: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3141,3145 **** /* i__1 = i_len(a1, 10L); */ #if 0 /* The simple approach. */ ! break; /* Use wrapper. */ #else /* The more interesting (and more optimal) approach. */ return ffecom_intrinsic_len_ (arg1); --- 3456,3460 ---- /* i__1 = i_len(a1, 10L); */ #if 0 /* The simple approach. */ ! break; #else /* The more interesting (and more optimal) approach. */ return ffecom_intrinsic_len_ (arg1); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3148,3164 **** case FFEINTRIN_impLGE: /* L__1 = l_ge(a1, a2, 10L, 10L); */ ! break; /* Use wrapper. */ case FFEINTRIN_impLGT: /* L__1 = l_gt(a1, a2, 10L, 10L); */ ! break; /* Use wrapper. */ case FFEINTRIN_impLLE: /* L__1 = l_le(a1, a2, 10L, 10L); */ ! break; /* Use wrapper. */ case FFEINTRIN_impLLT: /* L__1 = l_lt(a1, a2, 10L, 10L); */ ! break; /* Use wrapper. */ case FFEINTRIN_impMAX0: --- 3463,3479 ---- case FFEINTRIN_impLGE: /* L__1 = l_ge(a1, a2, 10L, 10L); */ ! break; case FFEINTRIN_impLGT: /* L__1 = l_gt(a1, a2, 10L, 10L); */ ! break; case FFEINTRIN_impLLE: /* L__1 = l_le(a1, a2, 10L, 10L); */ ! break; case FFEINTRIN_impLLT: /* L__1 = l_lt(a1, a2, 10L, 10L); */ ! break; case FFEINTRIN_impMAX0: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3180,3184 **** case FFEINTRIN_impMAX1: /* i__1 = (integer) (doublereal)(( r1 ) >= ( r2 ) ? ( r1 ) : ( r2 ! )) ; */ expr_tree = ffecom_2 (MAX_EXPR, arg1_type, ffecom_expr (arg1), --- 3495,3499 ---- case FFEINTRIN_impMAX1: /* i__1 = (integer) (doublereal)(( r1 ) >= ( r2 ) ? ( r1 ) : ( r2 ! )) ; */ expr_tree = ffecom_2 (MAX_EXPR, arg1_type, ffecom_expr (arg1), *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3213,3217 **** case FFEINTRIN_impMIN1: /* i__1 = (integer) (doublereal)(( r1 ) <= ( r2 ) ? ( r1 ) : ( r2 ! )) ; */ expr_tree = ffecom_2 (MIN_EXPR, arg1_type, ffecom_expr (arg1), --- 3528,3532 ---- case FFEINTRIN_impMIN1: /* i__1 = (integer) (doublereal)(( r1 ) <= ( r2 ) ? ( r1 ) : ( r2 ! )) ; */ expr_tree = ffecom_2 (MIN_EXPR, arg1_type, ffecom_expr (arg1), *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3730,3734 **** case FFEINTRIN_impMVBITS: - tree_type = void_type_node; /* Instead of NULL_TREE for SUBR. */ { tree arg1_tree; --- 4045,4048 ---- *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3851,3854 **** --- 4165,4310 ---- return expr_tree; + case FFEINTRIN_impERF: + case FFEINTRIN_impDERF: + ix = FFECOM_gfrtL_ERF; + goto library; /* :::::::::::::::::::: */ + + case FFEINTRIN_impERFC: + case FFEINTRIN_impDERFC: + ix = FFECOM_gfrtL_ERFC; + goto library; /* :::::::::::::::::::: */ + + case FFEINTRIN_impIARGC: + /* extern int xargc; i__1 = xargc - 1; */ + expr_tree = ffecom_2 (MINUS_EXPR, TREE_TYPE (ffecom_tree_xargc_), + ffecom_tree_xargc_, + convert (TREE_TYPE (ffecom_tree_xargc_), + integer_one_node)); + return expr_tree; + + case FFEINTRIN_impSIGNAL: + { + tree arg1_tree; + tree arg2_tree; + tree arg3_tree; + + ffecom_push_calltemps (); + + arg1_tree = ffecom_ptr_to_expr (arg1); + + /* Pass procedure as a pointer to it, anything else by value. */ + if (ffeinfo_kind (ffebld_info (arg2)) == FFEINFO_kindENTITY) + arg2_tree = ffecom_expr (arg2); + else + arg2_tree = ffecom_ptr_to_expr (arg2); + arg2_tree = convert (TREE_TYPE (null_pointer_node), + 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; + + expr_tree + = ffecom_call_ (ffecom_gfrt_tree_ (FFECOM_gfrtSIGNAL), + ffecom_gfrt_kind_type_ (FFECOM_gfrtSIGNAL), + FALSE, + integer_type_node, + 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), + expr_tree)); + } + return expr_tree; + + case FFEINTRIN_impSYSTEM: + { + tree arg1_len = integer_zero_node; + 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; + + expr_tree + = ffecom_call_ (ffecom_gfrt_tree_ (FFECOM_gfrtSYSTEM), + ffecom_gfrt_kind_type_ (FFECOM_gfrtSYSTEM), + FALSE, + integer_type_node, + 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), + expr_tree)); + } + return expr_tree; + + case FFEINTRIN_impEXIT: + if (arg1 != NULL) + break; + + #ifdef VMS_TARGET + expr_tree = ffecom_integer_zero_node; /* C lib translates this!! */ + #else + expr_tree = ffecom_integer_zero_node; + #endif + + expr_tree = build_tree_list (NULL_TREE, + ffecom_1 (ADDR_EXPR, + build_pointer_type + (ffecom_integer_type_node), + expr_tree)); + + return + ffecom_call_ (ffecom_gfrt_tree_ (FFECOM_gfrtEXIT), + ffecom_gfrt_kind_type_ (FFECOM_gfrtEXIT), + FALSE, + void_type_node, + expr_tree, + NULL_TREE, NULL, NULL, NULL_TREE, TRUE); + + case FFEINTRIN_impFLUSH: + if (arg1 == NULL) + break; + + /* Ignore the arg, since the library has no use for it yet. */ + return + ffecom_call_ (ffecom_gfrt_tree_ (FFECOM_gfrtFLUSH), + ffecom_gfrt_kind_type_ (FFECOM_gfrtFLUSH), + FALSE, + void_type_node, + NULL_TREE, + NULL_TREE, NULL, NULL, NULL_TREE, TRUE); + + case FFEINTRIN_impABORT: + case FFEINTRIN_impGETARG: + case FFEINTRIN_impGETENV: + break; + default: assert ("unimplemented intrinsic" == NULL); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3861,3867 **** ix = ffeintrin_gfrt (ffebld_symter_implementation (ffebld_left (expr))); return ffecom_call_ (ffecom_gfrt_tree_ (ix), ffecom_gfrt_kind_type_ (ix), ! ffe_is_f2c_library () && returns_complex, tree_type, ! expr_tree, dest_tree, dest_info, dest_used); library: /* :::::::::::::::::::: */ --- 4317,4326 ---- ix = ffeintrin_gfrt (ffebld_symter_implementation (ffebld_left (expr))); + assert (ix != FFECOM_gfrt); /* Must have an implementation! */ return ffecom_call_ (ffecom_gfrt_tree_ (ix), ffecom_gfrt_kind_type_ (ix), ! (ffe_is_f2c_library () && ffecom_gfrt_complex_[ix]), ! tree_type, ! expr_tree, dest_tree, dest, dest_used, ! NULL_TREE, TRUE); library: /* :::::::::::::::::::: */ *************** library: /* :::::::::::::::::::: */ *** 3892,3897 **** return ffecom_call_ (ffecom_gfrt_tree_ (ix), ffecom_gfrt_kind_type_ (ix), ! ffe_is_f2c_library () && returns_complex, tree_type, ! expr_tree, dest_tree, dest_info, dest_used); /**INDENT* (Do not reformat this comment even with -fca option.) --- 4351,4358 ---- return ffecom_call_ (ffecom_gfrt_tree_ (ix), ffecom_gfrt_kind_type_ (ix), ! (ffe_is_f2c_library () && ffecom_gfrt_complex_[ix]), ! tree_type, ! expr_tree, dest_tree, dest, dest_used, ! NULL_TREE, TRUE); /**INDENT* (Do not reformat this comment even with -fca option.) *************** C *** 3910,3936 **** 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)) --- 4371,4397 ---- 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)) *************** ffecom_expr_power_integer_ (ffebld left, *** 4802,4806 **** convert (ltype, integer_one_node), l, ! NULL_TREE, ffeinfo_new_null (), NULL); } --- 5263,5267 ---- convert (ltype, integer_one_node), l, ! NULL_TREE, NULL, NULL); } *************** ffecom_expr_power_integer_ (ffebld left, *** 4815,4819 **** convert (ltype, integer_one_node), l, ! NULL_TREE, ffeinfo_new_null (), NULL); r = ffecom_1 (NEGATE_EXPR, rtype, r); assert (TREE_CODE (r) == INTEGER_CST); --- 5276,5280 ---- convert (ltype, integer_one_node), l, ! NULL_TREE, NULL, NULL); r = ffecom_1 (NEGATE_EXPR, rtype, r); assert (TREE_CODE (r) == INTEGER_CST); *************** ffecom_expr_power_integer_ (ffebld left, *** 4857,4860 **** --- 5318,5349 ---- } + if (ffecom_transform_only_dummies_) + { + /* Though rhs isn't a constant, in-line code cannot be expanded + here 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, generate the call to the run-time-library + function to evaluate the power for us. */ + + assert (ffeinfo_kindtype (ffebld_info (left)) + == FFEINFO_kindtypeINTEGER1); + assert (ffeinfo_kindtype (ffebld_info (right)) + == FFEINFO_kindtypeINTEGER1); + + l = build_tree_list (NULL_TREE, l); + r = build_tree_list (NULL_TREE, r); + TREE_CHAIN (l) = r; + + return ffecom_call_ (ffecom_gfrt_tree_ (FFECOM_gfrtPOW_II), + ffecom_gfrt_kind_type_ (FFECOM_gfrtPOW_II), + FALSE, ltype, l, + NULL_TREE, NULL, NULL, NULL_TREE, TRUE); + } + /* Right-hand operand not a constant, expand in-line code to figure out how to do the multiplies, &c. *************** ffecom_expr_power_integer_ (ffebld left, *** 4872,4885 **** { if ((basetypeof (l) == basetypeof (int)) ! && (rtmp < 0)) result = ((typeof (l)) 1) / ltmp; else { ! result = 1; ! if ((basetypeof (l) != basetypeof (int)) && (rtmp < 0)) ! { ! ltmp = ((typeof (l)) 1) / ltmp; ! rtmp = -rtmp; if (rtmp < 0) { --- 5361,5374 ---- { if ((basetypeof (l) == basetypeof (int)) ! && (rtmp < 0)) result = ((typeof (l)) 1) / ltmp; else { ! result = 1; ! if ((basetypeof (l) != basetypeof (int)) && (rtmp < 0)) ! { ! ltmp = ((typeof (l)) 1) / ltmp; ! rtmp = -rtmp; if (rtmp < 0) { *************** ffecom_expr_power_integer_ (ffebld left, *** 4887,4894 **** ltmp *= ltmp; } ! } ! for (;;) ! { ! if (rtmp & 1) result *= ltmp; if ((rtmp >>= 1) == 0) --- 5376,5383 ---- ltmp *= ltmp; } ! } ! for (;;) ! { ! if (rtmp & 1) result *= ltmp; if ((rtmp >>= 1) == 0) *************** ffecom_expr_power_integer_ (ffebld left, *** 4920,4923 **** --- 5409,5415 ---- = 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); *************** ffecom_expr_power_integer_ (ffebld left, *** 4927,4934 **** TRUE); - se = expand_start_stmt_expr (); - ++ffecom_no_new_tempvars_; /* not while expanding stmt expr, - see sequence_rtl_expr in back end. */ - expand_expr_stmt (ffecom_modify (void_type_node, rtmp, --- 5419,5422 ---- *************** ffecom_expr_power_integer_ (ffebld left, *** 4960,4964 **** convert (ltype, integer_one_node), ltmp, ! NULL_TREE, ffeinfo_new_null (), NULL))); expand_start_else (); expand_expr_stmt (ffecom_modify (void_type_node, --- 5448,5452 ---- convert (ltype, integer_one_node), ltmp, ! NULL_TREE, NULL, NULL))); expand_start_else (); expand_expr_stmt (ffecom_modify (void_type_node, *************** ffecom_expr_power_integer_ (ffebld left, *** 4980,4984 **** convert (ltype, integer_one_node), ltmp, ! NULL_TREE, ffeinfo_new_null (), NULL))); expand_expr_stmt (ffecom_modify (void_type_node, rtmp, --- 5468,5472 ---- convert (ltype, integer_one_node), ltmp, ! NULL_TREE, NULL, NULL))); expand_expr_stmt (ffecom_modify (void_type_node, rtmp, *************** ffecom_expr_power_integer_ (ffebld left, *** 5034,5038 **** expand_expr_stmt (result); ! --ffecom_no_new_tempvars_; result = expand_end_stmt_expr (se); TREE_SIDE_EFFECTS (result) = 1; --- 5522,5526 ---- expand_expr_stmt (result); ! ffecom_pop_calltemps (); result = expand_end_stmt_expr (se); TREE_SIDE_EFFECTS (result) = 1; *************** ffecom_f2c_set_lio_code_ (ffeinfoBasicty *** 5189,5193 **** tree t; ! for (j = 0; j < ARRAY_SIZE (ffecom_tree_type[0]); ++j) if (((t = ffecom_tree_type[bt][j]) != NULL_TREE) && (TYPE_PRECISION (t) == size)) --- 5677,5681 ---- tree t; ! for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j) if (((t = ffecom_tree_type[bt][j]) != NULL_TREE) && (TYPE_PRECISION (t) == size)) *************** ffecom_finish_symbol_transform_ (ffesymb *** 5297,5301 **** #if FFECOM_targetCURRENT == FFECOM_targetGCC - #ifndef ffecom_get_external_identifier_ static tree ffecom_get_appended_identifier_ (char us, char *name) --- 5785,5788 ---- *************** ffecom_get_appended_identifier_ (char us *** 5306,5310 **** newname = xmalloc ((i = strlen (name)) + 1 ! + FFETARGET_isEXTERNAL_UNDERSCORED + us); memcpy (newname, name, i); --- 5793,5797 ---- newname = xmalloc ((i = strlen (name)) + 1 ! + ffe_is_underscoring () + us); memcpy (newname, name, i); *************** ffecom_get_appended_identifier_ (char us *** 5320,5324 **** #endif - #endif /* Decide whether to append underscore to name before calling get_identifier. */ --- 5807,5810 ---- *************** ffecom_get_appended_identifier_ (char us *** 5325,5339 **** #if FFECOM_targetCURRENT == FFECOM_targetGCC - #ifndef ffecom_get_external_identifier_ static tree ! ffecom_get_external_identifier_ (char *name) { ! char us = FFETARGET_isUNDERSCORED_EXTERNAL_UNDERSCORED ! ? (strchr (name, '_') != NULL) ! : 0; /* If name is a built-in name, just return it as is. */ ! if ((strcmp (name, FFETARGET_nameBLANK_COMMON) == 0) #if FFETARGET_isENFORCED_MAIN_NAME || (strcmp (name, FFETARGET_nameENFORCED_NAME) == 0) --- 5811,5824 ---- #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) *************** ffecom_get_external_identifier_ (char *n *** 5344,5347 **** --- 5829,5836 ---- return get_identifier (name); + us = FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED + ? (strchr (name, '_') != NULL) + : 0; + return ffecom_get_appended_identifier_ (us, name); } *************** ffecom_get_external_identifier_ (char *n *** 5348,5352 **** #endif - #endif /* Decide whether to append underscore to internal name before calling get_identifier. --- 5837,5840 ---- *************** ffecom_get_external_identifier_ (char *n *** 5365,5380 **** #if FFECOM_targetCURRENT == FFECOM_targetGCC - #ifndef ffecom_get_identifier_ static tree ffecom_get_identifier_ (char *name) { - char us = (strchr (name, '_') != NULL); - /* If name does not contain an underscore, just return it as is. */ ! if (us == 0) return get_identifier (name); ! return ffecom_get_appended_identifier_ (FFETARGET_isUNDERSCORED_EXTERNAL_UNDERSCORED, name); } --- 5853,5866 ---- #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) == 0) return get_identifier (name); ! return ffecom_get_appended_identifier_ (FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED, name); } *************** ffecom_get_identifier_ (char *name) *** 5381,5385 **** #endif - #endif /* ffecom_gen_sfuncdef_ -- Generate definition of statement function --- 5867,5870 ---- *************** ffecom_gen_sfuncdef_ (ffesymbol s, ffein *** 5406,5409 **** --- 5891,5896 ---- 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 *************** ffecom_gen_sfuncdef_ (ffesymbol s, ffein *** 5462,5467 **** type = ffecom_tree_type[FFEINFO_basictypeCHARACTER][kt]; ! result = ffecom_get_invented_identifier ("__g77_result_%s", ! ffesymbol_text (s), 0); ffecom_char_enhance_arg_ (&type, s); /* Ignore returned length. */ --- 5949,5954 ---- 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. */ *************** ffecom_gen_sfuncdef_ (ffesymbol s, ffein *** 5520,5523 **** --- 6007,6012 ---- input_filename = old_input_filename; + ffecom_nested_entry_ = NULL; + return func; } *************** ffecom_init_local_zero_ (tree decl) *** 5583,5591 **** { int momentary = suspend_momentary (); ! init = build (CONSTRUCTOR, type, NULL_TREE, NULL_TREE); TREE_CONSTANT (init) = 1; TREE_STATIC (init) = 1; ! resume_momentary (momentary); } --- 6072,6080 ---- { int momentary = suspend_momentary (); ! init = build (CONSTRUCTOR, type, NULL_TREE, NULL_TREE); TREE_CONSTANT (init) = 1; TREE_STATIC (init) = 1; ! resume_momentary (momentary); } *************** ffecom_intrinsic_ichar_ (tree tree_type, *** 5613,5617 **** tree expr_tree; tree length_tree; ! switch (ffebld_op (arg)) { --- 6102,6106 ---- tree expr_tree; tree length_tree; ! switch (ffebld_op (arg)) { *************** ffecom_intrinsic_ichar_ (tree tree_type, *** 5632,5636 **** TREE_TYPE (expr_tree) = tree_type; return expr_tree; ! case FFEBLD_opSYMTER: case FFEBLD_opARRAYREF: --- 6121,6125 ---- TREE_TYPE (expr_tree) = tree_type; return expr_tree; ! case FFEBLD_opSYMTER: case FFEBLD_opARRAYREF: *************** ffecom_intrinsic_ichar_ (tree tree_type, *** 5674,5678 **** ffecom_f2c_ftnlen_zero_node)); return expr_tree; ! case FFEBLD_opPAREN: case FFEBLD_opCONVERT: --- 6163,6167 ---- ffecom_f2c_ftnlen_zero_node)); return expr_tree; ! case FFEBLD_opPAREN: case FFEBLD_opCONVERT: *************** ffecom_intrinsic_ichar_ (tree tree_type, *** 5684,5688 **** return ffecom_intrinsic_ichar_ (tree_type, ffebld_left (arg), maybe_tree); ! case FFEBLD_opCONCATENATE: { --- 6173,6177 ---- return ffecom_intrinsic_ichar_ (tree_type, ffebld_left (arg), maybe_tree); ! case FFEBLD_opCONCATENATE: { *************** ffecom_make_gfrt_ (ffecomGfrt ix) *** 6080,6083 **** --- 6569,6577 ---- break; + case FFECOM_rttypeINT_: + ttype = integer_type_node; + kt = FFEINFO_kindtypeINTEGER1; + break; + case FFECOM_rttypeINTEGER_: ttype = ffecom_f2c_integer_type_node; *************** ffecom_make_gfrt_ (ffecomGfrt ix) *** 6144,6148 **** #if FFECOM_targetCURRENT == FFECOM_targetGCC static void ! ffecom_member_phase1_ (ffestorag mst, ffestorag st) { ffesymbol s = ffestorag_symbol (st); --- 6638,6642 ---- #if FFECOM_targetCURRENT == FFECOM_targetGCC static void ! ffecom_member_phase1_ (ffestorag mst UNUSED, ffestorag st) { ffesymbol s = ffestorag_symbol (st); *************** ffecom_start_progunit_ () *** 6403,6410 **** #if FFETARGET_isENFORCED_MAIN else if (main_program) ! id = ffecom_get_external_identifier_ (FFETARGET_nameENFORCED_MAIN_NAME); #endif else ! id = ffecom_get_external_identifier_ (ffesymbol_text (fn)); start_function (id, --- 6897,6904 ---- #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, *************** ffecom_start_progunit_ () *** 6444,6449 **** type = ffecom_multi_type_node_; ! result = ffecom_get_invented_identifier ("__g77_result_%s", ! ffesymbol_text (fn), 0); /* Make length arg _and_ enhance type info for CHAR arg itself. */ --- 6938,6943 ---- 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. */ *************** ffecom_sym_transform_ (ffesymbol s) *** 6556,6559 **** --- 7050,7056 ---- ffecom_get_identifier_ (ffesymbol_text (s)), ffecom_tree_ptr_to_subr_type); + #if BUILT_FOR_270 + DECL_ARTIFICIAL (t) = 1; + #endif addr = TRUE; break; *************** ffecom_sym_transform_ (ffesymbol s) *** 6565,6569 **** t = build_decl (FUNCTION_DECL, ! ffecom_get_external_identifier_ (ffesymbol_text (s)), ffecom_tree_subr_type); /* Assume subr. */ DECL_EXTERNAL (t) = 1; --- 7062,7066 ---- t = build_decl (FUNCTION_DECL, ! ffecom_get_external_identifier_ (s), ffecom_tree_subr_type); /* Assume subr. */ DECL_EXTERNAL (t) = 1; *************** ffecom_sym_transform_ (ffesymbol s) *** 6649,6653 **** /* (t_type *) (((void *) &et) + offset */ ! t = convert (TREE_TYPE (null_pointer_node), /* (void *) */ ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (et)), --- 7146,7150 ---- /* (t_type *) (((void *) &et) + offset */ ! t = convert (string_type_node, /* (char *) */ ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (et)), *************** ffecom_sym_transform_ (ffesymbol s) *** 6669,6679 **** bool init = (ffesymbol_init (s) != NULL) && (ffebld_op (ffesymbol_init (s)) != FFEBLD_opANY); ! yes = suspend_momentary (); ! t = build_decl (VAR_DECL, ffecom_get_identifier_ (ffesymbol_text (s)), type); ! if (init || ffesymbol_namelisted (s) --- 7166,7176 ---- bool init = (ffesymbol_init (s) != NULL) && (ffebld_op (ffesymbol_init (s)) != FFEBLD_opANY); ! yes = suspend_momentary (); ! t = build_decl (VAR_DECL, ffecom_get_identifier_ (ffesymbol_text (s)), type); ! if (init || ffesymbol_namelisted (s) *************** ffecom_sym_transform_ (ffesymbol s) *** 6692,6697 **** DECL_INITIAL (t) = error_mark_node; t = start_decl (t, FALSE); ! if (init) initexpr = ffecom_expr (ffesymbol_init (s)); --- 7189,7199 ---- 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) initexpr = ffecom_expr (ffesymbol_init (s)); *************** ffecom_sym_transform_ (ffesymbol s) *** 6704,6708 **** assert (ffestorag_size (st) * BITS_PER_UNIT ! == TREE_INT_CST_LOW (DECL_SIZE (t))); resume_momentary (yes); --- 7206,7211 ---- assert (ffestorag_size (st) * BITS_PER_UNIT ! == (unsigned long int) ! TREE_INT_CST_LOW (DECL_SIZE (t))); resume_momentary (yes); *************** ffecom_sym_transform_ (ffesymbol s) *** 6808,6812 **** if ((ffebld_op (ffebld_right (dim)) == FFEBLD_opSTAR) || ffecom_doing_entry_) ! high = low; /* ~~Someday be able to do NULL_TREE here */ else high = ffecom_expr (ffebld_right (dim)); --- 7311,7321 ---- 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)). */ ! high = convert (TREE_TYPE (low), ! TYPE_MAX_VALUE (TREE_TYPE (low))); else high = ffecom_expr (ffebld_right (dim)); *************** ffecom_sym_transform_ (ffesymbol s) *** 6971,6974 **** --- 7480,7489 ---- low = variable_size (low); + /* ~~~similarly, this fixes dumb0.f. The C front end + does this, which is why dumb0.c would work. */ + + if (TREE_CODE (high) != INTEGER_CST) + high = variable_size (high); + type = build_array_type *************** ffecom_sym_transform_ (ffesymbol s) *** 6985,6988 **** --- 7500,7506 ---- 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 *************** ffecom_sym_transform_ (ffesymbol s) *** 7104,7110 **** + ffestorag_offset (st); ! /* (t_type *) (((void *) &ct) + offset */ ! t = convert (TREE_TYPE (null_pointer_node), /* (void *) */ ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (ct)), --- 7622,7628 ---- + ffestorag_offset (st); ! /* (t_type *) (((char *) &ct) + offset */ ! t = convert (string_type_node, /* (char *) */ ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (ct)), *************** ffecom_sym_transform_ (ffesymbol s) *** 7159,7163 **** t = build_decl (FUNCTION_DECL, ! ffecom_get_external_identifier_ (ffesymbol_text (s)), t); DECL_EXTERNAL (t) = 1; --- 7677,7681 ---- t = build_decl (FUNCTION_DECL, ! ffecom_get_external_identifier_ (s), t); DECL_EXTERNAL (t) = 1; *************** ffecom_sym_transform_ (ffesymbol s) *** 7185,7188 **** --- 7703,7709 ---- ffecom_get_identifier_ (ffesymbol_text (s)), t); + #if BUILT_FOR_270 + DECL_ARTIFICIAL (t) = 1; + #endif addr = TRUE; break; *************** ffecom_sym_transform_ (ffesymbol s) *** 7221,7225 **** t = build_decl (FUNCTION_DECL, ! ffecom_get_external_identifier_ (ffesymbol_text (s)), ffecom_tree_subr_type); DECL_EXTERNAL (t) = 1; --- 7742,7746 ---- t = build_decl (FUNCTION_DECL, ! ffecom_get_external_identifier_ (s), ffecom_tree_subr_type); DECL_EXTERNAL (t) = 1; *************** ffecom_sym_transform_ (ffesymbol s) *** 7240,7243 **** --- 7761,7767 ---- ffecom_get_identifier_ (ffesymbol_text (s)), ffecom_tree_ptr_to_subr_type); + #if BUILT_FOR_270 + DECL_ARTIFICIAL (t) = 1; + #endif addr = TRUE; break; *************** ffecom_sym_transform_ (ffesymbol s) *** 7299,7303 **** t = build_decl (FUNCTION_DECL, ! ffecom_get_external_identifier_ (ffesymbol_text (s)), ffecom_tree_blockdata_type); DECL_EXTERNAL (t) = 1; --- 7823,7827 ---- t = build_decl (FUNCTION_DECL, ! ffecom_get_external_identifier_ (s), ffecom_tree_blockdata_type); DECL_EXTERNAL (t) = 1; *************** ffecom_transform_common_ (ffesymbol s) *** 7581,7585 **** else cbtype = build_array_type (char_type_node, NULL_TREE); ! if (cbt == NULL_TREE) { --- 8105,8109 ---- else cbtype = build_array_type (char_type_node, NULL_TREE); ! if (cbt == NULL_TREE) { *************** ffecom_transform_common_ (ffesymbol s) *** 7586,7590 **** cbt = build_decl (VAR_DECL, ! ffecom_get_external_identifier_ (ffesymbol_text (s)), cbtype); DECL_EXTERNAL (cbt) = init ? 0 : 1; --- 8110,8114 ---- cbt = build_decl (VAR_DECL, ! ffecom_get_external_identifier_ (s), cbtype); DECL_EXTERNAL (cbt) = init ? 0 : 1; *************** ffecom_transform_equiv_ (ffestorag eqst) *** 7648,7655 **** tree eqtype; tree init; bool is_init = (ffestorag_init (eqst) != NULL) && (ffebld_op (ffestorag_init (eqst)) != FFEBLD_opANY); int yes; - static int mynumber = 0; assert (eqst != NULL); --- 8172,8179 ---- tree eqtype; tree init; + tree high; bool is_init = (ffestorag_init (eqst) != NULL) && (ffebld_op (ffestorag_init (eqst)) != FFEBLD_opANY); int yes; assert (eqst != NULL); *************** ffecom_transform_equiv_ (ffestorag eqst) *** 7680,7696 **** yes = suspend_momentary (); ! if (is_init && (init != NULL)) ! eqtype = TREE_TYPE (init); ! else ! eqtype = build_array_type (char_type_node, ! build_range_type (integer_type_node, ! integer_one_node, ! build_int_2 ! (ffestorag_size (eqst), ! 0))); eqt = build_decl (VAR_DECL, ! ffecom_get_invented_identifier ("__g77_equiv_%d", NULL, ! mynumber++), eqtype); DECL_EXTERNAL (eqt) = 0; --- 8204,8221 ---- yes = suspend_momentary (); ! high = build_int_2 (ffestorag_size (eqst), 0); ! TREE_TYPE (high) = ffecom_integer_type_node; + eqtype = build_array_type (char_type_node, + build_range_type (ffecom_integer_type_node, + ffecom_integer_one_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; *************** ffecom_transform_equiv_ (ffestorag eqst) *** 7731,7735 **** assert (ffestorag_size (eqst) * BITS_PER_UNIT ! == TREE_INT_CST_LOW (DECL_SIZE (eqt))); ffestorag_set_hook (eqst, eqt); --- 8256,8260 ---- assert (ffestorag_size (eqst) * BITS_PER_UNIT ! == (unsigned long int) TREE_INT_CST_LOW (DECL_SIZE (eqt))); ffestorag_set_hook (eqst, eqt); *************** ffecom_transform_namelist_ (ffesymbol s) *** 7758,7761 **** --- 8283,8287 ---- tree nvarsinit; tree field; + tree high; int yes; int i; *************** ffecom_transform_namelist_ (ffesymbol s) *** 7775,7779 **** /* Process inits. */ ! nameinit = ffecom_build_f2c_string_ ((i = strlen (ffesymbol_text (s))) + 1, ffesymbol_text (s)); TREE_TYPE (nameinit) --- 8301,8310 ---- /* 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) *************** ffecom_transform_namelist_ (ffesymbol s) *** 7783,7788 **** build_range_type (ffecom_f2c_ftnlen_type_node, ffecom_f2c_ftnlen_one_node, ! convert (ffecom_f2c_ftnlen_type_node, ! build_int_2 (i, 0)))), 1, 0); TREE_CONSTANT (nameinit) = 1; --- 8314,8318 ---- build_range_type (ffecom_f2c_ftnlen_type_node, ffecom_f2c_ftnlen_one_node, ! high)), 1, 0); TREE_CONSTANT (nameinit) = 1; *************** ffecom_transform_namelist_ (ffesymbol s) *** 7828,7831 **** --- 8358,8611 ---- #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, + *offset, + TYPE_SIZE (TREE_TYPE (TREE_TYPE (t)))); + break; + } + /* Not a COMMON reference, so an unrecognized pattern. */ + *decl = error_mark_node; + break; + + case PARM_DECL: + *decl = t; + *offset = size_zero_node; + break; + + case ADDR_EXPR: + if (TREE_CODE (TREE_OPERAND (t, 0)) == VAR_DECL) + { + /* A reference to COMMON. */ + *decl = TREE_OPERAND (t, 0); + *offset = size_zero_node; + 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 = size_zero_node; + *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. */ *************** ffecom_transform_namelist_ (ffesymbol s) *** 7833,7837 **** static tree ffecom_tree_divide_ (tree tree_type, tree left, tree right, ! tree dest_tree, ffeinfo dest_info, bool *dest_used) { if ((left == error_mark_node) --- 8613,8617 ---- 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) *************** ffecom_tree_divide_ (tree tree_type, tre *** 7871,7875 **** tree_type, left, ! dest_tree, dest_info, dest_used); } --- 8651,8656 ---- tree_type, left, ! dest_tree, dest, dest_used, ! NULL_TREE, TRUE); } *************** ffecom_type_localvar_ (ffesymbol s, ffei *** 7910,7920 **** type = ffecom_tree_type[bt][kt]; if (bt == FFEINFO_basictypeCHARACTER) ! type ! = build_array_type ! (type, ! build_range_type (ffecom_f2c_ftnlen_type_node, ! ffecom_f2c_ftnlen_one_node, ! convert (ffecom_f2c_ftnlen_type_node, ! build_int_2 (ffesymbol_size (s), 0)))); for (dl = ffesymbol_dims (s); dl != NULL; dl = ffebld_trail (dl)) { --- 8691,8706 ---- 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)); ! } ! for (dl = ffesymbol_dims (s); dl != NULL; dl = ffebld_trail (dl)) { *************** ffecom_type_permanent_copy_ (tree t) *** 8016,8019 **** --- 8802,8806 ---- max = build_int_2 (TREE_INT_CST_LOW (max), TREE_INT_CST_HIGH (max)); + TREE_TYPE (max) = TREE_TYPE (TYPE_MIN_VALUE (domain)); } *************** ffecom_call_gfrt (ffecomGfrt ix, tree ar *** 8924,8929 **** return ffecom_call_ (ffecom_gfrt_tree_ (ix), ffecom_gfrt_kind_type_ (ix), ffe_is_f2c_library () && ffecom_gfrt_complex_[ix], ! NULL_TREE, args, NULL_TREE, ffeinfo_new_null (), ! NULL); } #endif --- 9711,9716 ---- return ffecom_call_ (ffecom_gfrt_tree_ (ix), ffecom_gfrt_kind_type_ (ix), ffe_is_f2c_library () && ffecom_gfrt_complex_[ix], ! NULL_TREE, args, NULL_TREE, NULL, ! NULL, NULL_TREE, TRUE); } #endif *************** ffecom_expand_let_stmt (ffebld dest, ffe *** 9389,9393 **** if ((TREE_CODE (dest_tree) != VAR_DECL) || TREE_ADDRESSABLE (dest_tree)) ! source_tree = ffecom_expr_ (source, dest_tree, ffebld_info (dest), &dest_used, FALSE); else --- 10176,10180 ---- if ((TREE_CODE (dest_tree) != VAR_DECL) || TREE_ADDRESSABLE (dest_tree)) ! source_tree = ffecom_expr_ (source, dest_tree, dest, &dest_used, FALSE); else *************** tree *** 9431,9435 **** ffecom_expr (ffebld expr) { ! return ffecom_expr_ (expr, NULL_TREE, ffeinfo_new_null (), NULL, FALSE); } --- 10218,10222 ---- ffecom_expr (ffebld expr) { ! return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, FALSE); } *************** tree *** 9442,9446 **** ffecom_expr_assign (ffebld expr) { ! return ffecom_expr_ (expr, NULL_TREE, ffeinfo_new_null (), NULL, TRUE); } --- 10229,10233 ---- ffecom_expr_assign (ffebld expr) { ! return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, TRUE); } *************** tree *** 9453,9457 **** ffecom_expr_assign_w (ffebld expr) { ! return ffecom_expr_ (expr, NULL_TREE, ffeinfo_new_null (), NULL, TRUE); } --- 10240,10244 ---- ffecom_expr_assign_w (ffebld expr) { ! return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, TRUE); } *************** void *** 9557,9560 **** --- 10344,10348 ---- ffecom_init_0 () { + tree endlink; int i; int j; *************** ffecom_init_0 () *** 9748,9756 **** = build_pointer_type (ffecom_tree_fun_type_void); ! ffecom_tree_fun_type_double ! = build_function_type (double_type_node, NULL_TREE); ! for (i = 0; i < ARRAY_SIZE (ffecom_tree_type); ++i) ! for (j = 0; j < ARRAY_SIZE (ffecom_tree_type[0]); ++j) { ffecom_tree_type[i][j] = NULL_TREE; --- 10536,10556 ---- = 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_init_0 () *** 9886,9891 **** /* Make function and ptr-to-function types for non-CHARACTER types. */ ! for (i = 0; i < ARRAY_SIZE (ffecom_tree_type); ++i) ! for (j = 0; j < ARRAY_SIZE (ffecom_tree_type[0]); ++j) { if ((t = ffecom_tree_type[i][j]) != NULL_TREE) --- 10686,10691 ---- /* 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) *************** ffecom_init_0 () *** 9973,9978 **** field = NULL_TREE; ! for (i = 0; i < ARRAY_SIZE (ffecom_tree_type); ++i) ! for (j = 0; j < ARRAY_SIZE (ffecom_tree_type[0]); ++j) { char name[30]; --- 10773,10778 ---- 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]; *************** ffecom_init_0 () *** 10006,10015 **** = build_function_type (void_type_node, NULL_TREE); ! builtin_function ("__builtin_fsqrt", ffecom_tree_fun_type_double, BUILT_IN_FSQRT, "sqrt"); ! builtin_function ("__builtin_sin", ffecom_tree_fun_type_double, BUILT_IN_SIN, "sin"); ! builtin_function ("__builtin_cos", ffecom_tree_fun_type_double, BUILT_IN_COS, "cos"); ffecom_f2c_make_type_ (&ffecom_f2c_integer_type_node, --- 10806,10831 ---- = 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_init_0 () *** 10073,10076 **** --- 10889,10912 ---- } + /* Do "extern int xargc;". */ + + ffecom_tree_xargc_ = build_decl (VAR_DECL, + get_identifier ("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 (FLOAT_TYPE_SIZE != 32) + { + warning ("configuration: REAL, INTEGER, and LOGICAL are %d bits wide,", + (int) FLOAT_TYPE_SIZE); + warning ("but g77 doesn't yet work right unless they 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."); + } + #if 0 /* Code in ste.c that would crash has been commented out. */ if (TYPE_PRECISION (ffecom_f2c_ftnlen_type_node) *************** ffecom_notify_init_storage (ffestorag st *** 10363,10376 **** return; /* Oh, we already did this! */ - if (ffestorag_symbol (st) != NULL) - s = ffestorag_symbol (st); - else - s = ffestorag_typesymbol (st); - #if FFECOM_targetCURRENT == FFECOM_targetFFE ! fprintf (stdout, "= initialize_storage \"%s\" ", ! (s != NULL) ? ffesymbol_text (s) : "(unnamed)"); ! ffebld_dump (init); ! fputc ('\n', stdout); #endif --- 11199,11216 ---- 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 (stdout, "= initialize_storage \"%s\" ", ! (s != NULL) ? ffesymbol_text (s) : "(unnamed)"); ! ffebld_dump (init); ! fputc ('\n', stdout); ! } #endif *************** ffecom_ptr_to_expr (ffebld expr) *** 10690,10696 **** /* 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); --- 11530,11536 ---- /* 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); *************** ffecom_push_tempvar (tree type, ffetarge *** 10771,10776 **** } - assert (ffecom_no_new_tempvars_ == 0); - /* Create a new temp. */ --- 11611,11614 ---- *************** ffecom_push_tempvar (tree type, ffetarge *** 10792,10798 **** mynumber++), type); ! t = start_decl (t, FALSE); ! finish_decl (t, NULL_TREE, FALSE); resume_momentary (yes); --- 11630,11646 ---- mynumber++), type); ! { /* ~~~~ kludge alert here!!! else temp gets reused outside ! a compound-statement sequence.... */ ! extern tree sequence_rtl_expr; ! tree back_end_bug = sequence_rtl_expr; + sequence_rtl_expr = NULL_TREE; + + t = start_decl (t, FALSE); + finish_decl (t, NULL_TREE, FALSE); + + sequence_rtl_expr = back_end_bug; + } + resume_momentary (yes); *************** ffecom_return_expr (ffebld expr) *** 10864,10869 **** rtn = ffecom_func_result_; /* 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)) --- 11712,11717 ---- rtn = ffecom_func_result_; /* 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)) *************** ffecom_start_decl (tree decl, bool is_in *** 10919,10923 **** #if FFECOM_targetCURRENT == FFECOM_targetGCC void ! ffecom_sym_commit (ffesymbol s) { assert (!ffesymbol_retractable ()); --- 11767,11771 ---- #if FFECOM_targetCURRENT == FFECOM_targetGCC void ! ffecom_sym_commit (ffesymbol s UNUSED) { assert (!ffesymbol_retractable ()); *************** ffecom_sym_learned (ffesymbol s) *** 11063,11067 **** #if FFECOM_targetCURRENT == FFECOM_targetGCC void ! ffecom_sym_retract (ffesymbol s) { assert (!ffesymbol_retractable ()); --- 11911,11915 ---- #if FFECOM_targetCURRENT == FFECOM_targetGCC void ! ffecom_sym_retract (ffesymbol s UNUSED) { assert (!ffesymbol_retractable ()); *************** duplicate_decls (tree newdecl, tree oldd *** 11242,11245 **** --- 12090,12096 ---- tree newtype = TREE_TYPE (newdecl); + if (olddecl == newdecl) + return 1; + if (TREE_CODE (newtype) == ERROR_MARK || TREE_CODE (oldtype) == ERROR_MARK) *************** duplicate_decls (tree newdecl, tree oldd *** 11271,11279 **** 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)); ! 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. */ --- 12122,12142 ---- 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. */ *************** duplicate_decls (tree newdecl, tree oldd *** 11281,11289 **** = build_function_type (newreturntype, TYPE_ARG_TYPES (TREE_TYPE (olddecl))); ! ! types_match = 1; if (types_match) TREE_TYPE (olddecl) = newtype; } } if (!types_match) --- 12144,12154 ---- = 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) *************** duplicate_decls (tree newdecl, tree oldd *** 11324,11328 **** end_temporary_allocation (); } ! /* Merge the data types specified in the two decls. */ if (TREE_CODE (newdecl) != FUNCTION_DECL || !DECL_BUILT_IN (olddecl)) --- 12189,12193 ---- end_temporary_allocation (); } ! /* Merge the data types specified in the two decls. */ if (TREE_CODE (newdecl) != FUNCTION_DECL || !DECL_BUILT_IN (olddecl)) *************** duplicate_decls (tree newdecl, tree oldd *** 11374,11378 **** DECL_SOURCE_FILE (newdecl) = DECL_SOURCE_FILE (olddecl); ! if (DECL_CONTEXT (olddecl) == 0) DECL_CONTEXT (newdecl) = 0; } --- 12239,12244 ---- DECL_SOURCE_FILE (newdecl) = DECL_SOURCE_FILE (olddecl); ! if (DECL_CONTEXT (olddecl) == 0 ! && TREE_CODE (newdecl) != FUNCTION_DECL) DECL_CONTEXT (newdecl) = 0; } *************** duplicate_decls (tree newdecl, tree oldd *** 11389,11393 **** /* 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. */ --- 12255,12259 ---- /* 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. */ *************** duplicate_decls (tree newdecl, tree oldd *** 11395,11398 **** --- 12261,12272 ---- 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 (); } *************** finish_decl (tree decl, tree init, bool *** 11547,11555 **** ? /* 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) != NULL_TREE ! || !top_level) : /* An automatic variable with an incomplete type is an error. */ --- 12421,12428 ---- ? /* 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. */ *************** finish_decl (tree decl, tree init, bool *** 11576,11583 **** { rest_of_decl_compilation (decl, NULL, ! is_top_level || at_top_level, 0); ! if (!top_level) { /* Recompute the RTL of a local array now if it used to be an --- 12449,12456 ---- { 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 *************** finish_decl (tree decl, tree init, bool *** 11601,11605 **** { rest_of_decl_compilation (decl, NULL_PTR, ! is_top_level || at_top_level, 0); } --- 12474,12478 ---- { rest_of_decl_compilation (decl, NULL_PTR, ! DECL_CONTEXT (decl) == 0, 0); } *************** finish_decl (tree decl, tree init, bool *** 11615,11623 **** { /* 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)) --- 12488,12496 ---- { /* 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)) *************** finish_decl (tree decl, tree init, bool *** 11632,11638 **** 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; --- 12505,12511 ---- 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; *************** finish_function (int nested) *** 11727,11731 **** /* 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. */ --- 12600,12604 ---- /* 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. */ *************** finish_function (int nested) *** 11738,11743 **** { /* 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; } --- 12611,12616 ---- { /* 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; } *************** lang_printable_name (tree decl, char **k *** 11759,11762 **** --- 12632,12698 ---- } + /* 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 ffesymbol last_s = NULL; + ffesymbol s; + char *kind; + + 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_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_s = s; + } + } + #endif + /* Similar to `lookup_name' but look only at current binding level. */ *************** pop_f_function_context () *** 11820,11824 **** /* 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; --- 12756,12760 ---- /* 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; *************** storedecls (decls) *** 11916,11920 **** static void ! store_parm_decls (int is_main_program) { register tree fndecl = current_function_decl; --- 12852,12856 ---- static void ! store_parm_decls (int is_main_program UNUSED) { register tree fndecl = current_function_decl; *************** start_decl (tree decl, bool is_top_level *** 11954,11957 **** --- 12890,12896 ---- 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. */ *************** start_decl (tree decl, bool is_top_level *** 11961,11967 **** tem = pushdecl (decl); - /* For Fortran, we by default put things in .common when possible. */ - DECL_COMMON (tem) = 1; - /* For a local variable, define the RTL now. */ if (!top_level --- 12900,12903 ---- *************** start_decl (tree decl, bool is_top_level *** 11980,11984 **** { /* When parsing and digesting the initializer, use temporary storage. ! Do this even if we will ignore the value. */ if (at_top_level) temporary_allocation (); --- 12916,12920 ---- { /* When parsing and digesting the initializer, use temporary storage. ! Do this even if we will ignore the value. */ if (at_top_level) temporary_allocation (); *************** convert (type, expr) *** 12109,12113 **** void copy_lang_decl (node) ! tree node; { } --- 13045,13049 ---- void copy_lang_decl (node) ! tree node UNUSED; { } *************** global_bindings_p () *** 12138,12142 **** void incomplete_type_error (value, type) ! tree value; tree type; { --- 13074,13078 ---- void incomplete_type_error (value, type) ! tree value UNUSED; tree type; { *************** void *** 12157,12161 **** init_lex () { ! extern char *(*decl_printable_name) (); /* Make identifier nodes long enough for the language-specific slots. */ --- 13093,13099 ---- init_lex () { ! #if BUILT_FOR_270 ! extern void (*print_error_function) (char *); ! #endif /* Make identifier nodes long enough for the language-specific slots. */ *************** init_lex () *** 12162,12165 **** --- 13100,13106 ---- 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 } *************** void *** 12198,12201 **** --- 13139,13151 ---- lang_init () { + extern FILE *finput; /* Don't pollute com.h with this. */ + + /* 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); } *************** mark_addressable (exp) *** 12261,12265 **** tree maybe_build_cleanup (decl) ! tree decl; { /* There are no cleanups in Fortran. */ --- 13211,13215 ---- tree maybe_build_cleanup (decl) ! tree decl UNUSED; { /* There are no cleanups in Fortran. */ *************** poplevel (keep, reverse, functionbody) *** 12377,12382 **** { /* 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; --- 13327,13332 ---- { /* 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; *************** poplevel (keep, reverse, functionbody) *** 12431,12437 **** void print_lang_decl (file, node, indent) ! FILE *file; ! tree node; ! int indent; { } --- 13381,13387 ---- void print_lang_decl (file, node, indent) ! FILE *file UNUSED; ! tree node UNUSED; ! int indent UNUSED; { } *************** print_lang_statistics () *** 12454,12460 **** void print_lang_type (file, node, indent) ! FILE *file; ! tree node; ! int indent; { } --- 13404,13410 ---- void print_lang_type (file, node, indent) ! FILE *file UNUSED; ! tree node UNUSED; ! int indent UNUSED; { } *************** pushdecl (x) *** 12489,12492 **** --- 13439,13449 ---- 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; *************** pushdecl (x) *** 12493,12508 **** /* 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; --- 13450,13465 ---- /* 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; *************** pushdecl (x) *** 12509,12514 **** Later parts of the compiler might only know that `object' was of type ! `struct S' if if 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; --- 13466,13471 ---- Later parts of the compiler might only know that `object' was of type ! `struct S' if if 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; *************** pushdecl (x) *** 12515,12519 **** And they can then deduce (from the node for type struct S') that the ! original object declaration was: MY_TYPE object; --- 13472,13476 ---- And they can then deduce (from the node for type struct S') that the ! original object declaration was: MY_TYPE object; *************** pushdecl (x) *** 12520,12533 **** 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) --- 13477,13490 ---- 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) *************** pushdecl (x) *** 12549,12553 **** /* 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; --- 13506,13510 ---- /* 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; *************** truthvalue_conversion (expr) *** 12746,12750 **** case TRUTH_OR_EXPR: case TRUTH_XOR_EXPR: ! return convert (integer_type_node, expr); case ERROR_MARK: --- 13703,13708 ---- case TRUTH_OR_EXPR: case TRUTH_XOR_EXPR: ! TREE_TYPE (expr) = integer_type_node; ! return expr; case ERROR_MARK: *************** truthvalue_conversion (expr) *** 12787,12791 **** else return truthvalue_conversion (TREE_OPERAND (expr, 0)); ! case COND_EXPR: /* Distribute the conversion into the arms of a COND_EXPR. */ --- 13745,13749 ---- else return truthvalue_conversion (TREE_OPERAND (expr, 0)); ! case COND_EXPR: /* Distribute the conversion into the arms of a COND_EXPR. */ *************** type_for_mode (mode, unsignedp) *** 12871,12874 **** --- 13829,13835 ---- 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; *************** type_for_mode (mode, unsignedp) *** 12877,12883 **** return unsignedp ? short_unsigned_type_node : short_integer_type_node; - if (mode == TYPE_MODE (integer_type_node)) - return unsignedp ? unsigned_type_node : integer_type_node; - if (mode == TYPE_MODE (long_integer_type_node)) return unsignedp ? long_unsigned_type_node : long_integer_type_node; --- 13838,13841 ---- *************** type_for_mode (mode, unsignedp) *** 12898,12903 **** return build_pointer_type (integer_type_node); ! for (i = 0; i < ARRAY_SIZE (ffecom_tree_type); ++i) ! for (j = 0; j < ARRAY_SIZE (ffecom_tree_type[0]); ++j) { if (((t = ffecom_tree_type[i][j]) != NULL_TREE) --- 13856,13861 ---- 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) *************** type_for_size (bits, unsignedp) *** 12920,12923 **** --- 13878,13884 ---- 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; *************** type_for_size (bits, unsignedp) *** 12926,12932 **** return unsignedp ? short_unsigned_type_node : short_integer_type_node; - if (bits == TYPE_PRECISION (integer_type_node)) - return unsignedp ? unsigned_type_node : integer_type_node; - if (bits == TYPE_PRECISION (long_integer_type_node)) return unsignedp ? long_unsigned_type_node : long_integer_type_node; --- 13887,13890 ---- *************** open_include_file (filename, searchptr) *** 13152,13155 **** --- 14110,14120 ---- /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; *************** open_include_file (filename, searchptr) *** 13156,13161 **** if (searchptr && searchptr->fname ! && strlen (searchptr->fname) == p - filename ! && ! strncmp (searchptr->fname, filename, p - filename)) { /* FILENAME is in SEARCHPTR, which we've already checked. */ --- 14121,14126 ---- 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. */ *************** read_name_map (dirname) *** 13344,13348 **** strcpy (ptr->map_to + dirlen + 1, to); free (to); ! } ptr->map_next = map_list_ptr->map_list_map; --- 14309,14313 ---- strcpy (ptr->map_to + dirlen + 1, to); free (to); ! } ptr->map_next = map_list_ptr->map_list_map; *************** read_name_map (dirname) *** 13355,13359 **** fclose (f); } ! map_list_ptr->map_list_next = map_list; map_list = map_list_ptr; --- 14320,14324 ---- fclose (f); } ! map_list_ptr->map_list_next = map_list; map_list = map_list_ptr; *************** read_name_map (dirname) *** 13360,13364 **** return map_list_ptr->map_list_map; ! } static char * --- 14325,14329 ---- return map_list_ptr->map_list_map; ! } static char * *************** ffecom_initialize_char_syntax_ () *** 13427,13431 **** static void ! ffecom_close_include_ (FILE *f) { indepth--; --- 14392,14396 ---- static void ! ffecom_close_include_ (FILE *f UNUSED) { indepth--; *************** ffecom_decode_include_option_ (char *spe *** 13440,13444 **** { struct file_name_list *dirtmp; ! if (! ignore_srcdir && !strcmp (spec, "-")) ignore_srcdir = 1; --- 14405,14409 ---- { struct file_name_list *dirtmp; ! if (! ignore_srcdir && !strcmp (spec, "-")) ignore_srcdir = 1; *************** ffecom_open_include_ (char *name, ffewhe *** 13494,13497 **** --- 14459,14469 ---- #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, ']'); *************** ffecom_open_include_ (char *name, ffewhe *** 13519,13523 **** /* Allocate this permanently, because it gets stored in the definitions of macros. */ ! fname = (char *) 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 --- 14491,14495 ---- /* 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 *************** ffecom_open_include_ (char *name, ffewhe *** 13526,13532 **** /* If specified file name is absolute, just open it. */ ! if (*fbeg == '/') { ! strncpy (fname, fbeg, flen); fname[flen] = 0; f = open_include_file (fname, NULL_PTR); --- 14498,14508 ---- /* 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); *************** ffecom_open_include_ (char *name, ffewhe *** 13567,13571 **** { /* This is a normal VMS filespec, so use it unchanged. */ ! strncpy (fname, fbeg, flen); fname[flen] = 0; #if 0 /* Not for g77. */ --- 14543,14547 ---- { /* This is a normal VMS filespec, so use it unchanged. */ ! strncpy (fname, (char *) fbeg, flen); fname[flen] = 0; #if 0 /* Not for g77. */ *************** ffecom_open_include_ (char *name, ffewhe *** 13597,13601 **** /* A file that was not found. */ ! strncpy (fname, fbeg, flen); fname[flen] = 0; print_containing_files (ffebad_severity (FFEBAD_OPEN_INCLUDE)); --- 14573,14577 ---- /* A file that was not found. */ ! strncpy (fname, (char *) fbeg, flen); fname[flen] = 0; print_containing_files (ffebad_severity (FFEBAD_OPEN_INCLUDE)); diff -rcp2N g77-0.5.15/f/com.h g77-0.5.16/f/com.h *** g77-0.5.15/f/com.h Fri Apr 28 05:26:10 1995 --- g77-0.5.16/f/com.h Wed Aug 30 15:53:37 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: *************** the Free Software Foundation, 675 Mass A *** 34,39 **** #define FFECOM_dimensionsMAX 7 /* Max # dimensions (quick hack). */ ! #define FFECOM_targetFFE 0 ! #define FFECOM_targetGCC 1 #ifndef FFE_STANDALONE --- 35,40 ---- #define FFECOM_dimensionsMAX 7 /* Max # dimensions (quick hack). */ ! #define FFECOM_targetFFE 1 ! #define FFECOM_targetGCC 2 #ifndef FFE_STANDALONE *************** typedef enum *** 170,174 **** } ffecomGfrt; ! #endif /* Typedefs. */ --- 171,175 ---- } ffecomGfrt; ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Typedefs. */ *************** typedef enum *** 178,181 **** --- 179,191 ---- #include "tree.j" #endif + + #ifndef BUILT_FOR_270 + #ifdef DECL_STATIC_CONSTRUCTOR /* In gcc/tree.h. */ + #define BUILT_FOR_270 1 + #else + #define BUILT_FOR_270 0 + #endif + #endif /* !defined (BUILT_FOR_270) */ + typedef tree ffecomConstant; #define FFECOM_constantHOOK *************** struct _ffecom_symbol_ *** 196,200 **** bool addr; /* Is address of item instead of item. */ }; ! #endif /* Include files needed by this one. */ --- 206,210 ---- bool addr; /* Is address of item instead of item. */ }; ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Include files needed by this one. */ *************** extern tree ffecom_f2c_ptr_to_ftnlen_typ *** 237,241 **** extern tree ffecom_f2c_ftnint_type_node; extern tree ffecom_f2c_ptr_to_ftnint_type_node; ! #endif /* Declare functions with prototypes. */ --- 247,251 ---- extern tree ffecom_f2c_ftnint_type_node; extern tree ffecom_f2c_ptr_to_ftnint_type_node; ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Declare functions with prototypes. */ *************** tree ffecom_constantunion (ffebldConstan *** 259,263 **** tree ffecom_decl_field (tree context, tree prevfield, char *name, tree type); ! #endif void ffecom_close_include (FILE *f); int ffecom_decode_include_option (char *spec); --- 269,273 ---- 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); *************** tree ffecom_list_ptr_to_expr (ffebld lis *** 281,285 **** tree ffecom_lookup_label (ffelab label); tree ffecom_modify (tree newtype, tree lhs, tree rhs); ! #endif void ffecom_file (char *name); void ffecom_notify_init_storage (ffestorag st); --- 291,295 ---- tree ffecom_lookup_label (ffelab label); tree ffecom_modify (tree newtype, tree lhs, tree rhs); ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ void ffecom_file (char *name); void ffecom_notify_init_storage (ffestorag st); *************** tree ffecom_save_tree (tree t); *** 298,302 **** tree ffecom_start_decl (tree decl, bool is_init); void ffecom_sym_commit (ffesymbol s); ! #endif ffesymbol ffecom_sym_end_transition (ffesymbol s); ffesymbol ffecom_sym_exec_transition (ffesymbol s); --- 308,312 ---- tree ffecom_start_decl (tree decl, bool is_init); void ffecom_sym_commit (ffesymbol s); ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ ffesymbol ffecom_sym_end_transition (ffesymbol s); ffesymbol ffecom_sym_exec_transition (ffesymbol s); *************** tree ffecom_truth_value (tree expr); *** 308,312 **** tree ffecom_truth_value_invert (tree expr); tree ffecom_which_entrypoint_decl (void); ! #endif /* ~~~Eliminate these when possible, since the back end should be --- 318,322 ---- tree ffecom_truth_value_invert (tree expr); tree ffecom_which_entrypoint_decl (void); ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* ~~~Eliminate these when possible, since the back end should be *************** extern int flag_pedantic_errors; *** 317,320 **** --- 327,331 ---- void emit_nop (void); void announce_function (tree decl); + extern FILE *asm_out_file; void assemble_variable (tree decl, int top_level, int at_end, int dont_output_data); *************** void make_var_volatile (tree var); *** 334,337 **** --- 345,349 ---- int mark_addressable (tree expr); void output_inline_function (tree fndecl); + void pedwarn (char *s, ...); void pop_function_context (void); void pop_momentary_nofree (void); *************** void push_obstacks (struct obstack *curr *** 342,345 **** --- 354,358 ---- void put_var_into_stack (tree decl); void remember_end_note (tree block); + void report_error_function (char *file); void rest_of_compilation (tree decl); void rest_of_decl_compilation (tree decl, char *asmspec, int top_level, *************** tree truthvalue_conversion (tree expr); *** 351,355 **** void warning_with_decl (tree decl, char *s, ...); void warning (char *s, ...); ! #endif /* Define macros. */ --- 364,368 ---- void warning_with_decl (tree decl, char *s, ...); void warning (char *s, ...); ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Define macros. */ *************** void warning (char *s, ...); *** 362,370 **** #define ffecom_sym_commit(s) #define ffecom_sym_retract(s) ! #endif #if FFECOM_targetCURRENT == FFECOM_targetGCC #define ffecom_f2c_typecode(bt,kt) ffecom_f2c_typecode_[(bt)][(kt)] ! #endif #define ffecom_init_1() --- 375,383 ---- #define ffecom_sym_commit(s) #define ffecom_sym_retract(s) ! #endif /* FFECOM_targetCURRENT == FFECOM_targetFFE */ #if FFECOM_targetCURRENT == FFECOM_targetGCC #define ffecom_f2c_typecode(bt,kt) ffecom_f2c_typecode_[(bt)][(kt)] ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ #define ffecom_init_1() diff -rcp2N g77-0.5.15/f/compilers.h g77-0.5.16/f/compilers.h *** g77-0.5.15/f/compilers.h Fri Apr 28 05:26:10 1995 --- g77-0.5.16/f/compilers.h *************** *** 1,60 **** - /* compilers.h file for Gnu Fortran - Copyright (C) 1995 Free Software Foundation, Inc. - Contributed by James Craig Burley (burley@gnu.ai.mit.edu). - - This file is part of GNU Fortran. - - GNU Fortran 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, or (at your option) - any later version. - - GNU Fortran is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GNU Fortran; see the file COPYING. If not, write to - the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - - */ - - {".F", "@f77-cpp-input"}, - {"@f77-cpp-input", - /* For f77 we want -traditional to avoid errors with, for - instance, mismatched '. Also, we avoid unpleasant surprises - with substitution of names not prefixed by `_' by using %P - rather than %p (although this isn't consistent with SGI and - 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 -P %{nostdinc*} %{C} %{v} %{A*} %{I*} %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__=2 %{ansi:-trigraphs -$ -D__STRICT_ANSI__}\ - %{!undef:%P} -D_LANGUAGE_FORTRAN %{trigraphs} \ - %c %{O*:-D__OPTIMIZE__} -traditional %{ftraditional:-traditional}\ - %{traditional-cpp:-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", - "f771 %{!pipe:%g.i} \ - %{!Q:-quiet} -dumpbase %b.F %{d*} %{m*} %{a}\ - %{g*} %{O*} %{W*} %{w} %{pedantic*} \ - %{v:-version -fversion} %{f*} %{I*}\ - %{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 %{R} %{j} %{J} %{h} %{d2} %a %{keep-local-as-symbols:-L} \ - %{c:%W{o*}%{!o*:-o %w%b.o}}%{!c:-o %d%w%u.o}\ - %{!pipe:%g.s} %A\n }"}, - {".f", "@f77"}, - {".for", "@f77"}, - {"@f77","f771 %i \ - %{!Q:-quiet} -dumpbase %b.f %{d*} %{m*} %{a}\ - %{g*} %{O*} %{W*} %{w} %{pedantic*} \ - %{v:-version -fversion} %{f*} %{I*}\ - %{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 %{R} %{j} %{J} %{h} %{d2} %a %{keep-local-as-symbols:-L} \ - %{c:%W{o*}%{!o*:-o %w%b.o}}%{!c:-o %d%w%u.o}\ - %{!pipe:%g.s} %A\n }"}, --- 0 ---- diff -rcp2N g77-0.5.15/f/config-lang.in g77-0.5.16/f/config-lang.in *** g77-0.5.15/f/config-lang.in Wed Feb 15 19:17:13 1995 --- g77-0.5.16/f/config-lang.in Wed Aug 30 15:53:37 1995 *************** *** 16,20 **** #You should have received a copy of the GNU General Public License #along with GNU Fortran; see the file COPYING. If not, write to ! #the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. # Configure looks for the existence of this file to auto-config each language. --- 16,21 ---- #You should have received a copy of the GNU General Public License #along with GNU Fortran; see the file COPYING. If not, write to ! #the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! #02111-1307, USA. # Configure looks for the existence of this file to auto-config each language. *************** *** 26,32 **** # diff_excludes - files to ignore when building diffs between two versions. language="f77" ! compilers="f771" case "$arguments" in --- 27,41 ---- # diff_excludes - files to ignore when building diffs between two versions. + if grep put_pending_sizes $srcdir/stor-layout.c >/dev/null; then true + else + echo "You haven't applied the patches to the GCC distribution in" + echo "$srcdir as described in g77/README.g77 and gcc/f/gbe/README." + echo "" + exit 1 + fi + language="f77" ! compilers="f771\$(exeext)" case "$arguments" in *************** case "$arguments" in *** 36,40 **** # stagestuff="g77 g77-cross f771 libf2c.a f2c" ;; *) ! stagestuff="g77 g77-cross f771 libf2c.a" ;; esac --- 45,49 ---- # stagestuff="g77 g77-cross f771 libf2c.a f2c" ;; *) ! stagestuff="g77\$(exeext) g77-cross\$(exeext) f771\$(exeext) libf2c.a" ;; esac *************** test -d f/runtime/libI77 || mkdir f/runt *** 47,63 **** test -d f/runtime/libF77 || mkdir f/runtime/libF77 case "$srcdir" in .) ;; *) echo ! echo "Building f77 outside the source directory is only guaranteed with" ! echo "GNU make or a compatible VPATH mechanism." echo ;; esac - - if grep put_pending_sizes $srcdir/stor-layout.c >/dev/null; then true - else - echo "You haven't applied the patches to the GCC distribution in" - echo "$srcdir as described in README.g77 and f/gbe/README." - echo "" - exit 1 - fi --- 56,87 ---- test -d f/runtime/libF77 || mkdir f/runtime/libF77 + # Need to make top-level stageN directory trees, else if needed + # later by gcc/Makefile, it'll make only the first levels and + # the language subdirectory levels, not the runtime stuff. + for stageN in stage1 stage2 stage3 stage4 + do + test -d $stageN || mkdir $stageN + test -d $stageN/f || mkdir $stageN/f + test -d $stageN/f/runtime || mkdir $stageN/f/runtime + test -d $stageN/f/runtime/libF77 || mkdir $stageN/f/runtime/libF77 + test -d $stageN/f/runtime/libI77 || mkdir $stageN/f/runtime/libI77 + done + + # Make links into top-level stageN from target trees. + for stageN in stage1 stage2 stage3 stage4 include + do + $remove -f f/$stageN f/runtime/$stageN f/runtime/libF77/$stageN \ + f/runtime/libI77/$stageN + (cd f; $symbolic_link ../$stageN . 2>/dev/null) + (cd f/runtime; $symbolic_link ../$stageN . 2>/dev/null) + (cd f/runtime/libF77; $symbolic_link ../$stageN . 2>/dev/null) + (cd f/runtime/libI77; $symbolic_link ../$stageN . 2>/dev/null) + done + case "$srcdir" in .) ;; *) echo ! echo "Building f77 outside the source directory is likely to not work" ! echo "unless you are using GNU make or a compatible VPATH mechanism." echo ;; esac diff -rcp2N g77-0.5.15/f/config.j g77-0.5.16/f/config.j *** g77-0.5.15/f/config.j Thu Feb 16 21:43:59 1995 --- g77-0.5.16/f/config.j Wed Aug 30 15:53:37 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef MAKING_DEPENDENCIES --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #ifndef MAKING_DEPENDENCIES diff -rcp2N g77-0.5.15/f/convert.j g77-0.5.16/f/convert.j *** g77-0.5.15/f/convert.j Fri Feb 17 01:22:59 1995 --- g77-0.5.16/f/convert.j Wed Aug 30 15:53:37 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef MAKING_DEPENDENCIES --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #ifndef MAKING_DEPENDENCIES diff -rcp2N g77-0.5.15/f/data.c g77-0.5.16/f/data.c *** g77-0.5.15/f/data.c Wed Apr 12 10:03:11 1995 --- g77-0.5.16/f/data.c Wed Aug 30 15:53:37 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** ffedata_gather (ffestorag st) *** 212,216 **** ffetarget_aggregate_info (&ffedata_storage_bt_, &ffedata_storage_kt_, ! &ffedata_storage_units_, ffestorag_basictype (st), ffestorag_kindtype (st)); ffedata_storage_size_ = ffestorag_size (st) / ffedata_storage_units_; assert (ffestorag_size (st) % ffedata_storage_units_ == 0); --- 213,218 ---- ffetarget_aggregate_info (&ffedata_storage_bt_, &ffedata_storage_kt_, ! &ffedata_storage_units_, ffestorag_basictype (st), ! ffestorag_kindtype (st)); ffedata_storage_size_ = ffestorag_size (st) / ffedata_storage_units_; assert (ffestorag_size (st) % ffedata_storage_units_ == 0); *************** ffedata_gather (ffestorag st) *** 218,226 **** /* If a CBLOCK, gather all the init info for its explicit members. */ ! s = ffestorag_symbol (st); ! if (s != NULL) { for (b = ffesymbol_commonlist (s); b != NULL; b = ffebld_trail (b)) ! ffedata_gather_ (st, ffesymbol_storage (ffebld_symter (ffebld_head (b)))); } --- 220,230 ---- /* If a CBLOCK, gather all the init info for its explicit members. */ ! if ((ffestorag_type (st) == FFESTORAG_typeCBLOCK) ! && (ffestorag_symbol (st) != NULL)) { + s = ffestorag_symbol (st); for (b = ffesymbol_commonlist (s); b != NULL; b = ffebld_trail (b)) ! ffedata_gather_ (st, ! ffesymbol_storage (ffebld_symter (ffebld_head (b)))); } *************** ffedata_value_ (ffebld value, ffelexToke *** 1668,1672 **** ffebit_count (ffebld_accter_bits (accter), offset, FALSE, ffedata_charexpected_, &actual); /* How many FALSE? */ ! if (actual != ffedata_charexpected_) { ffebad_start (FFEBAD_DATA_MULTIPLE); --- 1672,1676 ---- ffebit_count (ffebld_accter_bits (accter), offset, FALSE, ffedata_charexpected_, &actual); /* How many FALSE? */ ! if (actual != (unsigned long int) ffedata_charexpected_) { ffebad_start (FFEBAD_DATA_MULTIPLE); diff -rcp2N g77-0.5.15/f/data.h g77-0.5.16/f/data.h *** g77-0.5.15/f/data.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/data.h Wed Aug 30 15:53:37 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/equiv.c g77-0.5.16/f/equiv.c *** g77-0.5.15/f/equiv.c Sat Feb 25 18:30:31 1995 --- g77-0.5.16/f/equiv.c Wed Aug 30 15:53:37 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** the Free Software Foundation, 675 Mass A *** 28,31 **** --- 29,34 ---- */ + #define FFEEQUIV_DEBUG 0 + /* Include files. */ *************** ffeequiv_layout_local_ (ffeequiv eq) *** 112,116 **** assert (eq != NULL); ! assert (ffeequiv_common (eq) == NULL); /* First find the symbol which, in the list of lists, has the reference --- 115,124 ---- assert (eq != NULL); ! ! if (ffeequiv_common (eq) != NULL) ! { /* Put in common due to programmer error. */ ! ffeequiv_kill (eq); ! return; ! } /* First find the symbol which, in the list of lists, has the reference *************** ffeequiv_layout_local_ (ffeequiv eq) *** 122,125 **** --- 130,137 ---- ok = TRUE; + #if FFEEQUIV_DEBUG + fprintf (stderr, "Equiv1:\n"); + #endif + for (list = ffeequiv_list (eq); list != NULL; *************** ffeequiv_layout_local_ (ffeequiv eq) *** 127,130 **** --- 139,146 ---- { /* For every equivalence list in the list of equivs */ + #if FFEEQUIV_DEBUG + fprintf (stderr, "("); + #endif + for (item = ffebld_head (list); item != NULL; *************** ffeequiv_layout_local_ (ffeequiv eq) *** 135,138 **** --- 151,159 ---- if (s == NULL) continue; /* Ignore me. */ + + #if FFEEQUIV_DEBUG + fprintf (stderr, "%s,", ffesymbol_text (s)); + #endif + assert (ffesymbol_storage (s) == NULL); /* No storage yet. */ ffesymbol_set_equiv (s, NULL); /* Equiv area slated for *************** ffeequiv_layout_local_ (ffeequiv eq) *** 146,149 **** --- 167,174 ---- } } + #if FFEEQUIV_DEBUG + fprintf (stderr, ")\n"); + #endif + } *************** ffeequiv_layout_local_ (ffeequiv eq) *** 217,222 **** --- 242,255 ---- through them all without making any new storage objects. */ + #if FFEEQUIV_DEBUG + fprintf (stderr, "Equiv2:\n"); + #endif + do { + #if FFEEQUIV_DEBUG + fprintf (stderr, " Equiv3:\n"); + #endif + new_storage = FALSE; need_storage = FALSE; *************** ffeequiv_layout_local_ (ffeequiv eq) *** 226,229 **** --- 259,266 ---- { /* For every equivalence list in the list of equivs */ + #if FFEEQUIV_DEBUG + fprintf (stderr, " ("); + #endif + root_offset = 0; sr = NULL; *************** ffeequiv_layout_local_ (ffeequiv eq) *** 234,244 **** { /* For every equivalence item in the list */ var = ffebld_head (item); - need_storage = TRUE; /* Somebody is likely to need - storage. */ sv = ffeequiv_symbol (var); if (sv == NULL) continue; /* Ignore me. */ if ((vst = ffesymbol_storage (sv)) == NULL) continue; /* No storage for this guy, try another. */ ffeequiv_offset_ (&var_offset, sv, var, FALSE, ffestorag_offset (vst)); --- 271,287 ---- { /* For every equivalence item in the list */ var = ffebld_head (item); sv = ffeequiv_symbol (var); if (sv == NULL) continue; /* Ignore me. */ + + #if FFEEQUIV_DEBUG + fprintf (stderr, "%s,", ffesymbol_text (sv)); + #endif + + need_storage = TRUE; /* Somebody is likely to need + storage. */ if ((vst = ffesymbol_storage (sv)) == NULL) continue; /* No storage for this guy, try another. */ + ffeequiv_offset_ (&var_offset, sv, var, FALSE, ffestorag_offset (vst)); *************** ffeequiv_layout_local_ (ffeequiv eq) *** 252,258 **** } if (sr == NULL) /* No storage to go on, try later. */ ! continue; ! need_storage = FALSE; /* Everyone in this sublist will get storage! */ /* We now know the root symbol/expr and the operating offset of --- 295,308 ---- } if (sr == NULL) /* No storage to go on, try later. */ ! { ! #if FFEEQUIV_DEBUG ! fprintf (stderr, ")\n"); ! #endif ! continue; ! } ! #if FFEEQUIV_DEBUG ! fprintf (stderr, ") %s:\n (", ffesymbol_text (sr)); ! #endif /* We now know the root symbol/expr and the operating offset of *************** ffeequiv_layout_local_ (ffeequiv eq) *** 266,279 **** { /* For every equivalence item in the list */ var = ffebld_head (item); - if (var == root) - continue; /* Except root, of course. */ sv = ffeequiv_symbol (var); if (sv == NULL) continue; /* Except erroneous stuff (opANY). */ ! ffesymbol_set_equiv (sv, NULL); /* Don't need this ref ! anymore. */ if (!ffeequiv_offset_ (&var_offset, sv, var, TRUE, root_offset)) continue; /* Attempt to start sym prior to equiv area! */ if (ffesymbol_rank (sv) == 0) num_elements = 1; --- 316,339 ---- { /* For every equivalence item in the list */ var = ffebld_head (item); sv = ffeequiv_symbol (var); if (sv == NULL) continue; /* Except erroneous stuff (opANY). */ ! if (var == root) ! { ! /* The last root symbol we see must therefore ! (by static deduction) be the first-listed "rooted" item ! in the EQUIVALENCE statements pertaining to this area. */ ! ffestorag_set_symbol (st, sv); ! continue; /* Root sym already set up. */ ! } ! if (!ffeequiv_offset_ (&var_offset, sv, var, TRUE, root_offset)) continue; /* Attempt to start sym prior to equiv area! */ + #if FFEEQUIV_DEBUG + fprintf (stderr, "%s:%ld,", ffesymbol_text (sv), + (long) var_offset); + #endif + if (ffesymbol_rank (sv) == 0) num_elements = 1; *************** ffeequiv_layout_local_ (ffeequiv eq) *** 296,299 **** --- 356,365 ---- } + /* The last symbol we see with a zero offset must therefore + (by static deduction) be the first-listed "rooted" item + in the EQUIVALENCE statements pertaining to this area. */ + if (var_offset == 0) + ffestorag_set_symbol (st, sv); + if ((vst = ffesymbol_storage (sv)) == NULL) { /* Create new ffestorag object, extend equiv *************** ffeequiv_layout_local_ (ffeequiv eq) *** 342,350 **** } } /* (For every equivalence item in the list) */ ffebld_set_head (list, NULL); /* Don't do this list again. */ } /* (For every equivalence list in the list of equivs) */ ! } ! while (new_storage && need_storage); ffeequiv_kill (eq); /* Fully processed, no longer needed. */ --- 408,418 ---- } } /* (For every equivalence item in the list) */ + #if FFEEQUIV_DEBUG + fprintf (stderr, ")\n"); + #endif ffebld_set_head (list, NULL); /* Don't do this list again. */ } /* (For every equivalence list in the list of equivs) */ ! } while (new_storage && need_storage); ffeequiv_kill (eq); /* Fully processed, no longer needed. */ *************** ffeequiv_layout_local_ (ffeequiv eq) *** 371,376 **** static bool ! ffeequiv_offset_ (ffetargetOffset *offset, ffesymbol s, ffebld expr, ! bool subtract, ffetargetOffset adjust) { ffetargetIntegerDefault value = 0; --- 439,444 ---- static bool ! ffeequiv_offset_ (ffetargetOffset *offset, ffesymbol s UNUSED, ! ffebld expr, bool subtract, ffetargetOffset adjust) { ffetargetIntegerDefault value = 0; *************** ffeequiv_layout_cblock (ffestorag st) *** 829,835 **** /* We now know the root symbol and the operating offset of that ! root into the common area. The other expressions in the ! list all identify an initial storage unit that must have the ! same offset. */ for (var = ffebld_head (item); --- 897,903 ---- /* We now know the root symbol and the operating offset of that ! root into the common area. The other expressions in the ! list all identify an initial storage unit that must have the ! same offset. */ for (var = ffebld_head (item); diff -rcp2N g77-0.5.15/f/equiv.h g77-0.5.16/f/equiv.h *** g77-0.5.15/f/equiv.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/equiv.h Wed Aug 30 15:53:37 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/expr.c g77-0.5.16/f/expr.c *** g77-0.5.15/f/expr.c Fri May 19 11:17:30 1995 --- g77-0.5.16/f/expr.c Wed Aug 30 15:53:37 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** ffeexpr_collapse_convert (ffebld expr, f *** 2895,2899 **** (ffebld_cu_ptr_character1 (u), sz, ffebld_constant_character1 (ffebld_conter (l)), ! ffebld_constant_character_pool ()); break; --- 2896,2900 ---- (ffebld_cu_ptr_character1 (u), sz, ffebld_constant_character1 (ffebld_conter (l)), ! ffebld_constant_pool ()); break; *************** ffeexpr_collapse_convert (ffebld expr, f *** 2908,2912 **** sz, ffebld_constant_integer1 (ffebld_conter (l)), ! ffebld_constant_character_pool ()); break; #endif --- 2909,2913 ---- sz, ffebld_constant_integer1 (ffebld_conter (l)), ! ffebld_constant_pool ()); break; #endif *************** ffeexpr_collapse_convert (ffebld expr, f *** 2919,2923 **** sz, ffebld_constant_integer2 (ffebld_conter (l)), ! ffebld_constant_character_pool ()); break; #endif --- 2920,2924 ---- sz, ffebld_constant_integer2 (ffebld_conter (l)), ! ffebld_constant_pool ()); break; #endif *************** ffeexpr_collapse_convert (ffebld expr, f *** 2930,2934 **** sz, ffebld_constant_integer3 (ffebld_conter (l)), ! ffebld_constant_character_pool ()); break; #endif --- 2931,2935 ---- sz, ffebld_constant_integer3 (ffebld_conter (l)), ! ffebld_constant_pool ()); break; #endif *************** ffeexpr_collapse_convert (ffebld expr, f *** 2941,2945 **** sz, ffebld_constant_integer4 (ffebld_conter (l)), ! ffebld_constant_character_pool ()); break; #endif --- 2942,2946 ---- sz, ffebld_constant_integer4 (ffebld_conter (l)), ! ffebld_constant_pool ()); break; #endif *************** ffeexpr_collapse_convert (ffebld expr, f *** 2961,2965 **** sz, ffebld_constant_logical1 (ffebld_conter (l)), ! ffebld_constant_character_pool ()); break; #endif --- 2962,2966 ---- sz, ffebld_constant_logical1 (ffebld_conter (l)), ! ffebld_constant_pool ()); break; #endif *************** ffeexpr_collapse_convert (ffebld expr, f *** 2972,2976 **** sz, ffebld_constant_logical2 (ffebld_conter (l)), ! ffebld_constant_character_pool ()); break; #endif --- 2973,2977 ---- sz, ffebld_constant_logical2 (ffebld_conter (l)), ! ffebld_constant_pool ()); break; #endif *************** ffeexpr_collapse_convert (ffebld expr, f *** 2983,2987 **** sz, ffebld_constant_logical3 (ffebld_conter (l)), ! ffebld_constant_character_pool ()); break; #endif --- 2984,2988 ---- sz, ffebld_constant_logical3 (ffebld_conter (l)), ! ffebld_constant_pool ()); break; #endif *************** ffeexpr_collapse_convert (ffebld expr, f *** 2994,2998 **** sz, ffebld_constant_logical4 (ffebld_conter (l)), ! ffebld_constant_character_pool ()); break; #endif --- 2995,2999 ---- sz, ffebld_constant_logical4 (ffebld_conter (l)), ! ffebld_constant_pool ()); break; #endif *************** ffeexpr_collapse_convert (ffebld expr, f *** 3010,3014 **** sz, ffebld_constant_hollerith (ffebld_conter (l)), ! ffebld_constant_character_pool ()); break; --- 3011,3015 ---- sz, ffebld_constant_hollerith (ffebld_conter (l)), ! ffebld_constant_pool ()); break; *************** ffeexpr_collapse_convert (ffebld expr, f *** 3019,3023 **** sz, ffebld_constant_typeless (ffebld_conter (l)), ! ffebld_constant_character_pool ()); break; --- 3020,3024 ---- sz, ffebld_constant_typeless (ffebld_conter (l)), ! ffebld_constant_pool ()); break; *************** ffeexpr_collapse_convert (ffebld expr, f *** 3073,3077 **** ffebld ! ffeexpr_collapse_paren (ffebld expr, ffelexToken t) { ffebld r; --- 3074,3078 ---- ffebld ! ffeexpr_collapse_paren (ffebld expr, ffelexToken t UNUSED) { ffebld r; *************** ffeexpr_collapse_paren (ffebld expr, ffe *** 3116,3120 **** ffebld ! ffeexpr_collapse_uplus (ffebld expr, ffelexToken t) { ffebld r; --- 3117,3121 ---- ffebld ! ffeexpr_collapse_uplus (ffebld expr, ffelexToken t UNUSED) { ffebld r; *************** ffeexpr_collapse_concatenate (ffebld exp *** 4510,4514 **** ffebld_constant_character1 (ffebld_conter (l)), ffebld_constant_character1 (ffebld_conter (r)), ! ffebld_constant_character_pool (), &len); expr = ffebld_new_conter_with_orig (ffebld_constant_new_character1_val (ffebld_cu_val_character1 (u)), expr); --- 4511,4515 ---- ffebld_constant_character1 (ffebld_conter (l)), ffebld_constant_character1 (ffebld_conter (r)), ! ffebld_constant_pool (), &len); expr = ffebld_new_conter_with_orig (ffebld_constant_new_character1_val (ffebld_cu_val_character1 (u)), expr); *************** ffeexpr_collapse_concatenate (ffebld exp *** 4521,4525 **** ffebld_constant_character2 (ffebld_conter (l)), ffebld_constant_character2 (ffebld_conter (r)), ! ffebld_constant_character_pool (), &len); expr = ffebld_new_conter_with_orig (ffebld_constant_new_character2_val (ffebld_cu_val_character2 (u)), expr); --- 4522,4526 ---- ffebld_constant_character2 (ffebld_conter (l)), ffebld_constant_character2 (ffebld_conter (r)), ! ffebld_constant_pool (), &len); expr = ffebld_new_conter_with_orig (ffebld_constant_new_character2_val (ffebld_cu_val_character2 (u)), expr); *************** ffeexpr_collapse_concatenate (ffebld exp *** 4532,4536 **** ffebld_constant_character3 (ffebld_conter (l)), ffebld_constant_character3 (ffebld_conter (r)), ! ffebld_constant_character_pool (), &len); expr = ffebld_new_conter_with_orig (ffebld_constant_new_character3_val (ffebld_cu_val_character3 (u)), expr); --- 4533,4537 ---- ffebld_constant_character3 (ffebld_conter (l)), ffebld_constant_character3 (ffebld_conter (r)), ! ffebld_constant_pool (), &len); expr = ffebld_new_conter_with_orig (ffebld_constant_new_character3_val (ffebld_cu_val_character3 (u)), expr); *************** ffeexpr_collapse_concatenate (ffebld exp *** 4543,4547 **** ffebld_constant_character4 (ffebld_conter (l)), ffebld_constant_character4 (ffebld_conter (r)), ! ffebld_constant_character_pool (), &len); expr = ffebld_new_conter_with_orig (ffebld_constant_new_character4_val (ffebld_cu_val_character4 (u)), expr); --- 4544,4548 ---- ffebld_constant_character4 (ffebld_conter (l)), ffebld_constant_character4 (ffebld_conter (r)), ! ffebld_constant_pool (), &len); expr = ffebld_new_conter_with_orig (ffebld_constant_new_character4_val (ffebld_cu_val_character4 (u)), expr); *************** ffeexpr_collapse_neqv (ffebld expr, ffel *** 6684,6688 **** ffebld ! ffeexpr_collapse_symter (ffebld expr, ffelexToken t) { ffebld r; --- 6685,6689 ---- ffebld ! ffeexpr_collapse_symter (ffebld expr, ffelexToken t UNUSED) { ffebld r; *************** ffeexpr_collapse_symter (ffebld expr, ff *** 6737,6741 **** ffebld ! ffeexpr_collapse_funcref (ffebld expr, ffelexToken t) { return expr; /* ~~someday go ahead and collapse these, --- 6738,6742 ---- ffebld ! ffeexpr_collapse_funcref (ffebld expr, ffelexToken t UNUSED) { return expr; /* ~~someday go ahead and collapse these, *************** ffeexpr_collapse_funcref (ffebld expr, f *** 6753,6757 **** ffebld ! ffeexpr_collapse_arrayref (ffebld expr, ffelexToken t) { return expr; --- 6754,6758 ---- ffebld ! ffeexpr_collapse_arrayref (ffebld expr, ffelexToken t UNUSED) { return expr; *************** ffeexpr_collapse_substr (ffebld expr, ff *** 6853,6857 **** error = ffetarget_substr_character1 (ffebld_cu_ptr_character1 (u), ffebld_constant_character1 (ffebld_conter (l)), first, last, ! ffebld_constant_character_pool (), &len); expr = ffebld_new_conter_with_orig (ffebld_constant_new_character1_val (ffebld_cu_val_character1 (u)), expr); --- 6854,6858 ---- error = ffetarget_substr_character1 (ffebld_cu_ptr_character1 (u), ffebld_constant_character1 (ffebld_conter (l)), first, last, ! ffebld_constant_pool (), &len); expr = ffebld_new_conter_with_orig (ffebld_constant_new_character1_val (ffebld_cu_val_character1 (u)), expr); *************** ffeexpr_collapse_substr (ffebld expr, ff *** 6863,6867 **** error = ffetarget_substr_character2 (ffebld_cu_ptr_character2 (u), ffebld_constant_character2 (ffebld_conter (l)), first, last, ! ffebld_constant_character_pool (), &len); expr = ffebld_new_conter_with_orig (ffebld_constant_new_character2_val (ffebld_cu_val_character2 (u)), expr); --- 6864,6868 ---- error = ffetarget_substr_character2 (ffebld_cu_ptr_character2 (u), ffebld_constant_character2 (ffebld_conter (l)), first, last, ! ffebld_constant_pool (), &len); expr = ffebld_new_conter_with_orig (ffebld_constant_new_character2_val (ffebld_cu_val_character2 (u)), expr); *************** ffeexpr_collapse_substr (ffebld expr, ff *** 6873,6877 **** error = ffetarget_substr_character3 (ffebld_cu_ptr_character3 (u), ffebld_constant_character3 (ffebld_conter (l)), first, last, ! ffebld_constant_character_pool (), &len); expr = ffebld_new_conter_with_orig (ffebld_constant_new_character3_val (ffebld_cu_val_character3 (u)), expr); --- 6874,6878 ---- error = ffetarget_substr_character3 (ffebld_cu_ptr_character3 (u), ffebld_constant_character3 (ffebld_conter (l)), first, last, ! ffebld_constant_pool (), &len); expr = ffebld_new_conter_with_orig (ffebld_constant_new_character3_val (ffebld_cu_val_character3 (u)), expr); *************** ffeexpr_collapse_substr (ffebld expr, ff *** 6883,6887 **** error = ffetarget_substr_character4 (ffebld_cu_ptr_character4 (u), ffebld_constant_character4 (ffebld_conter (l)), first, last, ! ffebld_constant_character_pool (), &len); expr = ffebld_new_conter_with_orig (ffebld_constant_new_character4_val (ffebld_cu_val_character4 (u)), expr); --- 6884,6888 ---- error = ffetarget_substr_character4 (ffebld_cu_ptr_character4 (u), ffebld_constant_character4 (ffebld_conter (l)), first, last, ! ffebld_constant_pool (), &len); expr = ffebld_new_conter_with_orig (ffebld_constant_new_character4_val (ffebld_cu_val_character4 (u)), expr); *************** ffeexpr_convert (ffebld source, ffelexTo *** 6971,6975 **** && (context == FFEEXPR_contextDATA)); break; ! default: bad = TRUE; --- 6972,6976 ---- && (context == FFEEXPR_contextDATA)); break; ! default: bad = TRUE; *************** ffeexpr_convert (ffebld source, ffelexTo *** 6996,7000 **** && (context == FFEEXPR_contextDATA)); break; ! default: bad = TRUE; --- 6997,7001 ---- && (context == FFEEXPR_contextDATA)); break; ! default: bad = TRUE; *************** ffeexpr_convert (ffebld source, ffelexTo *** 7016,7020 **** bad = TRUE; break; ! default: bad = TRUE; --- 7017,7021 ---- bad = TRUE; break; ! default: bad = TRUE; *************** ffeexpr_cb_comma_i_1_ (ffelexToken ft, f *** 7851,7855 **** static ffelexHandler ! ffeexpr_cb_comma_i_2_ (ffelexToken ft, ffebld expr, ffelexToken t) { ffeexprContext ctx; --- 7852,7856 ---- static ffelexHandler ! ffeexpr_cb_comma_i_2_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) { ffeexprContext ctx; *************** ffeexpr_cb_comma_i_2_ (ffelexToken ft, f *** 7907,7911 **** static ffelexHandler ! ffeexpr_cb_comma_i_3_ (ffelexToken ft, ffebld expr, ffelexToken t) { ffeexprContext ctx; --- 7908,7912 ---- static ffelexHandler ! ffeexpr_cb_comma_i_3_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) { ffeexprContext ctx; *************** ffeexpr_cb_comma_i_3_ (ffelexToken ft, f *** 7969,7973 **** static ffelexHandler ! ffeexpr_cb_comma_i_4_ (ffelexToken ft, ffebld expr, ffelexToken t) { switch (ffelex_token_type (t)) --- 7970,7974 ---- static ffelexHandler ! ffeexpr_cb_comma_i_4_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) { switch (ffelex_token_type (t)) *************** ffeexpr_cb_comma_i_5_ (ffelexToken t) *** 8079,8083 **** static ffelexHandler ! ffeexpr_cb_end_loc_ (ffelexToken ft, ffebld expr, ffelexToken t) { ffeexprExpr_ e; --- 8080,8084 ---- static ffelexHandler ! ffeexpr_cb_end_loc_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) { ffeexprExpr_ e; *************** ffeexpr_cb_end_notloc_ (ffelexToken ft, *** 8214,8218 **** ffebld_set_op (e->u.operand, FFEBLD_opPERCENT_LOC); ! switch (ffeexpr_stack_->context) { --- 8215,8219 ---- ffebld_set_op (e->u.operand, FFEBLD_opPERCENT_LOC); ! switch (ffeexpr_stack_->context) { *************** ffeexpr_cb_end_notloc_ (ffelexToken ft, *** 8220,8236 **** ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_; break; ! case FFEEXPR_contextINDEXORACTUALARG_: ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_; break; ! case FFEEXPR_contextSFUNCDEFACTUALARG_: ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_; break; ! case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_: ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_; break; ! default: assert ("bad context?!?!" == NULL); --- 8221,8237 ---- ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_; break; ! case FFEEXPR_contextINDEXORACTUALARG_: ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_; break; ! case FFEEXPR_contextSFUNCDEFACTUALARG_: ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_; break; ! case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_: ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_; break; ! default: assert ("bad context?!?!" == NULL); *************** ffeexpr_cb_end_notloc_1_ (ffelexToken t) *** 8303,8311 **** ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_; break; ! case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_: ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_; break; ! default: assert ("bad context?!?!" == NULL); --- 8304,8312 ---- ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_; break; ! case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_: ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_; break; ! default: assert ("bad context?!?!" == NULL); *************** ffeexpr_token_number_period_ (ffelexToke *** 13809,13814 **** } /* A name not representing an exponent, so assume it will be something ! like EQ, make an integer from the number, pass the period to binary ! state and the current token to the resulting state. */ e = ffeexpr_expr_new_ (); --- 13810,13815 ---- } /* A name not representing an exponent, so assume it will be something ! like EQ, make an integer from the number, pass the period to binary ! state and the current token to the resulting state. */ e = ffeexpr_expr_new_ (); *************** ffeexpr_sym_impdoitem_ (ffesymbol sp, ff *** 16034,16039 **** /* After the exec transition, the state will either be UNCERTAIN (could ! be a dummy or local var) or UNDERSTOOD (local var, because this is a ! PROGRAM/BLOCKDATA program unit). */ sp = ffecom_sym_exec_transition (sp); --- 16035,16040 ---- /* After the exec transition, the state will either be UNCERTAIN (could ! be a dummy or local var) or UNDERSTOOD (local var, because this is a ! PROGRAM/BLOCKDATA program unit). */ sp = ffecom_sym_exec_transition (sp); *************** ffeexpr_sym_impdoitem_ (ffesymbol sp, ff *** 16056,16063 **** { /* Enhance understanding of local symbol. This used to imply exec ! transition, but that doesn't seem necessary, since the local symbol ! doesn't actually get put into an ffebld tree here -- we just learn ! more about it, just like when we see a local symbol's name in the ! dummy-arg list of a statement function. */ if (ss != FFESYMBOL_stateUNCERTAIN) --- 16057,16064 ---- { /* Enhance understanding of local symbol. This used to imply exec ! transition, but that doesn't seem necessary, since the local symbol ! doesn't actually get put into an ffebld tree here -- we just learn ! more about it, just like when we see a local symbol's name in the ! dummy-arg list of a statement function. */ if (ss != FFESYMBOL_stateUNCERTAIN) *************** ffeexpr_sym_impdoitem_ (ffesymbol sp, ff *** 16157,16162 **** /* Now see what we've got for a new object: NONE means a new error ! cropped up; ANY means an old error to be ignored; otherwise, ! everything's ok, update the object (symbol) and continue on. */ if (na == FFESYMBOL_attrsetNONE) --- 16158,16163 ---- /* Now see what we've got for a new object: NONE means a new error ! cropped up; ANY means an old error to be ignored; otherwise, ! everything's ok, update the object (symbol) and continue on. */ if (na == FFESYMBOL_attrsetNONE) *************** ffeexpr_sym_lhs_call_ (ffesymbol s, ffel *** 16226,16229 **** --- 16227,16231 ---- ffeintrinSpec spec; ffeintrinImp imp; + bool error = FALSE; assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE) *************** ffeexpr_sym_lhs_call_ (ffesymbol s, ffel *** 16254,16258 **** if (sa & FFESYMBOL_attrsTYPE) ! na = FFESYMBOL_attrsetNONE; else /* Not TYPE. */ --- 16256,16260 ---- if (sa & FFESYMBOL_attrsTYPE) ! error = TRUE; else /* Not TYPE. */ *************** ffeexpr_sym_lhs_call_ (ffesymbol s, ffel *** 16276,16280 **** if (sa & FFESYMBOL_attrsTYPE) ! na = FFESYMBOL_attrsetNONE; else kind = FFEINFO_kindSUBROUTINE; --- 16278,16282 ---- if (sa & FFESYMBOL_attrsTYPE) ! error = TRUE; else kind = FFEINFO_kindSUBROUTINE; *************** ffeexpr_sym_lhs_call_ (ffesymbol s, ffel *** 16285,16289 **** | FFESYMBOL_attrsTYPE))); ! na = FFESYMBOL_attrsetNONE; } else if (sa & FFESYMBOL_attrsSFARG) --- 16287,16291 ---- | FFESYMBOL_attrsTYPE))); ! error = TRUE; } else if (sa & FFESYMBOL_attrsSFARG) *************** ffeexpr_sym_lhs_call_ (ffesymbol s, ffel *** 16292,16296 **** | FFESYMBOL_attrsTYPE))); ! na = FFESYMBOL_attrsetNONE; } else if (sa & FFESYMBOL_attrsTYPE) --- 16294,16298 ---- | FFESYMBOL_attrsTYPE))); ! error = TRUE; } else if (sa & FFESYMBOL_attrsTYPE) *************** ffeexpr_sym_lhs_call_ (ffesymbol s, ffel *** 16307,16311 **** | FFESYMBOL_attrsTYPE))); ! na = FFESYMBOL_attrsetNONE; } else if (sa == FFESYMBOL_attrsetNONE) --- 16309,16313 ---- | FFESYMBOL_attrsTYPE))); ! error = TRUE; } else if (sa == FFESYMBOL_attrsetNONE) *************** ffeexpr_sym_lhs_call_ (ffesymbol s, ffel *** 16338,16345 **** kind = FFEINFO_kindSUBROUTINE; where = FFEINFO_whereGLOBAL; - na = FFESYMBOL_attrsACTUALARG; /* Just not NONE nor ANY. */ } else ! na = FFESYMBOL_attrsetNONE; /* Error. */ /* Now see what we've got for a new object: NONE means a new error cropped --- 16340,16346 ---- kind = FFEINFO_kindSUBROUTINE; where = FFEINFO_whereGLOBAL; } else ! error = TRUE; /* Now see what we've got for a new object: NONE means a new error cropped *************** ffeexpr_sym_lhs_call_ (ffesymbol s, ffel *** 16347,16351 **** update the object (symbol) and continue on. */ ! if (na == FFESYMBOL_attrsetNONE) ffesymbol_error (s, t); else if (!(na & FFESYMBOL_attrsANY)) --- 16348,16352 ---- update the object (symbol) and continue on. */ ! if (error) ffesymbol_error (s, t); else if (!(na & FFESYMBOL_attrsANY)) *************** ffeexpr_sym_lhs_data_ (ffesymbol s, ffel *** 16380,16383 **** --- 16381,16385 ---- ffeinfoKind kind; ffeinfoWhere where; + bool error = FALSE; assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE) *************** ffeexpr_sym_lhs_data_ (ffesymbol s, ffel *** 16407,16411 **** | FFESYMBOL_attrsTYPE))); ! na = FFESYMBOL_attrsetNONE; } else if (sa & FFESYMBOL_attrsDUMMY) --- 16409,16413 ---- | FFESYMBOL_attrsTYPE))); ! error = TRUE; } else if (sa & FFESYMBOL_attrsDUMMY) *************** ffeexpr_sym_lhs_data_ (ffesymbol s, ffel *** 16416,16420 **** | FFESYMBOL_attrsTYPE))); ! na = FFESYMBOL_attrsetNONE; } else if (sa & FFESYMBOL_attrsARRAY) --- 16418,16422 ---- | FFESYMBOL_attrsTYPE))); ! error = TRUE; } else if (sa & FFESYMBOL_attrsARRAY) *************** ffeexpr_sym_lhs_data_ (ffesymbol s, ffel *** 16446,16450 **** if (sa & FFESYMBOL_attrsANYLEN) ! na = FFESYMBOL_attrsetNONE; else { --- 16448,16452 ---- if (sa & FFESYMBOL_attrsANYLEN) ! error = TRUE; else { *************** ffeexpr_sym_lhs_data_ (ffesymbol s, ffel *** 16458,16465 **** kind = FFEINFO_kindENTITY; where = FFEINFO_whereLOCAL; - na = FFESYMBOL_attrsSAVE; /* Just not NONE nor ANY. */ } else ! na = FFESYMBOL_attrsetNONE; /* Error. */ /* Now see what we've got for a new object: NONE means a new error cropped --- 16460,16466 ---- kind = FFEINFO_kindENTITY; where = FFEINFO_whereLOCAL; } else ! error = TRUE; /* Now see what we've got for a new object: NONE means a new error cropped *************** ffeexpr_sym_lhs_data_ (ffesymbol s, ffel *** 16467,16471 **** update the object (symbol) and continue on. */ ! if (na == FFESYMBOL_attrsetNONE) ffesymbol_error (s, t); else if (!(na & FFESYMBOL_attrsANY)) --- 16468,16472 ---- update the object (symbol) and continue on. */ ! if (error) ffesymbol_error (s, t); else if (!(na & FFESYMBOL_attrsANY)) *************** ffeexpr_sym_lhs_extfunc_ (ffesymbol s, f *** 16579,16582 **** --- 16580,16584 ---- ffeinfoWhere where; bool needs_type = FALSE; + bool error = FALSE; assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE) *************** ffeexpr_sym_lhs_extfunc_ (ffesymbol s, f *** 16638,16642 **** | FFESYMBOL_attrsTYPE))); ! na = FFESYMBOL_attrsetNONE; } else if (sa & FFESYMBOL_attrsSFARG) --- 16640,16644 ---- | FFESYMBOL_attrsTYPE))); ! error = TRUE; } else if (sa & FFESYMBOL_attrsSFARG) *************** ffeexpr_sym_lhs_extfunc_ (ffesymbol s, f *** 16645,16649 **** | FFESYMBOL_attrsTYPE))); ! na = FFESYMBOL_attrsetNONE; } else if (sa & FFESYMBOL_attrsTYPE) --- 16647,16651 ---- | FFESYMBOL_attrsTYPE))); ! error = TRUE; } else if (sa & FFESYMBOL_attrsTYPE) *************** ffeexpr_sym_lhs_extfunc_ (ffesymbol s, f *** 16661,16665 **** if (sa & FFESYMBOL_attrsANYLEN) ! na = FFESYMBOL_attrsetNONE; else { --- 16663,16667 ---- if (sa & FFESYMBOL_attrsANYLEN) ! error = TRUE; else { *************** ffeexpr_sym_lhs_extfunc_ (ffesymbol s, f *** 16674,16681 **** where = FFEINFO_whereGLOBAL; needs_type = TRUE; - na = FFESYMBOL_attrsACTUALARG; /* Just not NONE nor ANY. */ } else ! na = FFESYMBOL_attrsetNONE; /* Error. */ /* Now see what we've got for a new object: NONE means a new error cropped --- 16676,16682 ---- where = FFEINFO_whereGLOBAL; needs_type = TRUE; } else ! error = TRUE; /* Now see what we've got for a new object: NONE means a new error cropped *************** ffeexpr_sym_lhs_extfunc_ (ffesymbol s, f *** 16683,16687 **** update the object (symbol) and continue on. */ ! if (na == FFESYMBOL_attrsetNONE) ffesymbol_error (s, t); else if (!(na & FFESYMBOL_attrsANY)) --- 16684,16688 ---- update the object (symbol) and continue on. */ ! if (error) ffesymbol_error (s, t); else if (!(na & FFESYMBOL_attrsANY)) *************** ffeexpr_sym_lhs_impdoctrl_ (ffesymbol s, *** 16761,16765 **** ffesymbol_error (s, t); /* For now, complain. */ #else /* Someday will detect all cases where initializer doesn't reference ! all applicable iterators, in which case reenable this code. */ ffesymbol_signal_change (s); ffesymbol_set_state (s, FFESYMBOL_stateUNCERTAIN); --- 16762,16766 ---- ffesymbol_error (s, t); /* For now, complain. */ #else /* Someday will detect all cases where initializer doesn't reference ! all applicable iterators, in which case reenable this code. */ ffesymbol_signal_change (s); ffesymbol_set_state (s, FFESYMBOL_stateUNCERTAIN); *************** ffeexpr_sym_rhs_actualarg_ (ffesymbol s, *** 16946,16950 **** if (sa & FFESYMBOL_attrsANYLEN) ! na = FFESYMBOL_attrsetNONE; else { --- 16947,16951 ---- if (sa & FFESYMBOL_attrsANYLEN) ! ns = FFESYMBOL_stateNONE; else { *************** ffeexpr_sym_rhs_actualarg_ (ffesymbol s, *** 16955,16966 **** else if (sa == FFESYMBOL_attrsetNONE) { assert (ffesymbol_state (s) == FFESYMBOL_stateNONE); kind = FFEINFO_kindENTITY; where = FFEINFO_whereLOCAL; - na = FFESYMBOL_attrsACTUALARG; /* Just not NONE nor ANY. */ needs_type = TRUE; } else ! na = FFESYMBOL_attrsetNONE; /* Error. */ /* Now see what we've got for a new object: NONE means a new error cropped --- 16956,16968 ---- else if (sa == FFESYMBOL_attrsetNONE) { + /* New state is left empty because there isn't any state flag to + set for this case, and it's UNDERSTOOD after all. */ assert (ffesymbol_state (s) == FFESYMBOL_stateNONE); kind = FFEINFO_kindENTITY; where = FFEINFO_whereLOCAL; needs_type = TRUE; } else ! ns = FFESYMBOL_stateNONE; /* Error. */ /* Now see what we've got for a new object: NONE means a new error cropped *************** ffeexpr_sym_rhs_actualarg_ (ffesymbol s, *** 16968,16972 **** update the object (symbol) and continue on. */ ! if (na == FFESYMBOL_attrsetNONE) ffesymbol_error (s, t); else if (!(na & FFESYMBOL_attrsANY)) --- 16970,16974 ---- update the object (symbol) and continue on. */ ! if (ns == FFESYMBOL_stateNONE) ffesymbol_error (s, t); else if (!(na & FFESYMBOL_attrsANY)) *************** ffeexpr_sym_rhs_let_ (ffesymbol s, ffele *** 17081,17084 **** --- 17083,17087 ---- ffeinfoKind kind; ffeinfoWhere where; + bool error = FALSE; assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE) *************** ffeexpr_sym_rhs_let_ (ffesymbol s, ffele *** 17108,17112 **** | FFESYMBOL_attrsTYPE))); ! na = FFESYMBOL_attrsetNONE; } else if (sa & FFESYMBOL_attrsDUMMY) --- 17111,17115 ---- | FFESYMBOL_attrsTYPE))); ! error = TRUE; } else if (sa & FFESYMBOL_attrsDUMMY) *************** ffeexpr_sym_rhs_let_ (ffesymbol s, ffele *** 17151,17155 **** if (sa & FFESYMBOL_attrsANYLEN) ! na = FFESYMBOL_attrsetNONE; else { --- 17154,17158 ---- if (sa & FFESYMBOL_attrsANYLEN) ! error = TRUE; else { *************** ffeexpr_sym_rhs_let_ (ffesymbol s, ffele *** 17163,17170 **** kind = FFEINFO_kindENTITY; where = FFEINFO_whereLOCAL; - na = FFESYMBOL_attrsTYPE; /* Just not NONE nor ANY. */ } else ! na = FFESYMBOL_attrsetNONE; /* Error. */ /* Now see what we've got for a new object: NONE means a new error cropped --- 17166,17172 ---- kind = FFEINFO_kindENTITY; where = FFEINFO_whereLOCAL; } else ! error = TRUE; /* Now see what we've got for a new object: NONE means a new error cropped *************** ffeexpr_sym_rhs_let_ (ffesymbol s, ffele *** 17172,17176 **** update the object (symbol) and continue on. */ ! if (na == FFESYMBOL_attrsetNONE) ffesymbol_error (s, t); else if (!(na & FFESYMBOL_attrsANY)) --- 17174,17178 ---- update the object (symbol) and continue on. */ ! if (error) ffesymbol_error (s, t); else if (!(na & FFESYMBOL_attrsANY)) *************** ffeexpr_paren_rhs_let_ (ffesymbol s, ffe *** 17757,17760 **** --- 17759,17763 ---- ffeintrinImp imp; bool maybe_ambig = FALSE; + bool error = FALSE; assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE) *************** ffeexpr_paren_rhs_let_ (ffesymbol s, ffe *** 17866,17874 **** } if (sa & FFESYMBOL_attrsANYLEN) ! na = FFESYMBOL_attrsetNONE; /* Error, since the only way we can, ! given CHARACTER*(*) FOO, accept ! FOO(...) is for FOO to be a dummy ! arg or constant, but it can't ! become either now. */ else { --- 17869,17877 ---- } if (sa & FFESYMBOL_attrsANYLEN) ! error = TRUE; /* Error, since the only way we can, ! given CHARACTER*(*) FOO, accept ! FOO(...) is for FOO to be a dummy ! arg or constant, but it can't ! become either now. */ else { *************** ffeexpr_paren_rhs_let_ (ffesymbol s, ffe *** 17912,17916 **** kind = FFEINFO_kindFUNCTION; where = FFEINFO_whereGLOBAL; - na = FFESYMBOL_attrsEXTERNAL; /* Just not NONE nor ANY. */ maybe_ambig = TRUE; /* If basictypeCHARACTER, can't be sure; could be ENTITY/LOCAL w/substring ref. */ --- 17915,17918 ---- *************** ffeexpr_paren_rhs_let_ (ffesymbol s, ffe *** 17917,17921 **** } else ! na = FFESYMBOL_attrsetNONE; /* Error. */ /* Now see what we've got for a new object: NONE means a new error cropped --- 17919,17923 ---- } else ! error = TRUE; /* Now see what we've got for a new object: NONE means a new error cropped *************** ffeexpr_paren_rhs_let_ (ffesymbol s, ffe *** 17923,17927 **** update the object (symbol) and continue on. */ ! if (na == FFESYMBOL_attrsetNONE) ffesymbol_error (s, t); else if (!(na & FFESYMBOL_attrsANY)) --- 17925,17929 ---- update the object (symbol) and continue on. */ ! if (error) ffesymbol_error (s, t); else if (!(na & FFESYMBOL_attrsANY)) *************** ffeexpr_token_elements_ (ffelexToken ft, *** 18212,18216 **** if ((expr == NULL) /* && ((ffeexpr_stack_->rank != 0) || (ffelex_token_type(t) == ! FFELEX_typeCOMMA)) */ ) { if (ffebad_start (FFEBAD_NULL_ELEMENT)) --- 18214,18218 ---- if ((expr == NULL) /* && ((ffeexpr_stack_->rank != 0) || (ffelex_token_type(t) == ! FFELEX_typeCOMMA)) */ ) { if (ffebad_start (FFEBAD_NULL_ELEMENT)) *************** ffeexpr_token_funsubstr_ (ffelexToken ft *** 18980,18984 **** static ffelexHandler ! ffeexpr_token_anything_ (ffelexToken ft, ffebld expr, ffelexToken t) { ffeexprExpr_ e = ffeexpr_stack_->exprstack; --- 18982,18987 ---- static ffelexHandler ! ffeexpr_token_anything_ (ffelexToken ft UNUSED, ffebld expr UNUSED, ! ffelexToken t) { ffeexprExpr_ e = ffeexpr_stack_->exprstack; diff -rcp2N g77-0.5.15/f/expr.h g77-0.5.16/f/expr.h *** g77-0.5.15/f/expr.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/expr.h Wed Aug 30 15:53:37 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/fini.c g77-0.5.16/f/fini.c *** g77-0.5.15/f/fini.c Tue Feb 21 13:38:22 1995 --- g77-0.5.16/f/fini.c Wed Aug 30 15:53:36 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "proj.h" --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "proj.h" *************** main (int argc, char **argv) *** 254,258 **** bool do_exit = FALSE; ! for (i = 0; i < ARRAY_SIZE (names); ++i) { /* Initialize length/name ordered list roots. */ names[i].first = (name) &names[i]; --- 255,259 ---- bool do_exit = FALSE; ! for (i = 0; ((size_t) i) < ARRAY_SIZE (names); ++i) { /* Initialize length/name ordered list roots. */ names[i].first = (name) &names[i]; *************** main (int argc, char **argv) *** 401,406 **** /* Append name to end of alpha-sorted list (assumes names entered in ! alpha order wrt name, not kwname, even though kwname is output from ! this list). */ n = names_alpha.last; --- 402,407 ---- /* Append name to end of alpha-sorted list (assumes names entered in ! alpha order wrt name, not kwname, even though kwname is output from ! this list). */ n = names_alpha.last; *************** typedef enum %s_ %s;\n\ *** 513,517 **** /* Now output the length as a case, followed by the binary search within that length. */ ! for (len = 0; len < ARRAY_SIZE (names); ++len) { if (names[len].first != (name) &names[len]) --- 514,518 ---- /* Now output the length as a case, followed by the binary search within that length. */ ! for (len = 0; ((size_t) len) < ARRAY_SIZE (names); ++len) { if (names[len].first != (name) &names[len]) *************** testname (bool nested, int indent, name *** 634,638 **** assert (!nested || indent >= 2); ! assert (indent + 4 < ARRAY_SIZE (spaces)); num = 0; --- 635,639 ---- assert (!nested || indent >= 2); ! assert (((size_t) indent) + 4 < ARRAY_SIZE (spaces)); num = 0; *************** testnames (bool nested, int indent, int *** 708,712 **** assert (!nested || indent >= 2); ! assert (indent + 4 < ARRAY_SIZE (spaces)); num = 0; --- 709,713 ---- assert (!nested || indent >= 2); ! assert (((size_t) indent) + 4 < ARRAY_SIZE (spaces)); num = 0; diff -rcp2N g77-0.5.15/f/flags.j g77-0.5.16/f/flags.j *** g77-0.5.15/f/flags.j Thu Feb 16 21:43:59 1995 --- g77-0.5.16/f/flags.j Wed Aug 30 15:53:36 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef MAKING_DEPENDENCIES --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #ifndef MAKING_DEPENDENCIES diff -rcp2N g77-0.5.15/f/g77.1 g77-0.5.16/f/g77.1 *** g77-0.5.15/f/g77.1 Wed Apr 12 10:03:14 1995 --- g77-0.5.16/f/g77.1 Mon Aug 28 09:41:30 1995 *************** The C and F77 compilers are integrated; *** 17,25 **** .B g77 is a program to call ! .B gcc with options to recognize F77. .B gcc processes input files through one or more of four stages: preprocessing, compilation, ! assembly, and linking. This man page contains full descriptions for .I only F77 specific aspects of the compiler, though it also contains --- 17,25 ---- .B g77 is a program to call ! .B gcc with options to recognize F77. .B gcc processes input files through one or more of four stages: preprocessing, compilation, ! assembly, and linking. This man page contains full descriptions for .I only F77 specific aspects of the compiler, though it also contains *************** use the suffix `\|\c *** 38,46 **** There are many command-line options, including options to control details of optimization, warnings, and code generation, which are ! common to both .B gcc and .B g77\c ! \&. For full information on all options, see .BR gcc ( 1 ). --- 38,46 ---- There are many command-line options, including options to control details of optimization, warnings, and code generation, which are ! common to both .B gcc and .B g77\c ! \&. For full information on all options, see .BR gcc ( 1 ). *************** Options must be separate: `\|\c *** 49,53 **** \&\|' is quite different from `\|\c .B \-d \-r ! \&\|'. Most `\|\c --- 49,53 ---- \&\|' is quite different from `\|\c .B \-d \-r ! \&\|'. Most `\|\c *************** Most `\|\c *** 55,63 **** \&\|' and `\|\c .B \-W\c ! \&\|' options have two contrary forms: .BI \-f name and .BI \-fno\- name\c ! \& (or .BI \-W name and --- 55,63 ---- \&\|' and `\|\c .B \-W\c ! \&\|' options have two contrary forms: .BI \-f name and .BI \-fno\- name\c ! \& (or .BI \-W name and *************** Undefine macro \c *** 162,166 **** Issue warnings for conditions which pertain to usage that we recommend avoiding and that we believe is easy to avoid, even in conjunction ! with macros. .PP --- 162,166 ---- Issue warnings for conditions which pertain to usage that we recommend avoiding and that we believe is easy to avoid, even in conjunction ! with macros. .PP *************** a.out link edited output *** 192,196 **** .IR intro (3) .br ! /usr/include standard directory for .B #include files --- 192,196 ---- .IR intro (3) .br ! /usr/include standard directory for .B #include files *************** is usually *** 209,213 **** .br .I TMPDIR ! comes from the environment variable .B TMPDIR (default --- 209,213 ---- .br .I TMPDIR ! comes from the environment variable .B TMPDIR (default *************** if available, else *** 219,225 **** gcc(1), cpp(1), as(1), ld(1), gdb(1), adb(1), dbx(1), sdb(1). .br ! .RB "`\|" gcc "\|', `\|" cpp \|', .RB `\| as \|', `\| ld \|', ! and .RB `\| gdb \|' entries in --- 219,225 ---- gcc(1), cpp(1), as(1), ld(1), gdb(1), adb(1), dbx(1), sdb(1). .br ! .RB "`\|" gcc "\|', `\|" cpp \|', .RB `\| as \|', `\| ld \|', ! and .RB `\| gdb \|' entries in *************** entries in *** 227,237 **** \&. .br ! .I Using and Porting GNU CC (for version 2.0)\c ! , Richard M. Stallman; .I The C Preprocessor\c , Richard M. Stallman; ! .I Debugging with GDB: the GNU Source-Level Debugger\c , Richard M. Stallman and Roland H. Pesch; --- 227,237 ---- \&. .br ! .I Using and Porting GNU CC (for version 2.0)\c ! , Richard M. Stallman; .I The C Preprocessor\c , Richard M. Stallman; ! .I Debugging with GDB: the GNU Source-Level Debugger\c , Richard M. Stallman and Roland H. Pesch; diff -rcp2N g77-0.5.15/f/g77.c g77-0.5.16/f/g77.c *** g77-0.5.15/f/g77.c Fri Apr 28 05:26:10 1995 --- g77-0.5.16/f/g77.c Wed Aug 30 15:53:36 1995 *************** GNU General Public License for more deta *** 18,22 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ /* This program is a wrapper to the main `gcc' driver. The generic --- 18,23 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* This program is a wrapper to the main `gcc' driver. The generic *************** the Free Software Foundation, 675 Mass A *** 59,63 **** --- 60,69 ---- #include #include + #ifndef _WIN32 #include /* May get R_OK, etc. on some systems. */ + #else + #include + #endif + #include /* Defined to the name of the compiler; if using a cross compiler, the *************** the Free Software Foundation, 675 Mass A *** 93,98 **** #endif ! extern int errno, sys_nerr; ! #if defined(bsd4_4) || defined(__NetBSD__) || defined(__FreeBSD__) extern const char *const sys_errlist[]; #else --- 99,109 ---- #endif ! #ifndef errno ! extern int errno; ! #endif ! ! extern int sys_nerr; ! #ifndef HAVE_STRERROR ! #if defined(bsd4_4) extern const char *const sys_errlist[]; #else *************** extern const char *const sys_errlist[]; *** 99,102 **** --- 110,116 ---- extern char *sys_errlist[]; #endif + #else + extern char *strerror(); + #endif /* Name with which this program was invoked. */ *************** static char **xargv; *** 111,114 **** --- 125,200 ---- static int newargc; static char **newargv; + + /* Options this driver needs to recognize, not just know how to + skip over. */ + typedef enum + { + OPTION_b, /* Aka --prefix. */ + OPTION_B, /* Aka --target. */ + OPTION_c, /* Aka --compile. */ + OPTION_driver, /* Wrapper-specific option. */ + OPTION_E, /* Aka --preprocess. */ + OPTION_i, /* -imacros, -include, -include-*. */ + OPTION_M, /* Aka --dependencies. */ + OPTION_MM, /* Aka --user-dependencies. */ + OPTION_nostdlib, /* Aka --no-standard-libraries, or + -nodefaultlibs. */ + OPTION_P, /* Aka --print-*-name. */ + OPTION_S, /* Aka --assemble. */ + OPTION_v, /* Aka --verbose. */ + OPTION_V, /* Aka --use-version. */ + OPTION_x, /* Aka --language. */ + OPTION_ /* Unrecognized or unimportant. */ + } Option; + + /* THE FOLLOWING COMES STRAIGHT FROM gcc-2.6.3/gcc.c: */ + + /* This defines which switch letters take arguments. */ + + #ifndef SWITCH_TAKES_ARG + #define SWITCH_TAKES_ARG(CHAR) \ + ((CHAR) == 'D' || (CHAR) == 'U' || (CHAR) == 'o' \ + || (CHAR) == 'e' || (CHAR) == 'T' || (CHAR) == 'u' \ + || (CHAR) == 'I' || (CHAR) == 'm' \ + || (CHAR) == 'L' || (CHAR) == 'A') + #endif + + /* This defines which multi-letter switches take arguments. */ + + #define DEFAULT_WORD_SWITCH_TAKES_ARG(STR) \ + (!strcmp (STR, "Tdata") || !strcmp (STR, "Ttext") \ + || !strcmp (STR, "Tbss") || !strcmp (STR, "include") \ + || !strcmp (STR, "imacros") || !strcmp (STR, "aux-info") \ + || !strcmp (STR, "idirafter") || !strcmp (STR, "iprefix") \ + || !strcmp (STR, "iwithprefix") || !strcmp (STR, "iwithprefixbefore") \ + || !strcmp (STR, "isystem")) + + #ifndef WORD_SWITCH_TAKES_ARG + #define WORD_SWITCH_TAKES_ARG(STR) DEFAULT_WORD_SWITCH_TAKES_ARG (STR) + #endif + + /* END OF STUFF FROM gcc-2.6.3/gcc.c. */ + + char * + my_strerror(e) + int e; + { + + #ifdef HAVE_STRERROR + return strerror(e); + + #else + + static char buffer[30]; + if (!e) + return ""; + + if (e > 0 && e < sys_nerr) + return sys_errlist[e]; + + sprintf (buffer, "Unknown error %d", e); + return buffer; + #endif + } #ifdef HAVE_VPRINTF *************** choose_temp_base () *** 277,281 **** base = choose_temp_base_try ("/tmp", base); ! /* If all else fails, use the current directory! */ if (base == (char *)0) base = "./"; --- 363,367 ---- base = choose_temp_base_try ("/tmp", base); ! /* If all else fails, use the current directory! */ if (base == (char *)0) base = "./"; *************** perror_exec (name) *** 302,306 **** if (errno < sys_nerr) s = concat ("installation problem, cannot exec %s: ", ! sys_errlist[errno], ""); else s = "installation problem, cannot exec %s"; --- 388,392 ---- if (errno < sys_nerr) s = concat ("installation problem, cannot exec %s: ", ! my_strerror( errno ), ""); else s = "installation problem, cannot exec %s"; *************** run_dos (program, argv) *** 344,348 **** remove (rf); ! if (i == -1) perror_exec (program); --- 430,434 ---- remove (rf); ! if (i == -1) perror_exec (program); *************** run_dos (program, argv) *** 350,353 **** --- 436,719 ---- #endif /* __MSDOS__ */ + /* This structure describes one mapping. */ + struct option_map + { + /* The long option's name. */ + char *name; + /* The equivalent short option. */ + char *equivalent; + /* Argument info. A string of flag chars; NULL equals no options. + a => argument required. + o => argument optional. + j => join argument to equivalent, making one word. + * => require other text after NAME as an argument. */ + char *arg_info; + }; + + /* This is the table of mappings. Mappings are tried sequentially + for each option encountered; the first one that matches, wins. */ + + struct option_map option_map[] = + { + {"--all-warnings", "-Wall", 0}, + {"--ansi", "-ansi", 0}, + {"--assemble", "-S", 0}, + {"--assert", "-A", "a"}, + {"--comments", "-C", 0}, + {"--compile", "-c", 0}, + {"--debug", "-g", "oj"}, + {"--define-macro", "-D", "a"}, + {"--dependencies", "-M", 0}, + {"--driver", "", 0}, /* Wrapper-specific. */ + {"--dump", "-d", "a"}, + {"--dumpbase", "-dumpbase", "a"}, + {"--entry", "-e", 0}, + {"--extra-warnings", "-W", 0}, + {"--for-assembler", "-Wa", "a"}, + {"--for-linker", "-Xlinker", "a"}, + {"--force-link", "-u", "a"}, + {"--imacros", "-imacros", "a"}, + {"--include", "-include", "a"}, + {"--include-barrier", "-I-", 0}, + {"--include-directory", "-I", "a"}, + {"--include-directory-after", "-idirafter", "a"}, + {"--include-prefix", "-iprefix", "a"}, + {"--include-with-prefix", "-iwithprefix", "a"}, + {"--include-with-prefix-before", "-iwithprefixbefore", "a"}, + {"--include-with-prefix-after", "-iwithprefix", "a"}, + {"--language", "-x", "a"}, + {"--library-directory", "-L", "a"}, + {"--machine", "-m", "aj"}, + {"--machine-", "-m", "*j"}, + {"--no-line-commands", "-P", 0}, + {"--no-precompiled-includes", "-noprecomp", 0}, + {"--no-standard-includes", "-nostdinc", 0}, + {"--no-standard-libraries", "-nostdlib", 0}, + {"--no-warnings", "-w", 0}, + {"--optimize", "-O", "oj"}, + {"--output", "-o", "a"}, + {"--pedantic", "-pedantic", 0}, + {"--pedantic-errors", "-pedantic-errors", 0}, + {"--pipe", "-pipe", 0}, + {"--prefix", "-B", "a"}, + {"--preprocess", "-E", 0}, + {"--print-file-name", "-print-file-name=", "aj"}, + {"--print-libgcc-file-name", "-print-libgcc-file-name", 0}, + {"--print-missing-file-dependencies", "-MG", 0}, + {"--print-multi-lib", "-print-multi-lib", 0}, + {"--print-multi-directory", "-print-multi-directory", 0}, + {"--print-prog-name", "-print-prog-name=", "aj"}, + {"--profile", "-p", 0}, + {"--profile-blocks", "-a", 0}, + {"--quiet", "-q", 0}, + {"--save-temps", "-save-temps", 0}, + {"--shared", "-shared", 0}, + {"--silent", "-q", 0}, + {"--static", "-static", 0}, + {"--symbolic", "-symbolic", 0}, + {"--target", "-b", "a"}, + {"--trace-includes", "-H", 0}, + {"--traditional", "-traditional", 0}, + {"--traditional-cpp", "-traditional-cpp", 0}, + {"--trigraphs", "-trigraphs", 0}, + {"--undefine-macro", "-U", "a"}, + {"--use-version", "-V", "a"}, + {"--user-dependencies", "-MM", 0}, + {"--verbose", "-v", 0}, + {"--version", "-dumpversion", 0}, + {"--warn-", "-W", "*j"}, + {"--write-dependencies", "-MD", 0}, + {"--write-user-dependencies", "-MMD", 0}, + {"--", "-f", "*j"} + }; + + /* Compares --options that take one arg. */ + + static int + opteq (xskip, xarg, opt, name) + int *xskip; + char **xarg; + char *opt; + char *name; + { + int optlen; + int namelen; + int complen; + int i; + int cmp = strcmp (opt, name); + int skip = 1; + char *arg = NULL; + + if (cmp == 0) + { + /* Easy, a straight match. */ + *xskip = skip; + *xarg = arg; + return cmp; + } + + optlen = strlen (opt); + + for (i = 0; i < sizeof (option_map) / sizeof (option_map[0]); ++i) + { + char *arginfo; + int j; + + arginfo = option_map[i].arg_info; + if (arginfo == NULL) + arginfo = ""; + + namelen = strlen (option_map[i].name); + complen = optlen > namelen ? namelen : optlen; + + if (strncmp (opt, option_map[i].name, complen) == 0) + { + if (optlen < namelen) + { + for (j = i + 1; + j < sizeof (option_map) / sizeof (option_map[0]); + ++j) + if ((strlen (option_map[j].name) >= optlen) + && (strncmp (opt, option_map[j].name, optlen) == 0)) + fatal ("Ambiguous abbreviation `%s'", opt); + } + + if (optlen > namelen) + { + if (opt[namelen] == '=') + { + skip = 0; + arg = opt + namelen + 1; + } + else if (index (arginfo, '*') != 0) + ; + else + continue; + } + else if (index (arginfo, '*') != 0) + fatal ("Incomplete `%s' option", option_map[i].name); + + if (strcmp (name, option_map[i].name) != 0) + return 1; /* Not what is being looked for. */ + + *xskip = skip; + *xarg = arg; + return 0; + } + } + + return 1; + } + + /* Assumes text[0] == '-'. Returns number of argv items that belong to + (and follow) this one, an option id for options important to the + caller, and a pointer to the first char of the arg, if embedded (else + returns NULL, meaning no arg or it's the next argv). */ + + static void + lookup_option (xopt, xskip, xarg, text) + Option *xopt; + int *xskip; + char **xarg; + char *text; + { + Option opt = OPTION_; + int skip = -1; + char *arg = NULL; + + if ((skip = SWITCH_TAKES_ARG (text[1])) > (text[2] != '\0')) + skip -= (text[2] != '\0'); /* Usually one of "DUoeTuImLA". */ + else if (text[1] == 'B') + opt = OPTION_B, skip = (text[2] == '\0'), arg = text + 2; + else if (text[1] == 'b') + opt = OPTION_b, skip = (text[2] == '\0'), arg = text + 2; + else if ((text[1] == 'c') && (text[2] == '\0')) + opt = OPTION_c, skip = 0; + else if ((text[1] == 'E') && (text[2] == '\0')) + opt = OPTION_E, skip = 0; + else if (text[1] == 'i') + opt = OPTION_i, skip = 0; + else if ((text[1] == 'S') && (text[2] == '\0')) + opt = OPTION_S, skip = 0; + else if (text[1] == 'V') + opt = OPTION_V, skip = (text[2] == '\0'); + else if ((text[1] == 'v') && (text[2] == '\0')) + opt = OPTION_v, skip = 0; + else if (text[1] == 'x') + opt = OPTION_x, skip = (text[2] == '\0'), arg = text + 2; + else + { + if ((skip = WORD_SWITCH_TAKES_ARG (text + 1)) != 0) + /* Usually one of "Tdata", "Ttext", "Tbss", "include", + "imacros", "aux-info", "idirafter", "iprefix", + "iwithprefix", "iwithprefixbefore", "isystem". */ + ; + else if (strcmp (text, "--assemble") == 0) + opt = OPTION_S; + else if (strcmp (text, "--compile") == 0) + opt = OPTION_c; + else if (opteq (&skip, &arg, text, "--driver") == 0) + opt = OPTION_driver; + else if ((opteq (&skip, &arg, text, "--imacros") == 0) + || (opteq (&skip, &arg, text, "--include") == 0) + || (opteq (&skip, &arg, text, "--include-directory-after") == 0) + || (opteq (&skip, &arg, text, "--include-prefix") == 0) + || (opteq (&skip, &arg, text, "--include-with-prefix") == 0) + || (opteq (&skip, &arg, text, "--include-with-prefix-before") == 0) + || (opteq (&skip, &arg, text, "--include-with-prefix-after") == 0)) + opt = OPTION_i; + else if (opteq (&skip, &arg, text, "--language") == 0) + opt = OPTION_x; + else if ((strcmp (text, "-M") == 0) + || (strcmp (text, "--dependencies") == 0)) + opt = OPTION_M; + else if ((strcmp (text, "-MM") == 0) + || (strcmp (text, "--user-dependencies") == 0)) + opt = OPTION_MM; + else if (opteq (&skip, &arg, text, "--prefix") == 0) + opt = OPTION_B; + else if (strcmp (text, "--preprocess") == 0) + opt = OPTION_E; + else if ((opteq (&skip, &arg, text, "--print-file-name") == 0) + || (strcmp (text, "--print-libgcc-file-name") == 0) + || (strcmp (text, "--print-multi-lib") == 0) + || (strcmp (text, "--print-multi-directory") == 0) + || (opteq (&skip, &arg, text, "--print-prog-name") == 0)) + opt = OPTION_P; + else if ((strcmp (text, "-nostdlib") == 0) + || (strcmp (text, "--no-standard-libraries") == 0) + || (strcmp (text, "-nodefaultlibs") == 0)) + opt = OPTION_nostdlib; + else if (opteq (&skip, &arg, text, "--use-version") == 0) + opt = OPTION_V; + else if (strcmp (text, "--verbose") == 0) + opt = OPTION_v; + else if (strcmp (text, "-Xlinker") == 0) + skip = 1; + else if ((opteq (&skip, &arg, text, "--assert") == 0) + || (opteq (&skip, &arg, text, "--define-macro") == 0) + || (opteq (&skip, &arg, text, "--dump") == 0) + || (opteq (&skip, &arg, text, "--dumpbase") == 0) + || (opteq (&skip, &arg, text, "--for-assembler") == 0) + || (opteq (&skip, &arg, text, "--for-linker") == 0) + || (opteq (&skip, &arg, text, "--force-link") == 0) + || (opteq (&skip, &arg, text, "--library-directory") == 0) + || (opteq (&skip, &arg, text, "--machine") == 0) + || (opteq (&skip, &arg, text, "--output") == 0) + || (opteq (&skip, &arg, text, "--target") == 0) + || (opteq (&skip, &arg, text, "--undefine-macro") == 0)) + ; + else + skip = 0; + } + + if (xopt != NULL) + *xopt = opt; + if (xskip != NULL) + *xskip = skip; + if (xarg != NULL) + *xarg = arg; + } + static void append_arg (arg) *************** append_arg (arg) *** 371,375 **** int i; ! newargsize = xargc << 2; /* Allow 4 output args for each 1 input. */ newargv = (char **) malloc (newargsize * sizeof (char *)); --- 737,741 ---- int i; ! newargsize = (xargc << 2) + 20; newargv = (char **) malloc (newargsize * sizeof (char *)); *************** main (argc, argv) *** 392,395 **** --- 758,764 ---- register char *p; int verbose = 0; + Option opt; + int skip; + char *arg; /* This will be NULL if we encounter a situation where we should not *************** main (argc, argv) *** 397,400 **** --- 766,776 ---- char *library = "-lf2c"; + /* This will become 0 if anything other than -v and kin (like -V) + is seen, meaning the user is trying to accomplish something. + If it remains nonzero, the user wants version info, so add stuff to + the command line to make gcc invoke all the appropriate phases + to get all the version info. */ + int add_version_magic = 1; + /* The name of the compiler we will want to run---by default, it will be the definition of `GCC_NAME', e.g., `gcc'. */ *************** main (argc, argv) *** 441,504 **** #endif ! /* If -nostdlib or a "turn-off-linking" option is anywhere in the command line, don't do any library-option processing (except ! relating to -x). */ ! for (i = 1; i < argc; i++) { ! if ((strcmp (argv[i], "-nostdlib") == 0) ! || ((argv[i][2] == '\0' ! && (char *) strchr ("cSEM", argv[i][1]) != NULL) ! || strcmp (argv[i], "-MM") == 0)) ! /* Don't specify libraries after -nostdlib; or if we won't link, ! since that would cause a warning. */ ! library = NULL; ! else if (strcmp (argv[i], "-v") == 0) { verbose = 1; ! if (argc == 2) ! /* If they only gave us `-v', don't try to link ! in libf2c. */ ! library = NULL; } } ! for (i = 1; i < argc; i++) { if (argv[i][0] == '\0') append_arg (argv[i]); /* Interesting. Just append as is. */ else if ((argv[i][0] == '-') && (argv[i][1] != 'l')) ! { /* Not a filename or library. */ if (saw_library == 1) /* -l. */ append_arg ("-lm"); saw_library = 0; ! append_arg (argv[i]); /* Always append this arg first as is. */ if (argv[i][1] == '\0') ! ; /* "-" == Standard input. */ ! else if (strncmp (argv[i], "-x", 2) == 0) ! { /* Track input language. */ char *lang; ! if ((argv[i][2] == '\0') && (argc == i + 1)) ! fatal ("argument to `-x' is missing"); ! if (argv[i][2] == '\0') ! { ! lang = argv[++i]; ! append_arg (lang); ! } else ! lang = argv[i] + 2; saw_speclang = (strcmp (lang, "none") != 0); } ! else if (((argv[i][2] == '\0' ! && (char *)strchr ("bBVDUoeTuIYmLiA", argv[i][1]) != NULL) ! || strcmp (argv[i], "-Tdata") == 0)) ! { /* Skip over any args with arguments. */ ! if (argc == i + 1) ! fatal ("argument to `%s' missing\n", argv[i]); ! ++i; ! append_arg (argv[i]); } } else --- 817,938 ---- #endif ! /* First pass through arglist. ! ! If -nostdlib or a "turn-off-linking" option is anywhere in the command line, don't do any library-option processing (except ! relating to -x). Also, if -v is specified, but no other options ! that do anything special (allowing -V version, etc.), remember ! to add special stuff to make gcc command actually invoke all ! the different phases of the compilation process so all the version ! numbers can be seen. ! ! Also, here is where all problems with missing arguments to options ! are caught. If this loop is exited normally, it means all options ! have the appropriate number of arguments as far as the rest of this ! program is concerned. */ ! for (i = 1; i < argc; ++i) { ! if (argv[i][0] != '-') ! { ! add_version_magic = 0; ! continue; ! } ! ! lookup_option (&opt, &skip, NULL, argv[i]); ! ! switch (opt) { + case OPTION_nostdlib: + case OPTION_c: + case OPTION_S: + case OPTION_E: + case OPTION_M: + case OPTION_MM: + /* These options disable linking entirely or linking of the + standard libraries. */ + library = NULL; + add_version_magic = 0; + break; + + case OPTION_v: verbose = 1; ! break; ! ! case OPTION_b: ! case OPTION_B: ! case OPTION_driver: ! case OPTION_i: ! case OPTION_V: ! /* These options are useful in conjunction with -v to get ! appropriate version info. */ ! break; ! ! default: ! add_version_magic = 0; ! break; } + + /* This is the one place we check for missing arguments in the + program. */ + + if (i + skip < argc) + i += skip; + else + fatal ("argument to `%s' missing\n", argv[i]); } ! /* If only -v and related options (like -V), don't link the standard ! libraries. */ ! ! if (add_version_magic) ! library = NULL; ! ! /* Second pass through arglist, transforming arguments as appropriate. */ ! ! for (i = 1; i < argc; ++i) { if (argv[i][0] == '\0') append_arg (argv[i]); /* Interesting. Just append as is. */ + else if ((argv[i][0] == '-') && (argv[i][1] != 'l')) ! { ! /* Not a filename or library. */ ! if (saw_library == 1) /* -l. */ append_arg ("-lm"); saw_library = 0; ! ! lookup_option (&opt, &skip, &arg, argv[i]); if (argv[i][1] == '\0') ! append_arg (argv[i]); /* "-" == Standard input. */ ! ! else if (opt == OPTION_x) ! { ! /* Track input language. */ char *lang; ! append_arg (argv[i]); ! ! if (arg == NULL) ! lang = argv[i+1]; else ! lang = arg; ! saw_speclang = (strcmp (lang, "none") != 0); } ! else if (opt == OPTION_driver) ! { ! if (arg == NULL) ! gcc = argv[i+1]; ! else ! gcc = arg; ! i += skip; ! continue; /* Don't append args to new list. */ } + append_arg (argv[i]); + for (; skip != 0; --skip) + append_arg (argv[++i]); } else *************** main (argc, argv) *** 581,584 **** --- 1015,1032 ---- } } + else if (verbose && add_version_magic) + { + append_arg ("-fnull-version"); + append_arg ("-o"); + append_arg ("/dev/null"); + append_arg ("-xf77-cpp-input"); + append_arg ("/dev/null"); + append_arg ("-xnone"); + if (library) + { + append_arg (library); + append_arg ("-lm"); + } + } append_arg (NULL); *************** main (argc, argv) *** 598,602 **** fprintf (stderr, "\n"); } ! #ifndef OS2 #ifdef __MSDOS__ run_dos (gcc, newargv); --- 1046,1050 ---- fprintf (stderr, "\n"); } ! #if !defined(OS2) && !defined (_WIN32) #ifdef __MSDOS__ run_dos (gcc, newargv); *************** main (argc, argv) *** 605,610 **** pfatal_with_name (gcc); #endif /* __MSDOS__ */ ! #else /* OS2 */ ! if (spawnvp (gcc, newargv) < 0) pfatal_with_name (gcc); #endif --- 1053,1058 ---- pfatal_with_name (gcc); #endif /* __MSDOS__ */ ! #else /* OS2 or _WIN32 */ ! if (spawnvp (1, gcc, newargv) < 0) pfatal_with_name (gcc); #endif diff -rcp2N g77-0.5.15/f/gbe/2.6.3.diff g77-0.5.16/f/gbe/2.6.3.diff *** g77-0.5.15/f/gbe/2.6.3.diff Wed Apr 12 10:20:15 1995 --- g77-0.5.16/f/gbe/2.6.3.diff Thu Aug 10 04:05:00 1995 *************** *** 1,4 **** *** gcc-2.6.3/Makefile.in Fri Dec 2 16:03:09 1994 ! --- g77-2.6.3-0.5.14/Makefile.in Wed Apr 12 10:17:28 1995 *************** c-common.o : c-common.c $(CONFIG_H) $(TR *** 1010,1014 **** --- 1,27 ---- *** gcc-2.6.3/Makefile.in Fri Dec 2 16:03:09 1994 ! --- g77-2.6.3-0.5.16/Makefile.in Thu Aug 10 04:01:02 1995 ! *************** ENQUIRE_CFLAGS = -DNO_MEM -DNO_LONG_DOUB ! *** 118,121 **** ! --- 118,126 ---- ! ENQUIRE_LDFLAGS = $(LDFLAGS) ! ! + # NEXT FOUR LINES ADDED BY g77 PATCH ONLY TO ENABLE COMPATIBILITY WITH 2.7.x. ! + # Sed command to transform gcc to installed name. Overwritten by configure. ! + program_transform_name = -e s,x,x, ! + program_transform_cross_name = -e s,^,$(target)-, ! + ! # Tools to use when building a cross-compiler. ! # These are used because `configure' appends `cross-make' ! *************** infodir = $(prefix)/info ! *** 176,179 **** ! --- 181,188 ---- ! # Extension (if any) to put in installed man-page filename. ! manext = .1 ! + # NEXT THREE LINES ADDED BY g77 PATCH ONLY TO ENABLE COMPATIBILITY WITH 2.7.x. ! + objext = .o ! + exeext = ! + ! # Directory in which to put man pages. ! mandir = $(prefix)/man/man1 *************** c-common.o : c-common.c $(CONFIG_H) $(TR *** 1010,1014 **** *************** *** 8,15 **** $(CC) $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ -DSTANDARD_STARTFILE_PREFIX=\"$(libdir)/\" \ ! --- 1010,1014 ---- # Language-independent files. ! ! gcc.o: gcc.c $(CONFIG_H) multilib.h config.status f/compilers.h $(CC) $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ -DSTANDARD_STARTFILE_PREFIX=\"$(libdir)/\" \ --- 31,38 ---- $(CC) $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ -DSTANDARD_STARTFILE_PREFIX=\"$(libdir)/\" \ ! --- 1019,1023 ---- # Language-independent files. ! ! gcc.o: gcc.c $(CONFIG_H) multilib.h config.status f/lang-specs.h $(CC) $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ -DSTANDARD_STARTFILE_PREFIX=\"$(libdir)/\" \ *************** *** 21,32 **** $(CC) $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ $(MAYBE_TARGET_DEFAULT) $(MAYBE_USE_COLLECT2) \ ! --- 1032,1036 ---- fold-const.o : fold-const.c $(CONFIG_H) $(TREE_H) flags.h toplev.o : toplev.c $(CONFIG_H) $(TREE_H) $(RTL_H) flags.h input.h \ ! ! insn-attr.h xcoffout.h defaults.h f/options-lang.h $(CC) $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ $(MAYBE_TARGET_DEFAULT) $(MAYBE_USE_COLLECT2) \ *** gcc-2.6.3/fold-const.c Fri Dec 2 16:03:43 1994 ! --- g77-2.6.3-0.5.14/fold-const.c Tue Feb 21 14:18:46 1995 *************** eval_subst (arg, old0, new0, old1, new1) *** 1938,1943 **** --- 44,55 ---- $(CC) $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ $(MAYBE_TARGET_DEFAULT) $(MAYBE_USE_COLLECT2) \ ! --- 1041,1045 ---- fold-const.o : fold-const.c $(CONFIG_H) $(TREE_H) flags.h toplev.o : toplev.c $(CONFIG_H) $(TREE_H) $(RTL_H) flags.h input.h \ ! ! insn-attr.h xcoffout.h defaults.h f/lang-options.h $(CC) $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ $(MAYBE_TARGET_DEFAULT) $(MAYBE_USE_COLLECT2) \ *** gcc-2.6.3/fold-const.c Fri Dec 2 16:03:43 1994 ! --- g77-2.6.3-0.5.16/fold-const.c Thu Aug 10 04:01:03 1995 *************** eval_subst (arg, old0, new0, old1, new1) *** 1938,1943 **** *************** *** 72,86 **** STRIP_NOPS (xarg0); *** gcc-2.6.3/gcc.c Mon Nov 7 11:01:43 1994 ! --- g77-2.6.3-0.5.14/gcc.c Wed Apr 12 10:12:31 1995 ! *************** static int n_compilers; ! *** 565,568 **** ! --- 565,569 ---- ! static struct compiler default_compilers[] = ! { ! + #include "f/compilers.h" ! {".c", "@c"}, ! {"@c", *** gcc-2.6.3/stor-layout.c Thu Oct 20 09:41:02 1994 ! --- g77-2.6.3-0.5.14/stor-layout.c Tue Feb 21 14:18:46 1995 *************** get_pending_sizes () *** 80,83 **** --- 95,135 ---- STRIP_NOPS (xarg0); *** gcc-2.6.3/gcc.c Mon Nov 7 11:01:43 1994 ! --- g77-2.6.3-0.5.16/gcc.c Thu Aug 10 04:01:03 1995 ! *************** static struct compiler default_compilers ! *** 712,715 **** ! --- 712,716 ---- ! %{c:%W{o*}%{!o*:-o %w%b.o}}\ ! %{!c:-o %d%w%u.o} %{!pipe:%g.s} %A\n}}}}}} "}, ! + #include "f/lang-specs.h" ! /* Mark end of table */ ! {0, 0} ! *** gcc-2.6.3/obstack.c Sat Nov 12 06:40:02 1994 ! --- g77-2.6.3-0.5.16/obstack.c Thu Aug 10 04:01:04 1995 ! *************** Foundation, 675 Mass Ave, Cambridge, MA ! *** 27,33 **** ! (especially if it is a shared library). Rather than having every GNU ! program understand `configure --with-gnu-libc' and omit the object files, ! ! it is simpler to just do this in the source for each such file. */ ! ! ! #if defined (_LIBC) || !defined (__GNU_LIBRARY__) ! ! ! --- 27,40 ---- ! (especially if it is a shared library). Rather than having every GNU ! program understand `configure --with-gnu-libc' and omit the object files, ! ! it is simpler to just do this in the source for each such file. ! ! ! Actually, don't comment this code out after all. Else, unless the ! ! inlining set up by obstack.h also is commented out (and replaced by ! ! including the system's ), bugs will result on a system ! ! with an older obstack (with older and different inlining) installed. ! ! And for now it doesn't seem worth having obstack.h #include , ! ! as above, just to get __GNU_LIBRARY__ defined, for example. */ ! ! ! ! #if defined (_LIBC) || !defined (__GNU_LIBRARY__) || 1 ! ! *** gcc-2.6.3/stor-layout.c Thu Oct 20 09:41:02 1994 ! --- g77-2.6.3-0.5.16/stor-layout.c Thu Aug 10 04:01:04 1995 *************** get_pending_sizes () *** 80,83 **** *************** *** 101,112 **** to serve as the actual size-expression for a type or decl. */ *** gcc-2.6.3/toplev.c Tue Oct 25 16:09:12 1994 ! --- g77-2.6.3-0.5.14/toplev.c Fri Mar 24 20:50:26 1995 *************** char *lang_options[] = *** 725,728 **** ! --- 725,731 ---- "-Wno-protocol", ! + /* THESE ARE FOR FORTRAN. */ ! + #include "f/options-lang.h" + /* This is for GNAT and is temporary. */ --- 150,160 ---- to serve as the actual size-expression for a type or decl. */ *** gcc-2.6.3/toplev.c Tue Oct 25 16:09:12 1994 ! --- g77-2.6.3-0.5.16/toplev.c Thu Aug 10 04:01:05 1995 *************** char *lang_options[] = *** 725,728 **** ! --- 725,730 ---- "-Wno-protocol", ! + #include "f/lang-options.h" + /* This is for GNAT and is temporary. */ *************** *** 113,117 **** "-gnat", *** gcc-2.6.3/tree.c Fri Dec 2 16:03:49 1994 ! --- g77-2.6.3-0.5.14/tree.c Tue Feb 21 14:18:47 1995 *************** save_expr (expr) *** 1984,1988 **** --- 161,165 ---- "-gnat", *** gcc-2.6.3/tree.c Fri Dec 2 16:03:49 1994 ! --- g77-2.6.3-0.5.16/tree.c Thu Aug 10 04:01:05 1995 *************** save_expr (expr) *** 1984,1988 **** *************** *** 128,132 **** *** gcc-2.6.3/tree.h Thu Sep 8 14:25:41 1994 ! --- g77-2.6.3-0.5.14/tree.h Tue Feb 21 14:18:48 1995 *************** extern tree size_int PROTO((unsigned)) *** 1245,1248 **** --- 176,180 ---- *** gcc-2.6.3/tree.h Thu Sep 8 14:25:41 1994 ! --- g77-2.6.3-0.5.16/tree.h Thu Aug 10 04:01:06 1995 *************** extern tree size_int PROTO((unsigned)) *** 1245,1248 **** diff -rcp2N g77-0.5.15/f/gbe/2.7.0.diff g77-0.5.16/f/gbe/2.7.0.diff *** g77-0.5.15/f/gbe/2.7.0.diff --- g77-0.5.16/f/gbe/2.7.0.diff Mon Aug 28 13:19:15 1995 *************** *** 0 **** --- 1,70 ---- + *** gcc-2.7.0/obstack.c Thu Jun 15 18:12:08 1995 + --- g77-2.7.0-0.5.16/obstack.c Thu Aug 10 04:06:51 1995 + *************** Foundation, 675 Mass Ave, Cambridge, MA + *** 27,33 **** + (especially if it is a shared library). Rather than having every GNU + program understand `configure --with-gnu-libc' and omit the object files, + ! it is simpler to just do this in the source for each such file. */ + + ! #if defined (_LIBC) || !defined (__GNU_LIBRARY__) + + + --- 27,40 ---- + (especially if it is a shared library). Rather than having every GNU + program understand `configure --with-gnu-libc' and omit the object files, + ! it is simpler to just do this in the source for each such file. + + ! Actually, don't comment this code out after all. Else, unless the + ! inlining set up by obstack.h also is commented out (and replaced by + ! including the system's ), bugs will result on a system + ! with an older obstack (with older and different inlining) installed. + ! And for now it doesn't seem worth having obstack.h #include , + ! as above, just to get __GNU_LIBRARY__ defined, for example. */ + ! + ! #if defined (_LIBC) || !defined (__GNU_LIBRARY__) || 1 + + + *** gcc-2.7.0/stor-layout.c Thu Jun 15 08:08:47 1995 + --- g77-2.7.0-0.5.16/stor-layout.c Thu Aug 10 14:00:15 1995 + *************** get_pending_sizes () + *** 82,85 **** + --- 82,95 ---- + } + + + void + + put_pending_sizes (chain) + + tree chain; + + { + + if (pending_sizes) + + abort (); + + + + pending_sizes = chain; + + } + + + /* Given a size SIZE that may not be a constant, return a SAVE_EXPR + to serve as the actual size-expression for a type or decl. */ + *** gcc-2.7.0/tree.c Thu Jun 15 08:10:23 1995 + --- g77-2.7.0-0.5.16/tree.c Mon Aug 28 12:21:15 1995 + *************** save_expr (expr) + *** 2111,2115 **** + + if (TREE_CONSTANT (t) || (TREE_READONLY (t) && ! TREE_SIDE_EFFECTS (t)) + ! || TREE_CODE (t) == SAVE_EXPR) + return t; + + --- 2111,2115 ---- + + if (TREE_CONSTANT (t) || (TREE_READONLY (t) && ! TREE_SIDE_EFFECTS (t)) + ! || TREE_CODE (t) == SAVE_EXPR || TREE_CODE (t) == ERROR_MARK) + return t; + + *** gcc-2.7.0/tree.h Thu Jun 15 08:10:49 1995 + --- g77-2.7.0-0.5.16/tree.h Thu Aug 10 04:06:52 1995 + *************** extern tree size_int PROTO((unsigned H + *** 1290,1293 **** + --- 1290,1294 ---- + extern tree round_up PROTO((tree, int)); + extern tree get_pending_sizes PROTO((void)); + + extern void put_pending_sizes PROTO((tree)); + + /* Type for sizes of data-type. */ diff -rcp2N g77-0.5.15/f/gbe/README g77-0.5.16/f/gbe/README *** g77-0.5.15/f/gbe/README Wed Feb 15 19:24:07 1995 --- g77-0.5.16/f/gbe/README Thu Aug 17 06:19:05 1995 *************** *** 1,3 **** ! 950215 This directory contains .diff files for various GNU CC distributions. --- 1,3 ---- ! 950815 This directory contains .diff files for various GNU CC distributions. *************** it shares with not only the C front end, *** 9,12 **** --- 9,16 ---- ends (C++, Objective-C, Pascal, ADA, Chill, ...) as well. + This distribution of g77 is not supported for versions of gcc prior + to 2.6.2. The 2.6.3 patch file should work for version 2.6.2, but + you should probably use gcc-2.6.3 in any case if that is possible. + To apply a .diff file to, say, gcc 2.6.3, one might use the following command: *************** command: *** 13,16 **** --- 17,32 ---- patch -p1 -d gcc-2.6.3 < gcc-2.6.3/f/gbe/2.6.3.diff + + If you are using a version of gcc more recent than the most + recent .diff file's version, try the most recent .diff ONLY + if the difference is in the third field. E.g. the above + patch might work on gcc-2.6.4 or gcc-2.6.5 if these were + released. On the other hand, it probably wouldn't work for + a more major release like gcc-2.7.0 or gcc-3.0.0, and you + shouldn't try it. If the .diff file is missing, don't bother + asking `fortran@gnu.ai.mit.edu' for it -- it is certainly + being worked on. In the meantime, watch the usual channels + (see gcc/f/DOC *TROUBLE (BUGS, ETC.)*) for information on + support for the new version of gcc. We hope that changes to the back end required by g77 will soon diff -rcp2N g77-0.5.15/f/glimits.j g77-0.5.16/f/glimits.j *** g77-0.5.15/f/glimits.j Wed Feb 15 16:58:40 1995 --- g77-0.5.16/f/glimits.j Wed Aug 30 15:53:36 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef MAKING_DEPENDENCIES --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #ifndef MAKING_DEPENDENCIES diff -rcp2N g77-0.5.15/f/global.c g77-0.5.16/f/global.c *** g77-0.5.15/f/global.c Wed Apr 12 10:03:14 1995 --- g77-0.5.16/f/global.c Wed Aug 30 15:53:36 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** ffeglobal_init_common (ffesymbol s, ffel *** 159,163 **** /* Complain about just one attempt to reinit per program unit, but ! continue referring back to the first such successful attempt. */ } else --- 160,164 ---- /* Complain about just one attempt to reinit per program unit, but ! continue referring back to the first such successful attempt. */ } else diff -rcp2N g77-0.5.15/f/global.h g77-0.5.16/f/global.h *** g77-0.5.15/f/global.h Wed Apr 12 10:03:14 1995 --- g77-0.5.16/f/global.h Wed Aug 30 15:53:36 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: *************** void ffeglobal_terminate_1 (void); *** 102,109 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE #define FFEGLOBAL_ENABLED 0 ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #define FFEGLOBAL_ENABLED 1 ! #endif #endif --- 103,110 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE #define FFEGLOBAL_ENABLED 0 ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC #define FFEGLOBAL_ENABLED 1 ! #else ! #error #endif diff -rcp2N g77-0.5.15/f/hconfig.j g77-0.5.16/f/hconfig.j *** g77-0.5.15/f/hconfig.j Thu Feb 16 21:43:59 1995 --- g77-0.5.16/f/hconfig.j Wed Aug 30 15:53:36 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef MAKING_DEPENDENCIES --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #ifndef MAKING_DEPENDENCIES diff -rcp2N g77-0.5.15/f/implic.c g77-0.5.16/f/implic.c *** g77-0.5.15/f/implic.c Fri Apr 28 05:26:10 1995 --- g77-0.5.16/f/implic.c Wed Aug 30 15:53:36 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: diff -rcp2N g77-0.5.15/f/implic.h g77-0.5.16/f/implic.h *** g77-0.5.15/f/implic.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/implic.h Wed Aug 30 15:53:36 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/info-b.def g77-0.5.16/f/info-b.def *** g77-0.5.15/f/info-b.def Wed Feb 15 16:58:40 1995 --- g77-0.5.16/f/info-b.def Wed Aug 30 15:53:36 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/info-k.def g77-0.5.16/f/info-k.def *** g77-0.5.15/f/info-k.def Wed Feb 15 16:58:40 1995 --- g77-0.5.16/f/info-k.def Wed Aug 30 15:53:36 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/info-w.def g77-0.5.16/f/info-w.def *** g77-0.5.15/f/info-w.def Wed Feb 15 16:58:40 1995 --- g77-0.5.16/f/info-w.def Wed Aug 30 15:53:36 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/info.c g77-0.5.16/f/info.c *** g77-0.5.15/f/info.c Wed Feb 15 16:58:40 1995 --- g77-0.5.16/f/info.c Wed Aug 30 15:53:36 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** ffeinfo_where_string (ffeinfoWhere where *** 268,272 **** Returns the string based on the data type. */ ! #if 0 ffeinfo ffeinfo_new (ffeinfoBasictype basictype, ffeinfoKindtype kindtype, --- 269,273 ---- Returns the string based on the data type. */ ! #ifndef __GNUC__ ffeinfo ffeinfo_new (ffeinfoBasictype basictype, ffeinfoKindtype kindtype, diff -rcp2N g77-0.5.15/f/info.h g77-0.5.16/f/info.h *** g77-0.5.15/f/info.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/info.h Wed Aug 30 15:53:36 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: *************** ffetype ffeinfo_type (ffeinfoBasictype b *** 150,155 **** --- 151,158 ---- #define ffeinfo_kindtype(i) (i.kindtype) #define ffeinfo_kindtype_max(bt,i,j) (((i) > (j)) ? (i) : (j)) + #ifdef __GNUC__ #define ffeinfo_new(bt,kt,r,k,w,sz) \ ((ffeinfo) {(bt), (kt), (r), (k), (w), (sz)}) + #endif #define ffeinfo_new_any() \ ffeinfo_new (FFEINFO_basictypeANY, FFEINFO_kindtypeANY, 0, \ diff -rcp2N g77-0.5.15/f/input.j g77-0.5.16/f/input.j *** g77-0.5.15/f/input.j --- g77-0.5.16/f/input.j Wed Aug 30 15:53:36 1995 *************** *** 0 **** --- 1,27 ---- + /* input.j -- Wrapper for GCC's input.h + Copyright (C) 1995 Free Software Foundation, Inc. + Contributed by James Craig Burley (burley@gnu.ai.mit.edu). + + This file is part of GNU Fortran. + + GNU Fortran 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, or (at your option) + any later version. + + GNU Fortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with GNU Fortran; see the file COPYING. If not, write to + the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA + 02111-1307, USA. */ + + #ifndef MAKING_DEPENDENCIES + #ifndef _J_f_input + #define _J_f_input + #include "input.h" + #endif + #endif diff -rcp2N g77-0.5.15/f/intrin.c g77-0.5.16/f/intrin.c *** g77-0.5.15/f/intrin.c Wed Apr 12 10:03:15 1995 --- g77-0.5.16/f/intrin.c Wed Aug 30 15:53:36 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ *************** struct _ffeintrin_imp_ *** 59,63 **** #if FFECOM_targetCURRENT == FFECOM_targetGCC ffecomGfrt gfrt; /* gfrt index in library. */ ! #endif ffeinfoBasictype basictype; ffeinfoKindtype kindtype; --- 60,64 ---- #if FFECOM_targetCURRENT == FFECOM_targetGCC ffecomGfrt gfrt; /* gfrt index in library. */ ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ ffeinfoBasictype basictype; ffeinfoKindtype kindtype; *************** struct _ffeintrin_imp_ *** 66,69 **** --- 67,71 ---- }; + static ffebad ffeintrin_check_0_ (ffebld arglist); static ffebad ffeintrin_check_1_ (ffebld arglist, ffebld *xarg1); static ffebad ffeintrin_check_1or2_ (ffebld arglist, ffebld *xarg1, *************** static ffebad ffeintrin_check_1or2_ (ffe *** 71,74 **** --- 73,78 ---- static ffebad ffeintrin_check_2_ (ffebld arglist, ffebld *xarg1, ffebld *xarg2); + static ffebad ffeintrin_check_2or3_ (ffebld arglist, ffebld *xarg1, + ffebld *xarg2, ffebld *xarg3); static ffebad ffeintrin_check_3_ (ffebld arglist, ffebld *xarg1, ffebld *xarg2, ffebld *xarg3); *************** static ffebad ffeintrin_check_cmplx_1or2 *** 83,87 **** --- 87,94 ---- static ffebad ffeintrin_check_dcmplx_1_ (ffebld arglist); static ffebad ffeintrin_check_dcmplx_1or2_ (ffebld arglist); + static ffebad ffeintrin_check_getarg_ (ffebld arglist); + static ffebad ffeintrin_check_getenv_ (ffebld arglist); static ffebad ffeintrin_check_int_1_ (ffebld arglist); + static ffebad ffeintrin_check_int_1_o_ (ffebld arglist); static ffebad ffeintrin_check_int_1or2_ (ffebld arglist); static ffebad ffeintrin_check_int_2_ (ffebld arglist); *************** static ffebad ffeintrin_check_realdbl_1o *** 107,116 **** --- 114,129 ---- static ffebad ffeintrin_check_realdbl_2_ (ffebld arglist); static ffebad ffeintrin_check_realdbl_2p_ (ffebld arglist); + static ffebad ffeintrin_check_signal_ (ffebld arglist); + static ffebad ffeintrin_check_system_ (ffebld arglist); static ffebad ffeintrin_check_void_ (ffebld arglist); static int ffeintrin_cmp_name_ (const void *name, const void *intrinsic); + #define ffeintrin_check_exit_ ffeintrin_check_int_1_o_ + #define ffeintrin_check_flush_ ffeintrin_check_int_1_o_ + static struct _ffeintrin_name_ ffeintrin_names_[] = { /* Alpha order. */ + {"ABORT", "abort", "Abort", FFEINTRIN_genNONE, FFEINTRIN_specABORT,}, /* UNIX */ {"ABS", "abs", "Abs", FFEINTRIN_genABS, FFEINTRIN_specABS,}, {"ACHAR", "achar", "AChar", FFEINTRIN_genACHAR, FFEINTRIN_specNONE,}, /* F90, F2C */ *************** static struct _ffeintrin_name_ ffeintrin *** 117,122 **** {"ACOS", "acos", "ACos", FFEINTRIN_genACOS, FFEINTRIN_specACOS,}, {"ACOSD", "acosd", "ACosD", FFEINTRIN_genACOSD, FFEINTRIN_specACOSD,}, /* VXT */ ! {"ADJUSTL", "adjustl", "AdjustL", FFEINTRIN_genADJUSTL, FFEINTRIN_specNONE,}, /* F90 */ ! {"ADJUSTR", "adjustr", "AdjustR", FFEINTRIN_genADJUSTR, FFEINTRIN_specNONE,}, /* F90 */ {"AIMAG", "aimag", "AImag", FFEINTRIN_genAIMAG, FFEINTRIN_specAIMAG,}, {"AIMAX0", "aimax0", "AIMax0", FFEINTRIN_genNONE, FFEINTRIN_specAIMAX0,}, /* VXT */ --- 130,135 ---- {"ACOS", "acos", "ACos", FFEINTRIN_genACOS, FFEINTRIN_specACOS,}, {"ACOSD", "acosd", "ACosD", FFEINTRIN_genACOSD, FFEINTRIN_specACOSD,}, /* VXT */ ! {"ADJUSTL", "adjustl", "AdjustL", FFEINTRIN_genADJUSTL, FFEINTRIN_specNONE,}, /* F90 */ ! {"ADJUSTR", "adjustr", "AdjustR", FFEINTRIN_genADJUSTR, FFEINTRIN_specNONE,}, /* F90 */ {"AIMAG", "aimag", "AImag", FFEINTRIN_genAIMAG, FFEINTRIN_specAIMAG,}, {"AIMAX0", "aimax0", "AIMax0", FFEINTRIN_genNONE, FFEINTRIN_specAIMAX0,}, /* VXT */ *************** static struct _ffeintrin_name_ ffeintrin *** 156,160 **** {"CDSIN", "cdsin", "CDSin", FFEINTRIN_genNONE, FFEINTRIN_specCDSIN,}, /* VXT */ {"CDSQRT", "cdsqrt", "CDSqRt", FFEINTRIN_genNONE, FFEINTRIN_specCDSQRT,}, /* VXT */ ! {"CEILING", "ceiling", "Ceiling", FFEINTRIN_genCEILING, FFEINTRIN_specNONE,}, /* F90 */ {"CEXP", "cexp", "CExp", FFEINTRIN_genNONE, FFEINTRIN_specCEXP,}, {"CHAR", "char", "Char", FFEINTRIN_genCHAR, FFEINTRIN_specCHAR,}, --- 169,173 ---- {"CDSIN", "cdsin", "CDSin", FFEINTRIN_genNONE, FFEINTRIN_specCDSIN,}, /* VXT */ {"CDSQRT", "cdsqrt", "CDSqRt", FFEINTRIN_genNONE, FFEINTRIN_specCDSQRT,}, /* VXT */ ! {"CEILING", "ceiling", "Ceiling", FFEINTRIN_genCEILING, FFEINTRIN_specNONE,}, /* F90 */ {"CEXP", "cexp", "CExp", FFEINTRIN_genNONE, FFEINTRIN_specCEXP,}, {"CHAR", "char", "Char", FFEINTRIN_genCHAR, FFEINTRIN_specCHAR,}, *************** static struct _ffeintrin_name_ ffeintrin *** 176,180 **** {"DATAN", "datan", "DATan", FFEINTRIN_genNONE, FFEINTRIN_specDATAN,}, {"DATAN2", "datan2", "DATan2", FFEINTRIN_genNONE, FFEINTRIN_specDATAN2,}, ! {"DATAN2D", "datan2d", "DATan2D", FFEINTRIN_genNONE, FFEINTRIN_specDATAN2D,}, /* VXT */ {"DATAND", "datand", "DATanD", FFEINTRIN_genNONE, FFEINTRIN_specDATAND,}, /* VXT */ {"DATE_AND_TIME", "date_and_time", "Date_and_Time", FFEINTRIN_genNONE, FFEINTRIN_specDATE_AND_TIME,}, /* F90 */ --- 189,193 ---- {"DATAN", "datan", "DATan", FFEINTRIN_genNONE, FFEINTRIN_specDATAN,}, {"DATAN2", "datan2", "DATan2", FFEINTRIN_genNONE, FFEINTRIN_specDATAN2,}, ! {"DATAN2D", "datan2d", "DATan2D", FFEINTRIN_genNONE, FFEINTRIN_specDATAN2D,}, /* VXT */ {"DATAND", "datand", "DATanD", FFEINTRIN_genNONE, FFEINTRIN_specDATAND,}, /* VXT */ {"DATE_AND_TIME", "date_and_time", "Date_and_Time", FFEINTRIN_genNONE, FFEINTRIN_specDATE_AND_TIME,}, /* F90 */ *************** static struct _ffeintrin_name_ ffeintrin *** 187,190 **** --- 200,205 ---- {"DCOSH", "dcosh", "DCosH", FFEINTRIN_genNONE, FFEINTRIN_specDCOSH,}, {"DDIM", "ddim", "DDim", FFEINTRIN_genNONE, FFEINTRIN_specDDIM,}, + {"DERF", "derf", "DErF", FFEINTRIN_genNONE, FFEINTRIN_specDERF,}, /* UNIX */ + {"DERFC", "derfc", "DErFC", FFEINTRIN_genNONE, FFEINTRIN_specDERFC,}, /* UNIX */ {"DEXP", "dexp", "DExp", FFEINTRIN_genNONE, FFEINTRIN_specDEXP,}, {"DFLOAT", "dfloat", "DFloat", FFEINTRIN_genDFLOAT, FFEINTRIN_specNONE,}, /* F2C, VXT */ *************** static struct _ffeintrin_name_ ffeintrin *** 212,217 **** {"DTAND", "dtand", "DTanD", FFEINTRIN_genNONE, FFEINTRIN_specDTAND,}, /* VXT */ {"DTANH", "dtanh", "DTanH", FFEINTRIN_genNONE, FFEINTRIN_specDTANH,}, ! {"EOSHIFT", "eoshift", "EOShift", FFEINTRIN_genEOSHIFT, FFEINTRIN_specNONE,}, /* F90 */ ! {"EPSILON", "epsilon", "Epsilon", FFEINTRIN_genEPSILON, FFEINTRIN_specNONE,}, /* F90 */ {"EXP", "exp", "Exp", FFEINTRIN_genEXP, FFEINTRIN_specEXP,}, {"EXPONENT", "exponent", "Exponent", FFEINTRIN_genEXPONENT, FFEINTRIN_specNONE,}, /* F90 */ --- 227,235 ---- {"DTAND", "dtand", "DTanD", FFEINTRIN_genNONE, FFEINTRIN_specDTAND,}, /* VXT */ {"DTANH", "dtanh", "DTanH", FFEINTRIN_genNONE, FFEINTRIN_specDTANH,}, ! {"EOSHIFT", "eoshift", "EOShift", FFEINTRIN_genEOSHIFT, FFEINTRIN_specNONE,}, /* F90 */ ! {"EPSILON", "epsilon", "Epsilon", FFEINTRIN_genEPSILON, FFEINTRIN_specNONE,}, /* F90 */ ! {"ERF", "erf", "ErF", FFEINTRIN_genNONE, FFEINTRIN_specERF,}, /* UNIX */ ! {"ERFC", "erfc", "ErFC", FFEINTRIN_genNONE, FFEINTRIN_specERFC,}, /* UNIX */ ! {"EXIT", "exit", "Exit", FFEINTRIN_genNONE, FFEINTRIN_specEXIT,}, /* UNIX */ {"EXP", "exp", "Exp", FFEINTRIN_genEXP, FFEINTRIN_specEXP,}, {"EXPONENT", "exponent", "Exponent", FFEINTRIN_genEXPONENT, FFEINTRIN_specNONE,}, /* F90 */ *************** static struct _ffeintrin_name_ ffeintrin *** 220,223 **** --- 238,242 ---- {"FLOATJ", "floatj", "FloatJ", FFEINTRIN_genNONE, FFEINTRIN_specFLOATJ,}, /* VXT */ {"FLOOR", "floor", "Floor", FFEINTRIN_genFLOOR, FFEINTRIN_specNONE,}, /* F90 */ + {"FLUSH", "flush", "Flush", FFEINTRIN_genNONE, FFEINTRIN_specFLUSH,}, /* UNIX */ {"FPABSP", "fpabsp", "FPAbsP", FFEINTRIN_genFPABSP, FFEINTRIN_specNONE,}, /* F2C */ {"FPEXPN", "fpexpn", "FPExpn", FFEINTRIN_genFPEXPN, FFEINTRIN_specNONE,}, /* F2C */ *************** static struct _ffeintrin_name_ ffeintrin *** 227,230 **** --- 246,251 ---- {"FPSCAL", "fpscal", "FPScal", FFEINTRIN_genFPSCAL, FFEINTRIN_specNONE,}, /* F2C */ {"FRACTION", "fraction", "Fraction", FFEINTRIN_genFRACTION, FFEINTRIN_specNONE,}, /* F90 */ + {"GETARG", "getarg", "GetArg", FFEINTRIN_genNONE, FFEINTRIN_specGETARG,}, /* UNIX */ + {"GETENV", "getenv", "GetEnv", FFEINTRIN_genNONE, FFEINTRIN_specGETENV,}, /* UNIX */ {"HUGE", "huge", "Huge", FFEINTRIN_genHUGE, FFEINTRIN_specNONE,}, /* F90 */ {"IABS", "iabs", "IAbs", FFEINTRIN_genIABS, FFEINTRIN_specIABS,}, *************** static struct _ffeintrin_name_ ffeintrin *** 231,234 **** --- 252,256 ---- {"IACHAR", "iachar", "IAChar", FFEINTRIN_genIACHAR, FFEINTRIN_specNONE,}, /* F90, F2C */ {"IAND", "iand", "IAnd", FFEINTRIN_genIAND, FFEINTRIN_specNONE,}, /* F90, VXT */ + {"IARGC", "iargc", "IArgC", FFEINTRIN_genNONE, FFEINTRIN_specIARGC,}, /* UNIX */ {"IBCLR", "ibclr", "IBClr", FFEINTRIN_genIBCLR, FFEINTRIN_specNONE,}, /* F90, VXT */ {"IBITS", "ibits", "IBits", FFEINTRIN_genIBITS, FFEINTRIN_specNONE,}, /* F90, VXT */ *************** static struct _ffeintrin_name_ ffeintrin *** 255,259 **** {"IIQNNT", "iiqnnt", "IIQNnt", FFEINTRIN_genNONE, FFEINTRIN_specIIQNNT,}, /* VXT */ {"IISHFT", "iishft", "IIShft", FFEINTRIN_genNONE, FFEINTRIN_specNONE,}, /* VXT */ ! {"IISHFTC", "iishftc", "IIShftC", FFEINTRIN_genNONE, FFEINTRIN_specIISHFTC,}, /* VXT */ {"IISIGN", "iisign", "IISign", FFEINTRIN_genNONE, FFEINTRIN_specIISIGN,}, /* VXT */ {"IMAG", "imag", "Imag", FFEINTRIN_genIMAG, FFEINTRIN_spec_IMAG_C_F2C,}, /* F2C */ --- 277,281 ---- {"IIQNNT", "iiqnnt", "IIQNnt", FFEINTRIN_genNONE, FFEINTRIN_specIIQNNT,}, /* VXT */ {"IISHFT", "iishft", "IIShft", FFEINTRIN_genNONE, FFEINTRIN_specNONE,}, /* VXT */ ! {"IISHFTC", "iishftc", "IIShftC", FFEINTRIN_genNONE, FFEINTRIN_specIISHFTC,}, /* VXT */ {"IISIGN", "iisign", "IISign", FFEINTRIN_genNONE, FFEINTRIN_specIISIGN,}, /* VXT */ {"IMAG", "imag", "Imag", FFEINTRIN_genIMAG, FFEINTRIN_spec_IMAG_C_F2C,}, /* F2C */ *************** static struct _ffeintrin_name_ ffeintrin *** 287,291 **** {"JIQNNT", "jiqnnt", "JIQNnt", FFEINTRIN_genNONE, FFEINTRIN_specJIQNNT,}, /* VXT */ {"JISHFT", "jishft", "JIShft", FFEINTRIN_genNONE, FFEINTRIN_specJISHFT,}, /* VXT */ ! {"JISHFTC", "jishftc", "JIShftC", FFEINTRIN_genNONE, FFEINTRIN_specJISHFTC,}, /* VXT */ {"JISIGN", "jisign", "JISign", FFEINTRIN_genNONE, FFEINTRIN_specJISIGN,}, /* VXT */ {"JMAX0", "jmax0", "JMax0", FFEINTRIN_genNONE, FFEINTRIN_specJMAX0,}, /* VXT */ --- 309,313 ---- {"JIQNNT", "jiqnnt", "JIQNnt", FFEINTRIN_genNONE, FFEINTRIN_specJIQNNT,}, /* VXT */ {"JISHFT", "jishft", "JIShft", FFEINTRIN_genNONE, FFEINTRIN_specJISHFT,}, /* VXT */ ! {"JISHFTC", "jishftc", "JIShftC", FFEINTRIN_genNONE, FFEINTRIN_specJISHFTC,}, /* VXT */ {"JISIGN", "jisign", "JISign", FFEINTRIN_genNONE, FFEINTRIN_specJISIGN,}, /* VXT */ {"JMAX0", "jmax0", "JMax0", FFEINTRIN_genNONE, FFEINTRIN_specJMAX0,}, /* VXT */ *************** static struct _ffeintrin_name_ ffeintrin *** 308,312 **** {"LOG", "log", "Log", FFEINTRIN_genLOG, FFEINTRIN_specNONE,}, {"LOG10", "log10", "Log10", FFEINTRIN_genLOG10, FFEINTRIN_specNONE,}, ! {"LOGICAL", "logical", "Logical", FFEINTRIN_genLOGICAL, FFEINTRIN_specNONE,}, /* F90 */ {"LSHIFT", "lshift", "LShift", FFEINTRIN_genLSHIFT, FFEINTRIN_specNONE,}, /* F2C */ {"MATMUL", "matmul", "MatMul", FFEINTRIN_genMATMUL, FFEINTRIN_specNONE,}, /* F90 */ --- 330,334 ---- {"LOG", "log", "Log", FFEINTRIN_genLOG, FFEINTRIN_specNONE,}, {"LOG10", "log10", "Log10", FFEINTRIN_genLOG10, FFEINTRIN_specNONE,}, ! {"LOGICAL", "logical", "Logical", FFEINTRIN_genLOGICAL, FFEINTRIN_specNONE,}, /* F90 */ {"LSHIFT", "lshift", "LShift", FFEINTRIN_genLSHIFT, FFEINTRIN_specNONE,}, /* F2C */ {"MATMUL", "matmul", "MatMul", FFEINTRIN_genMATMUL, FFEINTRIN_specNONE,}, /* F90 */ *************** static struct _ffeintrin_name_ ffeintrin *** 327,331 **** {"MODULO", "modulo", "Modulo", FFEINTRIN_genMODULO, FFEINTRIN_specNONE,}, /* F90 */ {"MVBITS", "mvbits", "MvBits", FFEINTRIN_genMVBITS, FFEINTRIN_specNONE,}, /* F90 */ ! {"NEAREST", "nearest", "Nearest", FFEINTRIN_genNEAREST, FFEINTRIN_specNONE,}, /* F90 */ {"NINT", "nint", "NInt", FFEINTRIN_genNINT, FFEINTRIN_specNINT,}, {"NOT", "not", "Not", FFEINTRIN_genNOT, FFEINTRIN_specNONE,}, /* F2C, F90, VXT */ --- 349,353 ---- {"MODULO", "modulo", "Modulo", FFEINTRIN_genMODULO, FFEINTRIN_specNONE,}, /* F90 */ {"MVBITS", "mvbits", "MvBits", FFEINTRIN_genMVBITS, FFEINTRIN_specNONE,}, /* F90 */ ! {"NEAREST", "nearest", "Nearest", FFEINTRIN_genNEAREST, FFEINTRIN_specNONE,}, /* F90 */ {"NINT", "nint", "NInt", FFEINTRIN_genNINT, FFEINTRIN_specNINT,}, {"NOT", "not", "Not", FFEINTRIN_genNOT, FFEINTRIN_specNONE,}, /* F2C, F90, VXT */ *************** static struct _ffeintrin_name_ ffeintrin *** 333,338 **** {"PACK", "pack", "Pack", FFEINTRIN_genPACK, FFEINTRIN_specNONE,}, /* F90 */ {"PRECISION", "precision", "Precision", FFEINTRIN_genPRECISION, FFEINTRIN_specNONE,}, /* F90 */ ! {"PRESENT", "present", "Present", FFEINTRIN_genPRESENT, FFEINTRIN_specNONE,}, /* F90 */ ! {"PRODUCT", "product", "Product", FFEINTRIN_genPRODUCT, FFEINTRIN_specNONE,}, /* F90 */ {"QABS", "qabs", "QAbs", FFEINTRIN_genNONE, FFEINTRIN_specQABS,}, /* VXT */ {"QACOS", "qacos", "QACos", FFEINTRIN_genNONE, FFEINTRIN_specQACOS,}, /* VXT */ --- 355,360 ---- {"PACK", "pack", "Pack", FFEINTRIN_genPACK, FFEINTRIN_specNONE,}, /* F90 */ {"PRECISION", "precision", "Precision", FFEINTRIN_genPRECISION, FFEINTRIN_specNONE,}, /* F90 */ ! {"PRESENT", "present", "Present", FFEINTRIN_genPRESENT, FFEINTRIN_specNONE,}, /* F90 */ ! {"PRODUCT", "product", "Product", FFEINTRIN_genPRODUCT, FFEINTRIN_specNONE,}, /* F90 */ {"QABS", "qabs", "QAbs", FFEINTRIN_genNONE, FFEINTRIN_specQABS,}, /* VXT */ {"QACOS", "qacos", "QACos", FFEINTRIN_genNONE, FFEINTRIN_specQACOS,}, /* VXT */ *************** static struct _ffeintrin_name_ ffeintrin *** 342,346 **** {"QATAN", "qatan", "QATan", FFEINTRIN_genNONE, FFEINTRIN_specQATAN,}, /* VXT */ {"QATAN2", "qatan2", "QATan2", FFEINTRIN_genNONE, FFEINTRIN_specQATAN2,}, /* VXT */ ! {"QATAN2D", "qatan2d", "QATan2D", FFEINTRIN_genNONE, FFEINTRIN_specQATAN2D,}, /* VXT */ {"QATAND", "qatand", "QATanD", FFEINTRIN_genNONE, FFEINTRIN_specQATAND,}, /* VXT */ {"QCOS", "qcos", "QCos", FFEINTRIN_genNONE, FFEINTRIN_specQCOS,}, /* VXT */ --- 364,368 ---- {"QATAN", "qatan", "QATan", FFEINTRIN_genNONE, FFEINTRIN_specQATAN,}, /* VXT */ {"QATAN2", "qatan2", "QATan2", FFEINTRIN_genNONE, FFEINTRIN_specQATAN2,}, /* VXT */ ! {"QATAN2D", "qatan2d", "QATan2D", FFEINTRIN_genNONE, FFEINTRIN_specQATAN2D,}, /* VXT */ {"QATAND", "qatand", "QATanD", FFEINTRIN_genNONE, FFEINTRIN_specQATAND,}, /* VXT */ {"QCOS", "qcos", "QCos", FFEINTRIN_genNONE, FFEINTRIN_specQCOS,}, /* VXT */ *************** static struct _ffeintrin_name_ ffeintrin *** 372,376 **** {"REAL", "real", "Real", FFEINTRIN_genREAL, FFEINTRIN_specREAL,}, {"REPEAT", "repeat", "Repeat", FFEINTRIN_genREPEAT, FFEINTRIN_specNONE,}, /* F90 */ ! {"RESHAPE", "reshape", "Reshape", FFEINTRIN_genRESHAPE, FFEINTRIN_specNONE,}, /* F90 */ {"RRSPACING", "rrspacing", "RRSpacing", FFEINTRIN_genRRSPACING, FFEINTRIN_specNONE,}, /* F90 */ {"RSHIFT", "rshift", "RShift", FFEINTRIN_genRSHIFT, FFEINTRIN_specNONE,}, /* F2C */ --- 394,398 ---- {"REAL", "real", "Real", FFEINTRIN_genREAL, FFEINTRIN_specREAL,}, {"REPEAT", "repeat", "Repeat", FFEINTRIN_genREPEAT, FFEINTRIN_specNONE,}, /* F90 */ ! {"RESHAPE", "reshape", "Reshape", FFEINTRIN_genRESHAPE, FFEINTRIN_specNONE,}, /* F90 */ {"RRSPACING", "rrspacing", "RRSpacing", FFEINTRIN_genRRSPACING, FFEINTRIN_specNONE,}, /* F90 */ {"RSHIFT", "rshift", "RShift", FFEINTRIN_genRSHIFT, FFEINTRIN_specNONE,}, /* F2C */ *************** static struct _ffeintrin_name_ ffeintrin *** 382,385 **** --- 404,408 ---- {"SHAPE", "shape", "Shape", FFEINTRIN_genSHAPE, FFEINTRIN_specNONE,}, /* F90 */ {"SIGN", "sign", "Sign", FFEINTRIN_genSIGN, FFEINTRIN_specSIGN,}, + {"SIGNAL", "signal", "Signal", FFEINTRIN_genNONE, FFEINTRIN_specSIGNAL,}, /* UNIX */ {"SIN", "sin", "Sin", FFEINTRIN_genSIN, FFEINTRIN_specSIN,}, {"SIND", "sind", "SinD", FFEINTRIN_genSIND, FFEINTRIN_specSIND,}, /* VXT */ *************** static struct _ffeintrin_name_ ffeintrin *** 387,394 **** {"SNGL", "sngl", "Sngl", FFEINTRIN_genNONE, FFEINTRIN_specSNGL,}, {"SNGLQ", "snglq", "SnglQ", FFEINTRIN_genNONE, FFEINTRIN_specSNGLQ,}, /* VXT */ ! {"SPACING", "spacing", "Spacing", FFEINTRIN_genSPACING, FFEINTRIN_specNONE,}, /* F90 */ {"SPREAD", "spread", "Spread", FFEINTRIN_genSPREAD, FFEINTRIN_specNONE,}, /* F90 */ {"SQRT", "sqrt", "SqRt", FFEINTRIN_genSQRT, FFEINTRIN_specSQRT,}, {"SUM", "sum", "Sum", FFEINTRIN_genSUM, FFEINTRIN_specNONE,}, /* F90 */ {"SYSTEM_CLOCK", "system_clock", "System_Clock", FFEINTRIN_genNONE, FFEINTRIN_specSYSTEM_CLOCK,}, /* F90 */ {"TAN", "tan", "Tan", FFEINTRIN_genTAN, FFEINTRIN_specTAN,}, --- 410,418 ---- {"SNGL", "sngl", "Sngl", FFEINTRIN_genNONE, FFEINTRIN_specSNGL,}, {"SNGLQ", "snglq", "SnglQ", FFEINTRIN_genNONE, FFEINTRIN_specSNGLQ,}, /* VXT */ ! {"SPACING", "spacing", "Spacing", FFEINTRIN_genSPACING, FFEINTRIN_specNONE,}, /* F90 */ {"SPREAD", "spread", "Spread", FFEINTRIN_genSPREAD, FFEINTRIN_specNONE,}, /* F90 */ {"SQRT", "sqrt", "SqRt", FFEINTRIN_genSQRT, FFEINTRIN_specSQRT,}, {"SUM", "sum", "Sum", FFEINTRIN_genSUM, FFEINTRIN_specNONE,}, /* F90 */ + {"SYSTEM", "system", "System", FFEINTRIN_genNONE, FFEINTRIN_specSYSTEM,}, /* UNIX */ {"SYSTEM_CLOCK", "system_clock", "System_Clock", FFEINTRIN_genNONE, FFEINTRIN_specSYSTEM_CLOCK,}, /* F90 */ {"TAN", "tan", "Tan", FFEINTRIN_genTAN, FFEINTRIN_specTAN,}, *************** static struct _ffeintrin_imp_ ffeintrin_ *** 435,442 **** #define DEFIMP(CODE,NAME,GFRT,RETURNS,EXPECTS) \ { NAME, GFRT, RETURNS, EXPECTS }, ! #endif ! #if FFECOM_targetCURRENT == FFECOM_targetFFE #define DEFIMP(CODE,NAME,GFRT,RETURNS,EXPECTS) \ { NAME, RETURNS, EXPECTS }, #endif #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) --- 459,467 ---- #define DEFIMP(CODE,NAME,GFRT,RETURNS,EXPECTS) \ { NAME, GFRT, RETURNS, EXPECTS }, ! #elif FFECOM_targetCURRENT == FFECOM_targetFFE #define DEFIMP(CODE,NAME,GFRT,RETURNS,EXPECTS) \ { NAME, RETURNS, EXPECTS }, + #else + #error #endif #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) *************** static struct _ffeintrin_spec_ ffeintrin *** 463,466 **** --- 488,500 ---- static ffebad + ffeintrin_check_0_ (ffebld arglist) + { + if (arglist != NULL) + return FFEBAD_INTRINSIC_TOOMANY; + + return FFEBAD; + } + + static ffebad ffeintrin_check_1_ (ffebld arglist, ffebld *xarg1) { *************** ffeintrin_check_2_ (ffebld arglist, ffeb *** 533,536 **** --- 567,603 ---- static ffebad + ffeintrin_check_2or3_ (ffebld arglist, ffebld *xarg1, ffebld *xarg2, + ffebld *xarg3) + { + ffebld arg1; + ffebld arg2; + ffebld arg3; + + arg1 = arglist; + if (arg1 == NULL) + return FFEBAD_INTRINSIC_TOOFEW; + + arg2 = ffebld_trail (arg1); + if (arg2 == NULL) + return FFEBAD_INTRINSIC_TOOFEW; + + arg3 = ffebld_trail (arg2); + if ((arg3 != NULL) + && (ffebld_trail (arg3) != NULL)) + return FFEBAD_INTRINSIC_TOOMANY; + + if (((arg1 = ffebld_head (arg1)) == NULL) + || ((arg2 = ffebld_head (arg2)) == NULL) + || ((arg3 != NULL) + && ((arg3 = ffebld_head (arg3)) == NULL))) + return FFEBAD_INTRINSIC_REF; + + *xarg1 = arg1; + *xarg2 = arg2; + *xarg3 = arg3; + return FFEBAD; + } + + static ffebad ffeintrin_check_3_ (ffebld arglist, ffebld *xarg1, ffebld *xarg2, ffebld *xarg3) *************** ffeintrin_check_dcmplx_1or2_ (ffebld arg *** 787,790 **** --- 854,946 ---- static ffebad + ffeintrin_check_getarg_ (ffebld arglist) + { + ffebld arg1; + ffebld arg2; + ffeinfo info; + ffebad bad; + + bad = ffeintrin_check_2_ (arglist, &arg1, &arg2); + if (bad != FFEBAD) + return bad; + + info = ffebld_info (arg1); + if ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER) + || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT) + || (ffeinfo_rank (info) != 0) + || (ffeinfo_kind (info) != FFEINFO_kindENTITY)) + return FFEBAD_INTRINSIC_REF; + + info = ffebld_info (arg2); + if ((ffeinfo_basictype (info) != FFEINFO_basictypeCHARACTER) + || (ffeinfo_kindtype (info) != FFEINFO_kindtypeCHARACTERDEFAULT) + || (ffeinfo_rank (info) != 0) + || (ffeinfo_kind (info) != FFEINFO_kindENTITY) + || ((ffebld_op (arg2) != FFEBLD_opSYMTER) + && (ffebld_op (arg2) != FFEBLD_opARRAYREF) + && (ffebld_op (arg2) != FFEBLD_opSUBSTR))) + return FFEBAD_INTRINSIC_REF; + + return FFEBAD; /* Ok. */ + } + + static ffebad + ffeintrin_check_getenv_ (ffebld arglist) + { + ffebld arg1; + ffebld arg2; + ffeinfo info; + ffebad bad; + + bad = ffeintrin_check_2_ (arglist, &arg1, &arg2); + if (bad != FFEBAD) + return bad; + + info = ffebld_info (arg1); + if ((ffeinfo_basictype (info) != FFEINFO_basictypeCHARACTER) + || (ffeinfo_kindtype (info) != FFEINFO_kindtypeCHARACTERDEFAULT) + || (ffeinfo_rank (info) != 0) + || (ffeinfo_kind (info) != FFEINFO_kindENTITY)) + return FFEBAD_INTRINSIC_REF; + + info = ffebld_info (arg2); + if ((ffeinfo_basictype (info) != FFEINFO_basictypeCHARACTER) + || (ffeinfo_kindtype (info) != FFEINFO_kindtypeCHARACTERDEFAULT) + || (ffeinfo_rank (info) != 0) + || (ffeinfo_kind (info) != FFEINFO_kindENTITY) + || ((ffebld_op (arg2) != FFEBLD_opSYMTER) + && (ffebld_op (arg2) != FFEBLD_opARRAYREF) + && (ffebld_op (arg2) != FFEBLD_opSUBSTR))) + return FFEBAD_INTRINSIC_REF; + + return FFEBAD; /* Ok. */ + } + + static ffebad + ffeintrin_check_int_1_o_ (ffebld arglist) + { + ffebld arg1; + ffeinfo info; + ffebad bad; + + bad = ffeintrin_check_0_ (arglist); + if (bad == FFEBAD) + return bad; + + bad = ffeintrin_check_1_ (arglist, &arg1); + if (bad != FFEBAD) + return bad; + + info = ffebld_info (arg1); + if ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER) + || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT) + || (ffeinfo_rank (info) != 0) + || (ffeinfo_kind (info) != FFEINFO_kindENTITY)) + return FFEBAD_INTRINSIC_REF; + + return FFEBAD; /* Ok. */ + } + + static ffebad ffeintrin_check_int_1_ (ffebld arglist) { *************** ffeintrin_check_realdbl_2p_ (ffebld argl *** 1351,1355 **** static ffebad ! ffeintrin_check_void_ (ffebld arglist) { return FFEBAD; /* Ok. */ --- 1507,1604 ---- static ffebad ! ffeintrin_check_signal_ (ffebld arglist) ! { ! ffebld arg1; ! ffebld arg2; ! ffebld arg3; ! ffeinfo info; ! ffebad bad; ! ! bad = ffeintrin_check_2or3_ (arglist, &arg1, &arg2, &arg3); ! if (bad != FFEBAD) ! return bad; ! ! info = ffebld_info (arg1); ! if ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER) ! || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT) ! || (ffeinfo_rank (info) != 0) ! || (ffeinfo_kind (info) != FFEINFO_kindENTITY)) ! return FFEBAD_INTRINSIC_REF; ! ! /* Second arg is either a dummy/external subroutine or an integer ! (for SIG_DFL, SIG_IGN, SIG_ERR). */ ! ! info = ffebld_info (arg2); ! if (((((ffeinfo_basictype (info) != FFEINFO_basictypeNONE) ! || (ffeinfo_kindtype (info) != FFEINFO_kindtypeNONE) ! || (ffeinfo_kind (info) != FFEINFO_kindSUBROUTINE)) ! && ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER) ! || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT) ! || (ffeinfo_kind (info) != FFEINFO_kindFUNCTION)) ! && (ffeinfo_kind (info) != FFEINFO_kindNONE)) /* Procedure. */ ! || (ffeinfo_rank (info) != 0) ! || ((ffeinfo_where (info) != FFEINFO_whereDUMMY) ! && (ffeinfo_where (info) != FFEINFO_whereGLOBAL))) ! && ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER) ! || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT) ! || (ffeinfo_rank (info) != 0) ! || (ffeinfo_kind (info) != FFEINFO_kindENTITY))) ! return FFEBAD_INTRINSIC_REF; ! ! /* Third arg, if present, is a place to put the returned value. */ ! ! if (arg3 != NULL) ! { ! info = ffebld_info (arg3); ! if ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER) ! || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT) ! || (ffeinfo_rank (info) != 0) ! || (ffeinfo_kind (info) != FFEINFO_kindENTITY) ! || ((ffebld_op (arg3) != FFEBLD_opSYMTER) ! && (ffebld_op (arg3) != FFEBLD_opARRAYREF))) ! return FFEBAD_INTRINSIC_REF; ! } ! ! return FFEBAD; /* Ok. */ ! } ! ! static ffebad ! ffeintrin_check_system_ (ffebld arglist) ! { ! ffebld arg1; ! ffebld arg2; ! ffeinfo info; ! ffebad bad; ! ! bad = ffeintrin_check_1or2_ (arglist, &arg1, &arg2); ! if (bad != FFEBAD) ! return bad; ! ! info = ffebld_info (arg1); ! if ((ffeinfo_basictype (info) != FFEINFO_basictypeCHARACTER) ! || (ffeinfo_kindtype (info) != FFEINFO_kindtypeCHARACTERDEFAULT) ! || (ffeinfo_rank (info) != 0) ! || (ffeinfo_kind (info) != FFEINFO_kindENTITY)) ! return FFEBAD_INTRINSIC_REF; ! ! /* Second arg, if present, is a place to put the returned value. */ ! ! if (arg2 != NULL) ! { ! info = ffebld_info (arg2); ! if ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER) ! || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT) ! || (ffeinfo_rank (info) != 0) ! || (ffeinfo_kind (info) != FFEINFO_kindENTITY) ! || ((ffebld_op (arg2) != FFEBLD_opSYMTER) ! && (ffebld_op (arg2) != FFEBLD_opARRAYREF))) ! return FFEBAD_INTRINSIC_REF; ! } ! ! return FFEBAD; /* Ok. */ ! } ! ! static ffebad ! ffeintrin_check_void_ (ffebld arglist UNUSED) { return FFEBAD; /* Ok. */ *************** ffeintrin_fulfill_generic (ffebld *expr, *** 1423,1427 **** for (i = 0; ! (i < ARRAY_SIZE (ffeintrin_gens_[gen].specs)) && ((tspec = ffeintrin_gens_[gen].specs[i]) != FFEINTRIN_specNONE); ++i) --- 1672,1676 ---- for (i = 0; ! (((size_t) i) < ARRAY_SIZE (ffeintrin_gens_[gen].specs)) && ((tspec = ffeintrin_gens_[gen].specs[i]) != FFEINTRIN_specNONE); ++i) *************** ffeintrin_init_0 () *** 1647,1651 **** assert (FFEINTRIN_spec == ARRAY_SIZE (ffeintrin_specs_)); ! for (i = 1; i < ARRAY_SIZE (ffeintrin_names_); ++i) { /* Make sure binary-searched list is in alpha order. */ --- 1896,1900 ---- assert (FFEINTRIN_spec == ARRAY_SIZE (ffeintrin_specs_)); ! for (i = 1; ((size_t) i) < ARRAY_SIZE (ffeintrin_names_); ++i) { /* Make sure binary-searched list is in alpha order. */ *************** ffeintrin_init_0 () *** 1655,1659 **** } ! for (i = 0; i < ARRAY_SIZE (ffeintrin_names_); ++i) { p1 = ffeintrin_names_[i].name_uc; --- 1904,1908 ---- } ! for (i = 0; ((size_t) i) < ARRAY_SIZE (ffeintrin_names_); ++i) { p1 = ffeintrin_names_[i].name_uc; *************** ffeintrin_is_intrinsic (char *name, ffel *** 1748,1752 **** for (i = 0; ! (i < ARRAY_SIZE (ffeintrin_gens_[gen].specs)) && ((tspec = ffeintrin_gens_[gen].specs[i]) != FFEINTRIN_specNONE); --- 1997,2001 ---- for (i = 0; ! (((size_t) i) < ARRAY_SIZE (ffeintrin_gens_[gen].specs)) && ((tspec = ffeintrin_gens_[gen].specs[i]) != FFEINTRIN_specNONE); *************** ffeintrin_is_intrinsic (char *name, ffel *** 1809,1813 **** { /* Here is where we produce a diagnostic about a reference to a ! disabled or unimplemented intrinsic, if the diagnostic is desired. */ if ((disabled || unimpl) --- 2058,2062 ---- { /* Here is where we produce a diagnostic about a reference to a ! disabled or unimplemented intrinsic, if the diagnostic is desired. */ if ((disabled || unimpl) *************** ffeintrin_is_intrinsic (char *name, ffel *** 1843,1847 **** for (i = 0; ! (i < ARRAY_SIZE (ffeintrin_gens_[gen].specs)) && ((tspec = ffeintrin_gens_[gen].specs[i]) != FFEINTRIN_specNONE); --- 2092,2096 ---- for (i = 0; ! (((size_t) i) < ARRAY_SIZE (ffeintrin_gens_[gen].specs)) && ((tspec = ffeintrin_gens_[gen].specs[i]) != FFEINTRIN_specNONE); *************** ffeintrin_state_family (ffeintrinFamily *** 1964,1967 **** --- 2213,2220 ---- case FFEINTRIN_familyF2Z: state = ffe_intrinsic_state_f2c (); + return state; + + case FFEINTRIN_familyF2U: + state = ffe_intrinsic_state_unix (); return state; diff -rcp2N g77-0.5.15/f/intrin.def g77-0.5.16/f/intrin.def *** g77-0.5.15/f/intrin.def Wed Apr 12 10:03:15 1995 --- g77-0.5.16/f/intrin.def Wed Aug 30 15:53:36 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: *************** the Free Software Foundation, 675 Mass A *** 68,76 **** is seen. */ DEFGEN (FFEINTRIN_genABS, "ABS", ! FFEINTRIN_specIABS, ! FFEINTRIN_specABS, ! FFEINTRIN_specDABS, ! FFEINTRIN_specCABS, FFEINTRIN_specIIABS, FFEINTRIN_specJIABS, --- 69,83 ---- is seen. */ + /* Currently this list starts with the list of F77-standard intrinsics + in alphabetical order, then continues with the list of all other + intrinsics. So, unless mistakes are made in the first portion, no + new intrinsics should be added to that portion (since F77 isn't + changing). */ + DEFGEN (FFEINTRIN_genABS, "ABS", ! FFEINTRIN_specIABS, /* F77. */ ! FFEINTRIN_specABS, /* F77. */ ! FFEINTRIN_specDABS, /* F77. */ ! FFEINTRIN_specCABS, /* F77. */ FFEINTRIN_specIIABS, FFEINTRIN_specJIABS, *************** DEFGEN (FFEINTRIN_genABS, "ABS", *** 85,90 **** ) DEFGEN (FFEINTRIN_genACOS, "ACOS", ! FFEINTRIN_specACOS, ! FFEINTRIN_specDACOS, FFEINTRIN_specQACOS, FFEINTRIN_specNONE, --- 92,97 ---- ) DEFGEN (FFEINTRIN_genACOS, "ACOS", ! FFEINTRIN_specACOS, /* F77. */ ! FFEINTRIN_specDACOS, /* F77. */ FFEINTRIN_specQACOS, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genACOS, "ACOS", *** 100,106 **** FFEINTRIN_specNONE ) DEFGEN (FFEINTRIN_genAINT, "AINT", ! FFEINTRIN_specAINT, ! FFEINTRIN_specDINT, FFEINTRIN_specQINT, FFEINTRIN_specNONE, --- 107,129 ---- FFEINTRIN_specNONE ) + DEFGEN (FFEINTRIN_genAIMAG, "AIMAG", + FFEINTRIN_specAIMAG, /* F77. */ + FFEINTRIN_spec_IMAG_E, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE + ) DEFGEN (FFEINTRIN_genAINT, "AINT", ! FFEINTRIN_specAINT, /* F77. */ ! FFEINTRIN_specDINT, /* F77. */ FFEINTRIN_specQINT, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genAINT, "AINT", *** 116,122 **** FFEINTRIN_specNONE ) DEFGEN (FFEINTRIN_genANINT, "ANINT", ! FFEINTRIN_specANINT, ! FFEINTRIN_specDNINT, FFEINTRIN_specQNINT, FFEINTRIN_specNONE, --- 139,177 ---- FFEINTRIN_specNONE ) + DEFGEN (FFEINTRIN_genAMAX0, "AMAX0", + FFEINTRIN_specAMAX0, /* F77. */ + FFEINTRIN_specAIMAX0, + FFEINTRIN_specAJMAX0, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE + ) + DEFGEN (FFEINTRIN_genAMIN0, "AMIN0", + FFEINTRIN_specAMIN0, /* F77. */ + FFEINTRIN_specAIMIN0, + FFEINTRIN_specAJMIN0, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE + ) DEFGEN (FFEINTRIN_genANINT, "ANINT", ! FFEINTRIN_specANINT, /* F77. */ ! FFEINTRIN_specDNINT, /* F77. */ FFEINTRIN_specQNINT, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genANINT, "ANINT", *** 133,138 **** ) DEFGEN (FFEINTRIN_genASIN, "ASIN", ! FFEINTRIN_specASIN, ! FFEINTRIN_specDASIN, FFEINTRIN_specQASIN, FFEINTRIN_specNONE, --- 188,193 ---- ) DEFGEN (FFEINTRIN_genASIN, "ASIN", ! FFEINTRIN_specASIN, /* F77. */ ! FFEINTRIN_specDASIN, /* F77. */ FFEINTRIN_specQASIN, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genASIN, "ASIN", *** 149,154 **** ) DEFGEN (FFEINTRIN_genATAN, "ATAN", ! FFEINTRIN_specATAN, ! FFEINTRIN_specDATAN, FFEINTRIN_specQATAN, FFEINTRIN_specNONE, --- 204,209 ---- ) DEFGEN (FFEINTRIN_genATAN, "ATAN", ! FFEINTRIN_specATAN, /* F77. */ ! FFEINTRIN_specDATAN, /* F77. */ FFEINTRIN_specQATAN, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genATAN, "ATAN", *** 165,170 **** ) DEFGEN (FFEINTRIN_genATAN2, "ATAN2", ! FFEINTRIN_specATAN2, ! FFEINTRIN_specDATAN2, FFEINTRIN_specQATAN2, FFEINTRIN_specNONE, --- 220,225 ---- ) DEFGEN (FFEINTRIN_genATAN2, "ATAN2", ! FFEINTRIN_specATAN2, /* F77. */ ! FFEINTRIN_specDATAN2, /* F77. */ FFEINTRIN_specQATAN2, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genATAN2, "ATAN2", *** 180,188 **** FFEINTRIN_specNONE ) DEFGEN (FFEINTRIN_genCMPLX, "CMPLX", ! FFEINTRIN_spec_CMPLX_I, ! FFEINTRIN_spec_CMPLX_R, ! FFEINTRIN_spec_CMPLX_D, ! FFEINTRIN_spec_CMPLX_C, FFEINTRIN_spec_CMPLX_J, FFEINTRIN_spec_CMPLX_Q, --- 235,259 ---- FFEINTRIN_specNONE ) + DEFGEN (FFEINTRIN_genCHAR, "CHAR", + FFEINTRIN_specCHAR, /* F77. */ + FFEINTRIN_spec_CHAR_N, + FFEINTRIN_spec_CHAR_J, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE + ) DEFGEN (FFEINTRIN_genCMPLX, "CMPLX", ! FFEINTRIN_spec_CMPLX_I, /* F77. */ ! FFEINTRIN_spec_CMPLX_R, /* F77. */ ! FFEINTRIN_spec_CMPLX_D, /* F77. */ ! FFEINTRIN_spec_CMPLX_C, /* F77. */ FFEINTRIN_spec_CMPLX_J, FFEINTRIN_spec_CMPLX_Q, *************** DEFGEN (FFEINTRIN_genCMPLX, "CMPLX", *** 196,203 **** FFEINTRIN_specNONE ) DEFGEN (FFEINTRIN_genCOS, "COS", ! FFEINTRIN_specCOS, ! FFEINTRIN_specDCOS, ! FFEINTRIN_specCCOS, FFEINTRIN_specQCOS, FFEINTRIN_specCDCOS, --- 267,290 ---- FFEINTRIN_specNONE ) + DEFGEN (FFEINTRIN_genCONJG, "CONJG", + FFEINTRIN_specCONJG, /* F77. */ + FFEINTRIN_specDCONJG, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE + ) DEFGEN (FFEINTRIN_genCOS, "COS", ! FFEINTRIN_specCOS, /* F77. */ ! FFEINTRIN_specDCOS, /* F77. */ ! FFEINTRIN_specCCOS, /* F77. */ FFEINTRIN_specQCOS, FFEINTRIN_specCDCOS, *************** DEFGEN (FFEINTRIN_genCOS, "COS", *** 213,218 **** ) DEFGEN (FFEINTRIN_genCOSH, "COSH", ! FFEINTRIN_specCOSH, ! FFEINTRIN_specDCOSH, FFEINTRIN_specQCOSH, FFEINTRIN_specNONE, --- 300,305 ---- ) DEFGEN (FFEINTRIN_genCOSH, "COSH", ! FFEINTRIN_specCOSH, /* F77. */ ! FFEINTRIN_specDCOSH, /* F77. */ FFEINTRIN_specQCOSH, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genCOSH, "COSH", *** 229,237 **** ) DEFGEN (FFEINTRIN_genDBLE, "DBLE", ! FFEINTRIN_spec_DBLE_I, ! FFEINTRIN_spec_DBLE_R, ! FFEINTRIN_spec_DBLE_D, ! FFEINTRIN_spec_DBLE_C, ! FFEINTRIN_spec_DBLE_J, FFEINTRIN_specDBLEQ, FFEINTRIN_spec_DBLE_E, --- 316,324 ---- ) DEFGEN (FFEINTRIN_genDBLE, "DBLE", ! FFEINTRIN_spec_DBLE_I, /* F77. */ ! FFEINTRIN_spec_DBLE_R, /* F77. */ ! FFEINTRIN_spec_DBLE_D, /* F77. */ ! FFEINTRIN_spec_DBLE_C, /* F77. */ ! FFEINTRIN_spec_DBLE_J, /* F77. */ FFEINTRIN_specDBLEQ, FFEINTRIN_spec_DBLE_E, *************** DEFGEN (FFEINTRIN_genDBLE, "DBLE", *** 245,251 **** ) DEFGEN (FFEINTRIN_genDIM, "DIM", ! FFEINTRIN_specIDIM, ! FFEINTRIN_specDIM, ! FFEINTRIN_specDDIM, FFEINTRIN_specIIDIM, FFEINTRIN_specJIDIM, --- 332,338 ---- ) DEFGEN (FFEINTRIN_genDIM, "DIM", ! FFEINTRIN_specIDIM, /* F77. */ ! FFEINTRIN_specDIM, /* F77. */ ! FFEINTRIN_specDDIM, /* F77. */ FFEINTRIN_specIIDIM, FFEINTRIN_specJIDIM, *************** DEFGEN (FFEINTRIN_genDIM, "DIM", *** 260,267 **** FFEINTRIN_specNONE ) DEFGEN (FFEINTRIN_genEXP, "EXP", ! FFEINTRIN_specEXP, ! FFEINTRIN_specDEXP, ! FFEINTRIN_specCEXP, FFEINTRIN_specQEXP, FFEINTRIN_specCDEXP, --- 347,370 ---- FFEINTRIN_specNONE ) + DEFGEN (FFEINTRIN_genDPROD, "DPROD", + FFEINTRIN_specDPROD, /* F77. */ + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE + ) DEFGEN (FFEINTRIN_genEXP, "EXP", ! FFEINTRIN_specEXP, /* F77. */ ! FFEINTRIN_specDEXP, /* F77. */ ! FFEINTRIN_specCEXP, /* F77. */ FFEINTRIN_specQEXP, FFEINTRIN_specCDEXP, *************** DEFGEN (FFEINTRIN_genEXP, "EXP", *** 276,283 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genIABS, "IABS", ! FFEINTRIN_specIABS, ! FFEINTRIN_specIIABS, ! FFEINTRIN_specJIABS, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 379,386 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genFLOAT, "FLOAT", ! FFEINTRIN_specFLOAT, /* F77. */ ! FFEINTRIN_specFLOATI, ! FFEINTRIN_specFLOATJ, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genIABS, "IABS", *** 292,318 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genINT, "INT", ! FFEINTRIN_spec_INT_I, ! FFEINTRIN_specINT, ! FFEINTRIN_specIDINT, ! FFEINTRIN_spec_INT_C, ! FFEINTRIN_specIINT, ! FFEINTRIN_specJINT, ! FFEINTRIN_specIIDINT, ! FFEINTRIN_specJIDINT, ! FFEINTRIN_specIIQINT, ! FFEINTRIN_specJIQINT, ! FFEINTRIN_spec_JINT_C, ! FFEINTRIN_spec_IINT_C, ! FFEINTRIN_spec_JINT_E, ! FFEINTRIN_spec_IINT_E ! ) ! DEFGEN (FFEINTRIN_genLOG, "LOG", ! FFEINTRIN_specALOG, ! FFEINTRIN_specDLOG, ! FFEINTRIN_specCLOG, ! FFEINTRIN_specQLOG, ! FFEINTRIN_specCDLOG, ! FFEINTRIN_specZLOG, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 395,404 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genIABS, "IABS", ! FFEINTRIN_specIABS, /* F77. */ ! FFEINTRIN_specIIABS, ! FFEINTRIN_specJIABS, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genLOG, "LOG", *** 322,331 **** FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genLOG10, "LOG10", ! FFEINTRIN_specALOG10, ! FFEINTRIN_specDLOG10, ! FFEINTRIN_specQLOG10, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 408,417 ---- FFEINTRIN_specNONE, FFEINTRIN_specNONE, + FFEINTRIN_specNONE, FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genICHAR, "ICHAR", ! FFEINTRIN_specICHAR, /* F77. */ ! FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genLOG10, "LOG10", *** 338,350 **** FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genMAX, "MAX", ! FFEINTRIN_specMAX0, ! FFEINTRIN_specAMAX1, ! FFEINTRIN_specDMAX1, ! FFEINTRIN_specIMAX0, ! FFEINTRIN_specJMAX0, ! FFEINTRIN_specQMAX1, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 424,435 ---- FFEINTRIN_specNONE, FFEINTRIN_specNONE, + FFEINTRIN_specNONE, FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genIDIM, "IDIM", ! FFEINTRIN_specIDIM, /* F77. */ ! FFEINTRIN_specIIDIM, ! FFEINTRIN_specJIDIM, ! FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genMAX, "MAX", *** 354,366 **** FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genMIN, "MIN", ! FFEINTRIN_specMIN0, ! FFEINTRIN_specAMIN1, ! FFEINTRIN_specDMIN1, ! FFEINTRIN_specIMIN0, ! FFEINTRIN_specJMIN0, ! FFEINTRIN_specQMIN1, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 439,452 ---- FFEINTRIN_specNONE, FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genIDINT, "IDINT", ! FFEINTRIN_specIDINT, /* F77. */ ! FFEINTRIN_specIIDINT, ! FFEINTRIN_specJIDINT, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genMIN, "MIN", *** 370,382 **** FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genMOD, "MOD", ! FFEINTRIN_specMOD, ! FFEINTRIN_specAMOD, ! FFEINTRIN_specDMOD, ! FFEINTRIN_specIMOD, ! FFEINTRIN_specJMOD, ! FFEINTRIN_specQMOD, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 456,466 ---- FFEINTRIN_specNONE, FFEINTRIN_specNONE, + FFEINTRIN_specNONE, FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genIDNINT, "IDNINT", ! FFEINTRIN_specIDNINT, /* F77. */ ! FFEINTRIN_specIIDNNT, ! FFEINTRIN_specJIDNNT, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genMOD, "MOD", *** 386,396 **** FFEINTRIN_specNONE, FFEINTRIN_specNONE, - FFEINTRIN_specNONE - ) - DEFGEN (FFEINTRIN_genMVBITS, "MVBITS", - FFEINTRIN_specMVBITS, FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 470,483 ---- FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, + FFEINTRIN_specNONE + ) + DEFGEN (FFEINTRIN_genIFIX, "IFIX", + FFEINTRIN_specIFIX, /* F77. */ + FFEINTRIN_specIIFIX, + FFEINTRIN_specJIFIX, + FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genMVBITS, "MVBITS", *** 404,416 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genNINT, "NINT", ! FFEINTRIN_specNINT, ! FFEINTRIN_specIDNINT, ! FFEINTRIN_specININT, ! FFEINTRIN_specJNINT, ! FFEINTRIN_specIIDNNT, ! FFEINTRIN_specJIDNNT, ! FFEINTRIN_specIIQNNT, ! FFEINTRIN_specJIQNNT, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 491,496 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genINDEX, "INDEX", ! FFEINTRIN_specINDEX, /* F77. */ FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genNINT, "NINT", *** 418,433 **** FFEINTRIN_specNONE, FFEINTRIN_specNONE, ! FFEINTRIN_specNONE ! ) ! DEFGEN (FFEINTRIN_genREAL, "REAL", ! FFEINTRIN_specREAL, ! FFEINTRIN_specFLOAT, ! FFEINTRIN_spec_REAL_R, ! FFEINTRIN_specSNGL, ! FFEINTRIN_spec_REAL_C, ! FFEINTRIN_specFLOATI, ! FFEINTRIN_specFLOATJ, ! FFEINTRIN_specSNGLQ, ! FFEINTRIN_spec_REAL_E, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 498,503 ---- FFEINTRIN_specNONE, FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genREAL, "REAL", *** 434,446 **** FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genSIGN, "SIGN", ! FFEINTRIN_specISIGN, ! FFEINTRIN_specSIGN, ! FFEINTRIN_specDSIGN, FFEINTRIN_specIISIGN, FFEINTRIN_specJISIGN, ! FFEINTRIN_specQSIGN, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 504,532 ---- FFEINTRIN_specNONE, FFEINTRIN_specNONE, + FFEINTRIN_specNONE, FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genINT, "INT", ! FFEINTRIN_spec_INT_I, /* F77. */ ! FFEINTRIN_specINT, /* F77. */ ! FFEINTRIN_specIDINT, /* F77. */ ! FFEINTRIN_spec_INT_C, /* F77. */ ! FFEINTRIN_specIINT, ! FFEINTRIN_specJINT, ! FFEINTRIN_specIIDINT, ! FFEINTRIN_specJIDINT, ! FFEINTRIN_specIIQINT, ! FFEINTRIN_specJIQINT, ! FFEINTRIN_spec_JINT_C, ! FFEINTRIN_spec_IINT_C, ! FFEINTRIN_spec_JINT_E, ! FFEINTRIN_spec_IINT_E ! ) ! DEFGEN (FFEINTRIN_genISIGN, "ISIGN", ! FFEINTRIN_specISIGN, /* F77. */ FFEINTRIN_specIISIGN, FFEINTRIN_specJISIGN, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genSIGN, "SIGN", *** 450,462 **** FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genSIN, "SIN", ! FFEINTRIN_specSIN, ! FFEINTRIN_specDSIN, ! FFEINTRIN_specCSIN, ! FFEINTRIN_specQSIN, ! FFEINTRIN_specCDSIN, ! FFEINTRIN_specZSIN, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 536,544 ---- FFEINTRIN_specNONE, FFEINTRIN_specNONE, + FFEINTRIN_specNONE, FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genLEN, "LEN", ! FFEINTRIN_specLEN, /* F77. */ FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genSIN, "SIN", *** 466,475 **** FFEINTRIN_specNONE, FFEINTRIN_specNONE, - FFEINTRIN_specNONE - ) - DEFGEN (FFEINTRIN_genSINH, "SINH", - FFEINTRIN_specSINH, - FFEINTRIN_specDSINH, - FFEINTRIN_specQSINH, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 548,551 ---- *************** DEFGEN (FFEINTRIN_genSINH, "SINH", *** 477,480 **** --- 553,560 ---- FFEINTRIN_specNONE, FFEINTRIN_specNONE, + FFEINTRIN_specNONE + ) + DEFGEN (FFEINTRIN_genLGE, "LGE", + FFEINTRIN_specLGE, /* F77. */ FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genSINH, "SINH", *** 482,494 **** FFEINTRIN_specNONE, FFEINTRIN_specNONE, - FFEINTRIN_specNONE - ) - DEFGEN (FFEINTRIN_genSQRT, "SQRT", - FFEINTRIN_specSQRT, - FFEINTRIN_specDSQRT, - FFEINTRIN_specCSQRT, - FFEINTRIN_specQSQRT, - FFEINTRIN_specCDSQRT, - FFEINTRIN_specZSQRT, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 562,565 ---- *************** DEFGEN (FFEINTRIN_genSQRT, "SQRT", *** 500,507 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genTAN, "TAN", ! FFEINTRIN_specTAN, ! FFEINTRIN_specDTAN, ! FFEINTRIN_specQTAN, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 571,576 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genLGT, "LGT", ! FFEINTRIN_specLGT, /* F77. */ FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genTAN, "TAN", *** 514,523 **** FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genTANH, "TANH", ! FFEINTRIN_specTANH, ! FFEINTRIN_specDTANH, ! FFEINTRIN_specQTANH, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 583,592 ---- FFEINTRIN_specNONE, FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genLLE, "LLE", ! FFEINTRIN_specLLE, /* F77. */ FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genTANH, "TANH", *** 530,538 **** FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genAIMAG, "AIMAG", ! FFEINTRIN_specAIMAG, ! FFEINTRIN_spec_IMAG_E, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 599,608 ---- FFEINTRIN_specNONE, FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genLLT, "LLT", ! FFEINTRIN_specLLT, /* F77. */ FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genAIMAG, "AIMAG", *** 546,558 **** FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genAMAX0, "AMAX0", ! FFEINTRIN_specAMAX0, ! FFEINTRIN_specAIMAX0, ! FFEINTRIN_specAJMAX0, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 616,629 ---- FFEINTRIN_specNONE, FFEINTRIN_specNONE, + FFEINTRIN_specNONE, FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genLOG, "LOG", ! FFEINTRIN_specALOG, /* F77. */ ! FFEINTRIN_specDLOG, /* F77. */ ! FFEINTRIN_specCLOG, /* F77. */ ! FFEINTRIN_specQLOG, ! FFEINTRIN_specCDLOG, ! FFEINTRIN_specZLOG, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genAMAX0, "AMAX0", *** 564,571 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genAMIN0, "AMIN0", ! FFEINTRIN_specAMIN0, ! FFEINTRIN_specAIMIN0, ! FFEINTRIN_specAJMIN0, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 635,642 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genLOG10, "LOG10", ! FFEINTRIN_specALOG10, /* F77. */ ! FFEINTRIN_specDLOG10, /* F77. */ ! FFEINTRIN_specQLOG10, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genAMIN0, "AMIN0", *** 580,590 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genFLOAT, "FLOAT", ! FFEINTRIN_specFLOAT, ! FFEINTRIN_specFLOATI, ! FFEINTRIN_specFLOATJ, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 651,661 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genMAX, "MAX", ! FFEINTRIN_specMAX0, /* F77. */ ! FFEINTRIN_specAMAX1, /* F77. */ ! FFEINTRIN_specDMAX1, /* F77. */ ! FFEINTRIN_specIMAX0, ! FFEINTRIN_specJMAX0, ! FFEINTRIN_specQMAX1, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genFLOAT, "FLOAT", *** 596,603 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genIDIM, "IDIM", ! FFEINTRIN_specIDIM, ! FFEINTRIN_specIIDIM, ! FFEINTRIN_specJIDIM, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 667,674 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genMAX0, "MAX0", ! FFEINTRIN_specMAX0, /* F77. */ ! FFEINTRIN_specIMAX0, ! FFEINTRIN_specJMAX0, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genIDIM, "IDIM", *** 612,619 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genIDINT, "IDINT", ! FFEINTRIN_specIDINT, ! FFEINTRIN_specIIDINT, ! FFEINTRIN_specJIDINT, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 683,690 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genMAX1, "MAX1", ! FFEINTRIN_specMAX1, /* F77. */ ! FFEINTRIN_specIMAX1, ! FFEINTRIN_specJMAX1, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genIDINT, "IDINT", *** 628,638 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genIDNINT, "IDNINT", ! FFEINTRIN_specIDNINT, ! FFEINTRIN_specIIDNNT, ! FFEINTRIN_specJIDNNT, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 699,709 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genMIN, "MIN", ! FFEINTRIN_specMIN0, /* F77. */ ! FFEINTRIN_specAMIN1, /* F77. */ ! FFEINTRIN_specDMIN1, /* F77. */ ! FFEINTRIN_specIMIN0, ! FFEINTRIN_specJMIN0, ! FFEINTRIN_specQMIN1, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genIDNINT, "IDNINT", *** 644,651 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genIFIX, "IFIX", ! FFEINTRIN_specIFIX, ! FFEINTRIN_specIIFIX, ! FFEINTRIN_specJIFIX, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 715,722 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genMIN0, "MIN0", ! FFEINTRIN_specMIN0, /* F77. */ ! FFEINTRIN_specIMIN0, ! FFEINTRIN_specJMIN0, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genIFIX, "IFIX", *** 660,667 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genIMAG, "IMAG", ! FFEINTRIN_spec_IMAG_C_F2C, ! FFEINTRIN_spec_IMAG_E_F2C, ! FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 731,738 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genMIN1, "MIN1", ! FFEINTRIN_specMIN1, /* F77. */ ! FFEINTRIN_specIMIN1, ! FFEINTRIN_specJMIN1, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genIMAG, "IMAG", *** 676,682 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genIQINT, "IQINT", ! FFEINTRIN_specIIQINT, ! FFEINTRIN_specJIQINT, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 747,758 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genMOD, "MOD", ! FFEINTRIN_specMOD, /* F77. */ ! FFEINTRIN_specAMOD, /* F77. */ ! FFEINTRIN_specDMOD, /* F77. */ ! FFEINTRIN_specIMOD, ! FFEINTRIN_specJMOD, ! FFEINTRIN_specQMOD, ! FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genIQINT, "IQINT", *** 685,688 **** --- 761,775 ---- FFEINTRIN_specNONE, FFEINTRIN_specNONE, + FFEINTRIN_specNONE + ) + DEFGEN (FFEINTRIN_genNINT, "NINT", + FFEINTRIN_specNINT, /* F77. */ + FFEINTRIN_specIDNINT, /* F77. */ + FFEINTRIN_specININT, + FFEINTRIN_specJNINT, + FFEINTRIN_specIIDNNT, + FFEINTRIN_specJIDNNT, + FFEINTRIN_specIIQNNT, + FFEINTRIN_specJIQNNT, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genIQINT, "IQINT", *** 692,698 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genIQNINT, "IQNINT", ! FFEINTRIN_specIIQNNT, ! FFEINTRIN_specJIQNNT, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 779,792 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genREAL, "REAL", ! FFEINTRIN_specREAL, /* F77. */ ! FFEINTRIN_specFLOAT, /* F77. */ ! FFEINTRIN_spec_REAL_R, /* F77. */ ! FFEINTRIN_specSNGL, /* F77. */ ! FFEINTRIN_spec_REAL_C, /* F77. */ ! FFEINTRIN_specFLOATI, ! FFEINTRIN_specFLOATJ, ! FFEINTRIN_specSNGLQ, ! FFEINTRIN_spec_REAL_E, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genIQNINT, "IQNINT", *** 699,702 **** --- 793,805 ---- FFEINTRIN_specNONE, FFEINTRIN_specNONE, + FFEINTRIN_specNONE + ) + DEFGEN (FFEINTRIN_genSIGN, "SIGN", + FFEINTRIN_specISIGN, /* F77. */ + FFEINTRIN_specSIGN, /* F77. */ + FFEINTRIN_specDSIGN, /* F77. */ + FFEINTRIN_specIISIGN, + FFEINTRIN_specJISIGN, + FFEINTRIN_specQSIGN, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genIQNINT, "IQNINT", *** 708,715 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genMAX0, "MAX0", ! FFEINTRIN_specMAX0, ! FFEINTRIN_specIMAX0, ! FFEINTRIN_specJMAX0, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 811,821 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genSIN, "SIN", ! FFEINTRIN_specSIN, /* F77. */ ! FFEINTRIN_specDSIN, /* F77. */ ! FFEINTRIN_specCSIN, /* F77. */ ! FFEINTRIN_specQSIN, ! FFEINTRIN_specCDSIN, ! FFEINTRIN_specZSIN, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genMAX0, "MAX0", *** 719,731 **** FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, ! FFEINTRIN_specNONE ! ) ! DEFGEN (FFEINTRIN_genMAX1, "MAX1", ! FFEINTRIN_specMAX1, ! FFEINTRIN_specIMAX1, ! FFEINTRIN_specJMAX1, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 825,839 ---- FFEINTRIN_specNONE, FFEINTRIN_specNONE, + FFEINTRIN_specNONE + ) + DEFGEN (FFEINTRIN_genSINH, "SINH", + FFEINTRIN_specSINH, /* F77. */ + FFEINTRIN_specDSINH, /* F77. */ + FFEINTRIN_specQSINH, FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genMAX1, "MAX1", *** 733,736 **** --- 841,855 ---- FFEINTRIN_specNONE, FFEINTRIN_specNONE, + FFEINTRIN_specNONE + ) + DEFGEN (FFEINTRIN_genSQRT, "SQRT", + FFEINTRIN_specSQRT, /* F77. */ + FFEINTRIN_specDSQRT, /* F77. */ + FFEINTRIN_specCSQRT, /* F77. */ + FFEINTRIN_specQSQRT, + FFEINTRIN_specCDSQRT, + FFEINTRIN_specZSQRT, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genMAX1, "MAX1", *** 740,747 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genMIN0, "MIN0", ! FFEINTRIN_specMIN0, ! FFEINTRIN_specIMIN0, ! FFEINTRIN_specJMIN0, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 859,866 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genTAN, "TAN", ! FFEINTRIN_specTAN, /* F77. */ ! FFEINTRIN_specDTAN, /* F77. */ ! FFEINTRIN_specQTAN, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genMIN0, "MIN0", *** 756,763 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genMIN1, "MIN1", ! FFEINTRIN_specMIN1, ! FFEINTRIN_specIMIN1, ! FFEINTRIN_specJMIN1, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 875,882 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genTANH, "TANH", ! FFEINTRIN_specTANH, /* F77. */ ! FFEINTRIN_specDTANH, /* F77. */ ! FFEINTRIN_specQTANH, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genCEILING, "CEILING", *** 1012,1047 **** FFEINTRIN_specNONE ) - DEFGEN (FFEINTRIN_genCHAR, "CHAR", /* VXT */ - FFEINTRIN_specCHAR, - FFEINTRIN_spec_CHAR_N, - FFEINTRIN_spec_CHAR_J, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE - ) - DEFGEN (FFEINTRIN_genCONJG, "CONJG", /* VXT */ - FFEINTRIN_specCONJG, - FFEINTRIN_specDCONJG, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE - ) DEFGEN (FFEINTRIN_genCOSD, "COSD", /* VXT */ FFEINTRIN_specCOSD, --- 1131,1134 ---- *************** DEFGEN (FFEINTRIN_genDOT_PRODUCT, "DOT_P *** 1156,1175 **** FFEINTRIN_specNONE ) - DEFGEN (FFEINTRIN_genDPROD, "DPROD", /* F90 */ - FFEINTRIN_specDPROD, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE - ) DEFGEN (FFEINTRIN_genEOSHIFT, "EOSHIFT", /* F90 */ FFEINTRIN_specEOSHIFT, --- 1243,1246 ---- *************** DEFGEN (FFEINTRIN_genIBSET, "IBSET", /* *** 1444,1463 **** FFEINTRIN_specNONE ) - DEFGEN (FFEINTRIN_genICHAR, "ICHAR", /* F90 */ - FFEINTRIN_specICHAR, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE, - FFEINTRIN_specNONE - ) DEFGEN (FFEINTRIN_genIEOR, "IEOR", /* F90, VXT */ FFEINTRIN_specIEOR, --- 1515,1518 ---- *************** DEFGEN (FFEINTRIN_genIEOR, "IEOR", /* F9 *** 1476,1482 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genINDEX, "INDEX", /* F90 */ ! FFEINTRIN_specINDEX, ! FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 1531,1537 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genIMAG, "IMAG", ! FFEINTRIN_spec_IMAG_C_F2C, ! FFEINTRIN_spec_IMAG_E_F2C, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genIOR, "IOR", /* F90, *** 1508,1578 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genISHFT, "ISHFT", /* F90 */ ! FFEINTRIN_specISHFT, ! FFEINTRIN_specIISHFT, ! FFEINTRIN_specJISHFT, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE ! ) ! DEFGEN (FFEINTRIN_genISHFTC, "ISHFTC", /* F90, VXT */ ! FFEINTRIN_specISHFTC, ! FFEINTRIN_specIISHFTC, ! FFEINTRIN_specJISHFTC, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE ! ) ! DEFGEN (FFEINTRIN_genISIGN, "ISIGN", /* F90 */ ! FFEINTRIN_specISIGN, ! FFEINTRIN_specIISIGN, ! FFEINTRIN_specJISIGN, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE ! ) ! DEFGEN (FFEINTRIN_genKIND, "KIND", /* F90 */ ! FFEINTRIN_specKIND, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE ! ) ! DEFGEN (FFEINTRIN_genLBOUND, "LBOUND", /* F90 */ ! FFEINTRIN_specLBOUND, ! FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 1563,1569 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genIQINT, "IQINT", ! FFEINTRIN_specIIQINT, ! FFEINTRIN_specJIQINT, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genLBOUND, "LBOUND", / *** 1588,1594 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genLEN, "LEN", /* F90 */ ! FFEINTRIN_specLEN, ! FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 1579,1585 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genIQNINT, "IQNINT", ! FFEINTRIN_specIIQNNT, ! FFEINTRIN_specJIQNNT, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genLEN, "LEN", /* F90 *** 1604,1611 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genLEN_TRIM, "LEN_TRIM", /* F90 */ ! FFEINTRIN_specLEN_TRIM, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 1595,1602 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genISHFT, "ISHFT", /* F90 */ ! FFEINTRIN_specISHFT, ! FFEINTRIN_specIISHFT, ! FFEINTRIN_specJISHFT, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genLEN_TRIM, "LEN_TRIM *** 1620,1627 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genLGE, "LGE", /* F90 */ ! FFEINTRIN_specLGE, ! FFEINTRIN_specNONE, ! FFEINTRIN_specNONE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 1611,1618 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genISHFTC, "ISHFTC", /* F90, VXT */ ! FFEINTRIN_specISHFTC, ! FFEINTRIN_specIISHFTC, ! FFEINTRIN_specJISHFTC, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genLGE, "LGE", /* F90 *** 1636,1641 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genLGT, "LGT", /* F90 */ ! FFEINTRIN_specLGT, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 1627,1632 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genKIND, "KIND", /* F90 */ ! FFEINTRIN_specKIND, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genLGT, "LGT", /* F90 *** 1652,1657 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genLLE, "LLE", /* F90 */ ! FFEINTRIN_specLLE, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 1643,1648 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genLBOUND, "LBOUND", /* F90 */ ! FFEINTRIN_specLBOUND, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genLLE, "LLE", /* F90 *** 1668,1673 **** FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genLLT, "LLT", /* F90 */ ! FFEINTRIN_specLLT, FFEINTRIN_specNONE, FFEINTRIN_specNONE, --- 1659,1664 ---- FFEINTRIN_specNONE ) ! DEFGEN (FFEINTRIN_genLEN_TRIM, "LEN_TRIM", /* F90 */ ! FFEINTRIN_specLEN_TRIM, FFEINTRIN_specNONE, FFEINTRIN_specNONE, *************** DEFGEN (FFEINTRIN_genMODULO, "MODULO", / *** 1860,1863 **** --- 1851,1870 ---- FFEINTRIN_specNONE ) + DEFGEN (FFEINTRIN_genMVBITS, "MVBITS", + FFEINTRIN_specMVBITS, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE, + FFEINTRIN_specNONE + ) DEFGEN (FFEINTRIN_genNEAREST, "NEAREST", /* F90 */ FFEINTRIN_specNEAREST, *************** DEFGEN (FFEINTRIN_genNONE, "none", *** 2458,2461 **** --- 2465,2469 ---- #define VOID_ FFEINFO_basictypeNONE, FFEINFO_kindtypeNONE, NC_ #define NC_ FFETARGET_charactersizeNONE + #define c0_ ffeintrin_check_0_ #define cI1_ ffeintrin_check_int_1_ #define cL1_ ffeintrin_check_log_1_ *************** DEFGEN (FFEINTRIN_genNONE, "none", *** 2492,2495 **** --- 2500,2504 ---- #define cA3_ ffeintrin_check_char_3_ #define Void_ ffeintrin_check_void_ + DEFIMP (FFEINTRIN_impABS, "ABS", FFECOM_gfrtABS, R_, cR1_) DEFIMP (FFEINTRIN_impACOS, "ACOS", FFECOM_gfrtACOS, R_, cR1_) *************** DEFIMP (FFEINTRIN_imp_REAL_D, "real_d", *** 2581,2584 **** --- 2590,2594 ---- DEFIMP (FFEINTRIN_imp_REAL_I, "real_i", FFECOM_gfrt, R_, cI1_) DEFIMP (FFEINTRIN_imp_REAL_R, "real_r", FFECOM_gfrt, R_, cR1_) + DEFIMP (FFEINTRIN_impABORT, "ABORT", FFECOM_gfrtABORT, VOID_, c0_) DEFIMP (FFEINTRIN_impACHAR, "ACHAR", FFECOM_gfrt, A_, cI1_) DEFIMP (FFEINTRIN_impBIT_SIZE, "BIT_SIZE", FFECOM_gfrt, I_, cI1_) *************** DEFIMP (FFEINTRIN_impCDSIN, "CDSIN", FFE *** 2591,2597 **** --- 2601,2616 ---- DEFIMP (FFEINTRIN_impCDSQRT, "CDSQRT", FFECOM_gfrtCDSQRT, E_, cE1_) DEFIMP (FFEINTRIN_impDCONJG, "DCONJG", FFECOM_gfrtDCONJG, E_, cE1_) + DEFIMP (FFEINTRIN_impDERF, "DERF", FFECOM_gfrtDERF, D_, cD1_) + DEFIMP (FFEINTRIN_impDERFC, "DERFC", FFECOM_gfrtDERFC, D_, cD1_) DEFIMP (FFEINTRIN_impDIMAG, "DIMAG", FFECOM_gfrtDIMAG, D_, cE1_) + DEFIMP (FFEINTRIN_impERF, "ERF", FFECOM_gfrtERF, R_, cR1_) + DEFIMP (FFEINTRIN_impERFC, "ERFC", FFECOM_gfrtERFC, R_, cR1_) + DEFIMP (FFEINTRIN_impEXIT, "EXIT", FFECOM_gfrtEXIT, VOID_, ffeintrin_check_exit_) + DEFIMP (FFEINTRIN_impFLUSH, "FLUSH", FFECOM_gfrtFLUSH, VOID_, ffeintrin_check_flush_) + DEFIMP (FFEINTRIN_impGETARG, "GETARG", FFECOM_gfrtGETARG, VOID_, ffeintrin_check_getarg_) + DEFIMP (FFEINTRIN_impGETENV, "GETENV", FFECOM_gfrtGETENV, VOID_, ffeintrin_check_getenv_) DEFIMP (FFEINTRIN_impIACHAR, "IACHAR", FFECOM_gfrt, I_, cA1_) DEFIMP (FFEINTRIN_impIAND, "IAND", FFECOM_gfrt, I_, cI2_) + DEFIMP (FFEINTRIN_impIARGC, "IARGC", FFECOM_gfrtIARGC, I_, c0_) DEFIMP (FFEINTRIN_impIBCLR, "IBCLR", FFECOM_gfrt, I_, cI2_) DEFIMP (FFEINTRIN_impIBITS, "IBITS", FFECOM_gfrt, I_, cI3_) *************** DEFIMP (FFEINTRIN_impLOC, "LOC", FFECOM_ *** 2604,2607 **** --- 2623,2628 ---- DEFIMP (FFEINTRIN_impMVBITS, "MVBITS", FFECOM_gfrt, VOID_, ffeintrin_check_mvbits_) DEFIMP (FFEINTRIN_impNOT, "NOT", FFECOM_gfrt, I_, cI1_) + DEFIMP (FFEINTRIN_impSIGNAL, "SIGNAL", FFECOM_gfrt, VOID_, ffeintrin_check_signal_) + DEFIMP (FFEINTRIN_impSYSTEM, "SYSTEM", FFECOM_gfrt, VOID_, ffeintrin_check_system_) DEFIMP (FFEINTRIN_imp_AND_L, "and_l", FFECOM_gfrt, L_, cL2_) DEFIMP (FFEINTRIN_imp_CMPLX_E, "cmplx_e", FFECOM_gfrt, C_, cE1or2_) *************** DEFIMP (FFEINTRIN_imp_RSHIFT_L, "rshift_ *** 2622,2625 **** --- 2643,2647 ---- DEFIMP (FFEINTRIN_imp_XOR_L, "xor_l", FFECOM_gfrt, L_, cL2_) DEFIMP (FFEINTRIN_impNONE, "none", FFECOM_gfrt, VOID_, Void_) + #undef I_ #undef L_ *************** DEFIMP (FFEINTRIN_impNONE, "none", FFECO *** 2649,2652 **** --- 2671,2680 ---- meaning the same thing (convert INTEGER to REAL). */ + /* Currently this list starts with the list of F77-standard intrinsics + in alphabetical order, then continues with the list of all other + intrinsics. So, unless mistakes are made in the first portion, no + new intrinsics should be added to that portion (since F77 isn't + changing). */ + DEFSPEC (FFEINTRIN_specABS, "ABS", *************** DEFSPEC (FFEINTRIN_spec_REAL_R, *** 3201,3204 **** --- 3229,3238 ---- FFEINTRIN_imp_REAL_R ) + DEFSPEC (FFEINTRIN_specABORT, + "ABORT", + FALSE, + FFEINTRIN_familyF2U, + FFEINTRIN_impABORT + ) DEFSPEC (FFEINTRIN_specACHAR, "ACHAR", *************** DEFSPEC (FFEINTRIN_specDCOSD, *** 3429,3432 **** --- 3463,3478 ---- FFEINTRIN_impNONE ) + DEFSPEC (FFEINTRIN_specDERF, + "DERF", + FALSE, + FFEINTRIN_familyF2U, + FFEINTRIN_impDERF + ) + DEFSPEC (FFEINTRIN_specDERFC, + "DERFC", + FALSE, + FFEINTRIN_familyF2U, + FFEINTRIN_impDERFC + ) DEFSPEC (FFEINTRIN_specDFLOAT, "DFLOAT", *************** DEFSPEC (FFEINTRIN_specEPSILON, *** 3495,3498 **** --- 3541,3562 ---- FFEINTRIN_impNONE ) + DEFSPEC (FFEINTRIN_specERF, + "ERF", + FALSE, + FFEINTRIN_familyF2U, + FFEINTRIN_impERF + ) + DEFSPEC (FFEINTRIN_specERFC, + "ERFC", + FALSE, + FFEINTRIN_familyF2U, + FFEINTRIN_impERFC + ) + DEFSPEC (FFEINTRIN_specEXIT, + "EXIT", + FALSE, + FFEINTRIN_familyF2U, + FFEINTRIN_impEXIT + ) DEFSPEC (FFEINTRIN_specEXPONENT, "EXPONENT", *************** DEFSPEC (FFEINTRIN_specFLOOR, *** 3519,3522 **** --- 3583,3592 ---- FFEINTRIN_impNONE ) + DEFSPEC (FFEINTRIN_specFLUSH, + "FLUSH", + FALSE, + FFEINTRIN_familyF2U, + FFEINTRIN_impFLUSH + ) DEFSPEC (FFEINTRIN_specFRACTION, "FRACTION", *************** DEFSPEC (FFEINTRIN_specFRACTION, *** 3525,3528 **** --- 3595,3610 ---- FFEINTRIN_impNONE ) + DEFSPEC (FFEINTRIN_specGETARG, + "GETARG", + FALSE, + FFEINTRIN_familyF2U, + FFEINTRIN_impGETARG + ) + DEFSPEC (FFEINTRIN_specGETENV, + "GETENV", + FALSE, + FFEINTRIN_familyF2U, + FFEINTRIN_impGETENV + ) DEFSPEC (FFEINTRIN_specHUGE, "HUGE", *************** DEFSPEC (FFEINTRIN_specIAND, *** 3543,3546 **** --- 3625,3634 ---- FFEINTRIN_impIAND ) + DEFSPEC (FFEINTRIN_specIARGC, + "IARGC", + FALSE, + FFEINTRIN_familyF2U, + FFEINTRIN_impIARGC + ) DEFSPEC (FFEINTRIN_specIBCLR, "IBCLR", *************** DEFSPEC (FFEINTRIN_specLOC, *** 3906,3910 **** "LOC", FALSE, ! FFEINTRIN_familyVXT, FFEINTRIN_impLOC ) --- 3994,3998 ---- "LOC", FALSE, ! FFEINTRIN_familyF2U, FFEINTRIN_impLOC ) *************** DEFSPEC (FFEINTRIN_specSHAPE, *** 4275,4278 **** --- 4363,4372 ---- FFEINTRIN_impNONE ) + DEFSPEC (FFEINTRIN_specSIGNAL, + "SIGNAL", + FALSE, + FFEINTRIN_familyF2U, + FFEINTRIN_impSIGNAL + ) DEFSPEC (FFEINTRIN_specSIND, "SIND", *************** DEFSPEC (FFEINTRIN_specSUM, *** 4304,4307 **** --- 4398,4407 ---- FFEINTRIN_familyF90, FFEINTRIN_impNONE + ) + DEFSPEC (FFEINTRIN_specSYSTEM, + "SYSTEM", + FALSE, + FFEINTRIN_familyF2U, + FFEINTRIN_impSYSTEM ) DEFSPEC (FFEINTRIN_specSYSTEM_CLOCK, diff -rcp2N g77-0.5.15/f/intrin.h g77-0.5.16/f/intrin.h *** g77-0.5.15/f/intrin.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/intrin.h Wed Aug 30 15:53:36 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ *************** typedef enum *** 36,39 **** --- 37,41 ---- FFEINTRIN_familyF2C, /* f2c intrinsics. */ FFEINTRIN_familyF2Z, /* f2c DOUBLE COMPLEX intrinsics. */ + FFEINTRIN_familyF2U, /* libf2c/libU77 UNIX system intrinsics. */ FFEINTRIN_family, } ffeintrinFamily; *************** void ffeintrin_fulfill_specific (ffebld *** 87,91 **** #if FFECOM_targetCURRENT == FFECOM_targetGCC ffecomGfrt ffeintrin_gfrt (ffeintrinImp imp); ! #endif void ffeintrin_init_0 (void); #define ffeintrin_init_1() --- 89,93 ---- #if FFECOM_targetCURRENT == FFECOM_targetGCC ffecomGfrt ffeintrin_gfrt (ffeintrinImp imp); ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ void ffeintrin_init_0 (void); #define ffeintrin_init_1() diff -rcp2N g77-0.5.15/f/lab.c g77-0.5.16/f/lab.c *** g77-0.5.15/f/lab.c Wed Feb 15 16:58:40 1995 --- g77-0.5.16/f/lab.c Wed Aug 30 15:53:36 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: diff -rcp2N g77-0.5.15/f/lab.h g77-0.5.16/f/lab.h *** g77-0.5.15/f/lab.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/lab.h Wed Aug 30 15:53:35 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/lang-options.h g77-0.5.16/f/lang-options.h *** g77-0.5.15/f/lang-options.h --- g77-0.5.16/f/lang-options.h Wed Aug 30 15:53:35 1995 *************** *** 0 **** --- 1,114 ---- + /* lang-options.h file for Fortran + Copyright (C) 1995 Free Software Foundation, Inc. + Contributed by James Craig Burley (burley@gnu.ai.mit.edu). + + This file is part of GNU Fortran. + + GNU Fortran 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, or (at your option) + any later version. + + GNU Fortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with GNU Fortran; see the file COPYING. If not, write to + the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA + 02111-1307, USA. + + */ + + /* This is the contribution to the `lang_options' array in gcc.c for + g77. */ + + #ifdef __STDC__ /* To be consistent with lang-specs.h. Maybe avoid + overflowing some old compiler's tables, etc. */ + + "-fversion", + "-fnull-version", + "-fident", + "-fno-ident", + "-ff90", + "-fno-f90", + "-fautomatic", + "-fno-automatic", + "-fdollar-ok", + "-fno-dollar-ok", + "-ff2c", + "-fno-f2c", + "-ff2c-library", + "-fno-f2c-library", + "-ffree-form", + "-fno-free-form", + "-ffixed-form", + "-fno-fixed-form", + "-fpedantic", + "-fno-pedantic", + "-fvxt-not-f90", + "-ff90-not-vxt", + "-fugly", + "-fno-ugly", + "-fugly-args", + "-fno-ugly-args", + "-fugly-init", + "-fno-ugly-init", + "-fdebug", + "-fno-debug", + "-finit-local-zero", + "-fno-init-local-zero", + "-fbackslash", + "-fno-backslash", + "-funderscoring", + "-fno-underscoring", + "-fintrin-case-initcap", + "-fintrin-case-upper", + "-fintrin-case-lower", + "-fintrin-case-any", + "-fmatch-case-initcap", + "-fmatch-case-upper", + "-fmatch-case-lower", + "-fmatch-case-any", + "-fsource-case-upper", + "-fsource-case-lower", + "-fsource-case-preserve", + "-fsymbol-case-initcap", + "-fsymbol-case-upper", + "-fsymbol-case-lower", + "-fsymbol-case-any", + "-fcase-strict-upper", + "-fcase-strict-lower", + "-fcase-initcap", + "-fcase-upper", + "-fcase-lower", + "-fcase-preserve", + "-fdcp-intrinsics-delete", + "-fdcp-intrinsics-hide", + "-fdcp-intrinsics-disable", + "-fdcp-intrinsics-enable", + "-ff2c-intrinsics-delete", + "-ff2c-intrinsics-hide", + "-ff2c-intrinsics-disable", + "-ff2c-intrinsics-enable", + "-ff90-intrinsics-delete", + "-ff90-intrinsics-hide", + "-ff90-intrinsics-disable", + "-ff90-intrinsics-enable", + "-fmil-intrinsics-delete", + "-fmil-intrinsics-hide", + "-fmil-intrinsics-disable", + "-fmil-intrinsics-enable", + "-fvxt-intrinsics-delete", + "-fvxt-intrinsics-hide", + "-fvxt-intrinsics-disable", + "-fvxt-intrinsics-enable", + "-Wimplicit", + "-Wno-implicit", + "-Wall", + /* Prefix options. */ + "-I", + "-ffixed-line-length-", + + #endif diff -rcp2N g77-0.5.15/f/lang-specs.h g77-0.5.16/f/lang-specs.h *** g77-0.5.15/f/lang-specs.h --- g77-0.5.16/f/lang-specs.h Wed Aug 30 15:53:35 1995 *************** *** 0 **** --- 1,81 ---- + /* lang-specs.h file for Fortran + Copyright (C) 1995 Free Software Foundation, Inc. + Contributed by James Craig Burley (burley@gnu.ai.mit.edu). + + This file is part of GNU Fortran. + + GNU Fortran 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, or (at your option) + any later version. + + GNU Fortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with GNU Fortran; see the file COPYING. If not, write to + the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA + 02111-1307, USA. + + */ + + /* This is the contribution to the `default_compilers' array in gcc.c for + g77. */ + + #ifdef __STDC__ /* Else stringizing of OO below won't work, but in + K&R case we're not building the f77 language. */ + + #ifdef OBJECT_SUFFIX /* Not defined compiling gcc.c prior to 2.7.0. */ + #define OO "%O" + #else + #define OO ".o" + #endif + + {".F", "@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 + with substitution of names not prefixed by `_' by using %P + rather than %p (although this isn't consistent with SGI and + 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 %{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} \ + %{!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" OO "}}%{!c:-o %d%w%u" OO "}\ + %{!pipe:%g.s} %A\n }}}}"}, + {".f", "@f77"}, + {".for", "@f77"}, + {"@f77", + "%{!M:%{!MM:%{!E:f771 %i \ + %{!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" OO "}}%{!c:-o %d%w%u" OO "}\ + %{!pipe:%g.s} %A\n }}}}"}, + + #undef OO + + #endif diff -rcp2N g77-0.5.15/f/lex.c g77-0.5.16/f/lex.c *** g77-0.5.15/f/lex.c Tue May 9 03:38:53 1995 --- g77-0.5.16/f/lex.c Wed Aug 30 15:53:35 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "proj.h" --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "proj.h" *************** the Free Software Foundation, 675 Mass A *** 29,32 **** --- 30,35 ---- #if FFECOM_targetCURRENT == FFECOM_targetGCC #include "config.j" + #include "flags.j" + #include "input.j" #include "tree.j" #endif *************** static void ffelex_display_token_ (void) *** 45,48 **** --- 48,55 ---- #endif static void ffelex_finish_statement_ (void); + #if FFECOM_targetCURRENT == FFECOM_targetGCC + static int ffelex_get_directive_line_ (char **text, FILE *finput); + static int ffelex_hash_ (FILE *f); + #endif static ffewhereColumnNumber ffelex_image_char_ (int c, ffewhereColumnNumber col); *************** static void ffelex_include_ (void); *** 50,53 **** --- 57,61 ---- static bool ffelex_is_free_char_ctx_contin_ (ffewhereColumnNumber col); static bool ffelex_is_free_nonc_ctx_contin_ (ffewhereColumnNumber col); + static void ffelex_next_line_ (void); static void ffelex_send_token_ (void); static ffelexHandler ffelex_swallow_tokens_ (ffelexToken t); *************** static unsigned long int ffelex_number_o *** 150,154 **** ffelex_number_of_tokens_ to 0, should be 0 or 1 in most cases. (Fixed-form source only.) */ ! static int ffelex_label_tokens_; /* Metering for token management, to catch token-memory leaks. */ --- 158,162 ---- ffelex_number_of_tokens_ to 0, should be 0 or 1 in most cases. (Fixed-form source only.) */ ! static unsigned long int ffelex_label_tokens_; /* Metering for token management, to catch token-memory leaks. */ *************** static char ffelex_raw_char_; *** 180,183 **** --- 188,197 ---- static bool ffelex_backslash_reconsider_ = FALSE; + /* Characters preread before lexing happened (might include EOF). */ + static int *ffelex_kludge_chars_ = NULL; + + /* Doing the kludge processing, so not initialized yet. */ + static bool ffelex_kludge_flag_ = FALSE; + /* The beginning of a (possible) CHARACTER/HOLLERITH token. */ static ffewhereLine ffelex_raw_where_line_; *************** ffelex_backslash_ (int c, ffewhereColumn *** 266,270 **** ffebad_finish (); } ! if (flag_traditional) return c; --- 280,284 ---- ffebad_finish (); } ! if (flag_traditional) return c; *************** ffelex_backslash_ (int c, ffewhereColumn *** 288,292 **** #if 0 /* Inappropriate for Fortran. */ case '\n': ! lineno++; *ignore_ptr = 1; return 0; --- 302,306 ---- #if 0 /* Inappropriate for Fortran. */ case '\n': ! ffelex_next_line_ (); *ignore_ptr = 1; return 0; *************** ffelex_backslash_ (int c, ffewhereColumn *** 422,426 **** || (count > 1 && ((1 << (TYPE_PRECISION (integer_type_node) - (count - 1) * 4)) ! <= firstdig))) { ffebad_start_msg ("Hex escape at %0 out of range", --- 436,440 ---- || (count > 1 && ((1 << (TYPE_PRECISION (integer_type_node) - (count - 1) * 4)) ! <= (int) firstdig))) { ffebad_start_msg ("Hex escape at %0 out of range", *************** ffelex_bad_here_ (int n, ffewhereLineNum *** 549,552 **** --- 563,852 ---- } + #if FFECOM_targetCURRENT == FFECOM_targetGCC + static int + ffelex_getc_ (FILE *finput) + { + int c; + + if (ffelex_kludge_chars_ == NULL) + return getc (finput); + + c = *ffelex_kludge_chars_++; + if (c != 0) + return c; + + ffelex_kludge_chars_ = NULL; + return getc (finput); + } + + #endif + #if FFECOM_targetCURRENT == FFECOM_targetGCC + static int + ffelex_cfebackslash_ (int *use_d, int *d, FILE *finput) + { + register int c = getc (finput); + register int code; + register unsigned count; + unsigned firstdig = 0; + int nonnull; + + *use_d = 0; + + switch (c) + { + case 'x': + if (warn_traditional) + warning ("the meaning of `\\x' varies with -traditional"); + + if (flag_traditional) + return c; + + code = 0; + count = 0; + nonnull = 0; + while (1) + { + c = getc (finput); + if (!(c >= 'a' && c <= 'f') + && !(c >= 'A' && c <= 'F') + && !(c >= '0' && c <= '9')) + { + *use_d = 1; + *d = c; + break; + } + code *= 16; + if (c >= 'a' && c <= 'f') + code += c - 'a' + 10; + if (c >= 'A' && c <= 'F') + code += c - 'A' + 10; + if (c >= '0' && c <= '9') + code += c - '0'; + if (code != 0 || count != 0) + { + if (count == 0) + firstdig = code; + count++; + } + nonnull = 1; + } + if (! nonnull) + error ("\\x used with no following hex digits"); + else if (count == 0) + /* Digits are all 0's. Ok. */ + ; + else if ((count - 1) * 4 >= TYPE_PRECISION (integer_type_node) + || (count > 1 + && (((unsigned) 1 + << (TYPE_PRECISION (integer_type_node) - (count - 1) + * 4)) + <= firstdig))) + pedwarn ("hex escape out of range"); + return code; + + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': + code = 0; + count = 0; + while ((c <= '7') && (c >= '0') && (count++ < 3)) + { + code = (code * 8) + (c - '0'); + c = getc (finput); + } + *use_d = 1; + *d = c; + return code; + + case '\\': case '\'': case '"': + return c; + + case '\n': + ffelex_next_line_ (); + *use_d = 2; + return 0; + + case EOF: + *use_d = 1; + *d = EOF; + return EOF; + + case 'n': + return TARGET_NEWLINE; + + case 't': + return TARGET_TAB; + + case 'r': + return TARGET_CR; + + case 'f': + return TARGET_FF; + + case 'b': + return TARGET_BS; + + case 'a': + if (warn_traditional) + warning ("the meaning of `\\a' varies with -traditional"); + + if (flag_traditional) + return c; + return TARGET_BELL; + + case 'v': + #if 0 /* Vertical tab is present in common usage compilers. */ + if (flag_traditional) + return c; + #endif + return TARGET_VT; + + case 'e': + case 'E': + if (pedantic) + pedwarn ("non-ANSI-standard escape sequence, `\\%c'", c); + return 033; + + case '?': + return c; + + /* `\(', etc, are used at beginning of line to avoid confusing Emacs. */ + case '(': + case '{': + case '[': + /* `\%' is used to prevent SCCS from getting confused. */ + case '%': + if (pedantic) + pedwarn ("non-ANSI escape sequence `\\%c'", c); + return c; + } + if (c >= 040 && c < 0177) + pedwarn ("unknown escape sequence `\\%c'", c); + else + pedwarn ("unknown escape sequence: `\\' followed by char code 0x%x", c); + return c; + } + + #endif + /* A miniature version of the C front-end lexer. */ + + #if FFECOM_targetCURRENT == FFECOM_targetGCC + static int + ffelex_cfelex_ (ffelexToken *xtoken, FILE *finput, int c) + { + ffelexToken token; + char buff[129]; + char *p; + char *q; + char *r; + register unsigned buffer_length; + + if ((*xtoken != NULL) && !ffelex_kludge_flag_) + ffelex_token_kill (*xtoken); + + switch (c) + { + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + buffer_length = ARRAY_SIZE (buff); + p = &buff[0]; + q = p; + r = &buff[buffer_length]; + for (;;) + { + *p++ = c; + if (p >= r) + { + register unsigned bytes_used = (p - q); + + buffer_length *= 2; + q = (char *)xrealloc (q, buffer_length); + p = &q[bytes_used]; + r = &q[buffer_length]; + } + c = ffelex_getc_ (finput); + if (!isdigit (c)) + break; + } + *p = '\0'; + token = ffelex_token_new_number (q, ffewhere_line_unknown (), + ffewhere_column_unknown ()); + + if (q != &buff[0]) + free (q); + + break; + + case '\"': + buffer_length = ARRAY_SIZE (buff); + p = &buff[0]; + q = p; + r = &buff[buffer_length]; + c = ffelex_getc_ (finput); + for (;;) + { + bool done = FALSE; + int use_d = 0; + int d; + + switch (c) + { + case '\"': + c = getc (finput); + done = TRUE; + break; + + case '\\': /* ~~~~~ */ + c = ffelex_cfebackslash_ (&use_d, &d, finput); + break; + + case EOF: + case '\n': + fatal ("Badly formed directive -- no closing quote"); + done = TRUE; + break; + + default: + break; + } + if (done) + break; + + if (use_d != 2) /* 0=>c, 1=>cd, 2=>nil. */ + { + *p++ = c; + if (p >= r) + { + register unsigned bytes_used = (p - q); + + buffer_length = bytes_used * 2; + q = (char *)xrealloc (q, buffer_length); + p = &q[bytes_used]; + r = &q[buffer_length]; + } + } + if (use_d == 1) + c = d; + else + c = getc (finput); + } + *p = '\0'; + token = ffelex_token_new_character (q, ffewhere_line_unknown (), + ffewhere_column_unknown ()); + + if (q != &buff[0]) + free (q); + + break; + + default: + token = NULL; + break; + } + + *xtoken = token; + return c; + } + #endif + #if 0 static void *************** ffelex_display_token_ () *** 555,559 **** fprintf (stdout, "; Token #%lu is %s (line %" ffewhereLineNumber_f "u, col %" ffewhereColumnNumber_f "u)", ! (unsigned long) ffelex_number_of_tokens_, ffelex_type_string_ (ffelex_token_->type), ffewhere_line_number (ffelex_token_->where_line), --- 855,859 ---- fprintf (stdout, "; Token #%lu is %s (line %" ffewhereLineNumber_f "u, col %" ffewhereColumnNumber_f "u)", ! ffelex_number_of_tokens_, ffelex_type_string_ (ffelex_token_->type), ffewhere_line_number (ffelex_token_->where_line), *************** ffelex_display_token_ () *** 569,572 **** --- 869,923 ---- #endif + #if FFECOM_targetCURRENT == FFECOM_targetGCC + static void + ffelex_file_pop_ (char *input_filename) + { + if (input_file_stack->next) + { + struct file_stack *p = input_file_stack; + input_file_stack = p->next; + free (p); + input_file_stack_tick++; + #ifdef DWARF_DEBUGGING_INFO + if (debug_info_level == DINFO_LEVEL_VERBOSE + && write_symbols == DWARF_DEBUG) + dwarfout_resume_previous_source_file (input_file_stack->line); + #endif /* DWARF_DEBUGGING_INFO */ + } + else + error ("#-lines for entering and leaving files don't match"); + + /* Now that we've pushed or popped the input stack, + update the name in the top element. */ + if (input_file_stack) + input_file_stack->name = input_filename; + } + + #endif + #if FFECOM_targetCURRENT == FFECOM_targetGCC + static void + ffelex_file_push_ (int old_lineno, char *input_filename) + { + struct file_stack *p + = (struct file_stack *) xmalloc (sizeof (struct file_stack)); + + input_file_stack->line = old_lineno; + p->next = input_file_stack; + p->name = input_filename; + input_file_stack = p; + input_file_stack_tick++; + #ifdef DWARF_DEBUGGING_INFO + if (debug_info_level == DINFO_LEVEL_VERBOSE + && write_symbols == DWARF_DEBUG) + dwarfout_start_new_source_file (input_filename); + #endif /* DWARF_DEBUGGING_INFO */ + + /* Now that we've pushed or popped the input stack, + update the name in the top element. */ + if (input_file_stack) + input_file_stack->name = input_filename; + } + + #endif static void ffelex_finish_statement_ () *************** ffelex_finish_statement_ () *** 637,640 **** --- 988,1386 ---- } + /* Copied from gcc/c-common.c get_directive_line. */ + + #if FFECOM_targetCURRENT == FFECOM_targetGCC + static int + ffelex_get_directive_line_ (char **text, FILE *finput) + { + static char *directive_buffer = NULL; + static unsigned buffer_length = 0; + register char *p; + register char *buffer_limit; + register int looking_for = 0; + register int char_escaped = 0; + + if (buffer_length == 0) + { + directive_buffer = (char *)xmalloc (128); + buffer_length = 128; + } + + buffer_limit = &directive_buffer[buffer_length]; + + for (p = directive_buffer; ; ) + { + int c; + + /* Make buffer bigger if it is full. */ + if (p >= buffer_limit) + { + register unsigned bytes_used = (p - directive_buffer); + + buffer_length *= 2; + directive_buffer + = (char *)xrealloc (directive_buffer, buffer_length); + p = &directive_buffer[bytes_used]; + buffer_limit = &directive_buffer[buffer_length]; + } + + c = getc (finput); + + /* Discard initial whitespace. */ + if ((c == ' ' || c == '\t') && p == directive_buffer) + continue; + + /* Detect the end of the directive. */ + if ((c == '\n' && looking_for == 0) + || c == EOF) + { + if (looking_for != 0) + fatal ("Bad directive -- missing close-quote"); + + *p++ = '\0'; + *text = directive_buffer; + return c; + } + + *p++ = c; + if (c == '\n') + ffelex_next_line_ (); + + /* Handle string and character constant syntax. */ + if (looking_for) + { + if (looking_for == c && !char_escaped) + looking_for = 0; /* Found terminator... stop looking. */ + } + else + if (c == '\'' || c == '"') + looking_for = c; /* Don't stop buffering until we see another + another one of these (or an EOF). */ + + /* Handle backslash. */ + char_escaped = (c == '\\' && ! char_escaped); + } + } + #endif + + /* Handle # directives that make it through (or are generated by) the + preprocessor. As much as reasonably possible, emulate the behavior + of the gcc compiler phase cc1, though interactions between #include + and INCLUDE might possibly produce bizarre results in terms of + error reporting and the generation of debugging info vis-a-vis the + locations of some things. + + Returns the next character unhandled, which is always newline or EOF. */ + + #if FFECOM_targetCURRENT == FFECOM_targetGCC + static int + ffelex_hash_ (FILE *finput) + { + register int c; + ffelexToken token = NULL; + + /* Read first nonwhite char after the `#'. */ + + c = ffelex_getc_ (finput); + while (c == ' ' || c == '\t') + c = ffelex_getc_ (finput); + + /* If a letter follows, then if the word here is `line', skip + it and ignore it; otherwise, ignore the line, with an error + if the word isn't `pragma', `ident', `define', or `undef'. */ + + if ((c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')) + { + if (c == 'p') + { + if (getc (finput) == 'r' + && getc (finput) == 'a' + && getc (finput) == 'g' + && getc (finput) == 'm' + && getc (finput) == 'a' + && ((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 */ + } + } + + else if (c == 'd') + { + if (getc (finput) == 'e' + && getc (finput) == 'f' + && getc (finput) == 'i' + && getc (finput) == 'n' + && getc (finput) == 'e' + && ((c = getc (finput)) == ' ' || c == '\t' || c == '\n' + || c == EOF)) + { + char *text; + + c = ffelex_get_directive_line_ (&text, finput); + + #ifdef DWARF_DEBUGGING_INFO + if ((debug_info_level == DINFO_LEVEL_VERBOSE) + && (write_symbols == DWARF_DEBUG)) + dwarfout_define (lineno, text); + #endif /* DWARF_DEBUGGING_INFO */ + + goto skipline; + } + } + else if (c == 'u') + { + if (getc (finput) == 'n' + && getc (finput) == 'd' + && getc (finput) == 'e' + && getc (finput) == 'f' + && ((c = getc (finput)) == ' ' || c == '\t' || c == '\n' + || c == EOF)) + { + char *text; + + c = ffelex_get_directive_line_ (&text, finput); + + #ifdef DWARF_DEBUGGING_INFO + if ((debug_info_level == DINFO_LEVEL_VERBOSE) + && (write_symbols == DWARF_DEBUG)) + dwarfout_undef (lineno, text); + #endif /* DWARF_DEBUGGING_INFO */ + + goto skipline; + } + } + else if (c == 'l') + { + if (getc (finput) == 'i' + && getc (finput) == 'n' + && getc (finput) == 'e' + && ((c = getc (finput)) == ' ' || c == '\t')) + goto linenum; + } + else if (c == 'i') + { + if (getc (finput) == 'd' + && getc (finput) == 'e' + && getc (finput) == 'n' + && getc (finput) == 't' + && ((c = getc (finput)) == ' ' || c == '\t')) + { + /* #ident. The pedantic warning is now in cccp.c. */ + + /* Here we have just seen `#ident '. + A string constant should follow. */ + + while (c == ' ' || c == '\t') + c = getc (finput); + + /* If no argument, ignore the line. */ + if (c == '\n' || c == EOF) + return c; + + c = ffelex_cfelex_ (&token, finput, c); + + if ((token == NULL) + || (ffelex_token_type (token) != FFELEX_typeCHARACTER)) + { + error ("invalid #ident"); + goto skipline; + } + + if (ffe_is_ident ()) + { + #ifdef ASM_OUTPUT_IDENT + ASM_OUTPUT_IDENT (asm_out_file, + ffelex_token_text (token)); + #endif + } + + /* Skip the rest of this line. */ + goto skipline; + } + } + + error ("undefined or invalid # directive"); + goto skipline; + } + + linenum: + /* Here we have either `#line' or `# '. + In either case, it should be a line number; a digit should follow. */ + + while (c == ' ' || c == '\t') + c = ffelex_getc_ (finput); + + /* If the # is the only nonwhite char on the line, + just ignore it. Check the new newline. */ + if (c == '\n' || c == EOF) + return c; + + /* Something follows the #; read a token. */ + + c = ffelex_cfelex_ (&token, finput, c); + + if ((token != NULL) + && (ffelex_token_type (token) == FFELEX_typeNUMBER)) + { + int old_lineno = lineno; + char *old_input_filename = input_filename; + ffewhereFile wf; + + /* subtract one, because it is the following line that + gets the specified number */ + int l = atoi (ffelex_token_text (token)) - 1; + + /* Is this the last nonwhite stuff on the line? */ + while (c == ' ' || c == '\t') + c = ffelex_getc_ (finput); + if (c == '\n' || c == EOF) + { + /* No more: store the line number and check following line. */ + lineno = l; + if (!ffelex_kludge_flag_) + { + ffewhere_file_set (NULL, TRUE, (ffewhereLineNumber) l); + + if (token != NULL) + ffelex_token_kill (token); + } + return c; + } + + /* More follows: it must be a string constant (filename). */ + + /* Read the string constant. */ + c = ffelex_cfelex_ (&token, finput, c); + + if ((token == NULL) + || (ffelex_token_type (token) != FFELEX_typeCHARACTER)) + { + error ("invalid #line"); + goto skipline; + } + + lineno = l; + + if (ffelex_kludge_flag_) + input_filename = ffelex_token_text (token); + else + { + wf = ffewhere_file_new (ffelex_token_text (token), + ffelex_token_length (token)); + input_filename = ffewhere_file_name (wf); + ffewhere_file_set (wf, TRUE, (ffewhereLineNumber) l); + } + + #if 0 /* Not sure what g77 should do with this yet. */ + /* Each change of file name + reinitializes whether we are now in a system header. */ + in_system_header = 0; + #endif + + if (main_input_filename == 0) + main_input_filename = input_filename; + + /* Is this the last nonwhite stuff on the line? */ + while (c == ' ' || c == '\t') + c = getc (finput); + if (c == '\n' || c == EOF) + { + if (!ffelex_kludge_flag_) + { + /* Update the name in the top element of input_file_stack. */ + if (input_file_stack) + input_file_stack->name = input_filename; + + if (token != NULL) + ffelex_token_kill (token); + } + return c; + } + + c = ffelex_cfelex_ (&token, finput, c); + + /* `1' after file name means entering new file. + `2' after file name means just left a file. */ + + if ((token != NULL) + && (ffelex_token_type (token) == FFELEX_typeNUMBER)) + { + int num = atoi (ffelex_token_text (token)); + + if (ffelex_kludge_flag_) + { + lineno = 1; + input_filename = old_input_filename; + fatal ("Use `#line ...' instead of `# ...' in first line"); + } + + if (num == 1) + { + /* Pushing to a new file. */ + ffelex_file_push_ (old_lineno, input_filename); + } + else if (num == 2) + { + /* Popping out of a file. */ + ffelex_file_pop_ (input_filename); + } + + /* Is this the last nonwhite stuff on the line? */ + while (c == ' ' || c == '\t') + c = getc (finput); + if (c == '\n' || c == EOF) + { + if (token != NULL) + ffelex_token_kill (token); + return c; + } + + c = ffelex_cfelex_ (&token, finput, c); + } + + /* `3' after file name means this is a system header file. */ + + #if 0 /* Not sure what g77 should do with this yet. */ + if ((token != NULL) + && (ffelex_token_type (token) == FFELEX_typeNUMBER) + && (atoi (ffelex_token_text (token)) == 3)) + in_system_header = 1; + #endif + + while (c == ' ' || c == '\t') + c = getc (finput); + if (((token != NULL) + || (c != '\n' && c != EOF)) + && ffelex_kludge_flag_) + { + lineno = 1; + input_filename = old_input_filename; + fatal ("Use `#line ...' instead of `# ...' in first line"); + } + } + else + error ("invalid #-line"); + + /* skip the rest of this line. */ + skipline: + if ((token != NULL) && !ffelex_kludge_flag_) + ffelex_token_kill (token); + while ((c = getc (finput)) != EOF && c != '\n') + ; + return c; + } + #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ + /* "Image" a character onto the card image, return incremented column number. *************** ffelex_include_ () *** 746,749 **** --- 1492,1497 ---- ffewhereFile current_wf = ffelex_current_wf_; ffewhereLineNumber linecount_current = ffelex_linecount_current_; + ffewhereLineNumber linecount_offset + = ffewhere_line_filelinenum (current_wl); #if FFECOM_targetCURRENT == FFECOM_targetGCC int old_lineno = lineno; *************** ffelex_include_ () *** 763,767 **** ffelex_set_include_ = FALSE; ! ffewhere_file_begin (current_wf, include_wherefile); if (ffelex_include_free_form_) ffelex_file_free (include_wherefile, include_file); --- 1511,1522 ---- ffelex_set_include_ = FALSE; ! ffelex_next_line_ (); ! ! ffewhere_file_set (include_wherefile, TRUE, 0); ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! ffelex_file_push_ (old_lineno, ffewhere_file_name (include_wherefile)); ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ ! if (ffelex_include_free_form_) ffelex_file_free (include_wherefile, include_file); *************** ffelex_include_ () *** 768,772 **** else ffelex_file_fixed (include_wherefile, include_file); ! ffewhere_file_end (include_wherefile, current_wf); ffecom_close_include (include_file); --- 1523,1533 ---- else ffelex_file_fixed (include_wherefile, include_file); ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! ffelex_file_pop_ (ffewhere_file_name (current_wf)); ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ ! ! ffewhere_file_set (current_wf, TRUE, linecount_offset); ! ffecom_close_include (include_file); *************** ffelex_is_free_nonc_ctx_contin_ (ffewher *** 838,841 **** --- 1599,1612 ---- static void + ffelex_next_line_ () + { + ffelex_linecount_current_ = ffelex_linecount_next_; + ++ffelex_linecount_next_; + #if FFECOM_targetCURRENT == FFECOM_targetGCC + ++lineno; + #endif + } + + static void ffelex_send_token_ () { *************** ffelex_file_fixed (ffewhereFile wf, FILE *** 962,965 **** --- 1733,1737 ---- char label_string[6]; /* Text of label. */ int labi; /* Length of label text. */ + bool finish_statement; /* Previous statement finished? */ bool just_do_label; /* Nothing but label (and continuation?) on line. */ *************** ffelex_file_fixed (ffewhereFile wf, FILE *** 990,994 **** /* Come here to get a new line. */ ! beginning_of_line: /* :::::::::::::::::::: */ disallow_continuation_line = FALSE; --- 1762,1766 ---- /* Come here to get a new line. */ ! beginning_of_line: /* :::::::::::::::::::: */ disallow_continuation_line = FALSE; *************** beginning_of_line: /* ::::::::::::::::: *** 996,1000 **** /* Come here directly when last line didn't clarify the continuation issue. */ ! beginning_of_line_again: /* :::::::::::::::::::: */ #ifdef REDUCE_CARD_SIZE_AFTER_BIGGY /* Define if occasional large lines. */ --- 1768,1772 ---- /* Come here directly when last line didn't clarify the continuation issue. */ ! beginning_of_line_again: /* :::::::::::::::::::: */ #ifdef REDUCE_CARD_SIZE_AFTER_BIGGY /* Define if occasional large lines. */ *************** beginning_of_line_again: /* :::::::::::: *** 1013,1017 **** c = latest_char_in_file; ! if ((c == EOF) || ((c = getc (f)) == EOF)) { --- 1785,1789 ---- c = latest_char_in_file; ! if ((c == EOF) || ((c = ffelex_getc_ (f)) == EOF)) { *************** beginning_of_line_again: /* :::::::::::: *** 1018,1035 **** end_of_file: /* :::::::::::::::::::: */ ffelex_finish_statement_ (); ! if (!ffewhere_line_is_unknown (ffelex_current_wl_)) ! ffewhere_line_kill (ffelex_current_wl_); ! if (!ffewhere_column_is_unknown (ffelex_current_wc_)) ! ffewhere_column_kill (ffelex_current_wc_); return (ffelexHandler) ffelex_handler_; - /* Line ending in EOF instead of \n still counts as a whole line. */ } ! ffelex_linecount_current_ = ffelex_linecount_next_; ! ++ffelex_linecount_next_; ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! ++lineno; ! #endif ffelex_bad_line_ = FALSE; --- 1790,1802 ---- end_of_file: /* :::::::::::::::::::: */ + /* Line ending in EOF instead of \n still counts as a whole line. */ + ffelex_finish_statement_ (); ! ffewhere_line_kill (ffelex_current_wl_); ! ffewhere_column_kill (ffelex_current_wc_); return (ffelexHandler) ffelex_handler_; } ! ffelex_next_line_ (); ffelex_bad_line_ = FALSE; *************** beginning_of_line_again: /* :::::::::::: *** 1039,1045 **** while (((lextype = ffelex_first_char_[c]) == FFELEX_typeCOMMENT) || (lextype == FFELEX_typeERROR) ! || (lextype == FFELEX_typeSLASH)) { ! if (lextype == FFELEX_typeERROR) { /* Bad first character, get line and display it with message. */ --- 1806,1837 ---- while (((lextype = ffelex_first_char_[c]) == FFELEX_typeCOMMENT) || (lextype == FFELEX_typeERROR) ! || (lextype == FFELEX_typeSLASH) ! || (lextype == FFELEX_typeHASH)) { ! /* Test most frequent type of line first, etc. */ ! if ((lextype == FFELEX_typeCOMMENT) ! || ((lextype == FFELEX_typeSLASH) ! && ((c = getc (f)) == '*'))) /* NOTE SIDE-EFFECT. */ ! { ! /* Typical case (straight comment), just ignore rest of line. */ ! comment_line: /* :::::::::::::::::::: */ ! ! while ((c != '\n') && (c != EOF)) ! c = getc (f); ! } ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! else if (lextype == FFELEX_typeHASH) ! c = ffelex_hash_ (f); ! #endif ! else if (lextype == FFELEX_typeSLASH) ! { ! /* SIDE-EFFECT ABOVE HAS HAPPENED. */ ! ffelex_card_image_[0] = '/'; ! ffelex_card_image_[1] = c; ! column = 2; ! goto bad_first_character; /* :::::::::::::::::::: */ ! } ! else ! /* typeERROR or unsupported typeHASH. */ { /* Bad first character, get line and display it with message. */ *************** beginning_of_line_again: /* :::::::::::: *** 1056,1074 **** ffelex_linecount_current_, 1); } - else if ((lextype == FFELEX_typeSLASH) && ((c = getc (f)) != '*')) - { - ffelex_card_image_[0] = '/'; - ffelex_card_image_[1] = c; - column = 2; - goto bad_first_character; /* :::::::::::::::::::: */ - } - else - { - /* Typical case (straight comment), just ignore rest of line. */ - comment_line: /* :::::::::::::::::::: */ - - while ((c != '\n') && (c != EOF)) - c = getc (f); - } /* Read past last char in line. */ --- 1848,1851 ---- *************** beginning_of_line_again: /* :::::::::::: *** 1076,1089 **** if (c == EOF) { ! ffelex_linecount_current_ = ffelex_linecount_next_; ! ++ffelex_linecount_next_; ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! ++lineno; ! #endif ! ! ffelex_finish_statement_ (); ! ffewhere_line_kill (ffelex_current_wl_); ! ffewhere_column_kill (ffelex_current_wc_); ! return (ffelexHandler) ffelex_handler_; } --- 1853,1858 ---- if (c == EOF) { ! ffelex_next_line_ (); ! goto end_of_file; /* :::::::::::::::::::: */ } *************** beginning_of_line_again: /* :::::::::::: *** 1090,1098 **** c = getc (f); ! ffelex_linecount_current_ = ffelex_linecount_next_; ! ++ffelex_linecount_next_; ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! ++lineno; ! #endif if (c == EOF) --- 1859,1863 ---- c = getc (f); ! ffelex_next_line_ (); if (c == EOF) *************** beginning_of_line_again: /* :::::::::::: *** 1125,1136 **** { /* Technically, we should now fill ffelex_card_image_ up thru column ! 72/132 with spaces, since character/hollerith constants must count ! them in that manner. To save CPU time in several ways (avoid a loop ! here that would be used only when we actually end a line in ! character-constant mode; avoid writing memory unnecessarily; avoid a ! loop later checking spaces when not scanning for character-constant ! characters), we don't do this, and we do the appropriate thing when ! we encounter end-of-line while actually processing a character ! constant. */ column = ffelex_final_nontab_column_; --- 1890,1901 ---- { /* Technically, we should now fill ffelex_card_image_ up thru column ! 72/132 with spaces, since character/hollerith constants must count ! them in that manner. To save CPU time in several ways (avoid a loop ! here that would be used only when we actually end a line in ! character-constant mode; avoid writing memory unnecessarily; avoid a ! loop later checking spaces when not scanning for character-constant ! characters), we don't do this, and we do the appropriate thing when ! we encounter end-of-line while actually processing a character ! constant. */ column = ffelex_final_nontab_column_; *************** beginning_of_line_again: /* :::::::::::: *** 1185,1188 **** --- 1950,1954 ---- ffelex_bad_1_ (FFEBAD_AMPERSAND, ffelex_linecount_current_, 1); + finish_statement = FALSE; just_do_label = FALSE; goto got_a_continuation; /* :::::::::::::::::::: */ *************** beginning_of_line_again: /* :::::::::::: *** 1199,1203 **** } ! stop_looking: /* :::::::::::::::::::: */ label_string[labi] = '\0'; --- 1965,1969 ---- } ! stop_looking: /* :::::::::::::::::::: */ label_string[labi] = '\0'; *************** stop_looking: /* :::::::::::::::::::: *** 1246,1250 **** --- 2012,2018 ---- and display an error message. */ + finish_statement = FALSE; just_do_label = FALSE; + switch (c) { *************** stop_looking: /* :::::::::::::::::::: *** 1263,1309 **** goto got_a_continuation;/* :::::::::::::::::::: */ /* This seems right to do. But it is close to call, since / * starting ! in column 6 will thus be interpreted as a continuation line ! beginning with '*'. */ /* Fall through. */ case '\0': /* End of line. Therefore may be continued-through line, so handle ! pending label as possible to-be-continued and drive end-of-statement ! for any previous statement, else treat as blank line. */ ! no_tokens_on_line: /* :::::::::::::::::::: */ if (first_label_char != FFEWHERE_columnUNKNOWN) { /* Can't be a continued-through line if it has a label. */ ! ffelex_finish_statement_ (); ! if (ffe_is_pedantic () && (c == '/')) ! ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT, ! ffelex_linecount_current_, column + 1); just_do_label = TRUE; break; } - if (ffe_is_pedantic () && (c == '/')) - ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT, - ffelex_linecount_current_, column + 1); goto beginning_of_line_again; /* :::::::::::::::::::: */ case '0': - ffelex_finish_statement_ (); if (ffe_is_pedantic () && (column != 5)) ffelex_bad_1_ (FFEBAD_NON_ANSI_CONTINUATION_COLUMN, ffelex_linecount_current_, column + 1); ! while ((c = ffelex_card_image_[++column]) == ' ') ! ; ! if ((c == '\0') ! || (c == '!') ! || ((c == '/') ! && (ffelex_card_image_[column + 1] == '*'))) ! { ! if (ffe_is_pedantic () && (c == '/')) ! ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT, ! ffelex_linecount_current_, column + 1); ! just_do_label = TRUE; ! } ! break; case '1': --- 2031,2062 ---- goto got_a_continuation;/* :::::::::::::::::::: */ /* This seems right to do. But it is close to call, since / * starting ! in column 6 will thus be interpreted as a continuation line ! beginning with '*'. */ /* Fall through. */ case '\0': /* End of line. Therefore may be continued-through line, so handle ! pending label as possible to-be-continued and drive end-of-statement ! for any previous statement, else treat as blank line. */ ! no_tokens_on_line: /* :::::::::::::::::::: */ + if (ffe_is_pedantic () && (c == '/')) + ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT, + ffelex_linecount_current_, column + 1); if (first_label_char != FFEWHERE_columnUNKNOWN) { /* Can't be a continued-through line if it has a label. */ ! finish_statement = TRUE; just_do_label = TRUE; break; } goto beginning_of_line_again; /* :::::::::::::::::::: */ case '0': if (ffe_is_pedantic () && (column != 5)) ffelex_bad_1_ (FFEBAD_NON_ANSI_CONTINUATION_COLUMN, ffelex_linecount_current_, column + 1); ! finish_statement = TRUE; ! goto check_for_content; /* :::::::::::::::::::: */ case '1': *************** stop_looking: /* :::::::::::::::::::: *** 1316,1319 **** --- 2069,2077 ---- case '8': case '9': + + /* NOTE: This label can be reached directly from the code + that lexes the label field in columns 1-5. */ + got_a_continuation: /* :::::::::::::::::::: */ + if (first_label_char != FFEWHERE_columnUNKNOWN) { *************** stop_looking: /* :::::::::::::::::::: *** 1342,1345 **** --- 2100,2106 ---- break; } + + check_for_content: /* :::::::::::::::::::: */ + while ((c = ffelex_card_image_[++column]) == ' ') ; *************** stop_looking: /* :::::::::::::::::::: *** 1358,1413 **** default: ! some_other_character: /* :::::::::::::::::::: */ if (column == 5) ! { ! ! got_a_continuation: /* :::::::::::::::::::: */ ! ! if (first_label_char != FFEWHERE_columnUNKNOWN) ! { ! ffelex_bad_2_ (FFEBAD_LABEL_ON_CONTINUATION, ! ffelex_linecount_current_, ! first_label_char, ! ffelex_linecount_current_, ! column + 1); ! first_label_char = FFEWHERE_columnUNKNOWN; ! } ! if (disallow_continuation_line) ! { ! if (!ignore_disallowed_continuation) ! ffelex_bad_1_ (FFEBAD_INVALID_CONTINUATION, ! ffelex_linecount_current_, column + 1); ! goto beginning_of_line; /* :::::::::::::::::::: */ ! } ! if ((ffelex_raw_mode_ != 0) ! && (((c = ffelex_card_image_[column + 1]) != '\0') ! || !ffelex_saw_tab_)) ! { ! ++column; ! break; ! } ! while ((c = ffelex_card_image_[++column]) == ' ') ! ; ! if ((c == '\0') ! || (c == '!') ! || ((c == '/') ! && (ffelex_card_image_[column + 1] == '*'))) ! { ! if (ffe_is_pedantic () && (c == '/')) ! ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT, ! ffelex_linecount_current_, column + 1); ! just_do_label = TRUE; ! } ! break; ! } /* Here is the very normal case of a regular character starting in ! column 7 or beyond with a blank in column 6. */ ! ffelex_finish_statement_ (); break; } /* If label is present, enclose it in a NUMBER token and send it along. */ --- 2119,2159 ---- default: ! some_other_character: /* :::::::::::::::::::: */ if (column == 5) ! goto got_a_continuation;/* :::::::::::::::::::: */ /* Here is the very normal case of a regular character starting in ! column 7 or beyond with a blank in column 6. */ ! finish_statement = TRUE; break; } + if (finish_statement + || (first_label_char != FFEWHERE_columnUNKNOWN)) + { + /* The line has content of some kind, install new end-statement + point for error messages. Note that "content" includes cases + where there's little apparent content but enough to finish + a statement. That's because finishing a statement can trigger + an impending INCLUDE, and that requires accurate line info being + maintained by the lexer. */ + + ffewhere_line_kill (ffelex_current_wl_); + ffewhere_column_kill (ffelex_current_wc_); + ffelex_current_wl_ = ffewhere_line_new (ffelex_linecount_current_); + ffelex_current_wc_ = ffewhere_column_new (ffelex_card_length_ + 1); + } + + /* We delay this for a combination of reasons. Mainly, it can start + INCLUDE processing, and we want to delay that until the lexer's + info on the line is coherent. And we want to delay that until we're + sure there's a reason to make that info coherent, to avoid saving + lots of useless lines. */ + + if (finish_statement) + ffelex_finish_statement_ (); + /* If label is present, enclose it in a NUMBER token and send it along. */ *************** stop_looking: /* :::::::::::::::::::: *** 1419,1423 **** strcpy (ffelex_token_->text, label_string); ffelex_token_->where_line ! = ffewhere_line_new (ffelex_linecount_current_); ffelex_token_->where_col = ffewhere_column_new (first_label_char); ffelex_token_->length = labi; --- 2165,2169 ---- strcpy (ffelex_token_->text, label_string); ffelex_token_->where_line ! = ffewhere_line_use (ffelex_current_wl_); ffelex_token_->where_col = ffewhere_column_new (first_label_char); ffelex_token_->length = labi; *************** stop_looking: /* :::::::::::::::::::: *** 1426,1437 **** } - /* The line definitely has content of some kind, install new end-statement - point for error messages. */ - - ffewhere_line_kill (ffelex_current_wl_); - ffewhere_column_kill (ffelex_current_wc_); - ffelex_current_wl_ = ffewhere_line_new (ffelex_linecount_current_); - ffelex_current_wc_ = ffewhere_column_new (ffelex_card_length_ + 1); - if (just_do_label) goto beginning_of_line; /* :::::::::::::::::::: */ --- 2172,2175 ---- *************** stop_looking: /* :::::::::::::::::::: *** 1543,1547 **** } ! parse_nonraw_character: /* :::::::::::::::::::: */ switch (ffelex_token_->type) --- 2281,2285 ---- } ! parse_nonraw_character: /* :::::::::::::::::::: */ switch (ffelex_token_->type) *************** parse_nonraw_character: /* ::::::::::::: *** 2124,2128 **** c = ffelex_card_image_[++column]; ! parse_next_character: /* :::::::::::::::::::: */ if (ffelex_raw_mode_ != 0) --- 2862,2866 ---- c = ffelex_card_image_[++column]; ! parse_next_character: /* :::::::::::::::::::: */ if (ffelex_raw_mode_ != 0) *************** ffelex_file_free (ffewhereFile wf, FILE *** 2196,2203 **** /* Come here to get a new line. */ ! beginning_of_line: /* :::::::::::::::::::: */ c = latest_char_in_file; ! if ((c == EOF) || ((c = getc (f)) == EOF)) { --- 2934,2941 ---- /* Come here to get a new line. */ ! beginning_of_line: /* :::::::::::::::::::: */ c = latest_char_in_file; ! if ((c == EOF) || ((c = ffelex_getc_ (f)) == EOF)) { *************** beginning_of_line: /* ::::::::::::::::: *** 2204,2221 **** end_of_file: /* :::::::::::::::::::: */ ffelex_finish_statement_ (); ! if (!ffewhere_line_is_unknown (ffelex_current_wl_)) ! ffewhere_line_kill (ffelex_current_wl_); ! if (!ffewhere_column_is_unknown (ffelex_current_wc_)) ! ffewhere_column_kill (ffelex_current_wc_); return (ffelexHandler) ffelex_handler_; - /* Line ending in EOF instead of \n still counts as a whole line. */ } ! ffelex_linecount_current_ = ffelex_linecount_next_; ! ++ffelex_linecount_next_; ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! ++lineno; ! #endif ffelex_bad_line_ = FALSE; --- 2942,2954 ---- end_of_file: /* :::::::::::::::::::: */ + /* Line ending in EOF instead of \n still counts as a whole line. */ + ffelex_finish_statement_ (); ! ffewhere_line_kill (ffelex_current_wl_); ! ffewhere_column_kill (ffelex_current_wc_); return (ffelexHandler) ffelex_handler_; } ! ffelex_next_line_ (); ffelex_bad_line_ = FALSE; *************** beginning_of_line: /* ::::::::::::::::: *** 2223,2228 **** /* Skip over initial-comment and empty lines as quickly as possible! */ ! while ((c == '\n') || (c == '!')) { comment_line: /* :::::::::::::::::::: */ --- 2956,2973 ---- /* Skip over initial-comment and empty lines as quickly as possible! */ ! while ((c == '\n') ! || (c == '!') ! || (c == '#')) { + if (c == '#') + { + #if FFECOM_targetCURRENT == FFECOM_targetGCC + c = ffelex_hash_ (f); + #else + /* Don't skip over # line after all. */ + break; + #endif + } + comment_line: /* :::::::::::::::::::: */ *************** beginning_of_line: /* ::::::::::::::::: *** 2232,2245 **** if (c == EOF) { ! ffelex_linecount_current_ = ffelex_linecount_next_; ! ++ffelex_linecount_next_; ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! ++lineno; ! #endif ! ! ffelex_finish_statement_ (); ! ffewhere_line_kill (ffelex_current_wl_); ! ffewhere_column_kill (ffelex_current_wc_); ! return (ffelexHandler) ffelex_handler_; } --- 2977,2982 ---- if (c == EOF) { ! ffelex_next_line_ (); ! goto end_of_file; /* :::::::::::::::::::: */ } *************** beginning_of_line: /* ::::::::::::::::: *** 2246,2254 **** c = getc (f); ! ffelex_linecount_current_ = ffelex_linecount_next_; ! ++ffelex_linecount_next_; ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! ++lineno; ! #endif if (c == EOF) --- 2983,2987 ---- c = getc (f); ! ffelex_next_line_ (); if (c == EOF) *************** beginning_of_line: /* ::::::::::::::::: *** 2453,2457 **** } ! parse_nonraw_character: /* :::::::::::::::::::: */ if ((c == '&') && ffelex_is_free_nonc_ctx_contin_ (column + 1)) --- 3186,3190 ---- } ! parse_nonraw_character: /* :::::::::::::::::::: */ if ((c == '&') && ffelex_is_free_nonc_ctx_contin_ (column + 1)) *************** parse_nonraw_character: /* ::::::::::::: *** 2461,2465 **** } ! parse_nonraw_character_noncontin: /* :::::::::::::::::::: */ switch (ffelex_token_->type) --- 3194,3198 ---- } ! parse_nonraw_character_noncontin: /* :::::::::::::::::::: */ switch (ffelex_token_->type) *************** parse_nonraw_character_noncontin: /* ::: *** 3058,3062 **** c = ffelex_card_image_[++column]; ! parse_next_character: /* :::::::::::::::::::: */ if (ffelex_raw_mode_ != 0) --- 3791,3795 ---- c = ffelex_card_image_[++column]; ! parse_next_character: /* :::::::::::::::::::: */ if (ffelex_raw_mode_ != 0) *************** parse_next_character: /* :::::::::::::: *** 3071,3074 **** --- 3804,3847 ---- } + /* See the code in com.c that calls this to understand why. */ + + #if FFECOM_targetCURRENT == FFECOM_targetGCC + void + ffelex_hash_kludge (FILE *finput) + { + /* If you change this constant string, you have to change whatever + code might thus be affected by it in terms of having to use + ffelex_getc_() instead of getc() in the lexers and _hash_. */ + static char match[] = "# 1 \""; + static int kludge[ARRAY_SIZE (match) + 1]; + int c; + char *p; + int *q; + + /* Read chars as long as they match the target string. + Copy them into an array that will serve as a record + of what we read (essentially a multi-char ungetc(), + for code that uses ffelex_getc_ instead of getc() elsewhere + in the lexer. */ + for (p = &match[0], q = &kludge[0], c = getc (finput); + (c == *p) && (*p != '\0') && (c != EOF); + ++p, ++q, c = getc (finput)) + *q = c; + + *q = c; /* Might be EOF, which requires int. */ + *++q = 0; + + ffelex_kludge_chars_ = &kludge[0]; + + if (*p == 0) + { + ffelex_kludge_flag_ = TRUE; + ++ffelex_kludge_chars_; + ffelex_hash_ (finput); /* Handle it NOW rather than later. */ + ffelex_kludge_flag_ = FALSE; + } + } + + #endif void ffelex_init_1 () *************** ffelex_init_1 () *** 3096,3099 **** --- 3869,3873 ---- ffelex_first_char_['/'] = FFELEX_typeSLASH; ffelex_first_char_['&'] = FFELEX_typeRAW; + ffelex_first_char_['#'] = FFELEX_typeHASH; for (i = '0'; i <= '9'; ++i) *************** ffelex_set_expecting_hollerith (long len *** 3242,3249 **** non-HOLLERITH token was sent in between the calls, but play it safe). */ ! if (!ffewhere_line_is_unknown (ffelex_raw_where_line_)) ! ffewhere_line_kill (ffelex_raw_where_line_); ! if (!ffewhere_column_is_unknown (ffelex_raw_where_col_)) ! ffewhere_column_kill (ffelex_raw_where_col_); /* Now handle the length function. */ --- 4016,4021 ---- non-HOLLERITH token was sent in between the calls, but play it safe). */ ! ffewhere_line_kill (ffelex_raw_where_line_); ! ffewhere_column_kill (ffelex_raw_where_col_); /* Now handle the length function. */ diff -rcp2N g77-0.5.15/f/lex.h g77-0.5.16/f/lex.h *** g77-0.5.15/f/lex.h Wed Apr 12 10:03:17 1995 --- g77-0.5.16/f/lex.h Wed Aug 30 15:53:35 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: *************** typedef enum *** 44,47 **** --- 45,49 ---- FFELEX_typeQUOTE, FFELEX_typeDOLLAR, + FFELEX_typeHASH, FFELEX_typePERCENT, FFELEX_typeAMPERSAND, *************** bool ffelex_expecting_character (void); *** 120,123 **** --- 122,126 ---- ffelexHandler ffelex_file_fixed (ffewhereFile wf, FILE *f); ffelexHandler ffelex_file_free (ffewhereFile wf, FILE *f); + void ffelex_hash_kludge (FILE *f); void ffelex_init_1 (void); bool ffelex_is_names_expected (void); diff -rcp2N g77-0.5.15/f/malloc.c g77-0.5.16/f/malloc.c *** g77-0.5.15/f/malloc.c Tue Feb 21 13:38:24 1995 --- g77-0.5.16/f/malloc.c Wed Aug 30 15:53:35 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** static char *malloc_types_[] *** 76,79 **** --- 77,81 ---- static void malloc_kill_area_ (mallocPool pool, mallocArea_ a); + static void malloc_verify_area_ (mallocPool pool, mallocArea_ a); /* Internal macros. */ *************** malloc_kill_area_ (mallocPool pool, mall *** 103,106 **** --- 105,122 ---- } + /* malloc_verify_area_ -- Verify storage area and its object + + malloc_verify_area_(mallocPool pool,mallocArea_ area); + + Does the actual verifying of a storage area. */ + + static void + malloc_verify_area_ (mallocPool pool UNUSED, mallocArea_ a) + { + mallocSize s = a->size; + + assert (strcmp (a->name, ((char *) (a->where)) + s) == 0); + } + /* malloc_init -- Initialize malloc cluster *************** malloc_pool_kill (mallocPool p) *** 206,210 **** mallocPool ! malloc_pool_new (char *name, mallocPool parent, unsigned long chunks) { mallocPool p; --- 222,227 ---- mallocPool ! malloc_pool_new (char *name, mallocPool parent, ! unsigned long chunks UNUSED) { mallocPool p; *************** malloc_resize_ (void *ptr, mallocSize s) *** 471,473 **** --- 488,514 ---- } return ptr; + } + + /* malloc_verify_inpool_ -- Verify object + + Find the mallocArea_ for the pointer, make sure the type is proper, and + verify both of them. */ + + void + malloc_verify_inpool_ (mallocPool pool, mallocType_ type, void *ptr, + mallocSize s) + { + mallocArea_ a; + + if (pool == NULL) + pool = malloc_pool_image (); + + assert ((pool == malloc_pool_image ()) + || malloc_pool_find_ (pool, malloc_pool_image ())); + + a = malloc_find_inpool_ (pool, ptr); + assert (a->type == type); + if ((type != MALLOC_typeUS_) && (type != MALLOC_typeUSR_)) + assert (a->size == s); + malloc_verify_area_ (pool, a); } diff -rcp2N g77-0.5.15/f/malloc.h g77-0.5.16/f/malloc.h *** g77-0.5.15/f/malloc.h Tue Feb 21 13:38:24 1995 --- g77-0.5.16/f/malloc.h Wed Aug 30 15:53:35 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: *************** void *malloc_resize_ (void *ptr, mallocS *** 114,117 **** --- 115,120 ---- void *malloc_resize_inpool_ (mallocPool pool, mallocType_ type, void *ptr, mallocSize new_size, mallocSize old_size); + void malloc_verify_inpool_ (mallocPool pool, mallocType_ type, void *ptr, + mallocSize size); /* Define macros. */ *************** void *malloc_resize_inpool_ (mallocPool *** 118,157 **** #define malloc_new_ks(pool,name,size) \ ! malloc_new_inpool_(pool,MALLOC_typeKS_,name,size) #define malloc_new_ksr(pool,name,size) \ ! malloc_new_inpool_(pool,MALLOC_typeKSR_,name,size) #define malloc_new_kp(pool,name,size) \ ! malloc_new_inpool_(pool,MALLOC_typeKP_,name,size) #define malloc_new_kpr(pool,name,size) \ ! malloc_new_inpool_(pool,MALLOC_typeKPR_,name,size) #define malloc_new_us(pool,name,size) \ ! malloc_new_inpool_(pool,MALLOC_typeUS_,name,size) #define malloc_new_usr(pool,name,size) \ ! malloc_new_inpool_(pool,MALLOC_typeUSR_,name,size) #define malloc_new_zks(pool,name,size,z) \ ! malloc_new_zinpool_(pool,MALLOC_typeKS_,name,size,z) #define malloc_new_zksr(pool,name,size,z) \ ! malloc_new_zinpool_(pool,MALLOC_typeKSR_,name,size,z) #define malloc_new_zkp(pool,name,size,z) \ ! malloc_new_zinpool_(pool,MALLOC_typeKP_,name,size,z) #define malloc_new_zkpr(pool,name,size,z) \ ! malloc_new_zinpool_(pool,MALLOC_typeKPR_,name,size,z) #define malloc_new_zus(pool,name,size,z) \ ! malloc_new_zinpool_(pool,MALLOC_typeUS_,name,size,z) #define malloc_new_zusr(pool,name,size,z) \ ! malloc_new_zinpool_(pool,MALLOC_typeUSR_,name,size,z) #define malloc_kill_ks(pool,ptr,size) \ ! malloc_kill_inpool_(pool,MALLOC_typeKS_,ptr,size) #define malloc_kill_ksr(pool,ptr,size) \ ! malloc_kill_inpool_(pool,MALLOC_typeKSR_,ptr,size) ! #define malloc_kill_us(pool,ptr) malloc_kill_inpool_(pool,MALLOC_typeUS_,ptr,0) ! #define malloc_kill_usr(pool,ptr) malloc_kill_inpool_(pool,MALLOC_typeUSR_,ptr,0) #define malloc_pool_image() (&malloc_root_.malloc_pool_image_) #define malloc_resize_ksr(pool,ptr,new_size,old_size) \ ! malloc_resize_inpool_(pool,MALLOC_typeKSR_,ptr,new_size,old_size) #define malloc_resize_kpr(pool,ptr,new_size,old_size) \ ! malloc_resize_inpool_(pool,MALLOC_typeKPR_,ptr,new_size,old_size) #define malloc_resize_usr(pool,ptr,new_size) \ ! malloc_resize_inpool_(pool,MALLOC_typeUSR_,ptr,new_size,0) /* End of #include file. */ --- 121,174 ---- #define malloc_new_ks(pool,name,size) \ ! malloc_new_inpool_ (pool,MALLOC_typeKS_,name,size) #define malloc_new_ksr(pool,name,size) \ ! malloc_new_inpool_ (pool,MALLOC_typeKSR_,name,size) #define malloc_new_kp(pool,name,size) \ ! malloc_new_inpool_ (pool,MALLOC_typeKP_,name,size) #define malloc_new_kpr(pool,name,size) \ ! malloc_new_inpool_ (pool,MALLOC_typeKPR_,name,size) #define malloc_new_us(pool,name,size) \ ! malloc_new_inpool_ (pool,MALLOC_typeUS_,name,size) #define malloc_new_usr(pool,name,size) \ ! malloc_new_inpool_ (pool,MALLOC_typeUSR_,name,size) #define malloc_new_zks(pool,name,size,z) \ ! malloc_new_zinpool_ (pool,MALLOC_typeKS_,name,size,z) #define malloc_new_zksr(pool,name,size,z) \ ! malloc_new_zinpool_ (pool,MALLOC_typeKSR_,name,size,z) #define malloc_new_zkp(pool,name,size,z) \ ! malloc_new_zinpool_ (pool,MALLOC_typeKP_,name,size,z) #define malloc_new_zkpr(pool,name,size,z) \ ! malloc_new_zinpool_ (pool,MALLOC_typeKPR_,name,size,z) #define malloc_new_zus(pool,name,size,z) \ ! malloc_new_zinpool_ (pool,MALLOC_typeUS_,name,size,z) #define malloc_new_zusr(pool,name,size,z) \ ! malloc_new_zinpool_ (pool,MALLOC_typeUSR_,name,size,z) #define malloc_kill_ks(pool,ptr,size) \ ! malloc_kill_inpool_ (pool,MALLOC_typeKS_,ptr,size) #define malloc_kill_ksr(pool,ptr,size) \ ! malloc_kill_inpool_ (pool,MALLOC_typeKSR_,ptr,size) ! #define malloc_kill_us(pool,ptr) \ ! malloc_kill_inpool_ (pool,MALLOC_typeUS_,ptr,0) ! #define malloc_kill_usr(pool,ptr) \ ! malloc_kill_inpool_ (pool,MALLOC_typeUSR_,ptr,0) #define malloc_pool_image() (&malloc_root_.malloc_pool_image_) #define malloc_resize_ksr(pool,ptr,new_size,old_size) \ ! malloc_resize_inpool_ (pool,MALLOC_typeKSR_,ptr,new_size,old_size) #define malloc_resize_kpr(pool,ptr,new_size,old_size) \ ! malloc_resize_inpool_ (pool,MALLOC_typeKPR_,ptr,new_size,old_size) #define malloc_resize_usr(pool,ptr,new_size) \ ! malloc_resize_inpool_ (pool,MALLOC_typeUSR_,ptr,new_size,0) ! #define malloc_verify_kp(pool,name,size) \ ! malloc_verify_inpool_ (pool,MALLOC_typeKP_,name,size) ! #define malloc_verify_kpr(pool,name,size) \ ! malloc_verify_inpool_ (pool,MALLOC_typeKPR_,name,size) ! #define malloc_verify_ks(pool,ptr,size) \ ! malloc_verify_inpool_ (pool,MALLOC_typeKS_,ptr,size) ! #define malloc_verify_ksr(pool,ptr,size) \ ! malloc_verify_inpool_ (pool,MALLOC_typeKSR_,ptr,size) ! #define malloc_verify_us(pool,ptr) \ ! malloc_verify_inpool_ (pool,MALLOC_typeUS_,ptr,0) ! #define malloc_verify_usr(pool,ptr) \ ! malloc_verify_inpool_ (pool,MALLOC_typeUSR_,ptr,0) /* End of #include file. */ diff -rcp2N g77-0.5.15/f/name.c g77-0.5.16/f/name.c *** g77-0.5.15/f/name.c Wed Feb 15 16:58:39 1995 --- g77-0.5.16/f/name.c Wed Aug 30 15:53:35 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** static ffename ffename_lookup_ (ffenameS *** 61,75 **** /* Internal macros. */ - - #define FFENAME_spacePROGUNIT_ 0 - #define FFENAME_spaceFILE_ 1 - - #if FFECOM_targetCURRENT == FFECOM_targetFFE - #define FFENAME_spaceCURRENT_ FFENAME_spacePROGUNIT_ - #else - #if FFECOM_targetCURRENT == FFECOM_targetGCC - #define FFENAME_spaceCURRENT_ FFENAME_spacePROGUNIT_ - #endif - #endif --- 62,65 ---- diff -rcp2N g77-0.5.15/f/name.h g77-0.5.16/f/name.h *** g77-0.5.15/f/name.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/name.h Wed Aug 30 15:53:35 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/options-lang.h g77-0.5.16/f/options-lang.h *** g77-0.5.15/f/options-lang.h Tue May 9 03:38:53 1995 --- g77-0.5.16/f/options-lang.h *************** *** 1,100 **** - /* options-lang.h file for Gnu Fortran - Copyright (C) 1995 Free Software Foundation, Inc. - Contributed by James Craig Burley (burley@gnu.ai.mit.edu). - - This file is part of GNU Fortran. - - GNU Fortran 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, or (at your option) - any later version. - - GNU Fortran is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GNU Fortran; see the file COPYING. If not, write to - the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - - */ - - "-fversion", - "-ff90", - "-fno-f90", - "-fautomatic", - "-fno-automatic", - "-fdollar-ok", - "-fno-dollar-ok", - "-ff2c", - "-fno-f2c", - "-ff2c-library", - "-fno-f2c-library", - "-ffree-form", - "-fno-free-form", - "-ffixed-form", - "-fno-fixed-form", - "-fpedantic", - "-fno-pedantic", - "-fvxt-not-f90", - "-ff90-not-vxt", - "-fugly", - "-fno-ugly", - "-fugly-args", - "-fno-ugly-args", - "-fugly-init", - "-fno-ugly-init", - "-fdebug", - "-fno-debug", - "-finit-local-zero", - "-fno-init-local-zero", - "-fbackslash", - "-fno-backslash", - "-fintrin-case-initcap", - "-fintrin-case-upper", - "-fintrin-case-lower", - "-fintrin-case-any", - "-fmatch-case-initcap", - "-fmatch-case-upper", - "-fmatch-case-lower", - "-fmatch-case-any", - "-fsource-case-upper", - "-fsource-case-lower", - "-fsource-case-preserve", - "-fsymbol-case-initcap", - "-fsymbol-case-upper", - "-fsymbol-case-lower", - "-fsymbol-case-any", - "-fcase-strict-upper", - "-fcase-strict-lower", - "-fcase-initcap", - "-fcase-upper", - "-fcase-lower", - "-fcase-preserve", - "-fdcp-intrinsics-delete", - "-fdcp-intrinsics-hide", - "-fdcp-intrinsics-disable", - "-fdcp-intrinsics-enable", - "-ff2c-intrinsics-delete", - "-ff2c-intrinsics-hide", - "-ff2c-intrinsics-disable", - "-ff2c-intrinsics-enable", - "-ff90-intrinsics-delete", - "-ff90-intrinsics-hide", - "-ff90-intrinsics-disable", - "-ff90-intrinsics-enable", - "-fmil-intrinsics-delete", - "-fmil-intrinsics-hide", - "-fmil-intrinsics-disable", - "-fmil-intrinsics-enable", - "-fvxt-intrinsics-delete", - "-fvxt-intrinsics-hide", - "-fvxt-intrinsics-disable", - "-fvxt-intrinsics-enable", - "-Wimplicit", - "-Wno-implicit", - "-Wall", - /* Prefix options. */ - "-I", - "-ffixed-line-length-", --- 0 ---- diff -rcp2N g77-0.5.15/f/parse.c g77-0.5.16/f/parse.c *** g77-0.5.15/f/parse.c Fri Apr 28 05:26:11 1995 --- g77-0.5.16/f/parse.c Wed Aug 30 15:53:35 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "proj.h" --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "proj.h" *************** the Free Software Foundation, 675 Mass A *** 35,40 **** void main (int argc, char *argv[]) ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC FILE *finput; --- 36,40 ---- void main (int argc, char *argv[]) ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC FILE *finput; *************** FILE *finput; *** 41,45 **** int yyparse () ! #endif #endif { --- 41,46 ---- int yyparse () ! #else ! #error #endif { *************** yyparse () *** 60,67 **** fprintf (stderr, "Unrecognized option: %s\n", argv[0]); } ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffe_set_is_pedantic (pedantic); ! #endif #endif --- 61,68 ---- fprintf (stderr, "Unrecognized option: %s\n", argv[0]); } ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffe_set_is_pedantic (pedantic); ! #else ! #error #endif *************** yyparse () *** 70,79 **** ffecom_file (NAME_OF_STDIN); ffe_file (wf, stdin); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC wf = ffewhere_file_new (main_input_filename, strlen (main_input_filename)); ffecom_file (main_input_filename); ffe_file (wf, finput); ! #endif #endif --- 71,80 ---- ffecom_file (NAME_OF_STDIN); ffe_file (wf, stdin); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC wf = ffewhere_file_new (main_input_filename, strlen (main_input_filename)); ffecom_file (main_input_filename); ffe_file (wf, finput); ! #else ! #error #endif *************** yyparse () *** 82,89 **** return 0; ! #else ffe_terminate_0 (); exit (0); #endif } --- 83,92 ---- return 0; ! #elif FFECOM_targetCURRENT == FFECOM_targetFFE ffe_terminate_0 (); exit (0); + #else + #error #endif } diff -rcp2N g77-0.5.15/f/proj.c g77-0.5.16/f/proj.c *** g77-0.5.15/f/proj.c Wed Apr 12 10:03:17 1995 --- g77-0.5.16/f/proj.c Wed Aug 30 15:53:35 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "proj.h" --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "proj.h" diff -rcp2N g77-0.5.15/f/proj.h g77-0.5.16/f/proj.h *** g77-0.5.15/f/proj.h Fri Apr 28 05:42:07 1995 --- g77-0.5.16/f/proj.h Wed Aug 30 15:53:35 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ *************** the Free Software Foundation, 675 Mass A *** 24,27 **** --- 25,40 ---- #define _H_f_proj + #if !defined (__GNUC__) || (__GNUC__ < 2) + #error You have to use gcc 2.x to build g77 (might be fixed in g77-0.6). + #endif + + #ifndef BUILT_WITH_270 + #if (__GNUC__ > 2) || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7) + #define BUILT_WITH_270 1 + #else + #define BUILT_WITH_270 0 + #endif + #endif /* !defined (BUILT_WITH_270) */ + /* This file used to attempt to allow for all sorts of broken systems. Because the auto-configuration scripts in conf-proj(.in) didn't work *************** typedef enum *** 74,77 **** --- 87,98 ---- #define STR(s) # s #define STRX(s) STR(s) + + #ifndef UNUSED /* Compile with -DUNUSED= if cc doesn't support this. */ + #if BUILT_WITH_270 + #define UNUSED __attribute__ ((unused)) + #else /* !BUILT_WITH_270 */ + #define UNUSED + #endif /* !BUILT_WITH_270 */ + #endif /* !defined (UNUSED) */ #endif diff -rcp2N g77-0.5.15/f/rtl.j g77-0.5.16/f/rtl.j *** g77-0.5.15/f/rtl.j Fri Feb 17 01:28:15 1995 --- g77-0.5.16/f/rtl.j Wed Aug 30 15:53:35 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef MAKING_DEPENDENCIES --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #ifndef MAKING_DEPENDENCIES diff -rcp2N g77-0.5.15/f/runtime/ChangeLog g77-0.5.16/f/runtime/ChangeLog *** g77-0.5.15/f/runtime/ChangeLog Fri May 19 11:47:28 1995 --- g77-0.5.16/f/runtime/ChangeLog Wed Aug 30 16:30:17 1995 *************** *** 1,2 **** --- 1,76 ---- + Wed Aug 30 15:58:35 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.16 released. + + * Incorporate changes by AT&T/Bellcore to libf2c through 950829. + + Mon Aug 28 12:50:34 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * libF77/Makefile.in, libI77/Makefile.in ($(lib)): Force ar'ing + and ranlib'ing of libf2c.a, else after rm'ing libf2c.a and + doing a make, only libI77 or libF77 would be added to + the newly created archive. + Also, instead of `$?' list all targets explicitly so all + objects are updated in libf2c.a even if only one actually + needs recompiling, for similar reason -- we can't easily tell + if a given object is really up-to-date in libf2c.a, or even + present there. + + Sun Aug 27 14:54:24 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * libF77/Makefile.in, libI77/Makefile.in: Fix spacing so + initial tabs are present in all appropriate places. + Move identical $(AR) commands in if then/else clauses + to single command preceding if. + (.c.o, Version[FI].o): Use $@ instead of $* because AIX (RS/6000) + says $@ means source, not object, basename, and $@ seems to work + everywhere. + + Wed Aug 23 15:44:25 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * libF77/system_.c (system_): Declare as returning `ftnint', + consistent with signal_, instead of defaulting to `int'. + Hope dmg@research.att.com agrees, else probably will + change to whatever he determines is correct (and change + g77 accordingly). + + Thu Aug 17 08:46:17 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * libI77/rsne.c (s_rsne): Call f_init if not already done. + + Thu Aug 17 04:35:28 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Incorporate changes by Bellcore to libf2c through 950817. + And this text is for EMACS: (foo at bar). + + Wed Aug 16 17:33:06 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * libF77/Makefile.in, libI77/Makefile.in (CFLAGS): Put -g1 + after configured CFLAGS but before GCC_CFLAGS, so by default + the libraries are built with minimal debugging information. + + Fri Jul 28 10:30:15 1995 Dave Love + + * libI77/open.c (f_open): Call f_init if not already done. + + Sat Jul 1 19:31:56 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * libF77/system_.c (system_): Make buff one byte bigger so + following byte doesn't get overwritten by call with large + string. + + Tue Jun 27 23:28:16 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Incorporate changes by Bellcore to libf2c through 950613. + + * libF77/Version.c (__G77_LIBF77_VERSION__): Add this string + to track g77 mods to libf2c. + + * libI77/Version.c (__G77_LIBI77_VERSION__): Add this string + to track g77 mods to libf2c. + + * libI77/rawio.h: #include only conditionally, + using macro intended for that purpose. + Fri May 19 11:20:00 1995 Craig Burley (burley@gnu.ai.mit.edu) *************** Fri May 19 11:20:00 1995 Craig Burley *** 7,11 **** Wed Apr 26 21:08:57 BST 1995 Dave Love ! * configure.in: Fix quoting problem in atexit check. * configure: Regenerated (with current autoconf). --- 81,85 ---- Wed Apr 26 21:08:57 BST 1995 Dave Love ! * configure.in: Fix quoting problem in atexit check. * configure: Regenerated (with current autoconf). diff -rcp2N g77-0.5.15/f/runtime/Makefile.in g77-0.5.16/f/runtime/Makefile.in *** g77-0.5.15/f/runtime/Makefile.in Wed Feb 15 19:12:01 1995 --- g77-0.5.16/f/runtime/Makefile.in Wed Aug 30 15:50:51 1995 *************** *** 17,21 **** #You should have received a copy of the GNU General Public License #along with GNU Fortran; see the file COPYING. If not, write to ! #the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. #### Start of system configuration section. #### --- 17,22 ---- #You should have received a copy of the GNU General Public License #along with GNU Fortran; see the file COPYING. If not, write to ! #the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! #02111-1307, USA. #### Start of system configuration section. #### *************** libf77: libF77/Makefile *** 88,92 **** cd ${srcdir} && autoconf && rm -f config.cache ../include/f2c.h libI77/Makefile libF77/Makefile Makefile: Makefile.in \ ! config.status $(FLAGS_TO_PASS) CONFIG_SITE=/dev/null $(SHELL) config.status # Extra dependencies for the targets above: --- 89,93 ---- cd ${srcdir} && autoconf && rm -f config.cache ../include/f2c.h libI77/Makefile libF77/Makefile Makefile: Makefile.in \ ! config.status $(FLAGS_TO_PASS) CONFIG_SITE=/dev/null $(SHELL) config.status # Extra dependencies for the targets above: diff -rcp2N g77-0.5.15/f/runtime/README g77-0.5.16/f/runtime/README *** g77-0.5.15/f/runtime/README Wed Apr 12 10:03:18 1995 --- g77-0.5.16/f/runtime/README Mon Aug 28 09:41:32 1995 *************** *** 1,6 **** ! -*- text -*- - 950227 - This directory contains the f2c library packaged for use with g77 to configure and build automatically (in principle!) as part of the top-level configure and --- 1,4 ---- ! 950827 This directory contains the f2c library packaged for use with g77 to configure and build automatically (in principle!) as part of the top-level configure and *************** Some key changes made by Burley: *** 32,34 **** ERR= and IOSTAT= report disk-full errors (assuming the underlying system library code does that correctly), again because that's the ! behavior most users expect (#define ALWAYS_FLUSH). --- 30,41 ---- ERR= and IOSTAT= report disk-full errors (assuming the underlying system library code does that correctly), again because that's the ! behavior most users expect (#define ALWAYS_FLUSH). But you should ! write CALL FLUSH or CALL FLUSH(IUNIT) as appropriate in your source ! code, because auto-flushing will not necessarily be enabled by ! default in future versions of g77's run-time library. ! ! - f2c.h configured to default to outputting leading zeros before ! decimal points in formatted and list-directed output, to be compatible ! with many other compilers (#define WANT_LEAD_0). Either way is ! standard-conforming, however, and you should try to avoid writing ! code that assumes one format or another. diff -rcp2N g77-0.5.15/f/runtime/TODO g77-0.5.16/f/runtime/TODO *** g77-0.5.15/f/runtime/TODO Sun Feb 12 13:35:23 1995 --- g77-0.5.16/f/runtime/TODO Mon Aug 28 09:41:32 1995 *************** *** 1,4 **** - -*- indented-text -*- - 950212 --- 1,2 ---- *************** TODO list for the g77 library *** 11,19 **** * Test cases. - - * Option to bring the output of real numbers more into line with the - rest of the world by not omitting zeroes before and after the - decimal point; this would make it easier to do comparisons with the - output of other compilers. * Allow the library to be stripped to save space. --- 9,12 ---- diff -rcp2N g77-0.5.15/f/runtime/configure g77-0.5.16/f/runtime/configure *** g77-0.5.15/f/runtime/configure Fri May 19 11:46:58 1995 --- g77-0.5.16/f/runtime/configure Wed Aug 30 15:57:57 1995 *************** EOF *** 1363,1366 **** --- 1363,1371 ---- + cat >> confdefs.h <<\EOF + #define WANT_LEAD_0 1 + EOF + + # avoid confusion in case the `makefile's from the f2c distribution have # got put here diff -rcp2N g77-0.5.15/f/runtime/configure.in g77-0.5.16/f/runtime/configure.in *** g77-0.5.15/f/runtime/configure.in Fri May 19 11:44:14 1995 --- g77-0.5.16/f/runtime/configure.in Wed Aug 30 15:50:51 1995 *************** *** 17,21 **** #You should have received a copy of the GNU General Public License #along with GNU Fortran; see the file COPYING. If not, write to ! #the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. AC_INIT(libF77/Version.c) --- 17,22 ---- #You should have received a copy of the GNU General Public License #along with GNU Fortran; see the file COPYING. If not, write to ! #the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! #02111-1307, USA. AC_INIT(libF77/Version.c) *************** dnl compile-time option or, perhaps, s *** 256,259 **** --- 257,266 ---- AC_DEFINE(ALWAYS_FLUSH) + dnl Most Fortran implementations do this, so to make it easier + dnl to compare the output of g77-compiled programs to those compiled + dnl by most other compilers, tell libf2c to put leading zeros in + dnl appropriate places on output + + AC_DEFINE(WANT_LEAD_0) # avoid confusion in case the `makefile's from the f2c distribution have diff -rcp2N g77-0.5.15/f/runtime/libF77/F77_aloc.c g77-0.5.16/f/runtime/libF77/F77_aloc.c *** g77-0.5.15/f/runtime/libF77/F77_aloc.c --- g77-0.5.16/f/runtime/libF77/F77_aloc.c Wed Aug 30 14:27:17 1995 *************** *** 0 **** --- 1,32 ---- + #include "f2c.h" + #undef abs + #undef min + #undef max + #include "stdio.h" + + static integer memfailure = 3; + + #ifdef KR_headers + extern char *malloc(); + extern void exit_(); + + char * + F77_aloc(Len, whence) integer Len; char *whence; + #else + #include "stdlib.h" + extern void exit_(integer*); + + char * + F77_aloc(integer Len, char *whence) + #endif + { + char *rv; + unsigned int uLen = (unsigned int) Len; /* for K&R C */ + + if (!(rv = malloc(uLen))) { + fprintf(stderr, "malloc(%u) failure in %s\n", + uLen, whence); + exit_(&memfailure); + } + return rv; + } diff -rcp2N g77-0.5.15/f/runtime/libF77/Makefile.in g77-0.5.16/f/runtime/libF77/Makefile.in *** g77-0.5.15/f/runtime/libF77/Makefile.in Wed Feb 15 19:13:38 1995 --- g77-0.5.16/f/runtime/libF77/Makefile.in Wed Aug 30 15:50:29 1995 *************** *** 19,23 **** #You should have received a copy of the GNU General Public License #along with GNU Fortran; see the file COPYING. If not, write to ! #the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. SHELL = /bin/sh --- 19,24 ---- #You should have received a copy of the GNU General Public License #along with GNU Fortran; see the file COPYING. If not, write to ! #the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! #02111-1307, USA. SHELL = /bin/sh *************** CFLAGS = @CFLAGS@ $(GCC_FLAGS) *** 35,38 **** --- 36,40 ---- CPPFLAGS = @CPPFLAGS@ DEFS = @DEFS@ + CGFLAGS = -g0 # f2c.h should already be installed in xgcc's include directory but add that # to -I anyhow in case not using xgcc. *************** CROSS = @CROSS@ *** 50,58 **** .c.o: ! $(CC) -c -DSkip_f2c_Undefs $(ALL_CFLAGS) $< ! ! MISC = Version.o main.o s_rnge.o abort_.o getarg_.o iargc_.o getenv_.o\ ! signal_.o s_stop.o s_paus.o system_.o cabs.o\ ! derf_.o derfc_.o erf_.o erfc_.o sig_die.o POW = pow_ci.o pow_dd.o pow_di.o pow_hh.o pow_ii.o pow_ri.o pow_zi.o pow_zz.o CX = c_abs.o c_cos.o c_div.o c_exp.o c_log.o c_sin.o c_sqrt.o --- 52,62 ---- .c.o: ! $(CC) -c -DSkip_f2c_Undefs $(ALL_CFLAGS) $(CGFLAGS) $< ! ld -r -x -o $@x $@ ! mv $@x $@ ! ! MISC = F77_aloc.o VersionF.o main.o s_rnge.o abort_.o getarg_.o iargc_.o\ ! getenv_.o signal_.o s_stop.o s_paus.o system_.o cabs.o\ ! derf_.o derfc_.o erf_.o erfc_.o sig_die.o exit.o POW = pow_ci.o pow_dd.o pow_di.o pow_hh.o pow_ii.o pow_ri.o pow_zi.o pow_zz.o CX = c_abs.o c_cos.o c_div.o c_exp.o c_log.o c_sin.o c_sqrt.o *************** F2C_H = ../../include/f2c.h *** 79,100 **** all: $(lib) ! $(lib): $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \ $(HALF) $(CMP) $(EFL) $(CHAR) # use cross tools if appropriate; note that the _FOR_TARGET tools have a # tooldir-type prefix even when we're not cross-compiling -if test "$(CROSS)"; then \ - $(AR) $(AR_FLAGS) $(lib) $? ; \ if $(RANLIB_TEST_FOR_TARGET); then $(RANLIB_FOR_TARGET) $(lib); \ ! else true; fi ; \ else \ - $(AR) $(AR_FLAGS) $(lib) $? ; \ $(RANLIB) $(lib); \ ! fi uninstall: ! install: ! Version.o: Version.c ! $(CC) -c -o $@ $(srcdir)/Version.c clean: --- 83,106 ---- all: $(lib) ! $(lib): force $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \ $(HALF) $(CMP) $(EFL) $(CHAR) # use cross tools if appropriate; note that the _FOR_TARGET tools have a # tooldir-type prefix even when we're not cross-compiling + $(AR) $(AR_FLAGS) $(lib) $(MISC) $(POW) $(CX) $(DCX) $(REAL) \ + $(DBL) $(INT) $(HALF) $(CMP) $(EFL) $(CHAR) -if test "$(CROSS)"; then \ if $(RANLIB_TEST_FOR_TARGET); then $(RANLIB_FOR_TARGET) $(lib); \ ! else true; fi ; \ else \ $(RANLIB) $(lib); \ ! fi uninstall: ! install: ! VersionF.o: Version.c ! $(CC) -c $(CGFLAGS) -o $@ $(srcdir)/Version.c ! ld -r -x -o $@x $@ ! mv $@x $@ clean: *************** clean: *** 104,105 **** --- 110,113 ---- $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \ $(HALF) $(CMP) $(EFL) $(CHAR): $(F2C_H) + + force: diff -rcp2N g77-0.5.15/f/runtime/libF77/Version.c g77-0.5.16/f/runtime/libF77/Version.c *** g77-0.5.15/f/runtime/libF77/Version.c Sun Feb 12 01:06:46 1995 --- g77-0.5.16/f/runtime/libF77/Version.c Wed Aug 30 14:27:17 1995 *************** *** 1,5 **** ! static char junk[] = "\n@(#)LIBF77 VERSION 2.01 27 Jan. 1995\n"; /* 2.00 11 June 1980. File version.c added to library. 2.01 31 May 1988. s_paus() flushes stderr; names of hl_* fixed --- 1,10 ---- ! static char junk[] = "\n@(#)LIBF77 VERSION 2.01 29 Aug. 1995\n"; /* + */ + + char __G77_LIBF77_VERSION__[] = "0.5.16"; + + /* 2.00 11 June 1980. File version.c added to library. 2.01 31 May 1988. s_paus() flushes stderr; names of hl_* fixed *************** static char junk[] = "\n@(#)LIBF77 VERSI *** 36,38 **** --- 41,53 ---- 27 Jan. 1995: minor tweak to s_copy.c: copy forward whenever possible (for better cache behavior). + 30 May 1995: added subroutine exit(rc) integer rc. Version not changed. + 29 Aug. 1995: add F77_aloc.c; use it in s_cat.c and system_.c. */ + + #include "stdio.h" + + void + g77_libf77_version () + { + fprintf (stderr, "__G77_LIBF77_VERSION__: %s\n", __G77_LIBF77_VERSION__); + } diff -rcp2N g77-0.5.15/f/runtime/libF77/exit.c g77-0.5.16/f/runtime/libF77/exit.c *** g77-0.5.15/f/runtime/libF77/exit.c --- g77-0.5.16/f/runtime/libF77/exit.c Mon Aug 7 08:17:41 1995 *************** *** 0 **** --- 1,37 ---- + /* This gives the effect of + + subroutine exit(rc) + integer*4 rc + stop + end + + * with the added side effect of supplying rc as the program's exit code. + */ + + #include "f2c.h" + #undef abs + #undef min + #undef max + #ifndef KR_headers + #include "stdlib.h" + #ifdef __cplusplus + extern "C" { + #endif + extern void f_exit(void); + #endif + + void + #ifdef KR_headers + exit_(rc) integer *rc; + #else + exit_(integer *rc) + #endif + { + #ifdef NO_ONEXIT + f_exit(); + #endif + exit(*rc); + } + #ifdef __cplusplus + } + #endif diff -rcp2N g77-0.5.15/f/runtime/libF77/main.c g77-0.5.16/f/runtime/libF77/main.c *** g77-0.5.15/f/runtime/libF77/main.c Fri Nov 18 16:25:38 1994 --- g77-0.5.16/f/runtime/libF77/main.c Wed Aug 30 14:27:17 1995 *************** *** 11,16 **** --- 11,22 ---- #ifndef KR_headers + #undef VOID #include "stdlib.h" #endif + + #ifndef VOID + #define VOID void + #endif + #ifdef __cplusplus extern "C" { *************** extern "C" { *** 19,23 **** #ifdef NO__STDC #define ONEXIT onexit ! extern void f_exit(); #else #ifndef KR_headers --- 25,29 ---- #ifdef NO__STDC #define ONEXIT onexit ! extern VOID f_exit(); #else #ifndef KR_headers *************** extern int atexit(void (*)(void)); *** 30,34 **** #ifndef NO_ONEXIT #define ONEXIT onexit ! extern void f_exit(); #endif #endif --- 36,40 ---- #ifndef NO_ONEXIT #define ONEXIT onexit ! extern VOID f_exit(); #endif #endif *************** extern void f_exit(); *** 36,40 **** #ifdef KR_headers ! extern void f_init(), sig_die(); extern int MAIN__(); #define Int /* int */ --- 42,46 ---- #ifdef KR_headers ! extern VOID f_init(), sig_die(); extern int MAIN__(); #define Int /* int */ *************** extern int MAIN__(void); *** 45,49 **** #endif ! static void sigfdie(Int n) { sig_die("Floating Exception", 1); --- 51,55 ---- #endif ! static VOID sigfdie(Int n) { sig_die("Floating Exception", 1); *************** sig_die("Floating Exception", 1); *** 51,55 **** ! static void sigidie(Int n) { sig_die("IOT Trap", 1); --- 57,61 ---- ! static VOID sigidie(Int n) { sig_die("IOT Trap", 1); *************** sig_die("IOT Trap", 1); *** 57,61 **** #ifdef SIGQUIT ! static void sigqdie(Int n) { sig_die("Quit signal", 1); --- 63,67 ---- #ifdef SIGQUIT ! static VOID sigqdie(Int n) { sig_die("Quit signal", 1); *************** sig_die("Quit signal", 1); *** 64,68 **** ! static void sigindie(Int n) { sig_die("Interrupt", 0); --- 70,74 ---- ! static VOID sigindie(Int n) { sig_die("Interrupt", 0); *************** sig_die("Interrupt", 0); *** 69,73 **** } ! static void sigtdie(Int n) { sig_die("Killed", 0); --- 75,79 ---- } ! static VOID sigtdie(Int n) { sig_die("Killed", 0); *************** sig_die("Killed", 0); *** 75,79 **** #ifdef SIGTRAP ! static void sigtrdie(Int n) { sig_die("Trace trap", 1); --- 81,85 ---- #ifdef SIGTRAP ! static VOID sigtrdie(Int n) { sig_die("Trace trap", 1); diff -rcp2N g77-0.5.15/f/runtime/libF77/s_cat.c g77-0.5.16/f/runtime/libF77/s_cat.c *** g77-0.5.15/f/runtime/libF77/s_cat.c Sun Feb 12 01:06:46 1995 --- g77-0.5.16/f/runtime/libF77/s_cat.c Wed Aug 30 14:27:18 1995 *************** *** 6,15 **** #include "f2c.h" #ifndef NO_OVERWRITE #undef abs #ifdef KR_headers ! extern char *malloc(); extern void free(); #else #include "stdlib.h" #endif #include "string.h" --- 6,18 ---- #include "f2c.h" #ifndef NO_OVERWRITE + #include "stdio.h" #undef abs #ifdef KR_headers ! extern char *F77_aloc(); extern void free(); + extern void exit_(); #else #include "stdlib.h" + extern char *F77_aloc(ftnlen, char*); #endif #include "string.h" *************** s_cat(char *lp, char *rpp[], ftnlen rnp[ *** 46,50 **** } lp0 = lp; ! lp = lp1 = malloc(L = ll); } #endif /* NO_OVERWRITE */ --- 49,53 ---- } lp0 = lp; ! lp = lp1 = F77_aloc(L = ll, "s_cat"); } #endif /* NO_OVERWRITE */ diff -rcp2N g77-0.5.15/f/runtime/libF77/signal_.c g77-0.5.16/f/runtime/libF77/signal_.c *** g77-0.5.15/f/runtime/libF77/signal_.c Sun Feb 12 01:06:47 1995 --- g77-0.5.16/f/runtime/libF77/signal_.c Wed Aug 30 14:27:18 1995 *************** ftnint signal_(sigp, proc) integer *sigp *** 17,22 **** #else #include "signal.h" ! ftnint signal_(integer *sigp, sig_type proc) #endif { --- 17,23 ---- #else #include "signal.h" + typedef int (*sig_proc)(int); ! ftnint signal_(integer *sigp, sig_proc proc) #endif { *************** ftnint signal_(integer *sigp, sig_type p *** 24,28 **** sig = (int)*sigp; ! signal(sig, proc); return 0; } --- 25,29 ---- sig = (int)*sigp; ! return (ftnint)signal(sig, (sig_type)proc); return 0; } diff -rcp2N g77-0.5.15/f/runtime/libF77/system_.c g77-0.5.16/f/runtime/libF77/system_.c *** g77-0.5.15/f/runtime/libF77/system_.c Fri Nov 18 16:26:28 1994 --- g77-0.5.16/f/runtime/libF77/system_.c Wed Aug 30 14:33:25 1995 *************** *** 4,7 **** --- 4,10 ---- #ifdef KR_headers + extern char *F77_aloc(); + + integer system_(s, n) register char *s; ftnlen n; #else *************** system_(s, n) register char *s; ftnlen n *** 10,24 **** #undef max #include "stdlib.h" system_(register char *s, ftnlen n) #endif { ! char buff[1000]; ! register char *bp, *blast; ! blast = buff + (n < 1000 ? n : 1000); ! for(bp = buff ; bpufd); ! if(xufd,x,SEEK_SET); n=fread(buf,1,(int)(y-x), b->ufd); ! for(i=n-ndec;i>=0;i--) { if(buf[i]!='\n') continue; --- 51,64 ---- w = -1; #endif ! for(ndec = 1;; ndec = 0) { ! y = x = ftell(b->ufd); ! if(x < sizeof(buf)) ! x = 0; ! else ! x -= sizeof(buf); (void) fseek(b->ufd,x,SEEK_SET); n=fread(buf,1,(int)(y-x), b->ufd); ! for(i = n - ndec; --i >= 0; ) { if(buf[i]!='\n') continue; *************** integer f_back(alist *a) *** 66,73 **** k++; fseek(b->ufd,x,SEEK_SET); ! do { if (getc(b->ufd) == '\n') { ! --k; ! if ((z = ftell(b->ufd)) >= y) { if (w == -1) goto break2; --- 68,74 ---- k++; fseek(b->ufd,x,SEEK_SET); ! for(;;) if (getc(b->ufd) == '\n') { ! if ((z = ftell(b->ufd)) >= y && ndec) { if (w == -1) goto break2; *************** integer f_back(alist *a) *** 74,80 **** break; } w = z; } - } while(k > 0); fseek(b->ufd, w, SEEK_SET); #else --- 75,82 ---- break; } + if (--k <= 0) + return 0; w = z; } fseek(b->ufd, w, SEEK_SET); #else diff -rcp2N g77-0.5.15/f/runtime/libI77/iio.c g77-0.5.16/f/runtime/libI77/iio.c *** g77-0.5.15/f/runtime/libI77/iio.c Wed Apr 12 10:03:18 1995 --- g77-0.5.16/f/runtime/libI77/iio.c Mon Aug 7 08:17:41 1995 *************** integer s_rsfi(icilist *a) *** 96,99 **** --- 96,103 ---- z_wnew(Void) { + if (f__recpos < f__hiwater) { + f__icptr += f__hiwater - f__recpos; + f__recpos = f__hiwater; + } while(f__recpos++ < f__svic->icirlen) *f__icptr++ = ' '; diff -rcp2N g77-0.5.15/f/runtime/libI77/lwrite.c g77-0.5.16/f/runtime/libI77/lwrite.c *** g77-0.5.15/f/runtime/libI77/lwrite.c Fri Nov 18 16:18:04 1994 --- g77-0.5.16/f/runtime/libI77/lwrite.c Thu Aug 17 06:19:07 1995 *************** l_g(char *buf, double n) *** 108,111 **** --- 108,112 ---- sprintf(b, LGFMT, n); switch(*b) { + #ifndef WANT_LEAD_0 case '0': while(b[0] = b[1]) *************** l_g(char *buf, double n) *** 112,115 **** --- 113,117 ---- b++; break; + #endif case 'i': case 'I': diff -rcp2N g77-0.5.15/f/runtime/libI77/open.c g77-0.5.16/f/runtime/libI77/open.c *** g77-0.5.15/f/runtime/libI77/open.c Fri Nov 18 16:18:05 1994 --- g77-0.5.16/f/runtime/libI77/open.c Sun Aug 20 17:06:09 1995 *************** integer f_open(olist *a) *** 82,85 **** --- 82,86 ---- struct stat stb; #endif + if(!f__init) f_init(); if(a->ounit>=MXUNIT || a->ounit<0) err(a->oerr,101,"open") diff -rcp2N g77-0.5.15/f/runtime/libI77/rawio.h g77-0.5.16/f/runtime/libI77/rawio.h *** g77-0.5.15/f/runtime/libI77/rawio.h Thu Jan 12 17:11:52 1995 --- g77-0.5.16/f/runtime/libI77/rawio.h Mon Aug 7 08:17:41 1995 *************** extern char *mktemp(char*); *** 34,38 **** --- 34,40 ---- #endif + #ifndef NO_FCNTL #include "fcntl.h" + #endif #ifndef O_WRONLY diff -rcp2N g77-0.5.15/f/runtime/libI77/rsne.c g77-0.5.16/f/runtime/libI77/rsne.c *** g77-0.5.15/f/runtime/libI77/rsne.c Fri Nov 18 16:18:12 1994 --- g77-0.5.16/f/runtime/libI77/rsne.c Sun Aug 20 17:06:09 1995 *************** s_rsne(cilist *a) *** 552,555 **** --- 552,556 ---- int n; + if(!f__init) f_init(); f__external=1; l_eof = 0; diff -rcp2N g77-0.5.15/f/runtime/libI77/wref.c g77-0.5.16/f/runtime/libI77/wref.c *** g77-0.5.15/f/runtime/libI77/wref.c Sun Feb 12 01:06:49 1995 --- g77-0.5.16/f/runtime/libI77/wref.c Thu Aug 17 06:19:08 1995 *************** wrt_E(ufloat *p, int w, int d, int e, ft *** 24,27 **** --- 24,30 ---- int d1, delta, e1, i, sign, signspace; double dd; + #ifdef WANT_LEAD_0 + int insert0 = 0; + #endif #ifndef VAX int e0 = e; *************** wrt_E(ufloat *p, int w, int d, int e, ft *** 54,57 **** --- 57,67 ---- delta = w - (2 /* for the . and the d adjustment above */ + 2 /* for the E+ */ + signspace + d + e); + #ifdef WANT_LEAD_0 + if (f__scale <= 0 && delta > 0) { + delta--; + insert0 = 1; + } + else + #endif if (delta < 0) { nogood: *************** nogood: *** 145,148 **** --- 155,162 ---- i = f__scale; if (f__scale <= 0) { + #ifdef WANT_LEAD_0 + if (insert0) + PUT('0'); + #endif PUT('.'); for(; i < 0; ++i) *************** wrt_F(ufloat *p, int w, int d, ftnlen le *** 217,222 **** --- 231,238 ---- #endif + #ifndef WANT_LEAD_0 if (buf[0] == '0' && d) { ++b; --n; } + #endif if (sign) { /* check for all zeros */ *************** wrt_F(ufloat *p, int w, int d, ftnlen le *** 235,241 **** ++n; if (n > w) { ! while(--w >= 0) ! PUT('*'); ! return 0; } for(w -= n; --w >= 0; ) --- 251,264 ---- ++n; if (n > w) { ! #ifdef WANT_LEAD_0 ! if (buf[0] == '0' && --n == w) ! ++b; ! else ! #endif ! { ! while(--w >= 0) ! PUT('*'); ! return 0; ! } } for(w -= n; --w >= 0; ) diff -rcp2N g77-0.5.15/f/runtime/libI77/wrtfmt.c g77-0.5.16/f/runtime/libI77/wrtfmt.c *** g77-0.5.15/f/runtime/libI77/wrtfmt.c Sun Feb 12 01:06:49 1995 --- g77-0.5.16/f/runtime/libI77/wrtfmt.c Thu Aug 17 06:19:08 1995 *************** wrt_G(ufloat *p, int w, int d, int e, ft *** 289,292 **** --- 289,295 ---- if (x != 0.) return(wrt_E(p,w,d,e,len)); + #ifdef WANT_LEAD_0 + i = 1; + #endif goto have_i; } diff -rcp2N g77-0.5.15/f/src.c g77-0.5.16/f/src.c *** g77-0.5.15/f/src.c Wed Feb 15 16:58:39 1995 --- g77-0.5.16/f/src.c Wed Aug 30 15:53:35 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: diff -rcp2N g77-0.5.15/f/src.h g77-0.5.16/f/src.h *** g77-0.5.15/f/src.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/src.h Wed Aug 30 15:53:35 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/st.c g77-0.5.16/f/st.c *** g77-0.5.15/f/st.c Wed Feb 15 16:58:39 1995 --- g77-0.5.16/f/st.c Wed Aug 30 15:53:35 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: diff -rcp2N g77-0.5.15/f/st.h g77-0.5.16/f/st.h *** g77-0.5.15/f/st.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/st.h Wed Aug 30 15:53:35 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/sta.c g77-0.5.16/f/sta.c *** g77-0.5.15/f/sta.c Wed Apr 12 10:03:19 1995 --- g77-0.5.16/f/sta.c Wed Aug 30 15:53:35 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** ffesta_save_ (ffelexToken t) *** 316,320 **** /* If this is an EOS or SEMICOLON token, switch to next handler, else ! return self as next handler for lexer. */ switch (ffelex_token_type (t)) --- 317,321 ---- /* If this is an EOS or SEMICOLON token, switch to next handler, else ! return self as next handler for lexer. */ switch (ffelex_token_type (t)) *************** ffesta_second_ (ffelexToken t) *** 831,838 **** /* WARNING: don't put anything that might cause an item to precede ! FORMAT in the list of possible statements (it's added below) without ! making sure FORMAT still is first. It has to run with ! ffelex_set_names_pure(TRUE), to make sure the lexer delivers NAMES ! tokens. */ case FFESTR_firstFORMAT: --- 832,839 ---- /* WARNING: don't put anything that might cause an item to precede ! FORMAT in the list of possible statements (it's added below) without ! making sure FORMAT still is first. It has to run with ! ffelex_set_names_pure(TRUE), to make sure the lexer delivers NAMES ! tokens. */ case FFESTR_firstFORMAT: *************** ffesta_second_ (ffelexToken t) *** 973,977 **** /* For now, a decent error message for an unconfirmed stmt, rather than ! just whatever is at the top of the list. */ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_unimplemented); --- 974,978 ---- /* For now, a decent error message for an unconfirmed stmt, rather than ! just whatever is at the top of the list. */ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_unimplemented); *************** ffesta_second_ (ffelexToken t) *** 1152,1156 **** goto no_stmts; /* :::::::::::::::::::: */ /* 1 exec stmt only, but not valid in context, so pretend as though ! statement is unrecognized. */ break; --- 1153,1157 ---- goto no_stmts; /* :::::::::::::::::::: */ /* 1 exec stmt only, but not valid in context, so pretend as though ! statement is unrecognized. */ break; diff -rcp2N g77-0.5.15/f/sta.h g77-0.5.16/f/sta.h *** g77-0.5.15/f/sta.h Wed Apr 12 10:03:19 1995 --- g77-0.5.16/f/sta.h Wed Aug 30 15:53:34 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/stb.c g77-0.5.16/f/stb.c *** g77-0.5.15/f/stb.c Wed Apr 12 10:03:24 1995 --- g77-0.5.16/f/stb.c Wed Aug 30 15:53:34 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** ffestb_subr_dimlist_ (ffelexToken ft, ff *** 1193,1197 **** static ffelexHandler ! ffestb_subr_dimlist_1_ (ffelexToken ft, ffebld expr, ffelexToken t) { switch (ffelex_token_type (t)) --- 1194,1198 ---- static ffelexHandler ! ffestb_subr_dimlist_1_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) { switch (ffelex_token_type (t)) *************** ffestb_subr_dimlist_1_ (ffelexToken ft, *** 1224,1228 **** static ffelexHandler ! ffestb_subr_dimlist_2_ (ffelexToken ft, ffebld expr, ffelexToken t) { switch (ffelex_token_type (t)) --- 1225,1229 ---- static ffelexHandler ! ffestb_subr_dimlist_2_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) { switch (ffelex_token_type (t)) *************** bad_1: /* :::::::::::::::::::: */ *** 4219,4223 **** static ffelexHandler ! ffestb_let1_ (ffelexToken ft, ffebld expr, ffelexToken t) { ffestb_local_.let.dest = expr; --- 4220,4224 ---- static ffelexHandler ! ffestb_let1_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) { ffestb_local_.let.dest = expr; *************** ffestb_varlist (ffelexToken t) *** 4805,4811 **** /* Here, we have at least one char after the first keyword and t is ! COMMA or EOS/SEMICOLON. Also we know that this form is valid for ! only the statements reaching here (specifically, INTENT won't reach ! here). */ if (!ffesrc_is_name_init (*p)) --- 4806,4812 ---- /* Here, we have at least one char after the first keyword and t is ! COMMA or EOS/SEMICOLON. Also we know that this form is valid for ! only the statements reaching here (specifically, INTENT won't reach ! here). */ if (!ffesrc_is_name_init (*p)) *************** ffestb_R522 (ffelexToken t) *** 5368,5372 **** /* Here, we have at least one char after "SAVE" and t is COMMA or ! EOS/SEMICOLON. */ if (!ffesrc_is_name_init (*p)) --- 5369,5373 ---- /* Here, we have at least one char after "SAVE" and t is COMMA or ! EOS/SEMICOLON. */ if (!ffesrc_is_name_init (*p)) *************** bad_i: /* :::::::::::::::::::: */ *** 7814,7818 **** ffelexHandler ! ffestb_construct (ffelexToken t) { /* This handler gets invoked only when token 0 is NAME/NAMES and token 1 is --- 7815,7819 ---- ffelexHandler ! ffestb_construct (ffelexToken t UNUSED) { /* This handler gets invoked only when token 0 is NAME/NAMES and token 1 is *************** ffestb_module (ffelexToken t) *** 8229,8238 **** /* Here we know that we're indeed looking at a MODULEPROCEDURE ! statement rather than MODULE and that the character following ! MODULEPROCEDURE in the NAMES token is a valid first character for a ! NAME. This means that unless the second token is COMMA, we have an ! ambiguous statement that can be read either as MODULE PROCEDURE name ! or MODULE PROCEDUREname, the former being an R1205, the latter an ! R1105. */ if (ffesta_first_kw != FFESTR_firstMODULEPROCEDURE) --- 8230,8239 ---- /* Here we know that we're indeed looking at a MODULEPROCEDURE ! statement rather than MODULE and that the character following ! MODULEPROCEDURE in the NAMES token is a valid first character for a ! NAME. This means that unless the second token is COMMA, we have an ! ambiguous statement that can be read either as MODULE PROCEDURE name ! or MODULE PROCEDUREname, the former being an R1205, the latter an ! R1105. */ if (ffesta_first_kw != FFESTR_firstMODULEPROCEDURE) *************** ffestb_R8103_ (ffelexToken ft, ffebld ex *** 8866,8870 **** static ffelexHandler ! ffestb_R8104_ (ffelexToken ft, ffebld expr, ffelexToken t) { switch (ffelex_token_type (t)) --- 8867,8871 ---- static ffelexHandler ! ffestb_R8104_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) { switch (ffelex_token_type (t)) *************** ffestb_R10014_ (ffelexToken t) *** 9695,9699 **** /* Here we have [number]P[number][text]. Treat as ! [number]P,[number][text]. */ ffestb_subr_R1001_append_p_ (); --- 9696,9700 ---- /* Here we have [number]P[number][text]. Treat as ! [number]P,[number][text]. */ ffestb_subr_R1001_append_p_ (); *************** ffestb_R100114_ (ffelexToken t) *** 10834,10838 **** static ffelexHandler ! ffestb_R100115_ (ffelexToken ft, ffebld expr, ffelexToken t) { switch (ffelex_token_type (t)) --- 10835,10839 ---- static ffelexHandler ! ffestb_R100115_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) { switch (ffelex_token_type (t)) *************** ffestb_R100115_ (ffelexToken ft, ffebld *** 10861,10865 **** static ffelexHandler ! ffestb_R100116_ (ffelexToken ft, ffebld expr, ffelexToken t) { switch (ffelex_token_type (t)) --- 10862,10866 ---- static ffelexHandler ! ffestb_R100116_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) { switch (ffelex_token_type (t)) *************** ffestb_R100116_ (ffelexToken ft, ffebld *** 10891,10895 **** static ffelexHandler ! ffestb_R100117_ (ffelexToken ft, ffebld expr, ffelexToken t) { switch (ffelex_token_type (t)) --- 10892,10896 ---- static ffelexHandler ! ffestb_R100117_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) { switch (ffelex_token_type (t)) *************** ffestb_R100117_ (ffelexToken ft, ffebld *** 10923,10927 **** static ffelexHandler ! ffestb_R100118_ (ffelexToken ft, ffebld expr, ffelexToken t) { switch (ffelex_token_type (t)) --- 10924,10928 ---- static ffelexHandler ! ffestb_R100118_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) { switch (ffelex_token_type (t)) *************** ffestb_V014 (ffelexToken t) *** 12210,12214 **** /* Here, we have at least one char after "VOLATILE" and t is COMMA or ! EOS/SEMICOLON. */ if (!ffesrc_is_name_init (*p)) --- 12211,12215 ---- /* Here, we have at least one char after "VOLATILE" and t is COMMA or ! EOS/SEMICOLON. */ if (!ffesrc_is_name_init (*p)) *************** ffestb_vxtcode9_ (ffelexToken t) *** 13960,13964 **** /* EXTENSION: Allow an optional preceding COMMA here if not pedantic. ! (f2c provides this extension, as do other compilers, supposedly.) */ if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA)) --- 13961,13965 ---- /* EXTENSION: Allow an optional preceding COMMA here if not pedantic. ! (f2c provides this extension, as do other compilers, supposedly.) */ if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA)) *************** ffestb_R91012_ (ffelexToken t) *** 16203,16207 **** /* EXTENSION: Allow an optional preceding COMMA here if not pedantic. ! (f2c provides this extension, as do other compilers, supposedly.) */ if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA)) --- 16204,16208 ---- /* EXTENSION: Allow an optional preceding COMMA here if not pedantic. ! (f2c provides this extension, as do other compilers, supposedly.) */ if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA)) *************** ffestb_V01812_ (ffelexToken t) *** 17529,17533 **** /* EXTENSION: Allow an optional preceding COMMA here if not pedantic. ! (f2c provides this extension, as do other compilers, supposedly.) */ if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA)) --- 17530,17534 ---- /* EXTENSION: Allow an optional preceding COMMA here if not pedantic. ! (f2c provides this extension, as do other compilers, supposedly.) */ if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA)) *************** ffestb_R524 (ffelexToken t) *** 19538,19542 **** /* Here, we have at least one char after "DIMENSION" and t is ! OPEN_PAREN. */ if (!ffesrc_is_name_init (*p)) --- 19539,19543 ---- /* Here, we have at least one char after "DIMENSION" and t is ! OPEN_PAREN. */ if (!ffesrc_is_name_init (*p)) *************** ffestb_R547 (ffelexToken t) *** 19783,19787 **** /* Here, we have at least one char after "COMMON" and t is COMMA, ! EOS/SEMICOLON, OPEN_PAREN, SLASH, or CONCAT. */ if (!ffesrc_is_name_init (*p)) --- 19784,19788 ---- /* Here, we have at least one char after "COMMON" and t is COMMA, ! EOS/SEMICOLON, OPEN_PAREN, SLASH, or CONCAT. */ if (!ffesrc_is_name_init (*p)) *************** ffestb_V003 (ffelexToken t) *** 23481,23485 **** /* Here, we have at least one char after "STRUCTURE" and t is COMMA, ! EOS/SEMICOLON, or OPEN_PAREN. */ if (!ffesrc_is_name_init (*p)) --- 23482,23486 ---- /* Here, we have at least one char after "STRUCTURE" and t is COMMA, ! EOS/SEMICOLON, or OPEN_PAREN. */ if (!ffesrc_is_name_init (*p)) diff -rcp2N g77-0.5.15/f/stb.h g77-0.5.16/f/stb.h *** g77-0.5.15/f/stb.h Wed Apr 12 10:03:25 1995 --- g77-0.5.16/f/stb.h Wed Aug 30 15:53:34 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/stc.c g77-0.5.16/f/stc.c *** g77-0.5.15/f/stc.c Fri May 19 11:17:31 1995 --- g77-0.5.16/f/stc.c Wed Aug 30 15:53:34 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** ffestc_labeldef_useless_ () *** 1265,1269 **** ffelab_set_type (ffestc_label_, FFELAB_typeANY); ffestd_labeldef_any (ffestc_label_); ! if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO) || (ffestw_label (ffestw_stack_top ()) != ffestc_label_)) --- 1266,1270 ---- ffelab_set_type (ffestc_label_, FFELAB_typeANY); ffestd_labeldef_any (ffestc_label_); ! if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO) || (ffestw_label (ffestw_stack_top ()) != ffestc_label_)) *************** ffestc_promote_sfdummy_ (ffelexToken t) *** 4463,4466 **** --- 4464,4468 ---- } + ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD); ffesymbol_set_maxentrynum (s, ffestc_sfdummy_argno_++); ffesymbol_signal_unreported (s); *************** ffestc_decl_start (ffestpType type, ffel *** 5307,5312 **** void ! ffestc_decl_attrib (ffestpAttrib attrib, ffelexToken attribt, ! ffestrOther intent_kw, ffesttDimList dims) { #if FFESTR_F90 --- 5309,5316 ---- void ! ffestc_decl_attrib (ffestpAttrib attrib UNUSED, ! ffelexToken attribt UNUSED, ! ffestrOther intent_kw UNUSED, ! ffesttDimList dims UNUSED) { #if FFESTR_F90 *************** ffestc_R501_start (ffestpType type, ffel *** 6182,6186 **** void ffestc_R501_attrib (ffestpAttrib attrib, ffelexToken attribt, ! ffestrOther intent_kw, ffesttDimList dims) { ffestc_check_attrib_ (); --- 6186,6191 ---- void ffestc_R501_attrib (ffestpAttrib attrib, ffelexToken attribt, ! ffestrOther intent_kw UNUSED, ! ffesttDimList dims UNUSED) { ffestc_check_attrib_ (); *************** ffestc_R528_start () *** 7530,7534 **** void ! ffestc_R528_item_object (ffebld expr, ffelexToken expr_token) { ffestc_check_item_ (); --- 7535,7539 ---- void ! ffestc_R528_item_object (ffebld expr, ffelexToken expr_token UNUSED) { ffestc_check_item_ (); *************** ffestc_R544_equiv_ (ffebld expr, ffelexT *** 8136,8141 **** else if (ffestc_local_.equiv.eq != ffesymbol_equiv (s)) { ! ffestc_local_.equiv.eq = ffeequiv_merge (ffestc_local_.equiv.eq, ! ffesymbol_equiv (s), t); if (ffestc_local_.equiv.eq == NULL) ffestc_local_.equiv.ok = FALSE; /* Couldn't merge. */ --- 8141,8147 ---- else if (ffestc_local_.equiv.eq != ffesymbol_equiv (s)) { ! ffestc_local_.equiv.eq = ffeequiv_merge (ffesymbol_equiv (s), ! ffestc_local_.equiv.eq, ! t); if (ffestc_local_.equiv.eq == NULL) ffestc_local_.equiv.ok = FALSE; /* Couldn't merge. */ *************** ffestc_R745 () *** 8689,8693 **** void ! ffestc_R803 (ffelexToken construct_name, ffebld expr, ffelexToken expr_token) { ffestw b; --- 8695,8700 ---- void ! ffestc_R803 (ffelexToken construct_name, ffebld expr, ! ffelexToken expr_token UNUSED) { ffestw b; *************** ffestc_R803 (ffelexToken construct_name, *** 8743,8747 **** void ! ffestc_R804 (ffebld expr, ffelexToken expr_token, ffelexToken name) { ffestc_check_simple_ (); --- 8750,8755 ---- void ! ffestc_R804 (ffebld expr, ffelexToken expr_token UNUSED, ! ffelexToken name) { ffestc_check_simple_ (); *************** ffestc_R806 (ffelexToken name) *** 8897,8901 **** void ! ffestc_R807 (ffebld expr, ffelexToken expr_token) { ffestw b; --- 8905,8909 ---- void ! ffestc_R807 (ffebld expr, ffelexToken expr_token UNUSED) { ffestw b; *************** ffestc_R819A (ffelexToken construct_name *** 9382,9387 **** void ! ffestc_R819B (ffelexToken construct_name, ffelexToken label_token, ffebld expr, ! ffelexToken expr_token) { ffestw b; --- 9390,9395 ---- void ! ffestc_R819B (ffelexToken construct_name, ffelexToken label_token, ! ffebld expr, ffelexToken expr_token UNUSED) { ffestw b; *************** ffestc_R820A (ffelexToken construct_name *** 9561,9565 **** void ! ffestc_R820B (ffelexToken construct_name, ffebld expr, ffelexToken expr_token) { ffestw b; --- 9569,9574 ---- void ! ffestc_R820B (ffelexToken construct_name, ffebld expr, ! ffelexToken expr_token UNUSED) { ffestw b; *************** ffestc_R834 (ffelexToken name) *** 9705,9709 **** block = ffestw_top_do (ffestw_previous (block))) { ! if (ffelex_token_strcmp (name, ffestw_name (block)) == 0) break; } --- 9714,9719 ---- block = ffestw_top_do (ffestw_previous (block))) { ! if ((ffestw_name (block) != NULL) ! && (ffelex_token_strcmp (name, ffestw_name (block)) == 0)) break; } *************** ffestc_R835 (ffelexToken name) *** 9754,9758 **** block = ffestw_top_do (ffestw_previous (block))) { ! if (ffelex_token_strcmp (name, ffestw_name (block)) == 0) break; } --- 9764,9769 ---- block = ffestw_top_do (ffestw_previous (block))) { ! if ((ffestw_name (block) != NULL) ! && (ffelex_token_strcmp (name, ffestw_name (block)) == 0)) break; } *************** ffestc_R836 (ffelexToken label_token) *** 9817,9821 **** void ! ffestc_R837 (ffesttTokenList label_toks, ffebld expr, ffelexToken expr_token) { ffesttTokenItem ti; --- 9828,9833 ---- void ! ffestc_R837 (ffesttTokenList label_toks, ffebld expr, ! ffelexToken expr_token UNUSED) { ffesttTokenItem ti; *************** ffestc_R837 (ffesttTokenList label_toks, *** 9864,9868 **** void ! ffestc_R838 (ffelexToken label_token, ffebld target, ffelexToken target_token) { ffelab label; --- 9876,9881 ---- void ! ffestc_R838 (ffelexToken label_token, ffebld target, ! ffelexToken target_token UNUSED) { ffelab label; *************** ffestc_R838 (ffelexToken label_token, ff *** 9889,9893 **** void ! ffestc_R839 (ffebld target, ffelexToken target_token, ffesttTokenList label_toks) { --- 9902,9906 ---- void ! ffestc_R839 (ffebld target, ffelexToken target_token UNUSED, ffesttTokenList label_toks) { *************** ffestc_R839 (ffebld target, ffelexToken *** 9944,9949 **** void ! ffestc_R840 (ffebld expr, ffelexToken expr_token, ffelexToken neg_token, ! ffelexToken zero_token, ffelexToken pos_token) { ffelab neg; --- 9957,9963 ---- void ! ffestc_R840 (ffebld expr, ffelexToken expr_token UNUSED, ! ffelexToken neg_token, ffelexToken zero_token, ! ffelexToken pos_token) { ffelab neg; *************** ffestc_R841 () *** 10018,10022 **** void ! ffestc_R842 (ffebld expr, ffelexToken expr_token) { ffestc_check_simple_ (); --- 10032,10036 ---- void ! ffestc_R842 (ffebld expr, ffelexToken expr_token UNUSED) { ffestc_check_simple_ (); *************** ffestc_R842 (ffebld expr, ffelexToken ex *** 10045,10049 **** void ! ffestc_R843 (ffebld expr, ffelexToken expr_token) { ffestc_check_simple_ (); --- 10059,10063 ---- void ! ffestc_R843 (ffebld expr, ffelexToken expr_token UNUSED) { ffestc_check_simple_ (); *************** ffestc_R923B_start () *** 11235,11239 **** void ! ffestc_R923B_item (ffebld expr, ffelexToken expr_token) { ffestc_check_item_ (); --- 11249,11253 ---- void ! ffestc_R923B_item (ffebld expr, ffelexToken expr_token UNUSED) { ffestc_check_item_ (); *************** ffestc_R1106 (ffelexToken name) *** 11421,11425 **** if ((name != NULL) ! && (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0)) { ffebad_start (FFEBAD_UNIT_WRONG_NAME); --- 11435,11439 ---- if ((name != NULL) ! && (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0)) { ffebad_start (FFEBAD_UNIT_WRONG_NAME); *************** ffestc_R1208_finish () *** 11935,11939 **** void ! ffestc_R1212 (ffebld expr, ffelexToken expr_token) { ffebld item; /* ITEM. */ --- 11949,11953 ---- void ! ffestc_R1212 (ffebld expr, ffelexToken expr_token UNUSED) { ffebld item; /* ITEM. */ *************** ffestc_R1213 (ffebld dest, ffebld source *** 12019,12023 **** void ffestc_R1219 (ffelexToken funcname, ffesttTokenList args, ! ffelexToken final, ffestpType type, ffebld kind, ffelexToken kindt, ffebld len, ffelexToken lent, ffelexToken recursive, ffelexToken result) --- 12033,12037 ---- void ffestc_R1219 (ffelexToken funcname, ffesttTokenList args, ! ffelexToken final UNUSED, ffestpType type, ffebld kind, ffelexToken kindt, ffebld len, ffelexToken lent, ffelexToken recursive, ffelexToken result) *************** ffestc_R1225 (ffelexToken name) *** 12299,12303 **** void ! ffestc_R1226 (ffelexToken entryname, ffesttTokenList args, ffelexToken final) { ffesymbol s; --- 12313,12318 ---- void ! ffestc_R1226 (ffelexToken entryname, ffesttTokenList args, ! ffelexToken final UNUSED) { ffesymbol s; *************** ffestc_R1226 (ffelexToken entryname, ffe *** 12379,12383 **** /* Figure out what kind of object we've got based on previous ! declarations of or references to the object. */ if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD) --- 12394,12398 ---- /* Figure out what kind of object we've got based on previous ! declarations of or references to the object. */ if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD) *************** ffestc_R1226 (ffelexToken entryname, ffe *** 12392,12397 **** /* Now see what we've got for a new object: NONE means a new error ! cropped up; ANY means an old error to be ignored; otherwise, ! everything's ok, update the object (symbol) and continue on. */ if (na == FFESYMBOL_attrsetNONE) --- 12407,12412 ---- /* Now see what we've got for a new object: NONE means a new error ! cropped up; ANY means an old error to be ignored; otherwise, ! everything's ok, update the object (symbol) and continue on. */ if (na == FFESYMBOL_attrsetNONE) *************** ffestc_R1226 (ffelexToken entryname, ffe *** 12425,12430 **** /* Since ENTRY might appear after executable stmts, do what would have ! been done if it hadn't -- give symbol implicit type and ! exec-transition it. */ if (!in_spec && ffesymbol_is_specable (s)) --- 12440,12445 ---- /* Since ENTRY might appear after executable stmts, do what would have ! been done if it hadn't -- give symbol implicit type and ! exec-transition it. */ if (!in_spec && ffesymbol_is_specable (s)) *************** ffestc_R1226 (ffelexToken entryname, ffe *** 12436,12440 **** /* Use whatever type info is available for ENTRY to set up type for its ! global-name-space function symbol relative. */ ffesymbol_set_info (fs, --- 12451,12455 ---- /* Use whatever type info is available for ENTRY to set up type for its ! global-name-space function symbol relative. */ ffesymbol_set_info (fs, *************** ffestc_R1226 (ffelexToken entryname, ffe *** 12447,12458 **** /* Now implicit-type and exec-transition the FUNCTION. ~~Question??: ! When ENTRY FOO() RESULT(IBAR) is supported, what will the typing be ! if FOO and IBAR would normally end up with different types? I think ! the answer is that FOO is always given whatever type would be chosen ! for IBAR, rather than the other way around, and I think it ends up ! working that way for FUNCTION FOO() RESULT(IBAR), but this should be ! checked out in all its different combos. Related question is, is ! there any way that FOO in either case ends up without type info ! filled in? Does anyone care? */ ffesymbol_signal_unreported (s); --- 12462,12473 ---- /* Now implicit-type and exec-transition the FUNCTION. ~~Question??: ! When ENTRY FOO() RESULT(IBAR) is supported, what will the typing be ! if FOO and IBAR would normally end up with different types? I think ! the answer is that FOO is always given whatever type would be chosen ! for IBAR, rather than the other way around, and I think it ends up ! working that way for FUNCTION FOO() RESULT(IBAR), but this should be ! checked out in all its different combos. Related question is, is ! there any way that FOO in either case ends up without type info ! filled in? Does anyone care? */ ffesymbol_signal_unreported (s); *************** ffestc_R1228 () *** 12596,12600 **** void ! ffestc_R1229_start (ffelexToken name, ffesttTokenList args, ffelexToken final) { ffesymbol s; --- 12611,12616 ---- void ! ffestc_R1229_start (ffelexToken name, ffesttTokenList args, ! ffelexToken final UNUSED) { ffesymbol s; *************** ffestc_R1229_finish (ffebld expr, ffelex *** 12712,12716 **** void ! ffestc_S3P4 (ffebld filename, ffelexToken filename_token) { ffestc_check_simple_ (); --- 12728,12732 ---- void ! ffestc_S3P4 (ffebld filename, ffelexToken filename_token UNUSED) { ffestc_check_simple_ (); *************** ffestc_V027_start () *** 13707,13711 **** void ffestc_V027_item (ffelexToken dest_token, ffebld source, ! ffelexToken source_token) { ffestc_check_item_ (); --- 13723,13727 ---- void ffestc_V027_item (ffelexToken dest_token, ffebld source, ! ffelexToken source_token UNUSED) { ffestc_check_item_ (); diff -rcp2N g77-0.5.15/f/stc.h g77-0.5.16/f/stc.h *** g77-0.5.15/f/stc.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/stc.h Wed Aug 30 15:53:34 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/std.c g77-0.5.16/f/std.c *** g77-0.5.15/f/std.c Fri Apr 28 05:26:12 1995 --- g77-0.5.16/f/std.c Wed Aug 30 15:53:34 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** static void ffestd_R1001error_ (ffesttFo *** 563,568 **** #define ffestd_subr_line_restore_(s) #define ffestd_subr_line_save_(s) ! #endif ! #endif #define ffestd_check_simple_() \ assert(ffestd_statelet_ == FFESTD_stateletSIMPLE_) --- 564,569 ---- #define ffestd_subr_line_restore_(s) #define ffestd_subr_line_save_(s) ! #endif /* FFECOM_TWOPASS */ ! #endif /* FFECOM_targetCURRENT != FFECOM_targetGCC */ #define ffestd_check_simple_() \ assert(ffestd_statelet_ == FFESTD_stateletSIMPLE_) *************** ffestd_stmt_pass_ () *** 685,690 **** value = build_int_2 (stmt->u.R1226.entrynum, 0); /* Yes, we really want to build a null LABEL_DECL here and not ! put it on any list. That's what pushcase wants, so that's ! what it gets! */ label = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE); --- 686,691 ---- value = build_int_2 (stmt->u.R1226.entrynum, 0); /* Yes, we really want to build a null LABEL_DECL here and not ! put it on any list. That's what pushcase wants, so that's ! what it gets! */ label = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE); *************** ffestd_subr_labels_ (bool unexpected) *** 1147,1152 **** if (ffelab_type (l) == FFELAB_typeLOOPEND) ffebad_here (0, ffelab_doref_line (l), ffelab_doref_column (l)); ! else ffebad_here (0, ffelab_firstref_line (l), ffelab_firstref_column (l)); ffebad_finish (); --- 1148,1159 ---- if (ffelab_type (l) == FFELAB_typeLOOPEND) ffebad_here (0, ffelab_doref_line (l), ffelab_doref_column (l)); ! else if (ffelab_type (l) != FFELAB_typeANY) ffebad_here (0, ffelab_firstref_line (l), ffelab_firstref_column (l)); + else if (!ffewhere_line_is_unknown (ffelab_firstref_line (l))) + ffebad_here (0, ffelab_firstref_line (l), ffelab_firstref_column (l)); + else if (!ffewhere_line_is_unknown (ffelab_doref_line (l))) + ffebad_here (0, ffelab_doref_line (l), ffelab_doref_column (l)); + else + ffebad_here (0, ffelab_definition_line (l), ffelab_definition_column (l)); ffebad_finish (); *************** ffestd_begin_uses () *** 1246,1252 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("; begin_uses\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 1253,1259 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("; begin_uses\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_begin_uses () *** 1263,1267 **** void ! ffestd_do (bool ok) { #if FFECOM_ONEPASS --- 1270,1274 ---- void ! ffestd_do (bool ok UNUSED) { #if FFECOM_ONEPASS *************** ffestd_end_uses (bool ok) *** 1296,1302 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("; end_uses\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 1303,1309 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("; end_uses\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_end_R740 (bool ok) *** 1324,1328 **** void ! ffestd_end_R807 (bool ok) { #if FFECOM_ONEPASS --- 1331,1335 ---- void ! ffestd_end_R807 (bool ok UNUSED) { #if FFECOM_ONEPASS *************** ffestd_init_3 () *** 1452,1462 **** void ! ffestd_labeldef_any (ffelab label) { #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "; any_label_def %lu\n", ffelab_value (label)); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 1459,1469 ---- void ! ffestd_labeldef_any (ffelab label UNUSED) { #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "; any_label_def %lu\n", ffelab_value (label)); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_labeldef_format (ffelab label) *** 1511,1522 **** void ! ffestd_labeldef_useless (ffelab label) { #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "; useless_label_def %lu\n", ffelab_value (label)); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 1518,1529 ---- void ! ffestd_labeldef_useless (ffelab label UNUSED) { #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "; useless_label_def %lu\n", ffelab_value (label)); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R423A () *** 1533,1540 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* PRIVATE_derived_type\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 1540,1547 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* PRIVATE_derived_type\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R423B () *** 1550,1557 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* SEQUENCE_derived_type\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 1557,1564 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* SEQUENCE_derived_type\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R425 (bool ok) *** 1604,1611 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "* END_TYPE %s\n", ffelex_token_text (ffestw_name (ffestw_stack_top ()))); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 1611,1618 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "* END_TYPE %s\n", ffelex_token_text (ffestw_name (ffestw_stack_top ()))); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R522 () *** 1901,1907 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* SAVE_all\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 1908,1914 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* SAVE_all\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R522start () *** 1920,1926 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* SAVE ", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 1927,1933 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* SAVE ", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R522start () *** 1933,1937 **** void ! ffestd_R522item_object (ffelexToken name) { ffestd_check_item_ (); --- 1940,1944 ---- void ! ffestd_R522item_object (ffelexToken name UNUSED) { ffestd_check_item_ (); *************** ffestd_R522item_object (ffelexToken name *** 1939,1945 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "%s,", ffelex_token_text (name)); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 1946,1952 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "%s,", ffelex_token_text (name)); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R522item_object (ffelexToken name *** 1952,1956 **** void ! ffestd_R522item_cblock (ffelexToken name) { ffestd_check_item_ (); --- 1959,1963 ---- void ! ffestd_R522item_cblock (ffelexToken name UNUSED) { ffestd_check_item_ (); *************** ffestd_R522item_cblock (ffelexToken name *** 1958,1965 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "/%s/,", ffelex_token_text (name)); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 1965,1972 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "/%s/,", ffelex_token_text (name)); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R522finish () *** 1977,1984 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 1984,1991 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R522finish () *** 1990,1994 **** void ! ffestd_R524_start (bool virtual) { ffestd_check_start_ (); --- 1997,2001 ---- void ! ffestd_R524_start (bool virtual UNUSED) { ffestd_check_start_ (); *************** ffestd_R524_start (bool virtual) *** 1999,2005 **** else fputs ("* DIMENSION ", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 2006,2012 ---- else fputs ("* DIMENSION ", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R524_start (bool virtual) *** 2012,2016 **** void ! ffestd_R524_item (ffelexToken name, ffesttDimList dims) { ffestd_check_item_ (); --- 2019,2023 ---- void ! ffestd_R524_item (ffelexToken name UNUSED, ffesttDimList dims UNUSED) { ffestd_check_item_ (); *************** ffestd_R524_item (ffelexToken name, ffes *** 2021,2027 **** ffestt_dimlist_dump (dims); fputs ("),", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 2028,2034 ---- ffestt_dimlist_dump (dims); fputs ("),", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R524_finish () *** 2040,2046 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 2047,2053 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R537_start () *** 2250,2256 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* PARAMETER (", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 2257,2263 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* PARAMETER (", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R537_start () *** 2264,2268 **** void ! ffestd_R537_item (ffebld dest, ffebld source) { ffestd_check_item_ (); --- 2271,2275 ---- void ! ffestd_R537_item (ffebld dest UNUSED, ffebld source UNUSED) { ffestd_check_item_ (); *************** ffestd_R537_item (ffebld dest, ffebld so *** 2273,2279 **** ffebld_dump (source); fputc (',', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 2280,2286 ---- ffebld_dump (source); fputc (',', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R537_finish () *** 2292,2299 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs (")\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 2299,2306 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs (")\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R539 () *** 2311,2318 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* IMPLICIT_NONE\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 2318,2325 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* IMPLICIT_NONE\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R539start () *** 2330,2336 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* IMPLICIT ", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 2337,2343 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* IMPLICIT ", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R539start () *** 2343,2348 **** void ! ffestd_R539item (ffestpType type, ffebld kind, ffelexToken kindt, ! ffebld len, ffelexToken lent, ffesttImpList letters) { #if FFECOM_targetCURRENT == FFECOM_targetFFE --- 2350,2356 ---- void ! ffestd_R539item (ffestpType type UNUSED, ffebld kind UNUSED, ! ffelexToken kindt UNUSED, ffebld len UNUSED, ! ffelexToken lent UNUSED, ffesttImpList letters UNUSED) { #if FFECOM_targetCURRENT == FFECOM_targetFFE *************** ffestd_R539item (ffestpType type, ffebld *** 2416,2422 **** ffestt_implist_dump (letters); fputs ("),", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 2424,2430 ---- ffestt_implist_dump (letters); fputs ("),", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R539finish () *** 2435,2441 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 2443,2449 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R542_start () *** 2454,2461 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* NAMELIST ", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 2462,2469 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* NAMELIST ", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R542_start () *** 2467,2471 **** void ! ffestd_R542_item_nlist (ffelexToken name) { ffestd_check_item_ (); --- 2475,2479 ---- void ! ffestd_R542_item_nlist (ffelexToken name UNUSED) { ffestd_check_item_ (); *************** ffestd_R542_item_nlist (ffelexToken name *** 2473,2480 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "/%s/", ffelex_token_text (name)); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 2481,2488 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "/%s/", ffelex_token_text (name)); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R542_item_nlist (ffelexToken name *** 2486,2490 **** void ! ffestd_R542_item_nitem (ffelexToken name) { ffestd_check_item_ (); --- 2494,2498 ---- void ! ffestd_R542_item_nitem (ffelexToken name UNUSED) { ffestd_check_item_ (); *************** ffestd_R542_item_nitem (ffelexToken name *** 2492,2499 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "%s,", ffelex_token_text (name)); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 2500,2507 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "%s,", ffelex_token_text (name)); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R542_finish () *** 2511,2518 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 2519,2526 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R544_start () *** 2532,2538 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* EQUIVALENCE (", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 2540,2546 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* EQUIVALENCE (", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R544_item (ffesttExprList exprlis *** 2554,2560 **** ffestt_exprlist_dump (exprlist); fputs ("),", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 2562,2568 ---- ffestt_exprlist_dump (exprlist); fputs ("),", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R544_finish () *** 2575,2581 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs (")\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 2583,2589 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs (")\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R547_start () *** 2595,2601 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* COMMON ", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 2603,2609 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* COMMON ", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R547_start () *** 2608,2612 **** void ! ffestd_R547_item_object (ffelexToken name, ffesttDimList dims) { ffestd_check_item_ (); --- 2616,2621 ---- void ! ffestd_R547_item_object (ffelexToken name UNUSED, ! ffesttDimList dims UNUSED) { ffestd_check_item_ (); *************** ffestd_R547_item_object (ffelexToken nam *** 2621,2627 **** } fputc (',', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 2630,2636 ---- } fputc (',', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R547_item_object (ffelexToken nam *** 2634,2638 **** void ! ffestd_R547_item_cblock (ffelexToken name) { ffestd_check_item_ (); --- 2643,2647 ---- void ! ffestd_R547_item_cblock (ffelexToken name UNUSED) { ffestd_check_item_ (); *************** ffestd_R547_item_cblock (ffelexToken nam *** 2643,2650 **** else fprintf (stdout, "/%s/,", ffelex_token_text (name)); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 2652,2659 ---- else fprintf (stdout, "/%s/,", ffelex_token_text (name)); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R547_finish () *** 2662,2669 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 2671,2678 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R745 (bool ok) *** 2911,2915 **** void ! ffestd_R803 (ffelexToken construct_name, ffebld expr) { ffestd_check_simple_ (); --- 2920,2924 ---- void ! ffestd_R803 (ffelexToken construct_name UNUSED, ffebld expr) { ffestd_check_simple_ (); *************** ffestd_R803 (ffelexToken construct_name, *** 2944,2948 **** void ! ffestd_R804 (ffebld expr, ffelexToken name) { ffestd_check_simple_ (); --- 2953,2957 ---- void ! ffestd_R804 (ffebld expr, ffelexToken name UNUSED) { ffestd_check_simple_ (); *************** ffestd_R804 (ffebld expr, ffelexToken na *** 2974,2978 **** void ! ffestd_R805 (ffelexToken name) { ffestd_check_simple_ (); --- 2983,2987 ---- void ! ffestd_R805 (ffelexToken name UNUSED) { ffestd_check_simple_ (); *************** ffestd_R805 (ffelexToken name) *** 2997,3001 **** void ! ffestd_R806 (bool ok) { #if FFECOM_ONEPASS --- 3006,3010 ---- void ! ffestd_R806 (bool ok UNUSED) { #if FFECOM_ONEPASS *************** ffestd_R807 (ffebld expr) *** 3054,3058 **** void ! ffestd_R809 (ffelexToken construct_name, ffebld expr) { ffestd_check_simple_ (); --- 3063,3067 ---- void ! ffestd_R809 (ffelexToken construct_name UNUSED, ffebld expr) { ffestd_check_simple_ (); *************** ffestd_R810 (unsigned long casenum) *** 3116,3120 **** void ! ffestd_R811 (bool ok) { #if FFECOM_ONEPASS --- 3125,3129 ---- void ! ffestd_R811 (bool ok UNUSED) { #if FFECOM_ONEPASS *************** ffestd_R811 (bool ok) *** 3143,3148 **** void ! ffestd_R819A (ffelexToken construct_name, ffelab label, ffebld var, ! ffebld start, ffelexToken start_token, ffebld end, ffelexToken end_token, ffebld incr, ffelexToken incr_token) --- 3152,3157 ---- void ! ffestd_R819A (ffelexToken construct_name UNUSED, ffelab label, ! ffebld var, ffebld start, ffelexToken start_token, ffebld end, ffelexToken end_token, ffebld incr, ffelexToken incr_token) *************** ffestd_R819A (ffelexToken construct_name *** 3187,3191 **** void ! ffestd_R819B (ffelexToken construct_name, ffelab label, ffebld expr) { ffestd_check_simple_ (); --- 3196,3201 ---- void ! ffestd_R819B (ffelexToken construct_name UNUSED, ffelab label, ! ffebld expr) { ffestd_check_simple_ (); *************** ffestd_R819B (ffelexToken construct_name *** 3225,3229 **** void ! ffestd_R825 (ffelexToken name) { ffestd_check_simple_ (); --- 3235,3239 ---- void ! ffestd_R825 (ffelexToken name UNUSED) { ffestd_check_simple_ (); *************** ffestd_R838 (ffelab label, ffebld target *** 3396,3400 **** void ! ffestd_R839 (ffebld target, ffelab *labels, int count) { ffestd_check_simple_ (); --- 3406,3410 ---- void ! ffestd_R839 (ffebld target, ffelab *labels UNUSED, int count UNUSED) { ffestd_check_simple_ (); *************** ffestd_R840 (ffebld expr, ffelab neg, ff *** 3459,3463 **** void ! ffestd_R841 (bool in_where) { ffestd_check_simple_ (); --- 3469,3473 ---- void ! ffestd_R841 (bool in_where UNUSED) { ffestd_check_simple_ (); *************** ffestd_R1001dump_ (ffests s, ffesttForma *** 4185,4191 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE ffestd_R1001dump_1005_3_ (s, next, "B"); ! #endif ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_R1001error_ (next); #endif break; --- 4195,4202 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE ffestd_R1001dump_1005_3_ (s, next, "B"); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_R1001error_ (next); + #else + #error #endif break; *************** ffestd_R1001dump_ (ffests s, ffesttForma *** 4210,4216 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE ffestd_R1001dump_1005_5_ (s, next, "EN"); ! #endif ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_R1001error_ (next); #endif break; --- 4221,4228 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE ffestd_R1001dump_1005_5_ (s, next, "EN"); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_R1001error_ (next); + #else + #error #endif break; *************** ffestd_R1001dump_ (ffests s, ffesttForma *** 4235,4241 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE ffestd_R1001dump_1010_1_ (s, next, "Q"); ! #endif ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_R1001error_ (next); #endif break; --- 4247,4254 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE ffestd_R1001dump_1010_1_ (s, next, "Q"); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_R1001error_ (next); + #else + #error #endif break; *************** ffestd_R1001error_ (ffesttFormatList f) *** 4639,4643 **** void ! ffestd_R1102 (ffesymbol s, ffelexToken name) { ffestd_check_simple_ (); --- 4652,4656 ---- void ! ffestd_R1102 (ffesymbol s, ffelexToken name UNUSED) { ffestd_check_simple_ (); *************** ffestd_R1102 (ffesymbol s, ffelexToken n *** 4657,4663 **** else fprintf (stdout, "< PROGRAM %s\n", ffelex_token_text (name)); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 4670,4676 ---- else fprintf (stdout, "< PROGRAM %s\n", ffelex_token_text (name)); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R1102 (ffesymbol s, ffelexToken n *** 4668,4672 **** void ! ffestd_R1103 (bool ok) { assert (ffestd_block_level_ == 0); --- 4681,4685 ---- void ! ffestd_R1103 (bool ok UNUSED) { assert (ffestd_block_level_ == 0); *************** ffestd_R1107_finish () *** 4807,4811 **** void ! ffestd_R1111 (ffesymbol s, ffelexToken name) { assert (ffestd_block_level_ == 0); --- 4820,4824 ---- void ! ffestd_R1111 (ffesymbol s, ffelexToken name UNUSED) { assert (ffestd_block_level_ == 0); *************** ffestd_R1111 (ffesymbol s, ffelexToken n *** 4822,4828 **** else fprintf (stdout, "< BLOCK_DATA %s\n", ffelex_token_text (name)); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 4835,4841 ---- else fprintf (stdout, "< BLOCK_DATA %s\n", ffelex_token_text (name)); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R1111 (ffesymbol s, ffelexToken n *** 4833,4837 **** void ! ffestd_R1112 (bool ok) { assert (ffestd_block_level_ == 0); --- 4846,4850 ---- void ! ffestd_R1112 (bool ok UNUSED) { assert (ffestd_block_level_ == 0); *************** ffestd_R1207_start () *** 5051,5057 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* EXTERNAL (", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5064,5070 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* EXTERNAL (", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R1207_item (ffelexToken name) *** 5071,5078 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "%s,", ffelex_token_text (name)); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 5084,5091 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "%s,", ffelex_token_text (name)); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R1207_finish () *** 5090,5097 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs (")\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 5103,5110 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs (")\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R1208_start () *** 5109,5116 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* INTRINSIC (", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 5122,5129 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* INTRINSIC (", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R1208_item (ffelexToken name) *** 5129,5136 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "%s,", ffelex_token_text (name)); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 5142,5149 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "%s,", ffelex_token_text (name)); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R1208_finish () *** 5148,5154 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs (")\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5161,5167 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs (")\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R1213 (ffebld dest, ffebld source *** 5219,5225 **** void ! ffestd_R1219 (ffesymbol s, ffelexToken funcname, ffesttTokenList args, ! ffestpType type, ffebld kind, ffelexToken kindt, ffebld len, ! ffelexToken lent, bool recursive, ffelexToken result, bool separate_result) { #if FFECOM_targetCURRENT == FFECOM_targetFFE --- 5232,5241 ---- void ! ffestd_R1219 (ffesymbol s, ffelexToken funcname UNUSED, ! ffesttTokenList args UNUSED, ffestpType type UNUSED, ! ffebld kind UNUSED, ffelexToken kindt UNUSED, ! ffebld len UNUSED, ffelexToken lent UNUSED, ! bool recursive UNUSED, ffelexToken result UNUSED, ! bool separate_result UNUSED) { #if FFECOM_targetCURRENT == FFECOM_targetFFE *************** ffestd_R1219 (ffesymbol s, ffelexToken f *** 5313,5319 **** fprintf (stdout, " result(%s)", ffelex_token_text (result)); fputc ('\n', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5329,5335 ---- fprintf (stdout, " result(%s)", ffelex_token_text (result)); fputc ('\n', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R1219 (ffesymbol s, ffelexToken f *** 5324,5328 **** void ! ffestd_R1221 (bool ok) { assert (ffestd_block_level_ == 0); --- 5340,5344 ---- void ! ffestd_R1221 (bool ok UNUSED) { assert (ffestd_block_level_ == 0); *************** ffestd_R1221 (bool ok) *** 5357,5362 **** void ! ffestd_R1223 (ffesymbol s, ffelexToken subrname, ffesttTokenList args, ! ffelexToken final, bool recursive) { assert (ffestd_block_level_ == 0); --- 5373,5379 ---- void ! ffestd_R1223 (ffesymbol s, ffelexToken subrname UNUSED, ! ffesttTokenList args UNUSED, ffelexToken final UNUSED, ! bool recursive UNUSED) { assert (ffestd_block_level_ == 0); *************** ffestd_R1223 (ffesymbol s, ffelexToken s *** 5379,5385 **** } fputc ('\n', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5396,5402 ---- } fputc ('\n', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R1223 (ffesymbol s, ffelexToken s *** 5390,5394 **** void ! ffestd_R1225 (bool ok) { assert (ffestd_block_level_ == 0); --- 5407,5411 ---- void ! ffestd_R1225 (bool ok UNUSED) { assert (ffestd_block_level_ == 0); *************** ffestd_R1228 () *** 5516,5520 **** void ! ffestd_R1229_start (ffelexToken name, ffesttTokenList args) { ffestd_check_start_ (); --- 5533,5537 ---- void ! ffestd_R1229_start (ffelexToken name UNUSED, ffesttTokenList args UNUSED) { ffestd_check_start_ (); *************** ffestd_R1229_start (ffelexToken name, ff *** 5521,5528 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 5538,5545 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_R1229_finish (ffesymbol s) *** 5577,5582 **** ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); #endif ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC /* With gcc, cannot do anything here, because the backend hasn't even (necessarily) been notified that we're compiling a program unit! */ --- 5594,5598 ---- ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); #endif ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC /* With gcc, cannot do anything here, because the backend hasn't even (necessarily) been notified that we're compiling a program unit! */ *************** ffestd_R1229_finish (ffesymbol s) *** 5587,5592 **** ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); #endif ! #endif ! #endif } --- 5603,5608 ---- ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); #endif ! #else ! #error #endif } *************** ffestd_V003_start (ffelexToken structure *** 5646,5653 **** else fprintf (stdout, "* STRUCTURE %s ", ffelex_token_text (structure_name)); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_subr_vxt_ (); ! #endif #endif } --- 5662,5669 ---- else fprintf (stdout, "* STRUCTURE %s ", ffelex_token_text (structure_name)); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_subr_vxt_ (); ! #else ! #error #endif } *************** ffestd_V003_item (ffelexToken name, ffes *** 5673,5680 **** } fputc (',', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 5689,5696 ---- } fputc (',', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_V003_finish () *** 5692,5698 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5708,5714 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_V004 (bool ok) *** 5707,5713 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* END_STRUCTURE\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5723,5729 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* END_STRUCTURE\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_V009 () *** 5724,5730 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* UNION\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5740,5746 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* UNION\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_V010 (bool ok) *** 5739,5746 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* END_UNION\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 5755,5762 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* END_UNION\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_V012 () *** 5756,5763 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* MAP\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 5772,5779 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* MAP\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_V013 (bool ok) *** 5771,5777 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* END_MAP\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5787,5793 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* END_MAP\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_V014_start () *** 5791,5798 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* VOLATILE (", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_subr_vxt_ (); ! #endif #endif } --- 5807,5814 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* VOLATILE (", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_subr_vxt_ (); ! #else ! #error #endif } *************** ffestd_V014_start () *** 5805,5809 **** void ! ffestd_V014_item_object (ffelexToken name) { ffestd_check_item_ (); --- 5821,5825 ---- void ! ffestd_V014_item_object (ffelexToken name UNUSED) { ffestd_check_item_ (); *************** ffestd_V014_item_object (ffelexToken nam *** 5811,5817 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "%s,", ffelex_token_text (name)); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5827,5833 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "%s,", ffelex_token_text (name)); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_V014_item_object (ffelexToken nam *** 5824,5828 **** void ! ffestd_V014_item_cblock (ffelexToken name) { ffestd_check_item_ (); --- 5840,5844 ---- void ! ffestd_V014_item_cblock (ffelexToken name UNUSED) { ffestd_check_item_ (); *************** ffestd_V014_item_cblock (ffelexToken nam *** 5830,5836 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "/%s/,", ffelex_token_text (name)); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5846,5852 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "/%s/,", ffelex_token_text (name)); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_V014_finish () *** 5849,5856 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs (")\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 5865,5872 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs (")\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_V016_start () *** 5869,5876 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* RECORD ", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_subr_vxt_ (); ! #endif #endif } --- 5885,5892 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* RECORD ", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_subr_vxt_ (); ! #else ! #error #endif } *************** ffestd_V016_item_structure (ffelexToken *** 5889,5896 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "/%s/,", ffelex_token_text (name)); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 5905,5912 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "/%s/,", ffelex_token_text (name)); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_V016_item_object (ffelexToken nam *** 5915,5921 **** } fputc (',', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5931,5937 ---- } fputc (',', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_V016_finish () *** 5934,5940 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5950,5956 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_V019_finish () *** 6141,6145 **** void ! ffestd_V020_start (ffestvFormat format) { ffestd_check_start_ (); --- 6157,6161 ---- void ! ffestd_V020_start (ffestvFormat format UNUSED) { ffestd_check_start_ (); *************** ffestd_V020_start (ffestvFormat format) *** 6179,6183 **** void ! ffestd_V020_item (ffebld expr) { ffestd_check_item_ (); --- 6195,6199 ---- void ! ffestd_V020_item (ffebld expr UNUSED) { ffestd_check_item_ (); *************** ffestd_V027_start () *** 6652,6656 **** void ! ffestd_V027_item (ffelexToken dest_token, ffebld source) { ffestd_check_item_ (); --- 6668,6672 ---- void ! ffestd_V027_item (ffelexToken dest_token UNUSED, ffebld source UNUSED) { ffestd_check_item_ (); *************** ffestd_V027_item (ffelexToken dest_token *** 6661,6667 **** ffebld_dump (source); fputc (',', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 6677,6683 ---- ffebld_dump (source); fputc (',', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffestd_V027_finish () *** 6680,6686 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 6696,6702 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } diff -rcp2N g77-0.5.15/f/std.h g77-0.5.16/f/std.h *** g77-0.5.15/f/std.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/std.h Wed Aug 30 15:53:34 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/ste.c g77-0.5.16/f/ste.c *** g77-0.5.15/f/ste.c Fri May 19 11:17:32 1995 --- g77-0.5.16/f/ste.c Wed Aug 30 15:53:34 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** static tree ffeste_io_olist_ (bool have_ *** 138,144 **** ffestpFile *blank_spec); static void ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt); ! #endif ! #if FFECOM_targetCURRENT == FFECOM_targetFFE static void ffeste_subr_file_ (char *kw, ffestpFile *spec); #endif --- 139,146 ---- 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 *************** ffeste_do (ffestw block) *** 2040,2045 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ END_DO\n", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); if (ffestw_do_tvar (block) == 0) --- 2042,2046 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ END_DO\n", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); if (ffestw_do_tvar (block) == 0) *************** ffeste_do (ffestw block) *** 2051,2055 **** clear_momentary (); ! #endif #endif } --- 2052,2057 ---- clear_momentary (); ! #else ! #error #endif } *************** ffeste_end_R807 () *** 2070,2079 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ END_IF\n", stdout); /* Also see ffeste_R806. */ ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); expand_end_cond (); clear_momentary (); ! #endif #endif } --- 2072,2081 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ END_IF\n", stdout); /* Also see ffeste_R806. */ ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); expand_end_cond (); clear_momentary (); ! #else ! #error #endif } *************** ffeste_labeldef_branch (ffelab label) *** 2088,2093 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "+ label %lu\n", ffelab_value (label)); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC { tree glabel; --- 2090,2094 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "+ label %lu\n", ffelab_value (label)); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC { tree glabel; *************** ffeste_labeldef_branch (ffelab label) *** 2104,2108 **** expand_label (glabel); } ! #endif #endif } --- 2105,2110 ---- expand_label (glabel); } ! #else ! #error #endif } *************** ffeste_labeldef_format (ffelab label) *** 2117,2124 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "$ label %lu\n", ffelab_value (label)); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_label_formatdef_ = label; ! #endif #endif } --- 2119,2126 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "$ label %lu\n", ffelab_value (label)); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_label_formatdef_ = label; ! #else ! #error #endif } *************** ffeste_R737A (ffebld dest, ffebld source *** 2139,2144 **** ffebld_dump (source); fputc ('\n', stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); ffecom_push_calltemps (); --- 2141,2145 ---- ffebld_dump (source); fputc ('\n', stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); ffecom_push_calltemps (); *************** ffeste_R737A (ffebld dest, ffebld source *** 2148,2152 **** ffecom_pop_calltemps (); clear_momentary (); ! #endif #endif } --- 2149,2154 ---- ffecom_pop_calltemps (); clear_momentary (); ! #else ! #error #endif } *************** ffeste_R803 (ffebld expr) *** 2167,2172 **** ffebld_dump (expr); fputs (")\n", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); ffecom_push_calltemps (); --- 2169,2173 ---- ffebld_dump (expr); fputs (")\n", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); ffecom_push_calltemps (); *************** ffeste_R803 (ffebld expr) *** 2176,2180 **** ffecom_pop_calltemps (); clear_momentary (); ! #endif #endif } --- 2177,2182 ---- ffecom_pop_calltemps (); clear_momentary (); ! #else ! #error #endif } *************** ffeste_R804 (ffebld expr) *** 2197,2202 **** ffebld_dump (expr); fputs (")\n", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); ffecom_push_calltemps (); --- 2199,2203 ---- ffebld_dump (expr); fputs (")\n", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); ffecom_push_calltemps (); *************** ffeste_R804 (ffebld expr) *** 2206,2210 **** ffecom_pop_calltemps (); clear_momentary (); ! #endif #endif } --- 2207,2212 ---- ffecom_pop_calltemps (); clear_momentary (); ! #else ! #error #endif } *************** ffeste_R805 () *** 2225,2234 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ ELSE\n", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); expand_start_else (); clear_momentary (); ! #endif #endif } --- 2227,2236 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ ELSE\n", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); expand_start_else (); clear_momentary (); ! #else ! #error #endif } *************** ffeste_R806 () *** 2243,2252 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ END_IF_then\n", stdout); /* Also see ffeste_shriek_if_. */ ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); expand_end_cond (); clear_momentary (); ! #endif #endif } --- 2245,2254 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ END_IF_then\n", stdout); /* Also see ffeste_shriek_if_. */ ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); expand_end_cond (); clear_momentary (); ! #else ! #error #endif } *************** ffeste_R807 (ffebld expr) *** 2267,2272 **** ffebld_dump (expr); fputs (")\n", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); ffecom_push_calltemps (); --- 2269,2273 ---- ffebld_dump (expr); fputs (")\n", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); ffecom_push_calltemps (); *************** ffeste_R807 (ffebld expr) *** 2276,2280 **** ffecom_pop_calltemps (); clear_momentary (); ! #endif #endif } --- 2277,2282 ---- ffecom_pop_calltemps (); clear_momentary (); ! #else ! #error #endif } *************** ffeste_R809 (ffestw block, ffebld expr) *** 2295,2300 **** ffebld_dump (expr); fputs (")\n", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffecom_push_calltemps (); --- 2297,2301 ---- ffebld_dump (expr); fputs (")\n", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffecom_push_calltemps (); *************** ffeste_R809 (ffestw block, ffebld expr) *** 2326,2330 **** ffecom_pop_calltemps (); ! #endif #endif } --- 2327,2332 ---- ffecom_pop_calltemps (); ! #else ! #error #endif } *************** ffeste_R810 (ffestw block, unsigned long *** 2386,2391 **** fputc ('\n', stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC { tree texprlow; --- 2388,2392 ---- fputc ('\n', stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC { tree texprlow; *************** ffeste_R810 (ffestw block, unsigned long *** 2442,2446 **** clear_momentary (); } /* ~~~handle character, character*1 */ ! #endif #endif } --- 2443,2448 ---- clear_momentary (); } /* ~~~handle character, character*1 */ ! #else ! #error #endif } *************** ffeste_R811 (ffestw block) *** 2455,2460 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ END_SELECT\n", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); --- 2457,2461 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ END_SELECT\n", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); *************** ffeste_R811 (ffestw block) *** 2468,2472 **** pop_momentary (); clear_momentary (); /* ~~~handle character and character*1 */ ! #endif #endif } --- 2469,2474 ---- pop_momentary (); clear_momentary (); /* ~~~handle character and character*1 */ ! #else ! #error #endif } *************** ffeste_R811 (ffestw block) *** 2475,2479 **** void ! ffeste_R819A (ffestw block, ffelab label, ffebld var, ffebld start, ffelexToken start_token, ffebld end, ffelexToken end_token, --- 2477,2481 ---- void ! ffeste_R819A (ffestw block, ffelab label UNUSED, ffebld var, ffebld start, ffelexToken start_token, ffebld end, ffelexToken end_token, *************** ffeste_R819A (ffestw block, ffelab label *** 2506,2511 **** ffebld_dump (incr); fputs (")\n", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC { ffeste_emit_line_note_ (); --- 2508,2512 ---- ffebld_dump (incr); fputs (")\n", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC { ffeste_emit_line_note_ (); *************** ffeste_R819A (ffestw block, ffelab label *** 2523,2527 **** ffecom_pop_calltemps (); } ! #endif #endif } --- 2524,2529 ---- ffecom_pop_calltemps (); } ! #else ! #error #endif } *************** ffeste_R819A (ffestw block, ffelab label *** 2534,2538 **** void ! ffeste_R819B (ffestw block, ffelab label, ffebld expr) { ffeste_check_simple_ (); --- 2536,2540 ---- void ! ffeste_R819B (ffestw block, ffelab label UNUSED, ffebld expr) { ffeste_check_simple_ (); *************** ffeste_R819B (ffestw block, ffelab label *** 2545,2550 **** ffebld_dump (expr); fputs (")\n", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC { ffeste_emit_line_note_ (); --- 2547,2551 ---- ffebld_dump (expr); fputs (")\n", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC { ffeste_emit_line_note_ (); *************** ffeste_R819B (ffestw block, ffelab label *** 2559,2563 **** clear_momentary (); } ! #endif #endif } --- 2560,2565 ---- clear_momentary (); } ! #else ! #error #endif } *************** ffeste_R825 () *** 2581,2589 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ END_DO_sugar\n", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); emit_nop (); ! #endif #endif } --- 2583,2591 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ END_DO_sugar\n", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); emit_nop (); ! #else ! #error #endif } *************** ffeste_R834 (ffestw block) *** 2602,2611 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "+ CYCLE block #%lu\n", ffestw_blocknum (block)); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); expand_continue_loop (ffestw_do_hook (block)); clear_momentary (); ! #endif #endif } --- 2604,2613 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "+ 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 (ffestw block) *** 2624,2633 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "+ EXIT block #%lu\n", ffestw_blocknum (block)); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); expand_exit_loop (ffestw_do_hook (block)); clear_momentary (); ! #endif #endif } --- 2626,2635 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "+ 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 (ffelab label) *** 2647,2652 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "+ GOTO %lu\n", ffelab_value (label)); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC { tree glabel; --- 2649,2653 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "+ GOTO %lu\n", ffelab_value (label)); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC { tree glabel; *************** ffeste_R836 (ffelab label) *** 2662,2666 **** } } ! #endif #endif } --- 2663,2668 ---- } } ! #else ! #error #endif } *************** ffeste_R837 (ffelab *labels, int count, *** 2691,2696 **** ffebld_dump (expr); fputc ('\n', stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC { tree texpr; --- 2693,2697 ---- ffebld_dump (expr); fputc ('\n', stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC { tree texpr; *************** ffeste_R837 (ffelab *labels, int count, *** 2728,2732 **** clear_momentary (); } ! #endif #endif } --- 2729,2734 ---- clear_momentary (); } ! #else ! #error #endif } *************** ffeste_R838 (ffelab label, ffebld target *** 2750,2755 **** ffebld_dump (target); fputc ('\n', stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC { tree expr_tree; --- 2752,2756 ---- ffebld_dump (target); fputc ('\n', stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC { tree expr_tree; *************** ffeste_R838 (ffelab label, ffebld target *** 2783,2787 **** ffecom_pop_calltemps (); } ! #endif #endif } --- 2784,2789 ---- ffecom_pop_calltemps (); } ! #else ! #error #endif } *************** ffeste_R839 (ffebld target) *** 2803,2808 **** ffebld_dump (target); fputc ('\n', stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC { tree t; --- 2805,2809 ---- ffebld_dump (target); fputc ('\n', stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC { tree t; *************** ffeste_R839 (ffebld target) *** 2820,2824 **** clear_momentary (); } ! #endif #endif } --- 2821,2826 ---- clear_momentary (); } ! #else ! #error #endif } *************** ffeste_R840 (ffebld expr, ffelab neg, ff *** 2840,2845 **** fprintf (stdout, ") %" ffelabValue_f "u,%" ffelabValue_f "u,%" ffelabValue_f "u\n", ffelab_value (neg), ffelab_value (zero), ffelab_value (pos)); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC { tree gneg = ffecom_lookup_label (neg); --- 2842,2846 ---- fprintf (stdout, ") %" ffelabValue_f "u,%" ffelabValue_f "u,%" ffelabValue_f "u\n", ffelab_value (neg), ffelab_value (zero), ffelab_value (pos)); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC { tree gneg = ffecom_lookup_label (neg); *************** ffeste_R840 (ffebld expr, ffelab neg, ff *** 2930,2934 **** clear_momentary (); } ! #endif #endif } --- 2931,2936 ---- clear_momentary (); } ! #else ! #error #endif } *************** ffeste_R841 () *** 2945,2953 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ CONTINUE\n", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); emit_nop (); ! #endif #endif } --- 2947,2955 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ CONTINUE\n", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); emit_nop (); ! #else ! #error #endif } *************** ffeste_R842 (ffebld expr) *** 2973,2978 **** fputc ('\n', stdout); } ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC { tree callit; --- 2975,2979 ---- fputc ('\n', stdout); } ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC { tree callit; *************** ffeste_R842 (ffebld expr) *** 3031,3035 **** clear_momentary (); } ! #endif #endif } --- 3032,3037 ---- clear_momentary (); } ! #else ! #error #endif } *************** ffeste_R843 (ffebld expr) *** 3058,3063 **** fputc ('\n', stdout); } ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC { tree callit; --- 3060,3064 ---- fputc ('\n', stdout); } ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC { tree callit; *************** ffeste_R843 (ffebld expr) *** 3147,3151 **** } #endif ! #endif #endif } --- 3148,3153 ---- } #endif ! #else ! #error #endif } *************** ffeste_R904 (ffestpOpenStmt *info) *** 3194,3199 **** ffeste_subr_file_ ("USEROPEN", &info->open_spec[FFESTP_openixUSEROPEN]); fputs (")\n", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC { tree args; --- 3196,3200 ---- ffeste_subr_file_ ("USEROPEN", &info->open_spec[FFESTP_openixUSEROPEN]); fputs (")\n", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC { tree args; *************** ffeste_R904 (ffestpOpenStmt *info) *** 3284,3288 **** clear_momentary (); ! #endif #endif } --- 3285,3290 ---- clear_momentary (); ! #else ! #error #endif } *************** ffeste_R907 (ffestpCloseStmt *info) *** 3306,3311 **** ffeste_subr_file_ ("STATUS", &info->close_spec[FFESTP_closeixSTATUS]); fputs (")\n", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC { tree args; --- 3308,3312 ---- ffeste_subr_file_ ("STATUS", &info->close_spec[FFESTP_closeixSTATUS]); fputs (")\n", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC { tree args; *************** ffeste_R907 (ffestpCloseStmt *info) *** 3391,3395 **** clear_momentary (); ! #endif #endif } --- 3392,3397 ---- clear_momentary (); ! #else ! #error #endif } *************** ffeste_R907 (ffestpCloseStmt *info) *** 3403,3408 **** void ! ffeste_R909_start (ffestpReadStmt *info, bool only_format, ffestvUnit unit, ! ffestvFormat format, bool rec, bool key) { ffeste_check_start_ (); --- 3405,3411 ---- void ! ffeste_R909_start (ffestpReadStmt *info, bool only_format UNUSED, ! ffestvUnit unit, ffestvFormat format, bool rec, ! bool key UNUSED) { ffeste_check_start_ (); *************** ffeste_R909_start (ffestpReadStmt *info, *** 3473,3478 **** ffeste_subr_file_ ("SIZE", &info->read_spec[FFESTP_readixSIZE]); fputs (") ", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #define specified(something) (info->read_spec[something].kw_or_val_present) --- 3476,3480 ---- ffeste_subr_file_ ("SIZE", &info->read_spec[FFESTP_readixSIZE]); fputs (") ", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC #define specified(something) (info->read_spec[something].kw_or_val_present) *************** ffeste_R909_start (ffestpReadStmt *info, *** 3649,3653 **** push_momentary (); ! #endif #endif } --- 3651,3656 ---- push_momentary (); ! #else ! #error #endif } *************** ffeste_R909_item (ffebld expr, ffelexTok *** 3667,3672 **** ffebld_dump (expr); fputc (',', stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC if (expr == NULL) return; --- 3670,3674 ---- ffebld_dump (expr); fputc (',', stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC if (expr == NULL) return; *************** ffeste_R909_item (ffebld expr, ffelexTok *** 3683,3687 **** (ffeste_io_abort_ != NULL_TREE)); clear_momentary (); ! #endif #endif } --- 3685,3690 ---- (ffeste_io_abort_ != NULL_TREE)); clear_momentary (); ! #else ! #error #endif } *************** ffeste_R909_finish () *** 3700,3705 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC /* Don't generate "if (iostat != 0) goto label;" if label is temp abort --- 3703,3707 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC /* Don't generate "if (iostat != 0) goto label;" if label is temp abort *************** ffeste_R909_finish () *** 3773,3777 **** clear_momentary (); } ! #endif #endif } --- 3775,3780 ---- clear_momentary (); } ! #else ! #error #endif } *************** ffeste_R910_start (ffestpWriteStmt *info *** 3834,3839 **** ffeste_subr_file_ ("REC", &info->write_spec[FFESTP_writeixREC]); fputs (") ", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #define specified(something) (info->write_spec[something].kw_or_val_present) --- 3837,3841 ---- ffeste_subr_file_ ("REC", &info->write_spec[FFESTP_writeixREC]); fputs (") ", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC #define specified(something) (info->write_spec[something].kw_or_val_present) *************** ffeste_R910_start (ffestpWriteStmt *info *** 3974,3978 **** push_momentary (); ! #endif #endif } --- 3976,3981 ---- push_momentary (); ! #else ! #error #endif } *************** ffeste_R910_item (ffebld expr, ffelexTok *** 3992,3997 **** ffebld_dump (expr); fputc (',', stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC if (expr == NULL) return; --- 3995,3999 ---- ffebld_dump (expr); fputc (',', stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC if (expr == NULL) return; *************** ffeste_R910_item (ffebld expr, ffelexTok *** 4004,4008 **** (ffeste_io_abort_ != NULL_TREE)); clear_momentary (); ! #endif #endif } --- 4006,4011 ---- (ffeste_io_abort_ != NULL_TREE)); clear_momentary (); ! #else ! #error #endif } *************** ffeste_R910_finish () *** 4021,4026 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC /* Don't generate "if (iostat != 0) goto label;" if label is temp abort --- 4024,4028 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC /* Don't generate "if (iostat != 0) goto label;" if label is temp abort *************** ffeste_R910_finish () *** 4064,4068 **** clear_momentary (); } ! #endif #endif } --- 4066,4071 ---- clear_momentary (); } ! #else ! #error #endif } *************** ffeste_R911_start (ffestpPrintStmt *info *** 4102,4107 **** ffeste_subr_file_ ("FORMAT", &info->print_spec[FFESTP_printixFORMAT]); fputc (' ', stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); --- 4105,4109 ---- ffeste_subr_file_ ("FORMAT", &info->print_spec[FFESTP_printixFORMAT]); fputc (' ', stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); *************** ffeste_R911_start (ffestpPrintStmt *info *** 4171,4175 **** push_momentary (); ! #endif #endif } --- 4173,4178 ---- push_momentary (); ! #else ! #error #endif } *************** ffeste_R911_item (ffebld expr, ffelexTok *** 4189,4194 **** ffebld_dump (expr); fputc (',', stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC if (expr == NULL) return; --- 4192,4196 ---- ffebld_dump (expr); fputc (',', stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC if (expr == NULL) return; *************** ffeste_R911_item (ffebld expr, ffelexTok *** 4200,4204 **** ffeste_io_call_ ((*ffeste_io_driver_) (expr), FALSE); clear_momentary (); ! #endif #endif } --- 4202,4207 ---- ffeste_io_call_ ((*ffeste_io_driver_) (expr), FALSE); clear_momentary (); ! #else ! #error #endif } *************** ffeste_R911_finish () *** 4217,4222 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC { if (ffeste_io_endgfrt_ != FFECOM_gfrt) --- 4220,4224 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC { if (ffeste_io_endgfrt_ != FFECOM_gfrt) *************** ffeste_R911_finish () *** 4230,4234 **** clear_momentary (); } ! #endif #endif } --- 4232,4237 ---- clear_momentary (); } ! #else ! #error #endif } *************** ffeste_R919 (ffestpBeruStmt *info) *** 4251,4258 **** ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]); fputs (")\n", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_subr_beru_ (info, FFECOM_gfrtFBACK); ! #endif #endif } --- 4254,4261 ---- ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]); fputs (")\n", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_subr_beru_ (info, FFECOM_gfrtFBACK); ! #else ! #error #endif } *************** ffeste_R920 (ffestpBeruStmt *info) *** 4275,4282 **** ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]); fputs (")\n", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_subr_beru_ (info, FFECOM_gfrtFEND); ! #endif #endif } --- 4278,4285 ---- ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]); fputs (")\n", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_subr_beru_ (info, FFECOM_gfrtFEND); ! #else ! #error #endif } *************** ffeste_R921 (ffestpBeruStmt *info) *** 4299,4306 **** ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]); fputs (")\n", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_subr_beru_ (info, FFECOM_gfrtFREW); ! #endif #endif } --- 4302,4309 ---- ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]); fputs (")\n", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_subr_beru_ (info, FFECOM_gfrtFREW); ! #else ! #error #endif } *************** ffeste_R921 (ffestpBeruStmt *info) *** 4313,4317 **** void ! ffeste_R923A (ffestpInquireStmt *info, bool by_file) { ffeste_check_simple_ (); --- 4316,4320 ---- void ! ffeste_R923A (ffestpInquireStmt *info, bool by_file UNUSED) { ffeste_check_simple_ (); *************** ffeste_R923A (ffestpInquireStmt *info, b *** 4357,4362 **** ffeste_subr_file_ ("WRITE", &info->inquire_spec[FFESTP_inquireixWRITE]); fputs (")\n", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC { tree args; --- 4360,4364 ---- ffeste_subr_file_ ("WRITE", &info->inquire_spec[FFESTP_inquireixWRITE]); fputs (")\n", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC { tree args; *************** ffeste_R923A (ffestpInquireStmt *info, b *** 4456,4460 **** clear_momentary (); ! #endif #endif } --- 4458,4463 ---- clear_momentary (); ! #else ! #error #endif } *************** ffeste_R923A (ffestpInquireStmt *info, b *** 4468,4472 **** void ! ffeste_R923B_start (ffestpInquireStmt *info) { ffeste_check_start_ (); --- 4471,4475 ---- void ! ffeste_R923B_start (ffestpInquireStmt *info UNUSED) { ffeste_check_start_ (); *************** ffeste_R923B_start (ffestpInquireStmt *i *** 4476,4485 **** ffeste_subr_file_ ("IOLENGTH", &info->inquire_spec[FFESTP_inquireixIOLENGTH]); fputs (") ", stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC assert ("INQUIRE(IOLENGTH=) not implemented yet! ~~~" == NULL); ffeste_emit_line_note_ (); clear_momentary (); ! #endif #endif } --- 4479,4488 ---- ffeste_subr_file_ ("IOLENGTH", &info->inquire_spec[FFESTP_inquireixIOLENGTH]); fputs (") ", stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC assert ("INQUIRE(IOLENGTH=) not implemented yet! ~~~" == NULL); ffeste_emit_line_note_ (); clear_momentary (); ! #else ! #error #endif } *************** ffeste_R923B_start (ffestpInquireStmt *i *** 4492,4496 **** void ! ffeste_R923B_item (ffebld expr) { ffeste_check_item_ (); --- 4495,4499 ---- void ! ffeste_R923B_item (ffebld expr UNUSED) { ffeste_check_item_ (); *************** ffeste_R923B_item (ffebld expr) *** 4499,4506 **** ffebld_dump (expr); fputc (',', stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC clear_momentary (); ! #endif #endif } --- 4502,4509 ---- ffebld_dump (expr); fputc (',', stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC clear_momentary (); ! #else ! #error #endif } *************** ffeste_R923B_finish () *** 4519,4526 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC clear_momentary (); ! #endif #endif } --- 4522,4529 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC clear_momentary (); ! #else ! #error #endif } *************** ffeste_R1001 (ffests s) *** 4537,4542 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "$ FORMAT %.*s\n", (int) ffests_length (s), ffests_text (s)); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC { tree t; --- 4540,4544 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "$ FORMAT %.*s\n", (int) ffests_length (s), ffests_text (s)); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC { tree t; *************** ffeste_R1001 (ffests s) *** 4567,4571 **** var = ffecom_lookup_label (ffeste_label_formatdef_); if ((var != NULL_TREE) ! && (TREE_CODE (var) != ERROR_MARK)) { DECL_INITIAL (var) = t; --- 4569,4573 ---- var = ffecom_lookup_label (ffeste_label_formatdef_); if ((var != NULL_TREE) ! && (TREE_CODE (var) == VAR_DECL)) { DECL_INITIAL (var) = t; *************** ffeste_R1001 (ffests s) *** 4588,4592 **** ffeste_label_formatdef_ = NULL; } ! #endif #endif } --- 4590,4595 ---- ffeste_label_formatdef_ = NULL; } ! #else ! #error #endif } *************** ffeste_R1103 () *** 4601,4608 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ END_PROGRAM\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 4604,4611 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ END_PROGRAM\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_R1112 () *** 4616,4623 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* END_BLOCK_DATA\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 4619,4626 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("* END_BLOCK_DATA\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_R1212 (ffebld expr) *** 4637,4642 **** ffebld_dump (expr); fputc ('\n', stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC { ffebld args = ffebld_right (expr); --- 4640,4644 ---- ffebld_dump (expr); fputc ('\n', stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC { ffebld args = ffebld_right (expr); *************** ffeste_R1212 (ffebld expr) *** 4731,4735 **** clear_momentary (); } ! #endif #endif } --- 4733,4738 ---- clear_momentary (); } ! #else ! #error #endif } *************** ffeste_R1221 () *** 4744,4751 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ END_FUNCTION\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 4747,4754 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ END_FUNCTION\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_R1225 () *** 4759,4766 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "+ END_SUBROUTINE\n"); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 4762,4769 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fprintf (stdout, "+ END_SUBROUTINE\n"); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_R1226 (ffesymbol entry) *** 4812,4817 **** } fputc ('\n', stdout); ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC { tree label = ffesymbol_hook (entry).length_tree; --- 4815,4819 ---- } fputc ('\n', stdout); ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC { tree label = ffesymbol_hook (entry).length_tree; *************** ffeste_R1226 (ffesymbol entry) *** 4825,4829 **** clear_momentary (); } ! #endif #endif } --- 4827,4832 ---- clear_momentary (); } ! #else ! #error #endif } *************** ffeste_R1226 (ffesymbol entry) *** 4837,4841 **** void ! ffeste_R1227 (ffestw block, ffebld expr) { ffeste_check_simple_ (); --- 4840,4844 ---- void ! ffeste_R1227 (ffestw block UNUSED, ffebld expr) { ffeste_check_simple_ (); *************** ffeste_R1227 (ffestw block, ffebld expr) *** 4852,4857 **** fputc ('\n', stdout); } ! #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC { tree rtn; --- 4855,4859 ---- fputc ('\n', stdout); } ! #elif FFECOM_targetCURRENT == FFECOM_targetGCC { tree rtn; *************** ffeste_R1227 (ffestw block, ffebld expr) *** 4877,4881 **** clear_momentary (); } ! #endif #endif } --- 4879,4884 ---- clear_momentary (); } ! #else ! #error #endif } *************** ffeste_V018_start (ffestpRewriteStmt *in *** 4915,4922 **** ffeste_subr_file_ ("IOSTAT", &info->rewrite_spec[FFESTP_rewriteixIOSTAT]); fputs (") ", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 4918,4925 ---- ffeste_subr_file_ ("IOSTAT", &info->rewrite_spec[FFESTP_rewriteixIOSTAT]); fputs (") ", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_V018_item (ffebld expr) *** 4935,4942 **** ffebld_dump (expr); fputc (',', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 4938,4945 ---- ffebld_dump (expr); fputc (',', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_V018_finish () *** 4954,4961 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 4957,4964 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_V019_start (ffestpAcceptStmt *inf *** 4994,5001 **** ffeste_subr_file_ ("FORMAT", &info->accept_spec[FFESTP_acceptixFORMAT]); fputc (' ', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 4997,5004 ---- ffeste_subr_file_ ("FORMAT", &info->accept_spec[FFESTP_acceptixFORMAT]); fputc (' ', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_V019_item (ffebld expr) *** 5014,5021 **** ffebld_dump (expr); fputc (',', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 5017,5024 ---- ffebld_dump (expr); fputc (',', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_V019_finish () *** 5033,5039 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5036,5042 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_V019_finish () *** 5048,5052 **** void ! ffeste_V020_start (ffestpTypeStmt *info, ffestvFormat format) { ffeste_check_start_ (); --- 5051,5056 ---- void ! ffeste_V020_start (ffestpTypeStmt *info UNUSED, ! ffestvFormat format UNUSED) { ffeste_check_start_ (); *************** ffeste_V020_start (ffestpTypeStmt *info, *** 5074,5080 **** ffeste_subr_file_ ("FORMAT", &info->type_spec[FFESTP_typeixFORMAT]); fputc (' ', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5078,5084 ---- ffeste_subr_file_ ("FORMAT", &info->type_spec[FFESTP_typeixFORMAT]); fputc (' ', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_V020_start (ffestpTypeStmt *info, *** 5087,5091 **** void ! ffeste_V020_item (ffebld expr) { ffeste_check_item_ (); --- 5091,5095 ---- void ! ffeste_V020_item (ffebld expr UNUSED) { ffeste_check_item_ (); *************** ffeste_V020_item (ffebld expr) *** 5094,5100 **** ffebld_dump (expr); fputc (',', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5098,5104 ---- ffebld_dump (expr); fputc (',', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_V020_finish () *** 5113,5119 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5117,5123 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_V021 (ffestpDeleteStmt *info) *** 5138,5144 **** ffeste_subr_file_ ("IOSTAT", &info->delete_spec[FFESTP_deleteixIOSTAT]); fputs (")\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5142,5148 ---- ffeste_subr_file_ ("IOSTAT", &info->delete_spec[FFESTP_deleteixIOSTAT]); fputs (")\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_V022 (ffestpBeruStmt *info) *** 5161,5167 **** ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]); fputs (")\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5165,5171 ---- ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]); fputs (")\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_V023_start (ffestpVxtcodeStmt *in *** 5187,5193 **** ffeste_subr_file_ ("IOSTAT", &info->vxtcode_spec[FFESTP_vxtcodeixIOSTAT]); fputs (") ", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5191,5197 ---- ffeste_subr_file_ ("IOSTAT", &info->vxtcode_spec[FFESTP_vxtcodeixIOSTAT]); fputs (") ", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_V023_item (ffebld expr) *** 5207,5213 **** ffebld_dump (expr); fputc (',', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5211,5217 ---- ffebld_dump (expr); fputc (',', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_V023_finish () *** 5226,5233 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 5230,5237 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_V024_start (ffestpVxtcodeStmt *in *** 5252,5259 **** ffeste_subr_file_ ("IOSTAT", &info->vxtcode_spec[FFESTP_vxtcodeixIOSTAT]); fputs (") ", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 5256,5263 ---- ffeste_subr_file_ ("IOSTAT", &info->vxtcode_spec[FFESTP_vxtcodeixIOSTAT]); fputs (") ", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_V024_item (ffebld expr) *** 5272,5279 **** ffebld_dump (expr); fputc (',', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 5276,5283 ---- ffebld_dump (expr); fputc (',', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_V024_finish () *** 5291,5298 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 5295,5302 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_V025_start () *** 5311,5318 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ DEFINE_FILE ", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 5315,5322 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputs ("+ DEFINE_FILE ", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_V025_item (ffebld u, ffebld m, ff *** 5337,5344 **** ffebld_dump (asv); fputs ("),", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 5341,5348 ---- ffebld_dump (asv); fputs ("),", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_V025_finish () *** 5356,5363 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC #endif - #endif } --- 5360,5367 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE fputc ('\n', stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } *************** ffeste_V026 (ffestpFindStmt *info) *** 5380,5386 **** ffeste_subr_file_ ("IOSTAT", &info->find_spec[FFESTP_findixIOSTAT]); fputs (")\n", stdout); #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #endif #endif } --- 5384,5390 ---- ffeste_subr_file_ ("IOSTAT", &info->find_spec[FFESTP_findixIOSTAT]); fputs (")\n", stdout); + #elif FFECOM_targetCURRENT == FFECOM_targetGCC #else ! #error #endif } diff -rcp2N g77-0.5.15/f/ste.h g77-0.5.16/f/ste.h *** g77-0.5.15/f/ste.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/ste.h Wed Aug 30 15:53:34 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: *************** void ffeste_V026 (ffestpFindStmt *info); *** 152,158 **** #define ffeste_set_line(name,num) \ (input_filename = (name), lineno = (num)) ! #else #define ffeste_set_line(name,num) ! #endif #define ffeste_terminate_0() #define ffeste_terminate_1() --- 153,161 ---- #define ffeste_set_line(name,num) \ (input_filename = (name), lineno = (num)) ! #elif FFECOM_targetCURRENT == FFECOM_targetFFE #define ffeste_set_line(name,num) ! #else ! #error ! #endif /* FFECOM_targetCURRENT == FFECOM_targetFFE */ #define ffeste_terminate_0() #define ffeste_terminate_1() diff -rcp2N g77-0.5.15/f/storag.c g77-0.5.16/f/storag.c *** g77-0.5.15/f/storag.c Wed Feb 15 16:58:38 1995 --- g77-0.5.16/f/storag.c Wed Aug 30 15:53:33 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** ffestorag_dump (ffestorag s) *** 117,124 **** case FFESTORAG_typeLOCAL: fprintf (stdout, "LOCAL "); - break; - - case FFESTORAG_typeDUMMY: - fprintf (stdout, "DUMMY "); break; --- 118,121 ---- diff -rcp2N g77-0.5.15/f/storag.h g77-0.5.16/f/storag.h *** g77-0.5.15/f/storag.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/storag.h Wed Aug 30 15:53:33 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: *************** typedef enum *** 38,42 **** FFESTORAG_typeCOMMON, /* A COMMON variable. */ FFESTORAG_typeLOCAL, /* A local entity (var/array/equivalence). */ - FFESTORAG_typeDUMMY, /* A dummy (not used, currently). */ FFESTORAG_typeEQUIV, /* An entity equivalenced into a COMMON/LOCAL entity. */ --- 39,42 ---- *************** struct _ffestorag_ *** 74,79 **** ffebld accretion; /* Initializations seen so far for aggregate. */ ffetargetOffset accretes; /* # inits needed to fill entire aggregate. */ ! ffesymbol symbol; /* NULL if typeLOCAL and non-NULL equivs. */ ! ffestoragList_ equivs_; /* NULL if typeLOCAL and non-NULL symbol. */ ffetargetOffset size; /* Size of area. */ ffetargetOffset offset; /* Offset of entity within area. */ --- 74,81 ---- ffebld accretion; /* Initializations seen so far for aggregate. */ ffetargetOffset accretes; /* # inits needed to fill entire aggregate. */ ! ffesymbol symbol; /* NULL if typeLOCAL and non-NULL equivs ! and the first "rooted" symbol not known. */ ! ffestoragList_ equivs_; /* NULL if typeLOCAL and not an EQUIVALENCE ! area. */ ffetargetOffset size; /* Size of area. */ ffetargetOffset offset; /* Offset of entity within area. */ diff -rcp2N g77-0.5.15/f/stp.c g77-0.5.16/f/stp.c *** g77-0.5.15/f/stp.c Wed Feb 15 16:58:38 1995 --- g77-0.5.16/f/stp.c Wed Aug 30 15:53:33 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: diff -rcp2N g77-0.5.15/f/stp.h g77-0.5.16/f/stp.h *** g77-0.5.15/f/stp.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/stp.h Wed Aug 30 15:53:33 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: *************** enum _ffestp_typeix_ *** 225,229 **** typedef enum _ffestp_typeix_ ffestpTypeIx; ! enum _ffestep_vxtcodeix_ { FFESTP_vxtcodeixB, --- 226,230 ---- typedef enum _ffestp_typeix_ ffestpTypeIx; ! enum _ffestp_vxtcodeix_ { FFESTP_vxtcodeixB, diff -rcp2N g77-0.5.15/f/str-1t.fin g77-0.5.16/f/str-1t.fin *** g77-0.5.15/f/str-1t.fin Wed Feb 15 16:58:38 1995 --- g77-0.5.16/f/str-1t.fin Wed Aug 30 15:53:33 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. } --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. } diff -rcp2N g77-0.5.15/f/str-2t.fin g77-0.5.16/f/str-2t.fin *** g77-0.5.15/f/str-2t.fin Wed Feb 15 16:58:37 1995 --- g77-0.5.16/f/str-2t.fin Wed Aug 30 15:53:33 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. } --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. } diff -rcp2N g77-0.5.15/f/str-fo.fin g77-0.5.16/f/str-fo.fin *** g77-0.5.15/f/str-fo.fin Wed Feb 15 16:58:37 1995 --- g77-0.5.16/f/str-fo.fin Wed Aug 30 15:53:33 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. } --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. } diff -rcp2N g77-0.5.15/f/str-io.fin g77-0.5.16/f/str-io.fin *** g77-0.5.15/f/str-io.fin Wed Feb 15 16:58:37 1995 --- g77-0.5.16/f/str-io.fin Wed Aug 30 15:53:33 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. } --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. } diff -rcp2N g77-0.5.15/f/str-nq.fin g77-0.5.16/f/str-nq.fin *** g77-0.5.15/f/str-nq.fin Wed Feb 15 16:58:37 1995 --- g77-0.5.16/f/str-nq.fin Wed Aug 30 15:53:33 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. } --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. } diff -rcp2N g77-0.5.15/f/str-op.fin g77-0.5.16/f/str-op.fin *** g77-0.5.15/f/str-op.fin Wed Feb 15 16:58:37 1995 --- g77-0.5.16/f/str-op.fin Wed Aug 30 15:53:33 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. } --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. } diff -rcp2N g77-0.5.15/f/str-ot.fin g77-0.5.16/f/str-ot.fin *** g77-0.5.15/f/str-ot.fin Wed Feb 15 16:58:37 1995 --- g77-0.5.16/f/str-ot.fin Wed Aug 30 15:53:33 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. } --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. } diff -rcp2N g77-0.5.15/f/str.c g77-0.5.16/f/str.c *** g77-0.5.15/f/str.c Wed Feb 15 16:58:37 1995 --- g77-0.5.16/f/str.c Wed Aug 30 15:53:33 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: diff -rcp2N g77-0.5.15/f/str.h g77-0.5.16/f/str.h *** g77-0.5.15/f/str.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/str.h Wed Aug 30 15:53:33 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/sts.c g77-0.5.16/f/sts.c *** g77-0.5.15/f/sts.c Wed Feb 15 16:58:37 1995 --- g77-0.5.16/f/sts.c Wed Aug 30 15:53:33 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: diff -rcp2N g77-0.5.15/f/sts.h g77-0.5.16/f/sts.h *** g77-0.5.15/f/sts.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/sts.h Wed Aug 30 15:53:33 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/stt.c g77-0.5.16/f/stt.c *** g77-0.5.15/f/stt.c Wed Feb 15 16:58:37 1995 --- g77-0.5.16/f/stt.c Wed Aug 30 15:53:33 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: diff -rcp2N g77-0.5.15/f/stt.h g77-0.5.16/f/stt.h *** g77-0.5.15/f/stt.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/stt.h Wed Aug 30 15:53:33 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/stu.c g77-0.5.16/f/stu.c *** g77-0.5.15/f/stu.c Wed Feb 15 16:58:37 1995 --- g77-0.5.16/f/stu.c Wed Aug 30 15:53:33 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ *************** ffestu_sym_end_transition (ffesymbol s) *** 184,195 **** /* Honestly, this appears to be a guess. I can't find anyplace in the ! standard that makes clear whether this unreferenced dummy argument ! is an ENTITY or a FUNCTION. And yet, for the f2c interface, picking ! one is critical for CHARACTER entities because it determines whether ! to expect an additional argument specifying the length of an ENTITY ! that is not expected (or needed) for a FUNCTION. HOWEVER, F90 makes ! this guess a correct one, and it does seem that the Section 18 Notes ! in Appendix B of F77 make it clear the F77 standard at least ! intended to make this guess correct as well, so this seems ok. */ nkd = FFEINFO_kindENTITY; --- 185,196 ---- /* Honestly, this appears to be a guess. I can't find anyplace in the ! standard that makes clear whether this unreferenced dummy argument ! is an ENTITY or a FUNCTION. And yet, for the f2c interface, picking ! one is critical for CHARACTER entities because it determines whether ! to expect an additional argument specifying the length of an ENTITY ! that is not expected (or needed) for a FUNCTION. HOWEVER, F90 makes ! this guess a correct one, and it does seem that the Section 18 Notes ! in Appendix B of F77 make it clear the F77 standard at least ! intended to make this guess correct as well, so this seems ok. */ nkd = FFEINFO_kindENTITY; diff -rcp2N g77-0.5.15/f/stu.h g77-0.5.16/f/stu.h *** g77-0.5.15/f/stu.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/stu.h Wed Aug 30 15:53:33 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/stv.c g77-0.5.16/f/stv.c *** g77-0.5.15/f/stv.c Wed Feb 15 16:58:37 1995 --- g77-0.5.16/f/stv.c Wed Aug 30 15:53:32 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: diff -rcp2N g77-0.5.15/f/stv.h g77-0.5.16/f/stv.h *** g77-0.5.15/f/stv.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/stv.h Wed Aug 30 15:53:32 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: diff -rcp2N g77-0.5.15/f/stw.c g77-0.5.16/f/stw.c *** g77-0.5.15/f/stw.c Wed Feb 15 16:58:37 1995 --- g77-0.5.16/f/stw.c Wed Aug 30 15:53:32 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** ffestw_update (ffestw b) *** 401,408 **** return b; ! if (!ffewhere_line_is_unknown (b->line_)) ! ffewhere_line_kill (b->line_); ! if (!ffewhere_column_is_unknown (b->col_)) ! ffewhere_column_kill (b->col_); b->line_ = ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0])); b->col_ = ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0])); --- 402,407 ---- return b; ! ffewhere_line_kill (b->line_); ! ffewhere_column_kill (b->col_); b->line_ = ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0])); b->col_ = ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0])); diff -rcp2N g77-0.5.15/f/stw.h g77-0.5.16/f/stw.h *** g77-0.5.15/f/stw.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/stw.h Wed Aug 30 15:53:32 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: *************** struct _ffestw_ *** 81,85 **** bool select_break_; /* TRUE when CASE should start with gen "break;". */ ! #endif }; --- 82,86 ---- bool select_break_; /* TRUE when CASE should start with gen "break;". */ ! #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC*/ }; diff -rcp2N g77-0.5.15/f/symbol.c g77-0.5.16/f/symbol.c *** g77-0.5.15/f/symbol.c Wed Feb 15 16:58:37 1995 --- g77-0.5.16/f/symbol.c Wed Aug 30 15:53:32 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "proj.h" --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "proj.h" *************** the Free Software Foundation, 675 Mass A *** 42,47 **** UNIX/C model where the object file is essentially a monolith. */ ! #define FFESYMBOL_globalPROGUNIT_ 0 ! #define FFESYMBOL_globalFILE_ 1 /* Choose how to handle global symbols here. */ --- 43,48 ---- UNIX/C model where the object file is essentially a monolith. */ ! #define FFESYMBOL_globalPROGUNIT_ 1 ! #define FFESYMBOL_globalFILE_ 2 /* Choose how to handle global symbols here. */ *************** the Free Software Foundation, 675 Mass A *** 49,56 **** #if FFECOM_targetCURRENT == FFECOM_targetFFE #define FFESYMBOL_globalCURRENT_ FFESYMBOL_globalPROGUNIT_ #else ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #define FFESYMBOL_globalCURRENT_ FFESYMBOL_globalPROGRAMUNIT_ ! #endif #endif --- 50,59 ---- #if FFECOM_targetCURRENT == FFECOM_targetFFE #define FFESYMBOL_globalCURRENT_ FFESYMBOL_globalPROGUNIT_ + #elif FFECOM_targetCURRENT == FFECOM_targetGCC + /* Would be good to understand why PROGUNIT in this case too. + (1995-08-22). */ + #define FFESYMBOL_globalCURRENT_ FFESYMBOL_globalPROGUNIT_ #else ! #error #endif *************** the Free Software Foundation, 675 Mass A *** 59,66 **** #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_ #define FFESYMBOL_SPACE_POOL_ ffe_pool_program_unit() ! #else ! #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalFILE_ #define FFESYMBOL_SPACE_POOL_ ffe_pool_file() ! #endif #endif --- 62,69 ---- #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_ #define FFESYMBOL_SPACE_POOL_ ffe_pool_program_unit() ! #elif FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalFILE_ #define FFESYMBOL_SPACE_POOL_ ffe_pool_file() ! #else ! #error #endif *************** ffesymbol_attrs_string (ffesymbolAttrs a *** 341,345 **** else sprintf (p, "?0x%" ffesymbolAttrs_f "x?", attrs); ! assert ((p - &string[0]) < ARRAY_SIZE (string)); return &string[0]; } --- 344,348 ---- else sprintf (p, "?0x%" ffesymbolAttrs_f "x?", attrs); ! assert (((size_t) (p - &string[0])) < ARRAY_SIZE (string)); return &string[0]; } *************** ffesymbol_terminate_1 () *** 1269,1273 **** ffesymbol_global_ = NULL; ! ffesymbol_kill_manifest (); #endif } --- 1272,1276 ---- ffesymbol_global_ = NULL; ! ffesymbol_kill_manifest_ (); #endif } diff -rcp2N g77-0.5.15/f/symbol.def g77-0.5.16/f/symbol.def *** g77-0.5.15/f/symbol.def Wed Feb 15 16:58:36 1995 --- g77-0.5.16/f/symbol.def Wed Aug 30 15:53:32 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ /* "How g77 learns about symbols" --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* "How g77 learns about symbols" diff -rcp2N g77-0.5.15/f/symbol.h g77-0.5.16/f/symbol.h *** g77-0.5.15/f/symbol.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/symbol.h Wed Aug 30 15:53:32 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef _H_f_symbol --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #ifndef _H_f_symbol diff -rcp2N g77-0.5.15/f/target.c g77-0.5.16/f/target.c *** g77-0.5.15/f/target.c Fri May 19 11:17:32 1995 --- g77-0.5.16/f/target.c Wed Aug 30 15:53:32 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** ffetarget_gt_character1 (bool *res, ffet *** 423,427 **** void ! ffetarget_layout (char *error_text, ffetargetAlign *alignment, ffetargetAlign *modulo, ffetargetOffset *size, ffeinfoBasictype bt, ffeinfoKindtype kt, --- 424,428 ---- void ! ffetarget_layout (char *error_text UNUSED, ffetargetAlign *alignment, ffetargetAlign *modulo, ffetargetOffset *size, ffeinfoBasictype bt, ffeinfoKindtype kt, *************** ffetarget_convert_any_character1_ (char *** 522,530 **** ffetargetCharacter1 l) { ! if (size <= l.length) { char *p; ffetargetCharacterSize i; ! memcpy (res, l.text, size); for (p = &l.text[0] + size, i = l.length - size; --- 523,531 ---- ffetargetCharacter1 l) { ! if (size <= (size_t) l.length) { char *p; ffetargetCharacterSize i; ! memcpy (res, l.text, size); for (p = &l.text[0] + size, i = l.length - size; *************** ffetarget_convert_any_hollerith_ (char * *** 547,555 **** ffetargetHollerith l) { ! if (size <= l.length) { char *p; ffetargetCharacterSize i; ! memcpy (res, l.text, size); for (p = &l.text[0] + size, i = l.length - size; --- 548,556 ---- ffetargetHollerith l) { ! if (size <= (size_t) l.length) { char *p; ffetargetCharacterSize i; ! memcpy (res, l.text, size); for (p = &l.text[0] + size, i = l.length - size; *************** ffetarget_convert_any_typeless_ (char *r *** 577,581 **** unsigned short int l4; unsigned char l5; ! int size_of; char *p; --- 578,582 ---- unsigned short int l4; unsigned char l5; ! size_t size_of; char *p; *************** ffetarget_convert_character1_integer1 (f *** 711,723 **** ffetargetInteger1 l, mallocPool pool) { ! unsigned long long int l1; ! unsigned long int l2; ! unsigned int l3; ! unsigned short int l4; ! unsigned char l5; ! int size_of; char *p; ! if (size >= sizeof (l1)) { l1 = l; --- 712,724 ---- ffetargetInteger1 l, mallocPool pool) { ! long long int l1; ! long int l2; ! int l3; ! short int l4; ! char l5; ! size_t size_of; char *p; ! if (((size_t) size) >= sizeof (l1)) { l1 = l; *************** ffetarget_convert_character1_integer1 (f *** 725,729 **** size_of = sizeof (l1); } ! else if (size >= sizeof (l2)) { l2 = l; --- 726,730 ---- size_of = sizeof (l1); } ! else if (((size_t) size) >= sizeof (l2)) { l2 = l; *************** ffetarget_convert_character1_integer1 (f *** 732,736 **** l1 = l2; } ! else if (size >= sizeof (l3)) { l3 = l; --- 733,737 ---- l1 = l2; } ! else if (((size_t) size) >= sizeof (l3)) { l3 = l; *************** ffetarget_convert_character1_integer1 (f *** 739,743 **** l1 = l3; } ! else if (size >= sizeof (l4)) { l4 = l; --- 740,744 ---- l1 = l3; } ! else if (((size_t) size) >= sizeof (l4)) { l4 = l; *************** ffetarget_convert_character1_integer1 (f *** 746,750 **** l1 = l4; } ! else if (size >= sizeof (l5)) { l5 = l; --- 747,751 ---- l1 = l4; } ! else if (((size_t) size) >= sizeof (l5)) { l5 = l; *************** ffetarget_convert_character1_integer1 (f *** 765,769 **** { res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size); ! if (size <= size_of) { int i = size_of - size; --- 766,770 ---- { res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size); ! if (((size_t) size) <= size_of) { int i = size_of - size; *************** ffetarget_convert_character1_logical1 (f *** 797,809 **** ffetargetLogical1 l, mallocPool pool) { ! unsigned long long int l1; ! unsigned long int l2; ! unsigned int l3; ! unsigned short int l4; ! unsigned char l5; ! int size_of; char *p; ! if (size >= sizeof (l1)) { l1 = l; --- 798,810 ---- ffetargetLogical1 l, mallocPool pool) { ! long long int l1; ! long int l2; ! int l3; ! short int l4; ! char l5; ! size_t size_of; char *p; ! if (((size_t) size) >= sizeof (l1)) { l1 = l; *************** ffetarget_convert_character1_logical1 (f *** 811,815 **** size_of = sizeof (l1); } ! else if (size >= sizeof (l2)) { l2 = l; --- 812,816 ---- size_of = sizeof (l1); } ! else if (((size_t) size) >= sizeof (l2)) { l2 = l; *************** ffetarget_convert_character1_logical1 (f *** 818,822 **** l1 = l2; } ! else if (size >= sizeof (l3)) { l3 = l; --- 819,823 ---- l1 = l2; } ! else if (((size_t) size) >= sizeof (l3)) { l3 = l; *************** ffetarget_convert_character1_logical1 (f *** 825,829 **** l1 = l3; } ! else if (size >= sizeof (l4)) { l4 = l; --- 826,830 ---- l1 = l3; } ! else if (((size_t) size) >= sizeof (l4)) { l4 = l; *************** ffetarget_convert_character1_logical1 (f *** 832,836 **** l1 = l4; } ! else if (size >= sizeof (l5)) { l5 = l; --- 833,837 ---- l1 = l4; } ! else if (((size_t) size) >= sizeof (l5)) { l5 = l; *************** ffetarget_convert_character1_logical1 (f *** 851,855 **** { res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size); ! if (size <= size_of) { int i = size_of - size; --- 852,856 ---- { res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size); ! if (((size_t) size) <= size_of) { int i = size_of - size; *************** ffetarget_convert_character1_typeless (f *** 888,895 **** unsigned short int l4; unsigned char l5; ! int size_of; char *p; ! if (size >= sizeof (l1)) { l1 = l; --- 889,896 ---- unsigned short int l4; unsigned char l5; ! size_t size_of; char *p; ! if (((size_t) size) >= sizeof (l1)) { l1 = l; *************** ffetarget_convert_character1_typeless (f *** 897,901 **** size_of = sizeof (l1); } ! else if (size >= sizeof (l2)) { l2 = l; --- 898,902 ---- size_of = sizeof (l1); } ! else if (((size_t) size) >= sizeof (l2)) { l2 = l; *************** ffetarget_convert_character1_typeless (f *** 904,908 **** l1 = l2; } ! else if (size >= sizeof (l3)) { l3 = l; --- 905,909 ---- l1 = l2; } ! else if (((size_t) size) >= sizeof (l3)) { l3 = l; *************** ffetarget_convert_character1_typeless (f *** 911,915 **** l1 = l3; } ! else if (size >= sizeof (l4)) { l4 = l; --- 912,916 ---- l1 = l3; } ! else if (((size_t) size) >= sizeof (l4)) { l4 = l; *************** ffetarget_convert_character1_typeless (f *** 918,922 **** l1 = l4; } ! else if (size >= sizeof (l5)) { l5 = l; --- 919,923 ---- l1 = l4; } ! else if (((size_t) size) >= sizeof (l5)) { l5 = l; *************** ffetarget_convert_character1_typeless (f *** 937,941 **** { res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size); ! if (size <= size_of) { int i = size_of - size; --- 938,942 ---- { res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size); ! if (((size_t) size) <= size_of) { int i = size_of - size; *************** ffetarget_typeless_hex (ffetargetTypeles *** 2206,2209 **** --- 2207,2217 ---- return !bad_digit && !overflow; + } + + void + ffetarget_verify_character1 (mallocPool pool, ffetargetCharacter1 val) + { + if (val.length != 0) + malloc_verify_kp (pool, val.text, val.length); } diff -rcp2N g77-0.5.15/f/target.h g77-0.5.16/f/target.h *** g77-0.5.15/f/target.h Fri May 19 11:17:32 1995 --- g77-0.5.16/f/target.h Wed Aug 30 15:53:32 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: *************** the Free Software Foundation, 675 Mass A *** 118,121 **** --- 119,125 ---- #define FFETARGET_defaultSTATE_MIL FFE_intrinsicstateENABLED #endif + #ifndef FFETARGET_defaultSTATE_UNIX + #define FFETARGET_defaultSTATE_UNIX FFE_intrinsicstateENABLED + #endif #ifndef FFETARGET_defaultSTATE_VXT #define FFETARGET_defaultSTATE_VXT FFE_intrinsicstateDELETED *************** the Free Software Foundation, 675 Mass A *** 132,137 **** underscore appended (for compatibility with existing systems). */ ! #ifndef FFETARGET_isEXTERNAL_UNDERSCORED ! #define FFETARGET_isEXTERNAL_UNDERSCORED 1 #endif --- 136,141 ---- underscore appended (for compatibility with existing systems). */ ! #ifndef FFETARGET_defaultEXTERNAL_UNDERSCORED ! #define FFETARGET_defaultEXTERNAL_UNDERSCORED 1 #endif *************** the Free Software Foundation, 675 Mass A *** 138,148 **** /* 1 if external Fortran names with underscores already in them should have an extra underscore appended (in addition to the one they ! might already have appened if FFETARGET_isEXTERNAL_UNDERSCORED). */ ! #ifndef FFETARGET_isUNDERSCORED_EXTERNAL_UNDERSCORED ! #define FFETARGET_isUNDERSCORED_EXTERNAL_UNDERSCORED FFETARGET_isEXTERNAL_UNDERSCORED #endif ! /* If FFETARGET_isEXTERNAL_UNDERSCORED is 0, the following definitions might also need to be overridden to make g77 objects compatible with f2c+gcc objects. Although I don't think the unnamed BLOCK DATA one --- 142,156 ---- /* 1 if external Fortran names with underscores already in them should have an extra underscore appended (in addition to the one they ! might already have appened if FFETARGET_defaultEXTERNAL_UNDERSCORED). ! NOTE: See gcc/f/com.c for other changes that need to be made ! if this is not #define'd to be 1, but underscoring is turned on. ! Right now there's only the option to disable underscoring in general, ! not to change just this setting. */ ! #ifndef FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED ! #define FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED 1 #endif ! /* If FFETARGET_defaultEXTERNAL_UNDERSCORED is 0, the following definitions might also need to be overridden to make g77 objects compatible with f2c+gcc objects. Although I don't think the unnamed BLOCK DATA one *************** the Free Software Foundation, 675 Mass A *** 225,231 **** --- 233,242 ---- #define FFETARGET_okREAL2 1 #define FFETARGET_okREAL3 0 + #define FFETARGET_okREALQUAD FFETARGET_okREAL3 #define FFETARGET_okCOMPLEX1 1 #define FFETARGET_okCOMPLEX2 1 #define FFETARGET_okCOMPLEX3 0 + #define FFETARGET_okCOMPLEXDOUBLE FFETARGET_okCOMPLEX2 + #define FFETARGET_okCOMPLEXQUAD FFETARGET_okCOMPLEX3 #define FFETARGET_okCHARACTER1 1 *************** the Free Software Foundation, 675 Mass A *** 250,254 **** typedef unsigned char ffetargetAlign; /* ffetargetOffset for alignment. */ #define ffetargetAlign_f "" ! typedef unsigned long ffetargetCharacterSize; #define ffetargetCharacterSize_f "l" typedef void (*ffetargetCopyfunc) (void *, void *, size_t); --- 261,265 ---- typedef unsigned char ffetargetAlign; /* ffetargetOffset for alignment. */ #define ffetargetAlign_f "" ! typedef long ffetargetCharacterSize; #define ffetargetCharacterSize_f "l" typedef void (*ffetargetCopyfunc) (void *, void *, size_t); *************** bool ffetarget_typeless_binary (ffetarge *** 806,809 **** --- 817,821 ---- bool ffetarget_typeless_octal (ffetargetTypeless *value, ffelexToken token); bool ffetarget_typeless_hex (ffetargetTypeless *value, ffelexToken token); + void ffetarget_verify_character1 (mallocPool pool, ffetargetCharacter1 val); int ffetarget_num_digits_ (ffelexToken t); void *ffetarget_memcpy_ (void *dst, void *src, size_t len); *************** void *ffetarget_memcpy_ (void *dst, void *** 1273,1277 **** #define ffetarget_init_4() #define ffetarget_integerdefault_is_magical(i) \ ! (i == FFETARGET_integerBIG_MAGICAL) #ifdef REAL_ARITHMETIC #define ffetarget_iszero_real1(l) \ --- 1285,1289 ---- #define ffetarget_init_4() #define ffetarget_integerdefault_is_magical(i) \ ! (((unsigned long int) i) == FFETARGET_integerBIG_MAGICAL) #ifdef REAL_ARITHMETIC #define ffetarget_iszero_real1(l) \ diff -rcp2N g77-0.5.15/f/tconfig.j g77-0.5.16/f/tconfig.j *** g77-0.5.15/f/tconfig.j Thu Feb 16 21:43:59 1995 --- g77-0.5.16/f/tconfig.j Wed Aug 30 15:53:32 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef MAKING_DEPENDENCIES --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #ifndef MAKING_DEPENDENCIES diff -rcp2N g77-0.5.15/f/tm.j g77-0.5.16/f/tm.j *** g77-0.5.15/f/tm.j Thu Feb 16 21:43:59 1995 --- g77-0.5.16/f/tm.j Wed Aug 30 15:53:32 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef MAKING_DEPENDENCIES --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #ifndef MAKING_DEPENDENCIES diff -rcp2N g77-0.5.15/f/top.c g77-0.5.16/f/top.c *** g77-0.5.15/f/top.c Fri May 19 11:17:32 1995 --- g77-0.5.16/f/top.c Wed Aug 30 15:53:32 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** the Free Software Foundation, 675 Mass A *** 55,59 **** #include "where.h" #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #include "flags.h" #endif --- 56,60 ---- #include "where.h" #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #include "flags.j" #endif *************** bool ffe_is_90_ = FFETARGET_defaultIS_90 *** 64,67 **** --- 65,70 ---- bool ffe_is_automatic_ = FFETARGET_defaultIS_AUTOMATIC; bool ffe_is_backslash_ = FFETARGET_defaultIS_BACKSLASH; + bool ffe_is_underscoring_ = FFETARGET_defaultEXTERNAL_UNDERSCORED + || FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED; bool ffe_is_dollar_ok_ = FFETARGET_defaultIS_DOLLAR_OK; bool ffe_is_f2c_ = FFETARGET_defaultIS_F2C; *************** bool ffe_is_f2c_library_ = FFETARGET_def *** 69,72 **** --- 72,76 ---- bool ffe_is_ffedebug_ = FALSE; bool ffe_is_free_form_ = FFETARGET_defaultIS_FREE_FORM; + 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 *************** ffeIntrinsicState ffe_intrinsic_state_f2 *** 88,91 **** --- 92,96 ---- ffeIntrinsicState ffe_intrinsic_state_f90_ = FFETARGET_defaultSTATE_F90; ffeIntrinsicState ffe_intrinsic_state_mil_ = FFETARGET_defaultSTATE_MIL; + ffeIntrinsicState ffe_intrinsic_state_unix_ = FFETARGET_defaultSTATE_UNIX; ffeIntrinsicState ffe_intrinsic_state_vxt_ = FFETARGET_defaultSTATE_VXT; int ffe_fixed_line_length_ = FFETARGET_defaultFIXED_LINE_LENGTH; *************** ffe_decode_option (char *opt) *** 148,151 **** --- 153,163 ---- if (strcmp (&opt[2], "version") == 0) ffe_set_is_version (TRUE); + else if (strcmp (&opt[2], "null-version") == 0) + ; /* Someday generate program to print version + info. */ + 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], "f90") == 0) ffe_set_is_90 (TRUE); *************** ffe_decode_option (char *opt) *** 216,219 **** --- 228,235 ---- else if (strcmp (&opt[2], "no-backslash") == 0) ffe_set_is_backslash (FALSE); + else if (strcmp (&opt[2], "underscoring") == 0) + ffe_set_is_underscoring (TRUE); + else if (strcmp (&opt[2], "no-underscoring") == 0) + ffe_set_is_underscoring (FALSE); else if (strcmp (&opt[2], "intrin-case-initcap") == 0) ffe_set_case_intrin (FFE_caseINITCAP); *************** ffe_decode_option (char *opt) *** 320,323 **** --- 336,347 ---- else if (strcmp (&opt[2], "mil-intrinsics-enable") == 0) ffe_set_intrinsic_state_mil (FFE_intrinsicstateENABLED); + else if (strcmp (&opt[2], "unix-intrinsics-delete") == 0) + ffe_set_intrinsic_state_unix (FFE_intrinsicstateDELETED); + else if (strcmp (&opt[2], "unix-intrinsics-hide") == 0) + ffe_set_intrinsic_state_unix (FFE_intrinsicstateHIDDEN); + else if (strcmp (&opt[2], "unix-intrinsics-disable") == 0) + ffe_set_intrinsic_state_unix (FFE_intrinsicstateDISABLED); + else if (strcmp (&opt[2], "unix-intrinsics-enable") == 0) + ffe_set_intrinsic_state_unix (FFE_intrinsicstateENABLED); else if (strcmp (&opt[2], "vxt-intrinsics-delete") == 0) ffe_set_intrinsic_state_vxt (FFE_intrinsicstateDELETED); *************** ffe_decode_option (char *opt) *** 367,371 **** else if (!strcmp (&opt[2], "all")) { - extra_warnings = 1; /* We save the value of warn_uninitialized, since if they put -Wuninitialized on the command line, we need to generate a --- 391,394 ---- *************** ffe_file (ffewhereFile wf, FILE *f) *** 397,401 **** ffe_init_1 (); ffelex_set_handler ((ffelexHandler) ffest_first); ! ffewhere_file_begin (NULL, wf); if (ffe_is_free_form_) ffelex_file_free (wf, f); --- 420,424 ---- ffe_init_1 (); ffelex_set_handler ((ffelexHandler) ffest_first); ! ffewhere_file_set (wf, TRUE, 0); if (ffe_is_free_form_) ffelex_file_free (wf, f); *************** ffe_file (ffewhereFile wf, FILE *f) *** 402,406 **** else ffelex_file_fixed (wf, f); - ffewhere_file_end (wf, NULL); ffest_eof (); ffe_terminate_1 (); --- 425,428 ---- diff -rcp2N g77-0.5.15/f/top.h g77-0.5.16/f/top.h *** g77-0.5.15/f/top.h Tue May 9 03:38:54 1995 --- g77-0.5.16/f/top.h Wed Aug 30 15:53:32 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: *************** extern bool ffe_is_90_; *** 81,84 **** --- 82,86 ---- extern bool ffe_is_automatic_; extern bool ffe_is_backslash_; + extern bool ffe_is_underscoring_; extern bool ffe_is_dollar_ok_; extern bool ffe_is_f2c_; *************** extern bool ffe_is_f2c_library_; *** 86,89 **** --- 88,92 ---- extern bool ffe_is_ffedebug_; extern bool ffe_is_free_form_; + extern bool ffe_is_ident_; extern bool ffe_is_init_local_zero_; extern bool ffe_is_mainprog_; *************** extern ffeIntrinsicState ffe_intrinsic_s *** 104,107 **** --- 107,111 ---- extern ffeIntrinsicState ffe_intrinsic_state_f90_; extern ffeIntrinsicState ffe_intrinsic_state_mil_; + extern ffeIntrinsicState ffe_intrinsic_state_unix_; extern ffeIntrinsicState ffe_intrinsic_state_vxt_; extern int ffe_fixed_line_length_; *************** void ffe_terminate_4 (void); *** 145,148 **** --- 149,153 ---- #define ffe_intrinsic_state_f90() ffe_intrinsic_state_f90_ #define ffe_intrinsic_state_mil() ffe_intrinsic_state_mil_ + #define ffe_intrinsic_state_unix() ffe_intrinsic_state_unix_ #define ffe_intrinsic_state_vxt() ffe_intrinsic_state_vxt_ #define ffe_is_90() ffe_is_90_ *************** void ffe_terminate_4 (void); *** 154,157 **** --- 159,163 ---- #define ffe_is_ffedebug() ffe_is_ffedebug_ #define ffe_is_free_form() ffe_is_free_form_ + #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_ *************** void ffe_terminate_4 (void); *** 162,165 **** --- 168,172 ---- #define ffe_is_ugly_args() ffe_is_ugly_args_ #define ffe_is_ugly_init() ffe_is_ugly_init_ + #define ffe_is_underscoring() ffe_is_underscoring_ #define ffe_is_version() ffe_is_version_ #define ffe_is_vxt_not_90() ffe_is_vxt_not_90_ *************** void ffe_terminate_4 (void); *** 177,180 **** --- 184,188 ---- #define ffe_set_intrinsic_state_f90(s) (ffe_intrinsic_state_f90_ = (s)) #define ffe_set_intrinsic_state_mil(s) (ffe_intrinsic_state_mil_ = (s)) + #define ffe_set_intrinsic_state_unix(s) (ffe_intrinsic_state_unix_ = (s)) #define ffe_set_intrinsic_state_vxt(s) (ffe_intrinsic_state_vxt_ = (s)) #define ffe_set_is_90(f) (ffe_is_90_ = (f)) *************** void ffe_terminate_4 (void); *** 186,189 **** --- 194,198 ---- #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_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)) *************** void ffe_terminate_4 (void); *** 193,196 **** --- 202,206 ---- #define ffe_set_is_ugly_args(f) (ffe_is_ugly_args_ = (f)) #define ffe_set_is_ugly_init(f) (ffe_is_ugly_init_ = (f)) + #define ffe_set_is_underscoring(f) (ffe_is_underscoring_ = (f)) #define ffe_set_is_version(f) (ffe_is_version_ = (f)) #define ffe_set_is_vxt_not_90(f) (ffe_is_vxt_not_90_ = (f)) diff -rcp2N g77-0.5.15/f/tree.j g77-0.5.16/f/tree.j *** g77-0.5.15/f/tree.j Fri Feb 17 01:28:31 1995 --- g77-0.5.16/f/tree.j Wed Aug 30 15:53:32 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef MAKING_DEPENDENCIES --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #ifndef MAKING_DEPENDENCIES diff -rcp2N g77-0.5.15/f/type.c g77-0.5.16/f/type.c *** g77-0.5.15/f/type.c Wed Apr 12 10:03:28 1995 --- g77-0.5.16/f/type.c Wed Aug 30 15:53:32 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "proj.h" --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "proj.h" *************** ffetype_lookup_kind (ffetype base_type, *** 31,35 **** if ((base_type->kinds_ == NULL) || (kind < 0) ! || (kind >= ARRAY_SIZE (base_type->kinds_->type_))) return NULL; --- 32,36 ---- if ((base_type->kinds_ == NULL) || (kind < 0) ! || (((size_t) kind) >= ARRAY_SIZE (base_type->kinds_->type_))) return NULL; *************** ffetype ffetype_lookup_star (ffetype bas *** 41,45 **** if ((base_type->stars_ == NULL) || (star < 0) ! || (star >= ARRAY_SIZE (base_type->stars_->type_))) return NULL; --- 42,46 ---- if ((base_type->stars_ == NULL) || (star < 0) ! || (((size_t) star) >= ARRAY_SIZE (base_type->stars_->type_))) return NULL; *************** void ffetype_set_kind (ffetype base_type *** 72,76 **** "ffetype_indexes_[kinds]", sizeof (*(base_type->kinds_))); ! for (i = 0; i < ARRAY_SIZE (base_type->kinds_->type_); ++i) base_type->kinds_->type_[i] = NULL; } --- 73,77 ---- "ffetype_indexes_[kinds]", sizeof (*(base_type->kinds_))); ! for (i = 0; ((size_t) i) < ARRAY_SIZE (base_type->kinds_->type_); ++i) base_type->kinds_->type_[i] = NULL; } *************** void ffetype_set_star (ffetype base_type *** 91,95 **** "ffetype_indexes_[stars]", sizeof (*(base_type->stars_))); ! for (i = 0; i < ARRAY_SIZE (base_type->stars_->type_); ++i) base_type->stars_->type_[i] = NULL; } --- 92,96 ---- "ffetype_indexes_[stars]", sizeof (*(base_type->stars_))); ! for (i = 0; ((size_t) i) < ARRAY_SIZE (base_type->stars_->type_); ++i) base_type->stars_->type_[i] = NULL; } diff -rcp2N g77-0.5.15/f/type.h g77-0.5.16/f/type.h *** g77-0.5.15/f/type.h Wed Apr 12 10:03:28 1995 --- g77-0.5.16/f/type.h Wed Aug 30 15:53:32 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef _H_f_type --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #ifndef _H_f_type diff -rcp2N g77-0.5.15/f/where.c g77-0.5.16/f/where.c *** g77-0.5.15/f/where.c Fri Apr 28 05:26:13 1995 --- g77-0.5.16/f/where.c Wed Aug 30 15:53:32 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** struct _ffewhere_ll_ *** 57,61 **** ffewhereLL_ previous; ffewhereFile wf; - ffewhereLL_ parent; ffewhereLineNumber line_no; /* ffelex_line_number() at time of creation. */ ffewhereLineNumber offset; /* User-desired offset (usually 1). */ --- 58,61 ---- *************** struct _ffewhere_root_line_ *** 78,82 **** static struct _ffewhere_root_ll_ ffewhere_root_ll_; - static ffewhereLL_ ffewhere_parent_ll_; /* Parent of last _begin'd file. */ static struct _ffewhere_root_line_ ffewhere_root_line_; --- 78,81 ---- *************** ffewhere_ll_lookup_ (ffewhereLineNumber *** 110,148 **** } - /* Start reading from a new file instead of an old one. */ - - void - ffewhere_file_begin (ffewhereFile old_wf, ffewhereFile new_wf) - { - if (old_wf != NULL) - assert (ffewhere_root_ll_.last->wf == old_wf); - - ffewhere_parent_ll_ = ffewhere_root_ll_.last; - ffewhere_file_set (new_wf, TRUE, 0); - } - - /* Stop reading from a new file, back to an old one. */ - - void - ffewhere_file_end (ffewhereFile new_wf, ffewhereFile old_wf) - { - ffewhereLL_ parent; - ffewhereLineNumber ln; - - assert (ffewhere_root_ll_.last->wf == new_wf); - - if (old_wf != NULL) - { - parent = ffewhere_parent_ll_; - assert (parent != NULL); - assert (parent->wf == old_wf); - - ln = parent->next->line_no - parent->line_no + parent->offset; - - ffewhere_parent_ll_ = parent->parent; - ffewhere_file_set (old_wf, TRUE, ln); - } - } - /* Kill file object. --- 109,112 ---- *************** ffewhere_file_set (ffewhereFile wf, bool *** 199,203 **** else ll->wf = wf; - ll->parent = ffewhere_parent_ll_; /* Last _begin'd ll object. */ ll->line_no = ffelex_line_number (); if (have_num) --- 163,166 ---- *************** ffewhere_init_1 () *** 224,229 **** ffewhere_root_ll_.first = ffewhere_root_ll_.last = (ffewhereLL_) &ffewhere_root_ll_.first; - - ffewhere_parent_ll_ = NULL; } --- 187,190 ---- *************** ffewhere_line_use (ffewhereLine wl) *** 370,375 **** "u\n", wl->line_num, wl->uses); #endif ! assert (wl->uses != 0); ! ++wl->uses; return wl; } --- 331,337 ---- "u\n", wl->line_num, wl->uses); #endif ! assert (ffewhere_line_is_unknown (wl) || (wl->uses != 0)); ! if (!ffewhere_line_is_unknown (wl)) ! ++wl->uses; return wl; } *************** ffewhere_track_copy (ffewhereTrack dwt, *** 561,566 **** void ! ffewhere_track_kill (ffewhereLine wrl, ffewhereColumn wrc, ffewhereTrack wt, ! ffewhereIndex length) { ffewhereLineNumber ln; --- 523,528 ---- void ! ffewhere_track_kill (ffewhereLine wrl, ffewhereColumn wrc UNUSED, ! ffewhereTrack wt, ffewhereIndex length) { ffewhereLineNumber ln; diff -rcp2N g77-0.5.15/f/where.h g77-0.5.16/f/where.h *** g77-0.5.15/f/where.h Wed Apr 12 10:03:29 1995 --- g77-0.5.16/f/where.h Wed Aug 30 15:53:32 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: *************** extern struct _ffewhere_line_ ffewhere_u *** 88,93 **** /* Declare functions with prototypes. */ - void ffewhere_file_begin (ffewhereFile old_wf, ffewhereFile new_wf); - void ffewhere_file_end (ffewhereFile new_wf, ffewhereFile old_wf); void ffewhere_file_kill (ffewhereFile wf); ffewhereFile ffewhere_file_new (char *name, size_t length); --- 89,92 ---- diff -rcp2N g77-0.5.15/f/zzz.c g77-0.5.16/f/zzz.c *** g77-0.5.15/f/zzz.c Fri May 19 11:17:32 1995 --- g77-0.5.16/f/zzz.c Wed Aug 30 15:53:32 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Related Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Related Modules: *************** the Free Software Foundation, 675 Mass A *** 29,60 **** */ - /* Include files. */ - #include "proj.h" #include "zzz.h" ! /* Externals defined here. */ ! ! char *ffezzz_version_string = "0.5.15"; ! char *ffezzz_date = __DATE__; ! char *ffezzz_time = __TIME__; ! ! /* Simple definitions and enumerations. */ ! ! ! /* Internal typedefs. */ ! ! ! /* Private include files. */ ! ! ! /* Internal structure definitions. */ ! ! ! /* Static objects accessed by functions in this module. */ ! ! ! /* Static functions (internal). */ ! ! ! /* Internal macros. */ --- 30,48 ---- */ #include "proj.h" #include "zzz.h" ! /* If you want to override the version date/time info with your own ! macros, e.g. for a consistent distribution when bootstrapping, ! go ahead! */ ! ! #ifndef FFEZZZ_DATE ! #define FFEZZZ_DATE __DATE__ ! #endif ! #ifndef FFEZZZ_TIME ! #define FFEZZZ_TIME __TIME__ ! #endif ! ! char *ffezzz_version_string = "0.5.16"; ! char *ffezzz_date = FFEZZZ_DATE; ! char *ffezzz_time = FFEZZZ_TIME; diff -rcp2N g77-0.5.15/f/zzz.h g77-0.5.16/f/zzz.h *** g77-0.5.15/f/zzz.h Thu Feb 16 21:42:52 1995 --- g77-0.5.16/f/zzz.h Wed Aug 30 15:53:32 1995 *************** GNU General Public License for more deta *** 17,21 **** You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. Owning Modules: --- 17,22 ---- You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. Owning Modules: *************** the Free Software Foundation, 675 Mass A *** 25,58 **** */ - /* Allow multiple inclusion to work. */ - #ifndef _H_f_zzz #define _H_f_zzz - /* Simple definitions and enumerations. */ - - - /* Typedefs. */ - - - /* Include files needed by this one. */ - - - /* Structure definitions. */ - - - /* Global objects accessed by users of this module. */ - extern char *ffezzz_version_string; extern char *ffezzz_date; extern char *ffezzz_time; - - /* Declare functions with prototypes. */ - - - /* Define macros. */ - - - /* End of #include file. */ #endif --- 26,35 ----