IMPORTANT: After applying this patch, you must rebuild the Info documentation derived from the Texinfo files in the g77 distribution, as this patch does not include patches to any derived files (to keep the size of the patch file down). Use the following command sequence after applying this patch to the `g77' directory: cd g77; make -k -f f/Makefile.in g77-only If that fails due to `makeinfo' not being installed, obtain texinfo-3.11.tar.gz from a GNU distribution site, unpack, build, and install it, and try the above command sequence again. Alternately, instead of using this patch, obtain the full g77 distribution named g77-0.5.21.tar.gz. This distribution contains the derived Info documentation. diff -rcp2N g77-0.5.20/README.g77 g77-0.5.21/README.g77 *** g77-0.5.20/README.g77 Sat Mar 1 04:13:06 1997 --- g77-0.5.21/README.g77 Tue Sep 2 21:25:23 1997 *************** *** 1,5 **** ! 1997-02-28 ! This directory contains the version 0.5.20 release of the GNU Fortran compiler. The GNU Fortran compiler is free software. See the file COPYING.g77 for copying permission. --- 1,5 ---- ! 1997-09-02 ! This directory contains the version 0.5.21 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,29 **** * To build GNU Fortran, you must have a source distribution of gcc ! version 2.7.2.2. Do not attempt to use any other version of gcc, because this version of g77 is designed to work only with ! gcc version 2.7.2.2. * 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, --- 16,27 ---- * To build GNU Fortran, you must have a source distribution of gcc ! version 2.7.2.3. Do not attempt to use any other version of gcc, because this version of g77 is designed to work only with ! gcc version 2.7.2.3. * 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. If you have just unpacked the g77 distribution, before proceeding, *************** you must merge the contents of the g77 d *** 31,43 **** gcc distribution on your system before proceeding. ! * Read and follow the instructions in g77-0.5.20/f/INSTALL that explain how to merge a g77 source directory into a gcc source directory. You can use Info to read the same installation instructions via: ! info -f g77-0.5.20/f/g77.info -n Unpacking The resulting directory layout includes the following, where gcc/ might be ! a link to, for example, gcc-2.7.2.2/: gcc/ Non-Fortran files in gcc (not part of g77*.tar) --- 29,41 ---- gcc distribution on your system before proceeding. ! * Read and follow the instructions in g77-0.5.21/f/INSTALL that explain how to merge a g77 source directory into a gcc source directory. You can use Info to read the same installation instructions via: ! info -f g77-0.5.21/f/g77.info -n Unpacking The resulting directory layout includes the following, where gcc/ might be ! a link to, for example, gcc-2.7.2.3/: gcc/ Non-Fortran files in gcc (not part of g77*.tar) *************** gcc/f/runtime/ contains the run-time lib *** 87,91 **** by g77, and referred to as libf2c (though libf2c is really a combination of two distinct libraries, libF77 and libI77 -- in g77, this distinction is ! not made). This separate subdirectory is not part of the program g77, just distributed with it. Some new files have been added to this subdirectory and some minor changes made to the files contained therein, to fix some --- 85,90 ---- by g77, and referred to as libf2c (though libf2c is really a combination of two distinct libraries, libF77 and libI77 -- in g77, this distinction is ! not made, and, further, Dave Love's implementation of libU77 is added ! to the mix). This separate subdirectory is not part of the program g77, just distributed with it. Some new files have been added to this subdirectory and some minor changes made to the files contained therein, to fix some diff -rcp2N g77-0.5.20/f/BUGS g77-0.5.21/f/BUGS *** g77-0.5.20/f/BUGS Thu Feb 27 05:12:28 1997 --- g77-0.5.21/f/BUGS Tue Sep 9 06:24:24 1997 *************** separating them out. *** 16,19 **** --- 16,38 ---- port, build, and install `g77', *Note Problems Installing::. + * `g77''s version of `gcc', and probably `g77' itself, cannot be + reliably used with the `-O2' option (or higher) on Digital + Semiconductor Alpha AXP machines. The problem is most immediately + noticed in differences discovered by `make compare' following a + bootstrap build using `-O2'. It also manifests itself as a + failure to compile `DATA' statements such as `DATA R/7./' + correctly; in this case, `R' might be initialized to `4.0'. + + Until this bug is fixed, use only `-O1' or no optimization. + + * A code-generation bug afflicts Intel x86 targets when `-O2' is + specified compiling, for example, an old version of the `DNRM2' + routine. The x87 coprocessor stack is being somewhat mismanaged + in cases where assigned `GOTO' and `ASSIGN' are involved. + + Version 0.5.21 of `g77' contains an initial effort to fix the + problem, but this effort is incomplete, and a more complete fix is + planned for the next release. + * Work is needed on the `SIGNAL()' intrinsic to ensure that pointers and integers are properly handled on all targets, including 64-bit *************** port, build, and install `g77', *Note Pr *** 32,36 **** unrolling loops. Until this is solved, try inserting or removing `CONTINUE' statements as the terminal statement, using the `END DO' ! form instead, and so on. * The `g77' command itself should more faithfully process options --- 51,56 ---- unrolling loops. Until this is solved, try inserting or removing `CONTINUE' statements as the terminal statement, using the `END DO' ! form instead, and so on. (Probably improved, but not wholly ! fixed, in 0.5.21.) * The `g77' command itself should more faithfully process options *************** port, build, and install `g77', *Note Pr *** 158,163 **** * `g77' doesn't work perfectly on 64-bit configurations such as the Alpha. This problem is expected to be largely resolved as of ! version 0.5.20, and version 0.6 should solve most or all related ! problems (such as 64-bit machines other than DEC Alphas). One known bug that causes a compile-time crash occurs when --- 178,184 ---- * `g77' doesn't work perfectly on 64-bit configurations such as the Alpha. This problem is expected to be largely resolved as of ! version 0.5.20, and further addressed by 0.5.21. Version 0.6 ! should solve most or all related problems (such as 64-bit machines ! other than Digital Semiconductor ("DEC") Alphas). One known bug that causes a compile-time crash occurs when diff -rcp2N g77-0.5.20/f/CREDITS g77-0.5.21/f/CREDITS *** g77-0.5.20/f/CREDITS Mon Mar 4 06:14:27 1996 --- g77-0.5.21/f/CREDITS Thu Jan 1 00:00:00 1970 *************** *** 1,6 **** - THIS FILE HAS BEEN OBSOLETED in the GNU Fortran distribution as - of version 0.5.18. It will be removed in a future distribution. - - Its contents have been assimilated into the Info documentation, - the source to which is in gcc/f/g77.texi. In particular, - see the node ``(g77)Contributors''. --- 0 ---- diff -rcp2N g77-0.5.20/f/ChangeLog g77-0.5.21/f/ChangeLog *** g77-0.5.20/f/ChangeLog Sat Mar 1 04:06:52 1997 --- g77-0.5.21/f/ChangeLog Tue Sep 9 06:11:33 1997 *************** *** 1,2 **** --- 1,688 ---- + Tue Sep 9 01:59:35 1997 Craig Burley + + * Version 0.5.21 released. + + Tue Sep 9 00:31:01 1997 Craig Burley + + * intdoc.c (dumpem): Put appropriate commentary in + output file, so readers know it isn't source. + + Wed Aug 27 08:08:25 1997 Craig Burley + + * proj.h: Always #include "config.j" first, to pick up + gcc's configuration. + * com.c: Change bcopy() and bzero() calls to memcpy() + and memset() calls, to make more of g77 ANSI C. + + 1997-08-26 Dave Love + + * Make-lang.in ($(srcdir)/f/runtime/configure, + $(srcdir)/f/runtime/libU77/configure): Fix for when srcdir isn't + relative. + + Tue Aug 26 05:59:21 1997 Craig Burley + + * ansify.c (main): Make sure readers of stdout know + it's derived from stdin; omit comment text; get source + line numbers in future stderr output to be correct. + + Tue Aug 26 01:36:01 1997 Craig Burley + + Fix 970825-0.f: + * stb.c (ffestb_R5284_): Allow OPEN_PAREN after closing + SLASH as well as NAME. + + Mon Aug 25 23:48:17 1997 Craig Burley + + Changes to allow g77 docs to be built entirely from scratch + using any ANSI C compiler, not requiring GNU C: + * Make-lang.in ($(srcdir)/f/intdoc.texi): "Pipe" new + location of intrinsic documentation data base, f/intdoc.in, + through new `ansify' program to append `\n\' to quoted + newlines, into f/intdoc.h0. Do appropriate cleanups. Explain. + (f77.mostlyclean): Add f/ansify and f/intdoc.h0 to cleanups. + * f/ansify.c: New program. + * f/intdoc.c: Fix so it conforms to ANSI C. + #include f/intdoc.h0 instead of f/intdoc.h. + Avoid some warnings. + * f/intdoc.h, f/intdoc.in: Rename the former to the latter; no + changes made to the content in this patch! + * f/intrin.h (ffeintrinFamily): Fix to conform to ANSI C. + + Sun Aug 24 06:52:48 1997 Craig Burley + + Fix up g77 compiler data base for libf2c routines: + * com-rt.def (FFECOM_gfrtSIGNAL): Change return type to + FTNINT to match actual code. + + * com.c (ffecomRttype_): Replace FFECOM_rttypeINT_ with + FFECOM_rttypeFTNINT_. + Add and fix up comments. + (ffecom_make_gfrt_, ffecom_gfrt_basictype, + ffecom_gfrt_kindtype): Replace FFECOM_rttypeINT_ with + FFECOM_rttypeFTNINT_; add FFECOM_rttypeDOUBLEREAL_. + + Wed Aug 20 17:18:40 1997 Craig Burley + + * global.c (ffeglobal_ref_progunit_): It's okay to have + a different CHARACTER*n length for a reference if the + existing length is for another reference, not a definition. + + Mon Aug 18 14:27:18 1997 Craig Burley + + Fix 970814-0.f: + * global.c (ffeglobal_new_progunit_): Distinguish + between previously defined, versus inferred, filewide + when it comes to diagnostics. + + Fix 970816-1.f: + * global.c (ffeglobal_ref_progunit_): Change BDATA into EXT + right at the beginning, so EXTERNAL FOO followed later + by SUBROUTINE FOO is not diagnosed. + + Fix 970813-0.f: + * com-rt.def (FFECOM_gfrtALARM): Returns `integer', not + `void'. + + Sun Aug 17 03:32:44 1997 Craig Burley + + Fix up problems when virtual memory exhausted: + * malloc.c (malloc_new_): Use gcc's xmalloc(), so we + print a nicer message when malloc returns no memory. + (malloc_resize_): Ditto for xrealloc(). + + * Make-lang.in, Makefile.in: Comment out lines containing + just formfeeds. + + Sat Aug 16 19:41:33 1997 Craig Burley + + * com.c (ffecom_make_gfrt_): For rttypeREAL_F2C_, return + double_type_node; for rttypeREAL_GNU_, return + _real_type_node. + + 1997-08-13 Dave Love + + * config-lang.in (diff_excludes): Add some hints about known + problematic platforms. + + 1997-08-13 Dave Love + + * intdoc.h: Document `alarm'. + + Mon Aug 11 21:19:22 1997 Craig Burley + + * Make-lang.in ($(RUNTIMESTAGESTUFF)): Add + f/runtime/stamp-lib. + + Mon Aug 11 01:52:03 1997 Craig Burley + + * com.c (ffecom_build_complex_constant_): Go with the + new build_complex() approach used in gcc-2.8. + + * com.c (ffecom_sym_transform_): Don't set + DECL_IN_SYSTEM_HEADER for a tree node that isn't + a VAR_DECL, which happens when var is in common! + + * com.c (ffecom_expr_intrinsic_) (case FFEINTRIN_impALARM): + No need to test codegen_imp -- there's only one valid here. + + * intrin.def (FFEINTRIN_impALARM): Specify `Status' argument + as write-only. + + Fri Aug 8 05:40:23 1997 Craig Burley + + Substantial changes to accommodate distinctions among + run-time routines that support intrinsics, and between + routines that compute and return the same type vs. those + that compute one type and return another (or `void'): + * com-rt.def: Specify new return type REAL_F2C_ instead + of many DOUBLE_, COMPLEX_F2C_ instead of COMPLEX_, and + so on. + Clear up the *BES* routines "once and for all". + * com.c: New return types. + (ffecom_convert_narrow_, ffecom_convert_widen_): + New functions that are "safe" variants of convert(), + to catch errors that ffecom_expr_intrinsic_() now + no longer catches. + (ffecom_arglist_expr_): Ensure arguments are not + converted to narrower types. + (ffecom_call_): Ensure return value is not converted + to a wider type. + (ffecom_char_args_): Use new ffeintrin_gfrt_direct() + routine. + (ffecom_expr_intrinsic_): Simplify how run-time + routine is selected (via `gfrt' only now; lose the + redundant `ix' variable). + Eliminate the `library' label; any code that doesn't + return directly just `break's out now with `gfrt' + set appropriately. + Set `gfrt' to default choice initially, either a + fast direct form or, if not available, a slower + indirect-callable form. + (ffecom_make_gfrt_): No longer need to do special + check for complex; it's built into the new return-type + regime. + (ffecom_ptr_to_expr): Use new ffeintrin_gfrt_indirect() + routine. + * intrin.c, intrin.h: `gfrt' field replaced with three fields, + so it is easier to provide faster direct-callable and + GNU-convention indirect-callable routines in the future. + DEFIMP macro adjusted accordingly, along with all its uses. + (ffeintrin_gfrt_direct): New function. + (ffeintrin_gfrt_indirect): Ditto. + (ffeintrin_is_actualarg): If `-fno-f2c' is in effect, + require a GNU-callable version of intrinsic instead of + an f2c-callable version, so indirect calling is still checked. + * intrin.def: Replace one GFRT field with the three new fields, + as appropriate for each DEFIMP intrinsic. + + * com.c (ffecom_stabilize_aggregate_, + ffecom_convert_to_complex_): Make these `static'. + + Thu Aug 7 11:24:34 1997 Craig Burley + + Provide means for front end to determine actual + "standard" return type for an intrinsic if it is + passed as an actual argument: + * com.h, com.c (ffecom_gfrt_basictype, + ffecom_gfrt_kindtype): New functions. + (ffecom_gfrt_kind_type_): Replaced with new function. + All callers updated. + (ffecom_make_gfrt_): No longer need do anything + with kind type. + + * intrin.c (ffeintrin_basictype, ffeintrin_kindtype): + Now returns correct type info for specific intrinsic + (based on type of run-time-library implementation). + + Wed Aug 6 23:08:46 1997 Craig Burley + + * global.c (ffeglobal_ref_progunit_): Don't reset + number of arguments just due to new type info, + so useful warnings can be issued. + + 1997-08-06 Dave Love + + * intrin.def: Fix IDATE_vxt argument order. + * intdoc.h: Likewise. + + Thu Jul 31 22:22:03 1997 Craig Burley + + * global.c (ffeglobal_proc_ref_arg): If REF/DESCR + disagreement, DESCR is CHARACTER, and types disagree, + pretend the argsummary agrees so the message ends up + being about type disagreement. + (ffeglobal_proc_def_arg): Ditto. + + * expr.c (ffeexpr_token_first_rhs_3_): Set info for LABTOK + to NONE of everything, to avoid misdiagnosing filewide + usage of alternate returns. + + Sun Jul 20 23:07:47 1997 Craig Burley + + * com.c (ffecom_sym_transform_): If type gets set + to error_mark_node, just return that for transformed symbol. + (ffecom_member_phase2_): If type gets set to error_mark_node, + just return. + (ffecom_check_size_overflow_): Add `dummy' argument to + flag that type is for a dummy, update all callers. + + Sun Jul 13 17:40:53 1997 Craig Burley + + Fix 970712-1.f: + * where.c (ffewhere_set_from_track): If start point + is too large, just use initial start point. 0.6 should + fix all this properly. + + Fix 970712-2.f: + * com.c (ffecom_sym_transform_): Preserve error_mark_node for type. + (ffecom_type_localvar_): Ditto. + (ffecom_sym_transform_): If type is error_mark_node, + don't error-check decl size, because back end responds by + setting that to an integer 0 instead of error_mark_node. + (ffecom_transform_common_): Same as earlier fix to _transform_ + in that size is checked by dividing BITS_PER_UNIT instead of + multiplying. + (ffecom_transform_equiv_): Ditto. + + Fix 970712-3.f: + * stb.c (ffestb_R10014_): Fix flaky fall-through in error + test for FFELEX_typeCONCAT by just replicating the code, + and do FFELEX_typeCOLONCOLON while at it. + + 1997-07-07 Dave Love + + * intdoc.h: Add various missing pieces; correct GMTIME, LTIME + result ordering. + + * intrin.def, com-rt.def: Add alarm. + + * com.c (ffecom_expr_intrinsic_): Add case for alarm. + + Thu Jun 26 04:19:40 1997 Craig Burley + + Fix 970302-3.f: + * com.c (ffecom_sym_transform_): For sanity-check compare + of gbe size of local variable to g77 expectation, + use varasm.c/assemble_variable technique of dividing + BITS_PER_UNIT out of gbe info instead of multiplying + g77 info up, to avoid crash when size in bytes is very + large, and overflows an `int' or similar when multiplied. + + Fix 970626-2.f: + * com.c (ffecom_finish_symbol_transform_): Don't bother + transforming a dummy argument, to avoid a crash. + * ste.c (ffeste_R1227): Don't return a value if the + result decl, or its type, is error_mark_node. + + Fix 970626-4.f: + * lex.c (ffelex_splice_tokens): `-fdollar-ok' is + irrelevant to whether a DOLLAR token should be made + from an initial character of `$'. + + Fix 970626-6.f: + * stb.c (ffestb_do3_): DO iteration variable is an + lhs, not rhs, expression. + + Fix 970626-7.f and 970626-8.f: + * expr.c (ffeexpr_cb_comma_i_1_): Set IMPDO expression + to have clean info, because undefined rank, for example, + caused crash on mangled source on UltraSPARC but not + on Alpha for a series of weird reasons. + (ffeexpr_cb_close_paren_): If not CLOSE_PAREN, push + opANY expression onto stack instead of attempting + to mimic what program might have wanted. + (ffeexpr_cb_close_paren_): Don't wrap opPAREN around + opIMPDO, just warn that it's gratuitous. + * bad.def (FFEBAD_IMPDO_PAREN): New warning. + + Fix 970626-9.f: + * expr.c (ffeexpr_declare_parenthesized_): Must shut down + parsing in kindANY case, otherwise the parsing engine might + decide there's an ambiguity. + (ffeexpr_token_name_rhs_): Eliminate parentypeSUBROUTINE_ + case, so we crash right away if it comes through. + * st.c, st.h, sta.c, sta.h (ffest_shutdown, ffesta_shutdown): + New functions. + + Tue Jun 24 19:47:29 1997 Craig Burley + + * com.c (ffecom_check_size_overflow_): New function + catches some cases of the size of a type getting + too large. varasm.c must catch the rest. + (ffecom_sym_transform_): Use new function. + (ffecom_type_localvar_): Ditto. + + Mon Jun 23 01:09:28 1997 Craig Burley + + * global.c (ffeglobal_proc_def_arg): Fix comparison + of argno to #args. + (ffeglobal_proc_ref_arg): Ditto. + + * lang-options.h, top.c: Rename `-fdebug' to `-fxyzzy', + since it's an unsupported internals option and some + poor user might guess that it does something. + + * bad.def: Make a warning for each filewide diagnostic. + Put all filewides together. + * com.c (ffecom_sym_transform_): Don't substitute + known global tree for global entities when `-fno-globals'. + * global.c (ffeglobal_new_progunit_): Don't produce + fatal diagnostics about globals when `-fno-globals'. + Instead, produce equivalent warning when `-Wglobals'. + (ffeglobal_proc_ref_arg): Ditto. + (ffeglobal_proc_ref_nargs): Ditto. + (ffeglobal_ref_progunit_): Ditto. + * lang-options.h, top.c, top.h: New `-fno-globals' option. + + Sat Jun 21 12:32:54 1997 Craig Burley + + * expr.c (ffeexpr_fulfill_call_): Set array variable + to avoid warning about uninitialized variable. + + * Make-lang.in: Get rid of any setting of HOST_* macros, + since these will break gcc's build! + * makefile: New file to make building derived files + easier. + + Thu Jun 19 18:19:28 1997 Craig Burley + + * g77.c (main): Install Emilio Lopes' patch to support + Ratfor, and to fix the printing of the version string + to go to stderr, not stdout. + * lang-specs.h: Install Emilio Lopes' patch to support + Ratfor, and patch the result to support picking up + `*f771' from the `specs' file. + + Thu Jun 12 14:36:25 1997 Craig Burley + + * storag.c (ffestorag_update_init, ffestorag_update_save): + Also update parent, in case equivalence processing + has already eliminated pointers to it via the + local equivalence info. + + Tue Jun 10 14:08:26 1997 Craig Burley + + * intdoc.c: Add cross-reference to end of description + of any generic intrinsic pointing to other intrinsics + with the same name. + + Warn about explicit type declaration for intrinsic + that disagrees with invocation: + * expr.c (ffeexpr_paren_rhs_let_): Preserve type info + for intrinsic functions. + (ffeexpr_token_funsubstr_): Ditto. + * intrin.c (ffeintrin_fulfill_generic): Warn if type + info of fulfilled intrinsic invocation disagrees with + explicit type info given symbol. + (ffeintrin_fulfill_specific): Ditto. + * stc.c (ffestc_R1208_item): Preserve type info + for intrinsics. + (ffestc_R501_item): Ditto. + + Mon Jun 9 17:45:44 1997 Craig Burley + + * com.c (ffecom_expr_intrinsic_): Fix several of the + libU77/libF77-unix handlers to properly convert their + arguments. + + * com-rt.def (FFECOM_gfrtFSTAT): Append missing "i" to + arg string. + + Fri Jun 6 14:37:30 1997 Craig Burley + + * com.c (ffecom_expr_intrinsic_): Have a case statement + for every intrinsic implementation, so missing ones + are caught via gcc warnings. + Don't call ffeintrin_codegen_imp anymore. + * intrin.c (ffeintrin_fulfill_generic): Remove cg_imp + stuff from here. + (ffeintrin_codegen_imp): Delete this function. + * intrin.def, intrin.h: Remove DEFIMQ stuff from here + as well. + + Thu Jun 5 13:03:07 1997 Craig Burley + + * top.c (ffe_decode_option): New -fbadu77-intrinsics-* + options. + * top.h: Ditto. + * intrin.h: New BADU77 family. + * intrin.c (ffeintrin_state_family): Ditto. + + Implement new scheme to track intrinsic names vs. forms: + * intrin.c (ffeintrin_fulfill_generic), + (ffeintrin_fulfill_specific), (ffeintrin_is_intrinsic), + intrin.def: The documented name is now either in the + generic info or, if no generic, in the specific info. + For a generic, the specific info contains merely the + distinguishing form (usually "function" or "subroutine"), + used for diagnostics about ambiguous references and + in the documentation. + + * intrin.def: Clean up formatting of DEFNAME block. + Convert many libU77 intrinsics into generics that + support both subroutine and function forms. + Put the function forms of side-effect routines into + the new BADU77 family. + Make MCLOCK and TIME return INTEGER*4 again, and add + INTEGER*8 equivalents called MCLOCK8 and TIME8. + Fix up more status return values to be written and + insist on them being I1 as well. + * com.c (ffecom_expr_intrinsic_): Lots of changes to + support new libU77 intrinsic interfaces. + + Mon Jun 2 00:37:53 1997 Craig Burley + + * com.c (ffecom_init_0): Pointer type is now INTEGER(KIND=7), + not INTEGER(KIND=0), since we want to reserve KIND=0 for + future use. + + Thu May 29 14:30:33 1997 Craig Burley + + Fix bugs preventing CTIME(I*4) from working correctly: + * com.c (ffecom_char_args_): For FUNCREF case, process + args to intrinsic just as they would be in + ffecom_expr_intrinsic_. + * com-rt.def (FFECOM_gfrtCTIME, FFECOM_gfrtTTYNAM): Fix + argument decls to specify `&'. + + Wed May 28 22:19:49 1997 Craig Burley + + Fix gratuitous warnings exposed by dophot aka 970528-1: + * global.c (ffeglobal_proc_def_arg, ffeglobal_proc_ref_arg): + Support distinct function/subroutine arguments instead of + just procedures. + * global.h: Ditto. + * expr.c (ffeexpr_fulfill_call_): A SYMTER with kindNONE + also is a procedure (either function or subroutine). + + Mon May 26 20:25:31 1997 Craig Burley + + * bad.def: Have several lexer diagnostics refer to + documentation for people who need more info on what Fortran + source code is supposed to look like. + + * expr.c (ffeexpr_reduced_bool1_), bad.def: New diagnostics + specific to .NOT. now mention only one operand instead + of two. + + * g77.c: Recognize -fsyntax-only, similar to -c etc. + (lookup_option): Fix bug that prevented non-`--' options + from being recognized. + + Sun May 25 04:29:04 1997 Craig Burley + + * intrin.def (FFEINTRIN_impCTIME): Accept `I*' expression + for STime instead of requiring `I2'. + + Tue May 20 16:14:40 1997 Craig Burley + + * symbol.c (ffesymbol_reference): All references to + standard intrinsics are considered explicit, so as + to avoid generating basically useless warnings. + * intrin.c, intrin.h (ffeintrin_is_standard): Returns TRUE + if intrinsic is standard. + + Sun May 18 21:14:59 1997 Craig Burley + + * com-rt.def: Changed all external names of the + form `"\([a-z0-9]*\)_' to `"G77_\1_0"' so as to + allow any name valid as an intrinsic to be used + as such and as a user-defined external procedure + name or common block as well. + + Thu May 8 13:07:10 1997 Craig Burley + + * expr.c (ffeexpr_cb_end_notloc_): For %VAL, %REF, and + %DESCR, copy arg info into new node. + + Mon May 5 14:42:17 1997 Craig Burley + + From Uwe F. Mayer : + * Make-lang.in (g77-cross): Fix typo in g77.c path. + + From Brian McIlwrath : + * lang-specs.h: Have g77 pick up options from a section + labeled `*f771' of the `specs' file. + + Sat May 3 02:46:08 1997 Craig Burley + + * intrin.def (FFEINTRIN_defSIGNAL): Add optional `Status' + argument that com.c already expects (per Dave Love). + + More changes to support better tracking of (filewide) + globals, in particular, the arguments to procedures: + * bad.def (FFEBAD_FILEWIDE_NARGS, FFEBAD_FILEWIDE_NARGS_W, + FFEBAD_FILEWIDE_ARG, FFEBAD_FILEWIDE_ARG_W): New diagnostics. + * expr.c (ffebad_fulfill_call_): Provide info on each + argument to ffeglobal. + * global.c, global.h (ffeglobal_proc_def_arg, + ffeglobal_proc_def_nargs, ffeglobal_proc_ref_arg, + ffeglobal_proc_ref_args): New functions. + (ffeglobalArgSummary, ffeglobalArgInfo_): New types. + + Tue Apr 29 18:35:41 1997 Craig Burley + + More changes to support better tracking of (filewide) + globals: + * expr.c (ffeexpr_fulfill_call_): New function. + (ffeexpr_token_name_lhs_): Call after building procedure + reference expression. Also leave info field for ANY-ized + expression alone. + (ffeexpr_token_arguments_): Ditto. + + Mon Apr 28 20:04:18 1997 Craig Burley + + Changes to support better tracking of (filewide) + globals, mainly to avoid crashes due to inlining: + * bad.def: Go back to quoting intrinsic names, + (FFEBAD_FILEWIDE_DISAGREEMENT, FFEBAD_FILEWIDE_TIFF, + FFEBAD_FILEWIDE_TYPE_MISMATCH): New diagnostics. + (FFEBAD_INTRINSIC_EXPIMP, FFEBAD_INTRINSIC_GLOBAL): Reword + for clarity. + * com.c (ffecom_do_entry_, ffecom_start_progunit_, + ffecom_sym_transform_): Accommodate new FFEGLOBAL_typeEXT + possibility. + * expr.c (ffeexpr_sym_lhs_call_, ffeexpr_sym_lhs_extfunc_, + ffeexpr_sym_rhs_actualarg_, ffeexpr_declare_parenthesized_, + ffeexpr_paren_rhs_let_, ffeexpr_token_funsubstr_): + Fill in real kind info instead of leaving NONE where + appropriate. + Register references to intrinsics and globals with ffesymbol + using new ffesymbol_reference function instead of + ffesymbol_globalize. + * global.c (ffeglobal_type_string_): New array for + new diagnostics. + * global.h, global.c: + Replace ->init mechanism with ->tick mechanism. + Move other common-related members into a substructure of + a union, so the proc substructure can be introduced + to include members related to externals other than commons. + Don't complain about ANY-ized globals; ANY-ize globals + once they're complained about, in any case where code + generation could become a problem. + Handle global entries that have NONE type (seen as + intrinsics), EXT type (seen as EXTERNAL), and so on. + Keep track of kind and type of externals, both via + definition and via reference. + Diagnose disagreements about kind or type of externals + (such as functions). + (ffeglobal_ref_intrinsic, ffeglobal_ref_progunit_): New + functions. + * stc.c (ffestc_R1207_item, ffestc_R1208_item, + ffestc_R1219, ffestc_R1226): + Call ffesymbol_reference, not ffesymbol_globalize. + * stu.c (ffestu_sym_end_transition, + ffestu_sym_exec_transition): + Call ffesymbol_reference, not ffesymbol_globalize. + * symbol.c (ffesymbol_globalize): Removed... + (ffesymbol_reference): ...to this new function, + which more generally registers references to symbols, + globalizes globals, and calls on the ffeglobal module + to check globals filewide. + + * global.h, global.c: Rename some macros and functions + to more clearly distinguish common from other globals. + All callers changed. + + * com.c (ffecom_sym_transform_): Trees describing + filewide globals must be allocated on permanent obstack. + + * expr.c (ffeexpr_token_name_lhs_): Don't generate + gratuitous diagnostics for FFEINFO_whereANY case. + + Thu Apr 17 03:27:18 1997 Craig Burley + + * global.c: Add support for flagging intrinsic/global + confusion via warnings. + * bad.def (FFEBAD_INTRINSIC_EXPIMP, + FFEBAD_INTRINSIC_GLOBAL): New diagnostics. + * expr.c (ffeexpr_token_funsubstr_): Ditto. + (ffeexpr_sym_lhs_call_): Ditto. + (ffeexpr_paren_rhs_let_): Ditto. + * stc.c (ffestc_R1208_item): Ditto. + + Wed Apr 16 22:40:56 1997 Craig Burley + + * expr.c (ffeexpr_declare_parenthesized_): INCLUDE + context can't be an intrinsic invocation either. + + Fri Mar 28 10:43:28 1997 Craig Burley + + * expr.c (ffeexpr_token_arguments_): Make sure top of + exprstack is operand before dereferencing operand field. + + * lex.c (ffelex_prepare_eos_): Fill up truncated + hollerith token, so crash on null ->text field doesn't + happen later. + + * stb.c (ffestb_R10014_): If NAMES isn't recognized (or + the recognized part is followed in the token by a + non-digit), don't try and collect digits, as there + might be more than FFEWHERE_indexMAX letters to skip + past to do so -- and the code is diagnosed anyway. + + Thu Mar 27 00:02:48 1997 Craig Burley + + * com.c (ffecom_sym_transform_): Force local + adjustable array onto stack. + + * stc.c (ffestc_R547_item_object): Don't actually put + the symbol in COMMON if the symbol has already been + EQUIVALENCE'd to a different COMMON area. + + * equiv.c (ffeequiv_add): Don't actually do anything + if there's a disagreement over which COMMON area is + involved. + + Tue Mar 25 03:35:19 1997 Craig Burley + + * com.c (ffecom_transform_common_): If no explicit init + of COMMON area, don't actually init it even though + storage area suggests it. + + Mon Mar 24 12:10:08 1997 Craig Burley + + * lex.c (ffelex_image_char_): Avoid overflowing the + column counter itself, as well as the card image. + + * where.c (ffewhere_line_new): Cast ffelex_line_length() + to (size_t) so 255 doesn't overflow to 0! + + * stc.c (ffestc_labeldef_notloop_begin_): Don't gratuitously + terminate loop before processing statement, so block + doesn't disappear out from under EXIT/CYCLE processing. + (ffestc_labeldef_notloop_): Has old code from above + function, instead of just calling it. + + * expr.c (ffeexpr_cb_comma_i_4_): Don't skip over + arbitrary token (such as EOS). + + * com.c (ffecom_init_zero_): Handle RECORD_TYPE and + UNION_TYPE so -fno-zeros works with -femulated-complex. + + 1997-03-12 Dave Love + + * intrin.def: New intrinsics INT2, INT8, CPU_TIME. Fix AND, OR, + XOR. [Integrated by burley, AND/OR/XOR already fixed, INT8 + implementation changed/fixed.] + + Wed Mar 12 10:40:08 1997 Craig Burley + + * Make-lang.in ($(srcdir)/f/intdoc.texi): Simplify rules + so building f/intdoc is not always necessary; remove + f/intdoc after running it if it is built. + + Tue Mar 11 23:42:00 1997 Craig Burley + + * intrin.def (FFEINTRIN_impAND, FFEINTRIN_impOR, + FFEINTRIN_impXOR): Use the IAND, IOR, and IEOR implementations + of these, instead of crashing in ffecom_expr_intrinsic_ + or adding case labels there. + + Mon Mar 10 22:51:23 1997 Craig Burley + + * intdoc.c: Fix so any C compiler can compile this. + Fri Feb 28 13:16:50 1997 Craig Burley diff -rcp2N g77-0.5.20/f/INSTALL g77-0.5.21/f/INSTALL *** g77-0.5.20/f/INSTALL Sat Mar 1 04:11:18 1997 --- g77-0.5.21/f/INSTALL Tue Sep 9 06:24:38 1997 *************** follow the `g77' installation instructio *** 39,49 **** on most systems, if desired. ! `gcc-2.7.2.2.tar.gz' You need to have this, or some other applicable, version of `gcc' on your system. The version should be an exact copy of a ! distribution from the FSF. It is approximately 7MB large. ! If you've already unpacked `gcc-2.7.2.2.tar.gz' into a directory ! (named `gcc-2.7.2.2') called the "source tree" for `gcc', you can delete the distribution itself, but you'll need to remember to skip any instructions to unpack this distribution. --- 39,52 ---- on most systems, if desired. ! The version of GNU `gzip' used to package this release is 1.24. ! (The version of GNU `tar' used to package this release is 1.11.2.) ! ! `gcc-2.7.2.3.tar.gz' You need to have this, or some other applicable, version of `gcc' on your system. The version should be an exact copy of a ! distribution from the FSF. Its size is approximately 7.1MB. ! If you've already unpacked `gcc-2.7.2.3.tar.gz' into a directory ! (named `gcc-2.7.2.3') called the "source tree" for `gcc', you can delete the distribution itself, but you'll need to remember to skip any instructions to unpack this distribution. *************** follow the `g77' installation instructio *** 52,77 **** You can obtain an FSF distribution of `gcc' from the FSF. ! `g77-0.5.20.tar.gz' ! You probably have already unpacked this distribution, or you are ! reading an advanced copy of this manual, which is contained in ! this distribution. This distribution approximately 1MB large. You can obtain an FSF distribution of `g77' from the FSF, the same way you obtained `gcc'. ! 100MB disk space ! For a complete "bootstrap" build, about 100MB of disk space is ! required for `g77' by the author's current GNU/Linux system. ! ! Some juggling can reduce the amount of space needed; during the ! bootstrap process, once Stage 3 starts, during which the version ! of `gcc' that has been copied into the `stage2/' directory is used ! to rebuild the system, you can delete the `stage1/' directory to ! free up some space. ! ! It is likely that many systems don't require the complete ! bootstrap build, as they already have a recent version of `gcc' ! installed. Such systems might be able to build `g77' with only ! about 75MB of free space. `patch' --- 55,138 ---- You can obtain an FSF distribution of `gcc' from the FSF. ! `g77-0.5.21.tar.gz' ! You probably have already unpacked this package, or you are ! reading an advance copy of these installation instructions, which ! are contained in this distribution. The size of this package is ! approximately 1.5MB. You can obtain an FSF distribution of `g77' from the FSF, the same way you obtained `gcc'. ! Enough disk space ! The amount of disk space needed to unpack, build, install, and use ! `g77' depends on the type of system you're using, how you build ! `g77', and how much of it you install (primarily, which languages ! you install). ! ! The sizes shown below assume all languages distributed in ! `gcc-2.7.2.3', plus `g77', will be built and installed. These ! sizes are indicative of GNU/Linux systems on Intel x86 running ! COFF and on Digital Alpha (AXP) systems running ELF. These should ! be fairly representative of 32-bit and 64-bit systems, ! respectively. ! ! Note that all sizes are approximate and subject to change without ! notice! They are based on preliminary releases of g77 made shortly ! before the public beta release. ! ! -- `gcc' and `g77' distributions occupy 8.6MB packed, 35MB ! unpacked. These consist of the source code and documentation, ! plus some derived files (mostly documentation), for `gcc' and ! `g77'. Any deviations from these numbers for different kinds ! of systems are likely to be very minor. ! ! -- A "bootstrap" build requires an additional 67.3MB for a ! total of 102MB on an ix86, and an additional 98MB for a total ! of 165MB on an Alpha. ! ! -- Removing `gcc/stage1' after the build recovers 10.7MB for a ! total of 91MB on an ix86, and recovers ??MB for a total of ! ??MB on an Alpha. ! ! After doing this, the integrity of the build can still be ! verified via `make compare', and the `gcc' compiler modified ! and used to build itself for testing fairly quickly, using ! the copy of the compiler kept in `gcc/stage2'. ! ! -- Removing `gcc/stage2' after the build further recovers ! 27.3MB for a total of 64.3MB, and recovers ??MB for a total ! of ??MB on an Alpha. ! ! After doing this, the compiler can still be installed, ! especially if GNU `make' is used to avoid gratuitous rebuilds ! (or, the installation can be done by hand). ! ! -- Installing `gcc' and `g77' copies 14.9MB onto the `--prefix' ! disk for a total of 79.2MB on an ix86, and copies ??MB onto ! the `--prefix' disk for a total of ??MB on an Alpha. ! ! After installation, if no further modifications and builds of ! `gcc' or `g77' are planned, the source and build directory may be ! removed, leaving the total impact on a system's disk storage as ! that of the amount copied during installation. ! ! Systems with the appropriate version of `gcc' installed don't ! require the complete bootstrap build. Doing a "straight build" ! requires about as much space as does a bootstrap build followed by ! removing both the `gcc/stage1' and `gcc/stage2' directories. ! ! Installing `gcc' and `g77' over existing versions might require ! less *new* disk space, but note that, unlike many products, `gcc' ! installs itself in a way that avoids overwriting other installed ! versions of itself, so that other versions may easily be invoked ! (via `gcc -V VERSION'). ! ! So, the amount of space saved as a result of having an existing ! version of `gcc' and `g77' already installed is not ! much--typically only the command drivers (`gcc', `g77', `g++', and ! so on, which are small) and the documentation is overwritten by ! the new installation. The rest of the new installation is done ! without replacing existing installed versions (assuming they have ! different version numbers). `patch' *************** follow the `g77' installation instructio *** 85,88 **** --- 146,151 ---- designed for humans to read them. + The version of GNU `patch' used to develop this release is 2.4. + `make' Your system must have `make', and you will probably save yourself *************** follow the `g77' installation instructio *** 90,93 **** --- 153,158 ---- `gmake'). + The version of GNU `make' used to develop this release is 3.73. + `cc' Your system must have a working C compiler. *************** follow the `g77' installation instructio *** 103,106 **** --- 168,173 ---- `gcc' and `g77'. + The version of GNU `bison' used to develop this release is 1.25. + *Note Missing bison?::, for information on how to work around not having `bison'. *************** follow the `g77' installation instructio *** 111,120 **** `gcc' and `g77'. *Note Missing makeinfo?::, for information on getting around the lack of `makeinfo'. ! `root' access To perform the complete installation procedures on a system, you ! need to have `root' access to that system, or equivalent access. Portions of the procedure (such as configuring and building `g77') --- 178,202 ---- `gcc' and `g77'. + The version of GNU `makeinfo' used to develop this release is + 1.68, from GNU `texinfo' version 3.11. + *Note Missing makeinfo?::, for information on getting around the lack of `makeinfo'. ! `sed' ! All UNIX systems have `sed', but some have a broken version that ! cannot handle configuring, building, or installing `gcc' or `g77'. ! ! The version of GNU `sed' used to develop this release is 2.05. ! (Note that GNU `sed' version 3.0 was withdrawn by the FSF--if you ! happen to have this version installed, replace it with version ! 2.05 immediately. See a GNU distribution site for further ! explanation.) ! ! `root' access or equivalent To perform the complete installation procedures on a system, you ! need to have `root' access to that system, or equivalent access to ! the `--prefix' directory tree specified on the `configure' command ! line. Portions of the procedure (such as configuring and building `g77') *************** developers and expert installers wouldn' *** 228,231 **** --- 310,344 ---- cleaning up. + Missing `gperf'? + ................ + + If a build aborts trying to invoke `gperf', that strongly suggests + an improper method was used to create the `gcc' source directory, such + as the UNIX `cp -r' command instead of `cp -pr', since this problem + very likely indicates that the date-time-modified information on the + `gcc' source files is incorrect. + + The proper solution is to recreate the `gcc' source directory from a + `gcc' distribution known to be provided by the FSF. + + It is possible you might be able to temporarily work around the + problem, however, by trying these commands: + + sh# cd gcc + sh# touch c-gperf.h + sh# + + These commands update the date-time-modified information for the + file produced by the invocation of `gperf' in the current versions of + `gcc', so that `make' no longer believes it needs to update it. This + file should already exist in a `gcc' distribution, but mistakes made + when copying the `gcc' directory can leave the modification information + set such that the `gperf' input files look more "recent" than the + corresponding output files. + + If the above does not work, definitely start from scratch and avoid + copying the `gcc' using any method that does not reliably preserve + date-time-modified information, such as the UNIX `cp -r' command. + Cross-compiler Problems ----------------------- *************** reasons. *** 264,268 **** * Improvements to the way `libf2c' is built could make building `g77' as a cross-compiler easier--for example, passing and using ! `LD' and `AR' in the appropriate ways. * There are still some challenges putting together the right --- 377,381 ---- * Improvements to the way `libf2c' is built could make building `g77' as a cross-compiler easier--for example, passing and using ! `$(LD)' and `$(AR)' in the appropriate ways. * There are still some challenges putting together the right *************** is assumed that the source distributions *** 454,459 **** system: ! /usr/FSF/gcc-2.7.2.2.tar.gz ! /usr/FSF/g77-0.5.20.tar.gz Users of the following systems should not blindly follow these --- 567,572 ---- system: ! /usr/FSF/gcc-2.7.2.3.tar.gz ! /usr/FSF/g77-0.5.21.tar.gz Users of the following systems should not blindly follow these *************** of some of the steps. These explanation *** 478,495 **** sh[ 1]# cd /usr/src ! sh[ 2]# gunzip -c < /usr/FSF/gcc-2.7.2.2.tar.gz | tar xf - [Might say "Broken pipe"...that is normal on some systems.] ! sh[ 3]# gunzip -c < /usr/FSF/g77-0.5.20.tar.gz | tar xf - ["Broken pipe" again possible.] ! sh[ 4]# ln -s gcc-2.7.2.2 gcc ! sh[ 5]# ln -s g77-0.5.20 g77 sh[ 6]# mv -i g77/* gcc [No questions should be asked by mv here; or, you made a mistake.] ! sh[ 7]# patch -p1 -V t -d gcc < gcc/f/gbe/2.7.2.2.diff [Unless patch complains about rejected patches, this step worked.] --- 591,608 ---- sh[ 1]# cd /usr/src ! sh[ 2]# gunzip -c < /usr/FSF/gcc-2.7.2.3.tar.gz | tar xf - [Might say "Broken pipe"...that is normal on some systems.] ! sh[ 3]# gunzip -c < /usr/FSF/g77-0.5.21.tar.gz | tar xf - ["Broken pipe" again possible.] ! sh[ 4]# ln -s gcc-2.7.2.3 gcc ! sh[ 5]# ln -s g77-0.5.21 g77 sh[ 6]# mv -i g77/* gcc [No questions should be asked by mv here; or, you made a mistake.] ! sh[ 7]# patch -p1 -V t -d gcc < gcc/f/gbe/2.7.2.3.diff [Unless patch complains about rejected patches, this step worked.] *************** of some of the steps. These explanation *** 513,525 **** [This takes a long time, and is where most problems occur.] ! sh[13]# rm -fr stage1 ! sh[14]# make -k install [The actual installation.] ! sh[15]# g77 -v [Verify that g77 is installed, obtain version info.] ! sh[16]# *Note Updating Your Info Directory: Updating Documentation, for --- 626,645 ---- [This takes a long time, and is where most problems occur.] ! sh[13]# make compare ! [This verifies that the compiler is `sane'. Only ! the file `f/zzz.o' (aka `tmp-foo1' and `tmp-foo2') ! should be in the list of object files this command ! prints as having different contents. If other files ! are printed, you have likely found a g77 bug.] ! sh[14]# rm -fr stage1 ! ! sh[15]# make -k install [The actual installation.] ! sh[16]# g77 -v [Verify that g77 is installed, obtain version info.] ! sh[17]# *Note Updating Your Info Directory: Updating Documentation, for *************** Step 1: `cd /usr/src' *** 536,549 **** installed version of `g77' and `gcc' in any case. ! Step 3: `gunzip -d < /usr/FSF/g77-0.5.20.tar.gz | tar xf -' It is not always necessary to obtain the latest version of `g77' as a complete `.tar.gz' file if you have a complete, earlier distribution of `g77'. If appropriate, you can unpack that earlier version of `g77', and then apply the appropriate patches to ! achieve the same result--a source tree containing version 0.5.20 of `g77'. ! Step 4: `ln -s gcc-2.7.2.2 gcc' ! Step 5: `ln -s g77-0.5.20 g77' These commands mainly help reduce typing, and help reduce visual clutter in examples in this manual showing what to type to install --- 656,670 ---- installed version of `g77' and `gcc' in any case. ! Step 3: `gunzip -d < /usr/FSF/g77-0.5.21.tar.gz | tar xf -' It is not always necessary to obtain the latest version of `g77' as a complete `.tar.gz' file if you have a complete, earlier distribution of `g77'. If appropriate, you can unpack that earlier version of `g77', and then apply the appropriate patches to ! achieve the same result--a source tree containing version 0.5.21 of `g77'. ! Step 4: `ln -s gcc-2.7.2.3 gcc' ! ! Step 5: `ln -s g77-0.5.21 g77' These commands mainly help reduce typing, and help reduce visual clutter in examples in this manual showing what to type to install *************** Step 5: `ln -s g77-0.5.20 g77' *** 555,559 **** Step 6: `mv -i g77/* gcc' After doing this, you can, if you like, type `rm g77' and `rmdir ! g77-0.5.20' to remove the empty directory and the symbol link to it. But, it might be helpful to leave them around as quick reminders of which version(s) of `g77' are installed on your --- 676,680 ---- Step 6: `mv -i g77/* gcc' After doing this, you can, if you like, type `rm g77' and `rmdir ! g77-0.5.21' to remove the empty directory and the symbol link to it. But, it might be helpful to leave them around as quick reminders of which version(s) of `g77' are installed on your *************** Step 6: `mv -i g77/* gcc' *** 565,569 **** Step 7: `patch -p1 ...' This can produce a wide variety of printed output, from `Hmm, I ! can't seem to find a patch in there anywhere...' to long lists of messages indicated that patches are being found, applied successfully, and so on. --- 686,690 ---- Step 7: `patch -p1 ...' This can produce a wide variety of printed output, from `Hmm, I ! can't seem to find a patch in there anywhere...' to long lists of messages indicated that patches are being found, applied successfully, and so on. *************** Step 12: `make bootstrap' *** 622,629 **** this step. ! Step 13: `rm -fr stage1' You don't need to do this, but it frees up disk space. ! Step 14: `make -k install' If this doesn't seem to work, try: --- 743,758 ---- this step. ! Step 13: `make compare' ! *Note Where to Port Bugs: Bug Lists, for information on where to ! report that you observed more than `f/zzz.o' having different ! contents during this phase. ! ! *Note How to Report Bugs: Bug Reporting, for information on *how* ! to report bugs like this. ! ! Step 14: `rm -fr stage1' You don't need to do this, but it frees up disk space. ! Step 15: `make -k install' If this doesn't seem to work, try: *************** Step 14: `make -k install' *** 636,640 **** texinfo manuals. ! Step 15: `g77 -v' If this command prints approximately 25 lines of output, including the GNU Fortran Front End version number (which should be the same --- 765,769 ---- texinfo manuals. ! Step 16: `g77 -v' If this command prints approximately 25 lines of output, including the GNU Fortran Front End version number (which should be the same *************** generally only the documentation is imme *** 704,711 **** sh# cd /usr/src ! sh# gunzip -d < /usr/FSF/gcc-2.7.2.2.tar.gz | tar xf - ! sh# gunzip -d < /usr/FSF/g77-0.5.20.tar.gz | tar xf - ! sh# ln -s gcc-2.7.2.2 gcc ! sh# ln -s g77-0.5.20 g77 sh# mv -i g77/* gcc --- 833,840 ---- sh# cd /usr/src ! sh# gunzip -c /usr/FSF/gcc-2.7.2.3.tar.gz | tar xf - ! sh# gunzip -c /usr/FSF/g77-0.5.21.tar.gz | tar xf - ! sh# ln -s gcc-2.7.2.3 gcc ! sh# ln -s g77-0.5.21 g77 sh# mv -i g77/* gcc *************** and the top level of just the `g77' sour *** 726,730 **** All three entries should be moved (or copied) into a `gcc' source tree (typically named after its version number and as it appears in the ! FSF distributions--e.g. `gcc-2.7.2.2'). `g77/f' is the subdirectory containing all of the code, --- 855,859 ---- All three entries should be moved (or copied) into a `gcc' source tree (typically named after its version number and as it appears in the ! FSF distributions--e.g. `gcc-2.7.2.3'). `g77/f' is the subdirectory containing all of the code, *************** to disappear. *** 821,825 **** Invoking `patch' as described in `gcc/f/gbe/README' can produce a wide variety of printed output, from `Hmm, I can't seem to find a patch ! in there anywhere...' to long lists of messages indicated that patches are being found, applied successfully, and so on. --- 950,954 ---- Invoking `patch' as described in `gcc/f/gbe/README' can produce a wide variety of printed output, from `Hmm, I can't seem to find a patch ! in there anywhere...' to long lists of messages indicated that patches are being found, applied successfully, and so on. *************** this command: *** 1011,1018 **** All sorts of interesting information on the locations of various `gcc'-related programs and data files should be visible in the output ! of the above command. However, you do have to sift through it ! yourself; `gcc' currently provides no easy way to ask it where it is ! installed and where it looks for the various programs and data files it ! calls on to do its work. Just *building* `g77' should not overwrite any installed --- 1140,1148 ---- All sorts of interesting information on the locations of various `gcc'-related programs and data files should be visible in the output ! of the above command. (The output also is likely to include a ! diagnostic from the linker, since there's no `main_()' function.) ! However, you do have to sift through it yourself; `gcc' currently ! provides no easy way to ask it where it is installed and where it looks ! for the various programs and data files it calls on to do its work. Just *building* `g77' should not overwrite any installed *************** them when they work: *** 1191,1200 **** sh# cd /usr/src/gcc sh# ./g77 --driver=./xgcc -B./ -v ! g77 version 0.5.20 ./xgcc -B./ -v -fnull-version -o /tmp/gfa18047 ... Reading specs from ./specs ! gcc version 2.7.2.2.f.2 ./cpp -lang-c -v -isystem ./include -undef ... ! GNU CPP version 2.7.2.2.f.2 (Linux/Alpha) #include "..." search starts here: #include <...> search starts here: --- 1321,1330 ---- sh# cd /usr/src/gcc sh# ./g77 --driver=./xgcc -B./ -v ! g77 version 0.5.21 ./xgcc -B./ -v -fnull-version -o /tmp/gfa18047 ... Reading specs from ./specs ! gcc version 2.7.2.3.f.1 ./cpp -lang-c -v -isystem ./include -undef ... ! GNU CPP version 2.7.2.3.f.1 (Linux/Alpha) #include "..." search starts here: #include <...> search starts here: *************** them when they work: *** 1202,1224 **** /usr/local/include /usr/alpha-unknown-linux/include ! /usr/lib/gcc-lib/alpha-unknown-linux/2.7.2.2.f.2/include /usr/include End of search list. ./f771 /tmp/cca18048.i -fset-g77-defaults -quiet -dumpbase ... ! GNU F77 version 2.7.2.2.f.2 (Linux/Alpha) compiled ... ! GNU Fortran Front End version 0.5.20-970224 compiled: ... as -nocpp -o /tmp/cca180481.o /tmp/cca18048.s ld -G 8 -O1 -o /tmp/gfa18047 /usr/lib/crt0.o -L. ... ! __G77_LIBF77_VERSION__: 0.5.20 ! @(#)LIBF77 VERSION 19960619 ! __G77_LIBI77_VERSION__: 0.5.20 ! @(#) LIBI77 VERSION pjw,dmg-mods 19961209 ! __G77_LIBU77_VERSION__: 0.5.20 ! @(#) LIBU77 VERSION 19970204 sh# ./xgcc -B./ -v -o /tmp/delete-me -xc /dev/null -xnone Reading specs from ./specs ! gcc version 2.7.2.2.f.2 ./cpp -lang-c -v -isystem ./include -undef ... ! GNU CPP version 2.7.2.2.f.2 (Linux/Alpha) #include "..." search starts here: #include <...> search starts here: --- 1332,1354 ---- /usr/local/include /usr/alpha-unknown-linux/include ! /usr/lib/gcc-lib/alpha-unknown-linux/2.7.2.3.f.1/include /usr/include End of search list. ./f771 /tmp/cca18048.i -fset-g77-defaults -quiet -dumpbase ... ! GNU F77 version 2.7.2.3.f.1 (Linux/Alpha) compiled ... ! GNU Fortran Front End version 0.5.21 compiled: ... as -nocpp -o /tmp/cca180481.o /tmp/cca18048.s ld -G 8 -O1 -o /tmp/gfa18047 /usr/lib/crt0.o -L. ... ! __G77_LIBF77_VERSION__: 0.5.21 ! @(#)LIBF77 VERSION 19970404 ! __G77_LIBI77_VERSION__: 0.5.21 ! @(#) LIBI77 VERSION pjw,dmg-mods 19970816 ! __G77_LIBU77_VERSION__: 0.5.21 ! @(#) LIBU77 VERSION 19970609 sh# ./xgcc -B./ -v -o /tmp/delete-me -xc /dev/null -xnone Reading specs from ./specs ! gcc version 2.7.2.3.f.1 ./cpp -lang-c -v -isystem ./include -undef ... ! GNU CPP version 2.7.2.3.f.1 (Linux/Alpha) #include "..." search starts here: #include <...> search starts here: *************** them when they work: *** 1226,1234 **** /usr/local/include /usr/alpha-unknown-linux/include ! /usr/lib/gcc-lib/alpha-unknown-linux/2.7.2.2.f.2/include /usr/include End of search list. ./cc1 /tmp/cca18063.i -quiet -dumpbase null.c -version ... ! GNU C version 2.7.2.2.f.2 (Linux/Alpha) compiled ... as -nocpp -o /tmp/cca180631.o /tmp/cca18063.s ld -G 8 -O1 -o /tmp/delete-me /usr/lib/crt0.o -L. ... --- 1356,1364 ---- /usr/local/include /usr/alpha-unknown-linux/include ! /usr/lib/gcc-lib/alpha-unknown-linux/2.7.2.3.f.1/include /usr/include End of search list. ./cc1 /tmp/cca18063.i -quiet -dumpbase null.c -version ... ! GNU C version 2.7.2.3.f.1 (Linux/Alpha) compiled ... as -nocpp -o /tmp/cca180631.o /tmp/cca18063.s ld -G 8 -O1 -o /tmp/delete-me /usr/lib/crt0.o -L. ... *************** them when they work: *** 1238,1242 **** sh# ! (Note that long lines have been truncated, and `...' used to indicate such truncations.) --- 1368,1372 ---- sh# ! (Note that long lines have been truncated, and `...' used to indicate such truncations.) diff -rcp2N g77-0.5.20/f/Make-lang.in g77-0.5.21/f/Make-lang.in *** g77-0.5.20/f/Make-lang.in Fri Feb 28 06:54:52 1997 --- g77-0.5.21/f/Make-lang.in Tue Sep 2 21:25:24 1997 *************** *** 38,42 **** # # $(srcdir) must be set to the gcc/ source directory (not gcc/f/). ! # Extra flags to pass to recursive makes (and to sub-configure). # Use different quoting rules compared with FLAGS_TO_PASS so we can use --- 38,42 ---- # # $(srcdir) must be set to the gcc/ source directory (not gcc/f/). ! # # Extra flags to pass to recursive makes (and to sub-configure). # Use different quoting rules compared with FLAGS_TO_PASS so we can use *************** G77_INSTALL_NAME = `t='$(program_transfo *** 94,99 **** F77_CROSS_NAME = `t='$(program_transform_cross_name)'; echo f77 | sed $$t` G77_CROSS_NAME = `t='$(program_transform_cross_name)'; echo g77 | sed $$t` ! ! # Define the names for selecting f77 in LANGUAGES. # Note that it would be nice to move the dependency on g77 --- 94,98 ---- F77_CROSS_NAME = `t='$(program_transform_cross_name)'; echo f77 | sed $$t` G77_CROSS_NAME = `t='$(program_transform_cross_name)'; echo g77 | sed $$t` ! # # Define the names for selecting f77 in LANGUAGES. # Note that it would be nice to move the dependency on g77 *************** g77: $(srcdir)/f/g77.c $(srcdir)/f/zzz.c *** 121,125 **** # Create a version of the g77 driver which calls the cross-compiler # (only if `f77' is in LANGUAGES). ! g77-cross: $(srcdir)f/g77.c $(srcdir)/f/zzz.c version.o $(LIBDEPS) case '$(LANGUAGES)' in \ *f77*) \ --- 120,124 ---- # Create a version of the g77 driver which calls the cross-compiler # (only if `f77' is in LANGUAGES). ! g77-cross: $(srcdir)/f/g77.c $(srcdir)/f/zzz.c version.o $(LIBDEPS) case '$(LANGUAGES)' in \ *f77*) \ *************** f/runtime/libU77/Makefile: \ *** 308,312 **** # top=`pwd`; cd f/f2c; \ # $${top}/f/f2c/configure --srcdir=$${top}/f/f2c ! # Build hooks: --- 307,311 ---- # top=`pwd`; cd f/f2c; \ # $${top}/f/f2c/configure --srcdir=$${top}/f/f2c ! # # Build hooks: *************** $(srcdir)/f/g77.dvi: f/g77.texi f/bugs.t *** 329,338 **** cd $(srcdir)/f; $(TEXI2DVI) g77.texi ! $(srcdir)/f/intdoc.texi: f/intdoc ! f/intdoc > $(srcdir)/f/intdoc.texi ! ! f/intdoc: f/intdoc.c f/intdoc.h f/intrin.def f/intrin.h ! $(HOST_CC) $(HOST_CFLAGS) -W -Wall $(HOST_LDFLAGS) \ `echo $(srcdir)/f/intdoc.c | sed 's,^\./,,'` -o f/intdoc $(srcdir)/f/BUGS: f/bugs0.texi f/bugs.texi --- 328,358 ---- cd $(srcdir)/f; $(TEXI2DVI) g77.texi ! # This dance is all about producing accurate documentation for g77's ! # intrinsics with minimum fuss. f/ansify appends "\n\" to C strings ! # so ANSI C compilers can compile f/intdoc.h -- gcc can compile f/intdoc.in ! # directly, if f/intdoc.c #include'd that, but we don't want to force ! # people to install gcc just to build the documentation. We use the ! # C format for f/intdoc.in in the first place to allow a fairly "free", ! # but widely known format for documentation -- basically anyone who knows ! # how to write texinfo source and enclose it in C constants can handle ! # it, and f/ansify allows them to not even end lines with "\n\". So, ! # essentially, the C preprocessor and compiler are used to enter the ! # document snippets into a data base via name lookup, rather than duplicating ! # that kind of code here. And we use f/intdoc.c instead of straight ! # texinfo in the first place so that as much information as possible ! # contained in f/intrin.def can be inserted directly and reliably into ! # the documentation. That's better than replicating it, because it ! # reduces the likelihood of discrepancies between the docs and the compiler ! # itself, which uses f/intrin.def; in fact, many bugs in f/intrin.def have ! # been found only upon reading the documentation that was automatically ! # produced from it. ! $(srcdir)/f/intdoc.texi: f/intdoc.c f/intdoc.in f/ansify.c f/intrin.def f/intrin.h ! $(HOST_CC) $(HOST_CFLAGS) $(HOST_LDFLAGS) \ ! `echo $(srcdir)/f/ansify.c | sed 's,^\./,,'` -o f/ansify ! f/ansify < $(srcdir)/f/intdoc.in > f/intdoc.h0 $(srcdir)/f/intdoc.in ! $(HOST_CC) $(HOST_CFLAGS) $(HOST_LDFLAGS) -I./f \ `echo $(srcdir)/f/intdoc.c | sed 's,^\./,,'` -o f/intdoc + f/intdoc > $(srcdir)/f/intdoc.texi + rm f/intdoc f/ansify f/intdoc.h0 $(srcdir)/f/BUGS: f/bugs0.texi f/bugs.texi *************** $(srcdir)/f/NEWS: f/news0.texi f/news.te *** 349,355 **** $(srcdir)/f/runtime/configure: $(srcdir)/f/runtime/configure.in ! cd f/runtime && $(MAKE) srcdir=../../$(srcdir)/f/runtime -f ../../$(srcdir)/f/runtime/Makefile.in rebuilt $(srcdir)/f/runtime/libU77/configure: $(srcdir)/f/runtime/libU77/configure.in ! cd f/runtime && $(MAKE) srcdir=../../$(srcdir)/f/runtime -f ../../$(srcdir)/f/runtime/Makefile.in rebuilt f77.rebuilt: $(srcdir)/f/g77.info $(srcdir)/f/BUGS $(srcdir)/f/INSTALL \ --- 369,375 ---- $(srcdir)/f/runtime/configure: $(srcdir)/f/runtime/configure.in ! cd $(srcdir)/f/runtime && $(MAKE) srcdir=. -f Makefile.in rebuilt $(srcdir)/f/runtime/libU77/configure: $(srcdir)/f/runtime/libU77/configure.in ! cd $(srcdir)/f/runtime && $(MAKE) srcdir=. -f Makefile.in rebuilt f77.rebuilt: $(srcdir)/f/g77.info $(srcdir)/f/BUGS $(srcdir)/f/INSTALL \ *************** maybe-f2c: *** 360,364 **** #For now, omit f2c stuff. -- burley # case "$(STAGESTUFF)" in *f2c*) $(MAKE) f2c;; esac ! # Install hooks: # f771 is installed elsewhere as part of $(COMPILERS). --- 380,384 ---- #For now, omit f2c stuff. -- burley # case "$(STAGESTUFF)" in *f2c*) $(MAKE) f2c;; esac ! # # Install hooks: # f771 is installed elsewhere as part of $(COMPILERS). *************** f77.uninstall: *** 487,491 **** rm -rf $(libdir)/libf2c.a ; \ fi ! # Clean hooks: # A lot of the ancillary files are deleted by the main makefile. --- 507,511 ---- rm -rf $(libdir)/libf2c.a ; \ fi ! # # Clean hooks: # A lot of the ancillary files are deleted by the main makefile. *************** f77.uninstall: *** 494,498 **** f77.mostlyclean: -rm -f f/*$(objext) ! -rm -f f/fini f/f771 f/stamp-str f/str-*.h f/str-*.j f/intdoc -cd f/runtime; $(MAKE) -f ../../$(srcdir)/f/runtime/Makefile.in mostlyclean f77.clean: --- 514,518 ---- f77.mostlyclean: -rm -f f/*$(objext) ! -rm -f f/fini f/f771 f/stamp-str f/str-*.h f/str-*.j f/intdoc f/ansify f/intdoc.h0 -cd f/runtime; $(MAKE) -f ../../$(srcdir)/f/runtime/Makefile.in mostlyclean f77.clean: *************** f77.maintainer-clean f77.realclean: f77. *** 520,524 **** -$(MAKE) f77.maintainer-clean -rm -f f/g77.info* f/g77.*aux f/TAGS f/BUGS f/INSTALL f/NEWS f/intdoc.texi ! # Stage hooks: # The main makefile has already created stage?/f. --- 540,544 ---- -$(MAKE) f77.maintainer-clean -rm -f f/g77.info* f/g77.*aux f/TAGS f/BUGS f/INSTALL f/NEWS f/intdoc.texi ! # # Stage hooks: # The main makefile has already created stage?/f. *************** f77.maintainer-clean f77.realclean: f77. *** 526,530 **** 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 --- 546,550 ---- 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 f/runtime/stamp-lib LIBF77STAGESTUFF = f/runtime/libF77/*$(objext) f/runtime/libF77/Makefile LIBI77STAGESTUFF = f/runtime/libI77/*$(objext) f/runtime/libI77/Makefile *************** f77.stage4: *** 557,561 **** -mv $(LIBI77STAGESTUFF) stage4/f/runtime/libI77 -mv $(LIBU77STAGESTUFF) stage4/f/runtime/libU77 ! # Maintenance hooks: --- 577,581 ---- -mv $(LIBI77STAGESTUFF) stage4/f/runtime/libI77 -mv $(LIBU77STAGESTUFF) stage4/f/runtime/libU77 ! # # Maintenance hooks: diff -rcp2N g77-0.5.20/f/Makefile.in g77-0.5.21/f/Makefile.in *** g77-0.5.20/f/Makefile.in Tue Feb 11 18:10:17 1997 --- g77-0.5.21/f/Makefile.in Tue Sep 2 21:25:24 1997 *************** ALL=all *** 107,112 **** # End of variables for you to override. ! # Definition of `all' is here so that new rules inserted by sed # do not specify the default target. all: all.indirect --- 107,130 ---- # End of variables for you to override. ! # Definition of `none' is here so that new rules inserted by sed # do not specify the default target. + none: + @echo '' + @echo 'Do not use this makefile to build anything other than the' + @echo 'g77 derived files via the "make g77-only" target.' + @echo 'Instead, use the documented procedures to build gcc itself,' + @echo 'which will build g77 as well when done properly.' + @echo '' + @exit 1 + + # This rule is just a handy way to build the g77 derived files without + # having the gcc source tree around. + g77-only: force + if [ -f g77.texi ] ; then \ + (cd ..; $(MAKE) srcdir=. HOST_CC=cc HOST_CFLAGS=-g -f f/Make-lang.in f77.rebuilt); \ + else \ + $(MAKE) srcdir=. HOST_CC=cc HOST_CFLAGS=-g -f f/Make-lang.in f77.rebuilt; \ + fi + all: all.indirect *************** all: all.indirect *** 119,123 **** ####cross overrides ####build overrides ! # Now figure out from those variables how to compile and link. --- 137,141 ---- ####cross overrides ####build overrides ! # # Now figure out from those variables how to compile and link. *************** FLAGS_TO_PASS = \ *** 185,189 **** .c.o: $(CC) -c $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) $< -o $@ ! # Lists of files for various purposes. --- 203,207 ---- .c.o: $(CC) -c $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) $< -o $@ ! # # Lists of files for various purposes. *************** Makefile: $(srcdir)/f/Makefile.in $(srcd *** 250,254 **** native: f771 ! # Compiling object files from source files. --- 268,272 ---- native: f771 ! # # Compiling object files from source files. *************** deps-kinda: *** 529,533 **** -e 's%^\(.*\)[ ]*: %f/\1: %g' ! # These exist for maintenance purposes. --- 547,551 ---- -e 's%^\(.*\)[ ]*: %f/\1: %g' ! # # These exist for maintenance purposes. *************** TAGS: force *** 540,544 **** etags -a ../*.h ../*.c; ! .PHONY: all all.indirect compiler native deps-kinda TAGS force: --- 558,562 ---- etags -a ../*.h ../*.c; ! .PHONY: none all all.indirect f77.rebuilt compiler native deps-kinda TAGS g77-only force: diff -rcp2N g77-0.5.20/f/NEWS g77-0.5.21/f/NEWS *** g77-0.5.20/f/NEWS Thu Feb 27 05:12:29 1997 --- g77-0.5.21/f/NEWS Tue Sep 9 06:24:40 1997 *************** News About GNU Fortran *** 7,10 **** --- 7,221 ---- ********************** + Changes made to recent versions of GNU Fortran are listed below, + with the most recent version first. + + The changes are generally listed with code-generation bugs first, + followed by compiler crashes involving valid code, new features, fixes + to existing features, new diagnostics, internal improvements, and + miscellany. This order is not strict--for example, some items involve + a combination of these elements. + + In 0.5.21: + ========== + + * Fix a code-generation bug introduced by 0.5.20 caused by loop + unrolling (by specifying `-funroll-loops' or similar). This bug + afflicted all code compiled by version 2.7.2.2.f.2 of `gcc' (C, + C++, Fortran, and so on). + + * Fix a code-generation bug manifested when combining local + `EQUIVALENCE' with a `DATA' statement that follows the first + executable statement (or is treated as an executable-context + statement as a result of using the `-fpedantic' option). + + * Fix a compiler crash that occured when an integer division by a + constant zero is detected. Instead, when the `-W' option is + specified, the `gcc' back end issues a warning about such a case. + This bug afflicted all code compiled by version 2.7.2.2.f.2 of + `gcc' (C, C++, Fortran, and so on). + + * Fix a compiler crash that occurred in some cases of procedure + inlining. (Such cases became more frequent in 0.5.20.) + + * Fix a compiler crash resulting from using `DATA' or similar to + initialize a `COMPLEX' variable or array to zero. + + * Fix compiler crashes involving use of `AND', `OR', or `XOR' + intrinsics. + + * Fix compiler bug triggered when using a `COMMON' or `EQUIVALENCE' + variable as the target of an `ASSIGN' or assigned-`GOTO' statement. + + * Fix compiler crashes due to using the name of a some non-standard + intrinsics (such as `FTELL' or `FPUTC') as such and as the name of + a procedure or common block. Such dual use of a name in a program + is allowed by the standard. + + * Place automatic arrays on the stack, even if `SAVE' or the + `-fno-automatic' option is in effect. This avoids a compiler + crash in some cases. + + * The `-malign-double' option now reliably aligns `DOUBLE PRECISION' + optimally on Pentium and Pentium Pro architectures (586 and 686 in + `gcc'). + + * New option `-Wno-globals' disables warnings about "suspicious" use + of a name both as a global name and as the implicit name of an + intrinsic, and warnings about disagreements over the number or + natures of arguments passed to global procedures, or the natures + of the procedures themselves. + + The default is to issue such warnings, which are new as of this + version of `g77'. + + * New option `-fno-globals' disables diagnostics about potentially + fatal disagreements analysis problems, such as disagreements over + the number or natures of arguments passed to global procedures, or + the natures of those procedures themselves. + + The default is to issue such diagnostics and flag the compilation + as unsuccessful. With this option, the diagnostics are issued as + warnings, or, if `-Wno-globals' is specified, are not issued at + all. + + This option also disables inlining of global procedures, to avoid + compiler crashes resulting from coding errors that these + diagnostics normally would identify. + + * Diagnose cases where a reference to a procedure disagrees with the + type of that procedure, or where disagreements about the number or + nature of arguments exist. This avoids a compiler crash. + + * Fix parsing bug whereby `g77' rejected a second initialization + specification immediately following the first's closing `/' without + an intervening comma in a `DATA' statement, and the second + specification was an implied-DO list. + + * Improve performance of the `gcc' back end so certain complicated + expressions involving `COMPLEX' arithmetic (especially + multiplication) don't appear to take forever to compile. + + * Fix a couple of profiling-related bugs in `gcc' back end. + + * Integrate GNU Ada's (GNAT's) changes to the back end, which + consist almost entirely of bug fixes. These fixes are circa + version 3.10p of GNAT. + + * Include some other `gcc' fixes that seem useful in `g77''s version + of `gcc'. (See `gcc/ChangeLog' for details--compare it to that + file in the vanilla `gcc-2.7.2.3.tar.gz' distribution.) + + * Fix `libU77' routines that accept file and other names to strip + trailing blanks from them, for consistency with other + implementations. Blanks may be forcibly appended to such names by + appending a single null character (`CHAR(0)') to the significant + trailing blanks. + + * Fix `CHMOD' intrinsic to work with file names that have embedded + blanks, commas, and so on. + + * Fix `SIGNAL' intrinsic so it accepts an optional third `Status' + argument. + + * Fix `IDATE()' intrinsic subroutine (VXT form) so it accepts + arguments in the correct order. Documentation fixed accordingly, + and for `GMTIME()' and `LTIME()' as well. + + * Make many changes to `libU77' intrinsics to support existing code + more directly. + + Such changes include allowing both subroutine and function forms + of many routines, changing `MCLOCK()' and `TIME()' to return + `INTEGER(KIND=1)' values, introducing `MCLOCK8()' and `TIME8()' to + return `INTEGER(KIND=2)' values, and placing functions that are + intended to perform side effects in a new intrinsic group, + `badu77'. + + * Improve `libU77' so it is more portable. + + * Add options `-fbadu77-intrinsics-delete', + `-fbadu77-intrinsics-hide', and so on. + + * Fix crashes involving diagnosed or invalid code. + + * `g77' and `gcc' now do a somewhat better job detecting and + diagnosing arrays that are too large to handle before these cause + diagnostics during the assembler or linker phase, a compiler + crash, or generation of incorrect code. + + * Make some fixes to alias analysis code. + + * Add support for `restrict' keyword in `gcc' front end. + + * Support `gcc' version 2.7.2.3 (modified by `g77' into version + 2.7.2.3.f.1), and remove support for prior versions of `gcc'. + + * Incorporate GNAT's patches to the `gcc' back end into `g77''s, so + GNAT users do not need to apply GNAT's patches to build both GNAT + and `g77' from the same source tree. + + * Modify `make' rules and related code so that generation of Info + documentation doesn't require compilation using `gcc'. Now, any + ANSI C compiler should be adequate to produce the `g77' + documentation (in particular, the tables of intrinsics) from + scratch. + + * Add `INT2' and `INT8' intrinsics. + + * Add `CPU_TIME' intrinsic. + + * Add `ALARM' intrinsic. + + * `CTIME' intrinsic now accepts any `INTEGER' argument, not just + `INTEGER(KIND=2)'. + + * Warn when explicit type declaration disagrees with the type of an + intrinsic invocation. + + * Support `*f771' entry in `gcc' `specs' file. + + * Fix typo in `make' rule `g77-cross', used only for cross-compiling. + + * Fix `libf2c' build procedure to re-archive library if previous + attempt to archive was interrupted. + + * Change `gcc' to unroll loops only during the last invocation (of + as many as two invocations) of loop optimization. + + * Improve handling of `-fno-f2c' so that code that attempts to pass + an intrinsic as an actual argument, such as `CALL FOO(ABS)', is + rejected due to the fact that the run-time-library routine is, + effectively, compiled with `-ff2c' in effect. + + * Fix `g77' driver to recognize `-fsyntax-only' as an option that + inhibits linking, just like `-c' or `-S', and to recognize and + properly handle the `-nostdlib', `-M', `-MM', `-nodefaultlibs', + and `-Xlinker' options. + + * Upgrade to `libf2c' as of 1997-08-16. + + * Modify `libf2c' to consistently and clearly diagnose recursive I/O + (at run time). + + * `g77' driver now prints version information (such as produced by + `g77 -v') to `stderr' instead of `stdout'. + + * The `.r' suffix now designates a Ratfor source file, to be + preprocessed via the `ratfor' command, available separately. + + * Fix some aspects of how `gcc' determines what kind of system is + being configured and what kinds are supported. For example, GNU + Linux/Alpha ELF systems now are directly supported. + + * Improve diagnostics. + + * Improve documentation and indexing. + + * Include all pertinent files for `libf2c' that come from + `netlib.bell-labs.com'; give any such files that aren't quite + accurate in `g77''s version of `libf2c' the suffix `.netlib'. + + * Reserve `INTEGER(KIND=0)' for future use. + In 0.5.20: ========== diff -rcp2N g77-0.5.20/f/ansify.c g77-0.5.21/f/ansify.c *** g77-0.5.20/f/ansify.c Thu Jan 1 00:00:00 1970 --- g77-0.5.21/f/ansify.c Tue Sep 2 21:25:24 1997 *************** *** 0 **** --- 1,208 ---- + /* ansify.c + Copyright (C) 1997 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. */ + + /* From f/proj.h, which uses #error -- not all C compilers + support that, and we want *this* program to be compilable + by pretty much any C compiler. */ + + #include "assert.j" /* Use gcc's assert.h. */ + #include + #include + #include + #include + + typedef enum + { + #if !defined(false) || !defined(true) + false = 0, true = 1, + #endif + #if !defined(FALSE) || !defined(TRUE) + FALSE = 0, TRUE = 1, + #endif + Doggone_Trailing_Comma_Dont_Work = 1 + } bool; + + #define ARRAY_SIZE(a) (sizeof(a)/sizeof(a[0])) + + #define die_unless(c) \ + do if (!(c)) \ + { \ + fprintf (stderr, "%s:%lu: " #c "\n", argv[1], lineno); \ + die (); \ + } \ + while(0) + + static void + die () + { + exit (1); + } + + int + main(int argc, char **argv) + { + int c; + static unsigned long lineno = 1; + + die_unless (argc == 2); + + printf ("\ + /* This file is automatically generated from `%s',\n\ + which you should modify instead. */\n\ + # 1 \"%s\"\n\ + ", + argv[1], argv[1]); + + while ((c = getchar ()) != EOF) + { + switch (c) + { + default: + putchar (c); + break; + + case '\n': + ++lineno; + putchar (c); + break; + + case '"': + putchar (c); + for (;;) + { + c = getchar (); + die_unless (c != EOF); + switch (c) + { + case '"': + putchar (c); + goto next_char; + + case '\n': + putchar ('\\'); + putchar ('n'); + putchar ('\\'); + putchar ('\n'); + ++lineno; + break; + + case '\\': + putchar (c); + c = getchar (); + die_unless (c != EOF); + putchar (c); + if (c == '\n') + ++lineno; + break; + + default: + putchar (c); + break; + } + } + break; + + case '\'': + putchar (c); + for (;;) + { + c = getchar (); + die_unless (c != EOF); + switch (c) + { + case '\'': + putchar (c); + goto next_char; + + case '\n': + putchar ('\\'); + putchar ('n'); + putchar ('\\'); + putchar ('\n'); + ++lineno; + break; + + case '\\': + putchar (c); + c = getchar (); + die_unless (c != EOF); + putchar (c); + if (c == '\n') + ++lineno; + break; + + default: + putchar (c); + break; + } + } + break; + + case '/': + putchar (c); + c = getchar (); + putchar (c); + if (c != '*') + break; + for (;;) + { + c = getchar (); + die_unless (c != EOF); + + switch (c) + { + case '\n': + ++lineno; + putchar (c); + break; + + case '*': + c = getchar (); + die_unless (c != EOF); + if (c == '/') + { + putchar ('*'); + putchar ('/'); + goto next_char; + } + if (c == '\n') + { + ++lineno; + putchar (c); + } + break; + + default: + /* Don't bother outputting content of comments. */ + break; + } + } + break; + } + + next_char: + ; + } + + die_unless (c == EOF); + + return 0; + } diff -rcp2N g77-0.5.20/f/bad.def g77-0.5.21/f/bad.def *** g77-0.5.20/f/bad.def Sun Feb 23 19:53:50 1997 --- g77-0.5.21/f/bad.def Sun Jul 13 20:42:34 1997 *************** FFEBAD_MSGS1 (FFEBAD_LABEL_ALREADY_DEFIN *** 46,50 **** "Label %A already defined at %1 when redefined at %0") FFEBAD_MSGS1 (FFEBAD_UNRECOGNIZED_CHARACTER, FATAL, ! "Unrecognized character at %0") FFEBAD_MSGS1 (FFEBAD_LABEL_WITHOUT_STMT, WARN, "Label definition %A at %0 on empty statement (as of %1)") --- 46,50 ---- "Label %A already defined at %1 when redefined at %0") FFEBAD_MSGS1 (FFEBAD_UNRECOGNIZED_CHARACTER, FATAL, ! "Unrecognized character at %0 [info -f g77 M LEX]") FFEBAD_MSGS1 (FFEBAD_LABEL_WITHOUT_STMT, WARN, "Label definition %A at %0 on empty statement (as of %1)") *************** FFEBAD_MSGS2 (FFEBAD_EXTRA_LABEL_DEF, FA *** 53,61 **** "Extra label definition %A at %0 following label definition %B at %1") FFEBAD_MSGS1 (FFEBAD_FIRST_CHAR_INVALID, FATAL, ! "Invalid first character at %0") FFEBAD_MSGS1 (FFEBAD_LINE_TOO_LONG, FATAL, ! "Line too long as of %0") FFEBAD_MSGS1 (FFEBAD_LABEL_FIELD_NOT_NUMERIC, FATAL, ! "Non-numeric character at %0 in label field") FFEBAD_MSGS1 (FFEBAD_LABEL_NUMBER_INVALID, FATAL, "Label number at %0 not in range 1-99999") --- 53,61 ---- "Extra label definition %A at %0 following label definition %B at %1") FFEBAD_MSGS1 (FFEBAD_FIRST_CHAR_INVALID, FATAL, ! "Invalid first character at %0 [info -f g77 M LEX]") FFEBAD_MSGS1 (FFEBAD_LINE_TOO_LONG, FATAL, ! "Line too long as of %0 [info -f g77 M LEX]") FFEBAD_MSGS1 (FFEBAD_LABEL_FIELD_NOT_NUMERIC, FATAL, ! "Non-numeric character at %0 in label field [info -f g77 M LEX]") FFEBAD_MSGS1 (FFEBAD_LABEL_NUMBER_INVALID, FATAL, "Label number at %0 not in range 1-99999") *************** FFEBAD_MSGS1 (FFEBAD_NON_ANSI_COMMENT, W *** 63,72 **** "At %0, '!' and '/*' are not valid comment delimiters") FFEBAD_MSGS1 (FFEBAD_NON_ANSI_CONTINUATION_COLUMN, WARN, ! "Continuation indicator at %0 must appear in column 6") FFEBAD_MSGS1 (FFEBAD_LABEL_ON_CONTINUATION, FATAL, ! "Label at %0 invalid with continuation line indicator at %1") FFEBAD_MSGS2 (FFEBAD_INVALID_CONTINUATION, FATAL, ! "Continuation indicator at %0 invalid on first non-comment line of file or following END or INCLUDE", ! "Continuation indicator at %0 invalid here") FFEBAD_MSGS1 (FFEBAD_NO_CLOSING_APOSTROPHE, FATAL, "Character constant at %0 has no closing apostrophe at %1") --- 63,72 ---- "At %0, '!' and '/*' are not valid comment delimiters") FFEBAD_MSGS1 (FFEBAD_NON_ANSI_CONTINUATION_COLUMN, WARN, ! "Continuation indicator at %0 must appear in column 6 [info -f g77 M LEX]") FFEBAD_MSGS1 (FFEBAD_LABEL_ON_CONTINUATION, FATAL, ! "Label at %0 invalid with continuation line indicator at %1 [info -f g77 M LEX]") FFEBAD_MSGS2 (FFEBAD_INVALID_CONTINUATION, FATAL, ! "Continuation indicator at %0 invalid on first non-comment line of file or following END or INCLUDE [info -f g77 M LEX]", ! "Continuation indicator at %0 invalid here [info -f g77 M LEX]") FFEBAD_MSGS1 (FFEBAD_NO_CLOSING_APOSTROPHE, FATAL, "Character constant at %0 has no closing apostrophe at %1") *************** FFEBAD_MSGS2 (FFEBAD_INVALID_TYPELESS_HE *** 127,131 **** "Invalid hexadecimal constant at %0") FFEBAD_MSGS2 (FFEBAD_INVALID_COMPLEX_PART, FATAL, ! "%A part of complex constant at %0 must be a real or integer constant -- otherwise use CMPLX() in place of ()", "%A part of complex constant at %0 not a real or integer constant") FFEBAD_MSGS2 (FFEBAD_INVALID_PERCENT, FATAL, --- 127,131 ---- "Invalid hexadecimal constant at %0") FFEBAD_MSGS2 (FFEBAD_INVALID_COMPLEX_PART, FATAL, ! "%A part of complex constant at %0 must be a real or integer constant -- otherwise use CMPLX() or COMPLEX() in place of ()", "%A part of complex constant at %0 not a real or integer constant") FFEBAD_MSGS2 (FFEBAD_INVALID_PERCENT, FATAL, *************** FFEBAD_MSGS2 (FFEBAD_MATH_ARG_KIND, FATA *** 154,171 **** "Invalid operand (is %A) at %1 for arithmetic operator at %0") FFEBAD_MSGS2 (FFEBAD_NO_CLOSING_QUOTE, FATAL, ! "Character constant at %0 has no closing quote at %1", ! "Unterminated character constant at %0") FFEBAD_MSGS2 (FFEBAD_BAD_CHAR_CONTINUE, FATAL, ! "Continuation line at %0 must have initial `&' since it continues a character context", ! "Missing initial `&' on continuation line at %0") FFEBAD_MSGS2 (FFEBAD_BAD_LEXTOK_CONTINUE, FATAL, ! "Continuation line at %0 must have initial `&' since it continues a split lexical token", ! "Missing initial `&' on continuation line at %0") FFEBAD_MSGS2 (FFEBAD_BAD_FREE_CONTINUE, FATAL, "Continuation line at %0 invalid because it consists only of a single `&' as the only nonblank character", "Invalid continuation line at %0") FFEBAD_MSGS2 (FFEBAD_STMT_BEGINS_BAD, FATAL, ! "Statement at %0 begins with invalid token", ! "Invalid statement at %0") FFEBAD_MSGS1 (FFEBAD_SEMICOLON, FATAL, "Semicolon at %0 is an invalid token") --- 154,171 ---- "Invalid operand (is %A) at %1 for arithmetic operator at %0") FFEBAD_MSGS2 (FFEBAD_NO_CLOSING_QUOTE, FATAL, ! "Character constant at %0 has no closing quote at %1 [info -f g77 M LEX]", ! "Unterminated character constant at %0 [info -f g77 M LEX]") FFEBAD_MSGS2 (FFEBAD_BAD_CHAR_CONTINUE, FATAL, ! "Continuation line at %0 must have initial `&' since it continues a character context [info -f g77 M LEX]", ! "Missing initial `&' on continuation line at %0 [info -f g77 M LEX]") FFEBAD_MSGS2 (FFEBAD_BAD_LEXTOK_CONTINUE, FATAL, ! "Continuation line at %0 must have initial `&' since it continues a split lexical token [info -f g77 M LEX]", ! "Missing initial `&' on continuation line at %0 [info -f g77 M LEX]") FFEBAD_MSGS2 (FFEBAD_BAD_FREE_CONTINUE, FATAL, "Continuation line at %0 invalid because it consists only of a single `&' as the only nonblank character", "Invalid continuation line at %0") FFEBAD_MSGS2 (FFEBAD_STMT_BEGINS_BAD, FATAL, ! "Statement at %0 begins with invalid token [info -f g77 M LEX]", ! "Invalid statement at %0 [info -f g77 M LEX]") FFEBAD_MSGS1 (FFEBAD_SEMICOLON, FATAL, "Semicolon at %0 is an invalid token") *************** FFEBAD_MSGS2 (FFEBAD_BAD_IMPDO, FATAL, *** 448,451 **** --- 448,453 ---- FFEBAD_MSGS1 (FFEBAD_BAD_IMPDCL, FATAL, "No specification for implied-DO iterator `%A' at %0") + FFEBAD_MSGS1 (FFEBAD_IMPDO_PAREN, WARN, + "Gratuitous parentheses surround implied-DO construct at %0") FFEBAD_MSGS1 (FFEBAD_ZERO_SIZE, FATAL, "Zero-size specification invalid at %0") *************** FFEBAD_MSGS2 (FFEBAD_BOOL_ARG_KIND, FATA *** 467,470 **** --- 469,478 ---- "Boolean/logical operator at %0 must operate on two scalar (not array) subexpressions, two function invocations returning logical scalars, or a combination of both -- but the subexpression at %1 is %A", "Invalid operand (is %A) at %1 for boolean operator at %0") + FFEBAD_MSGS2 (FFEBAD_NOT_ARG_TYPE, FATAL, + ".NOT. operator at %0 must operate on subexpression of logical type, but the subexpression at %1 is not of logical type", + "Invalid operand at %1 for .NOT. operator at %0") + FFEBAD_MSGS2 (FFEBAD_NOT_ARG_KIND, FATAL, + ".NOT. operator at %0 must operate on scalar subexpressions -- but the subexpression at %1 is %A", + "Invalid operand (is %A) at %1 for .NOT. operator at %0") FFEBAD_MSGS2 (FFEBAD_EQOP_ARGS_TYPE, FATAL, "Equality operator at %0 must operate on two subexpressions of arithmetic or character type, but neither subexpression at %1 or %2 is of arithmetic or character type", *************** FFEBAD_MSGS2 (FFEBAD_RELOP_ARG_KIND, FAT *** 486,517 **** "Invalid operand (is %A) at %1 for relational operator at %0") FFEBAD_MSGS2 (FFEBAD_INTRINSIC_REF, FATAL, ! "Reference to intrinsic %A at %0 invalid -- one or more arguments have incorrect type", ! "Invalid reference to intrinsic %A at %0") FFEBAD_MSGS2 (FFEBAD_INTRINSIC_TOOFEW, FATAL, ! "Too few arguments passed to intrinsic %A at %0", ! "Too few arguments for intrinsic %A at %0") FFEBAD_MSGS2 (FFEBAD_INTRINSIC_TOOMANY, FATAL, ! "Too many arguments passed to intrinsic %A at %0", ! "Too many arguments for intrinsic %A at %0") FFEBAD_MSGS2 (FFEBAD_INTRINSIC_DISABLED, FATAL, ! "Reference to disabled intrinsic %A at %0", ! "Disabled intrinsic %A at %0") FFEBAD_MSGS2 (FFEBAD_INTRINSIC_IS_SUBR, FATAL, ! "Reference to intrinsic subroutine %A as if it were a function at %0", ! "Function reference to intrinsic subroutine %A at %0") FFEBAD_MSGS2 (FFEBAD_INTRINSIC_IS_FUNC, FATAL, ! "Reference to intrinsic function %A as if it were a subroutine at %0", ! "Subroutine reference to intrinsic function %A at %0") FFEBAD_MSGS2 (FFEBAD_INTRINSIC_UNIMPL, FATAL, ! "Reference to unimplemented intrinsic %A at %0 -- use EXTERNAL to reference user-written procedure with this name", ! "Unimplemented intrinsic %A at %0") FFEBAD_MSGS2 (FFEBAD_INTRINSIC_UNIMPLW, WARN, ! "Reference to unimplemented intrinsic %A at %0 (assumed EXTERNAL)", ! "Unimplemented intrinsic %A at %0 (assumed EXTERNAL)") ! FFEBAD_MSGS2 (FFEBAD_INTRINSIC_AMBIG, FATAL, ! "Reference to generic intrinsic %A at %0 could be for specific intrinsic %B or %C", ! "Ambiguous reference to generic intrinsic %A (could be %B or %C) at %0") FFEBAD_MSGS1 (FFEBAD_INTRINSIC_CMPAMBIG, FATAL, ! "Ambiguous use of intrinsic %A at %0 [info -f g77 M CMPAMBIG]") FFEBAD_MSGS1 (FFEBAD_OPEN_INCLUDE, FATAL, "Unable to open INCLUDE file `%A' at %0") --- 494,530 ---- "Invalid operand (is %A) at %1 for relational operator at %0") FFEBAD_MSGS2 (FFEBAD_INTRINSIC_REF, FATAL, ! "Reference to intrinsic `%A' at %0 invalid -- one or more arguments have incorrect type", ! "Invalid reference to intrinsic `%A' at %0") FFEBAD_MSGS2 (FFEBAD_INTRINSIC_TOOFEW, FATAL, ! "Too few arguments passed to intrinsic `%A' at %0", ! "Too few arguments for intrinsic `%A' at %0") FFEBAD_MSGS2 (FFEBAD_INTRINSIC_TOOMANY, FATAL, ! "Too many arguments passed to intrinsic `%A' at %0", ! "Too many arguments for intrinsic `%A' at %0") FFEBAD_MSGS2 (FFEBAD_INTRINSIC_DISABLED, FATAL, ! "Reference to disabled intrinsic `%A' at %0", ! "Disabled intrinsic `%A' at %0") FFEBAD_MSGS2 (FFEBAD_INTRINSIC_IS_SUBR, FATAL, ! "Reference to intrinsic subroutine `%A' as if it were a function at %0", ! "Function reference to intrinsic subroutine `%A' at %0") FFEBAD_MSGS2 (FFEBAD_INTRINSIC_IS_FUNC, FATAL, ! "Reference to intrinsic function `%A' as if it were a subroutine at %0", ! "Subroutine reference to intrinsic function `%A' at %0") FFEBAD_MSGS2 (FFEBAD_INTRINSIC_UNIMPL, FATAL, ! "Reference to unimplemented intrinsic `%A' at %0 -- use EXTERNAL to reference user-written procedure with this name", ! "Unimplemented intrinsic `%A' at %0") FFEBAD_MSGS2 (FFEBAD_INTRINSIC_UNIMPLW, WARN, ! "Reference to unimplemented intrinsic `%A' at %0 (assumed EXTERNAL)", ! "Unimplemented intrinsic `%A' at %0 (assumed EXTERNAL)") ! FFEBAD_MSGS1 (FFEBAD_INTRINSIC_AMBIG, FATAL, ! "Reference to generic intrinsic `%A' at %0 could be to form %B or %C") FFEBAD_MSGS1 (FFEBAD_INTRINSIC_CMPAMBIG, FATAL, ! "Ambiguous use of intrinsic `%A' at %0 [info -f g77 M CMPAMBIG]") ! FFEBAD_MSGS1 (FFEBAD_INTRINSIC_EXPIMP, WARN, ! "Intrinsic `%A' referenced %Bly at %0, %Cly at %1 [info -f g77 M EXPIMP]") ! FFEBAD_MSGS1 (FFEBAD_INTRINSIC_GLOBAL, WARN, ! "Same name `%A' used for %B at %0 and %C at %1 [info -f g77 M INTGLOB]") ! FFEBAD_MSGS1 (FFEBAD_INTRINSIC_TYPE, WARN, ! "Explicit type declaration for intrinsic `%A' disagrees with invocation at %0") FFEBAD_MSGS1 (FFEBAD_OPEN_INCLUDE, FATAL, "Unable to open INCLUDE file `%A' at %0") *************** FFEBAD_MSGS2 (FFEBAD_ENTRY_CONFLICTS, FA *** 600,605 **** FFEBAD_MSGS1 (FFEBAD_RETURN_VALUE_UNSET, WARN, "Return value `%A' for FUNCTION at %0 not referenced in subprogram") - FFEBAD_MSGS1 (FFEBAD_FILEWIDE_ALREADY_SEEN, FATAL, - "Global name `%A' defined at %0 already defined at %1") FFEBAD_MSGS2 (FFEBAD_COMMON_ALREADY_INIT, FATAL, "Common block `%A' initialized at %0 already initialized at %1 -- only one program unit may specify initial values for a particular common block", --- 613,616 ---- *************** FFEBAD_MSGS1 (FFEBAD_COMMON_BLANK_INIT, *** 621,625 **** "Blank common initialized at %0") FFEBAD_MSGS1 (FFEBAD_NEED_INTRINSIC, WARN, ! "Intrinsic %A is passed as actual argument at %0 but not explicitly declared INTRINSIC") FFEBAD_MSGS1 (FFEBAD_NEED_EXTERNAL, WARN, "External procedure `%A' is passed as actual argument at %0 but not explicitly declared EXTERNAL") --- 632,636 ---- "Blank common initialized at %0") FFEBAD_MSGS1 (FFEBAD_NEED_INTRINSIC, WARN, ! "Intrinsic `%A' is passed as actual argument at %0 but not explicitly declared INTRINSIC") FFEBAD_MSGS1 (FFEBAD_NEED_EXTERNAL, WARN, "External procedure `%A' is passed as actual argument at %0 but not explicitly declared EXTERNAL") *************** FFEBAD_MSGS1 (FFEBAD_TYPELESS_OVERFLOW, *** 662,665 **** --- 673,698 ---- FFEBAD_MSGS1 (FFEBAD_AMPERSAND, WARN, "First-column ampersand continuation at %0") + FFEBAD_MSGS1 (FFEBAD_FILEWIDE_ALREADY_SEEN, FATAL, + "Global name `%A' defined at %0 already defined at %1 [info -f g77 M GLOBALS]") + FFEBAD_MSGS1 (FFEBAD_FILEWIDE_ALREADY_SEEN_W, WARN, + "Global name `%A' defined at %0 already defined at %1 [info -f g77 M GLOBALS]") + FFEBAD_MSGS1 (FFEBAD_FILEWIDE_DISAGREEMENT, FATAL, + "Global name `%A' is %B at %0 but is %C at %1 [info -f g77 M GLOBALS]") + FFEBAD_MSGS1 (FFEBAD_FILEWIDE_DISAGREEMENT_W, WARN, + "Global name `%A' is %B at %0 but is %C at %1 [info -f g77 M GLOBALS]") + FFEBAD_MSGS1 (FFEBAD_FILEWIDE_TYPE_MISMATCH, FATAL, + "Global name `%A' at %0 has different type at %1 [info -f g77 M GLOBALS]") + FFEBAD_MSGS1 (FFEBAD_FILEWIDE_TYPE_MISMATCH_W, WARN, + "Global name `%A' at %0 has different type at %1 [info -f g77 M GLOBALS]") + FFEBAD_MSGS1 (FFEBAD_FILEWIDE_NARGS, FATAL, + "Too %B arguments passed to `%A' at %0 versus definition at %1 [info -f g77 M GLOBALS]") + FFEBAD_MSGS1 (FFEBAD_FILEWIDE_NARGS_W, WARN, + "Too %B arguments for `%A' at %0 versus invocation at %1 [info -f g77 M GLOBALS]") + FFEBAD_MSGS1 (FFEBAD_FILEWIDE_ARG, FATAL, + "Argument #%B of `%A' is %C at %0 but is %D at %1 [info -f g77 M GLOBALS]") + FFEBAD_MSGS1 (FFEBAD_FILEWIDE_ARG_W, WARN, + "Argument #%B of `%A' is %C at %0 but is %D at %1 [info -f g77 M GLOBALS]") + FFEBAD_MSGS1 (FFEBAD_ARRAY_LARGE, FATAL, + "Array `%A' at %0 is too large to handle") #undef INFORM diff -rcp2N g77-0.5.20/f/bugs.texi g77-0.5.21/f/bugs.texi *** g77-0.5.20/f/bugs.texi Thu Feb 27 04:52:13 1997 --- g77-0.5.21/f/bugs.texi Tue Sep 9 06:10:52 1997 *************** *** 6,10 **** @c in the G77 distribution, as well as in the G77 manual. ! @c 1996-02-24 @ifclear BUGSONLY --- 6,10 ---- @c in the G77 distribution, as well as in the G77 manual. ! @c 1996-09-09 @ifclear BUGSONLY *************** configure, port, build, and install @cod *** 26,29 **** --- 26,62 ---- @itemize @bullet + @cindex Alpha + @cindex -O2 + @item + @code{g77}'s version of @code{gcc}, and probably @code{g77} + itself, cannot be reliably used with the @samp{-O2} option + (or higher) on Digital Semiconductor Alpha AXP machines. + The problem is most immediately noticed in differences + discovered by @kbd{make compare} following a bootstrap + build using @samp{-O2}. + It also manifests itself as a failure to compile + @samp{DATA} statements such as @samp{DATA R/7./} correctly; + in this case, @samp{R} might be initialized to @samp{4.0}. + + Until this bug is fixed, use only @samp{-O1} or no optimization. + + @cindex DNRM2 + @cindex stack, 387 coprocessor + @cindex ix86 + @cindex -O2 + @item + A code-generation bug afflicts + Intel x86 targets when @samp{-O2} is specified + compiling, for example, an old version of + the @samp{DNRM2} routine. + The x87 coprocessor stack is being somewhat + mismanaged in cases where assigned @code{GOTO} + and @code{ASSIGN} are involved. + + Version 0.5.21 of @code{g77} contains an initial + effort to fix the problem, but this effort is + incomplete, and a more complete fix is planned + for the next release. + @cindex SIGNAL() intrinsic @cindex intrinsics, SIGNAL() *************** Until this is solved, try inserting or r *** 54,57 **** --- 87,91 ---- statements as the terminal statement, using the @code{END DO} form instead, and so on. + (Probably improved, but not wholly fixed, in 0.5.21.) @item *************** for SGI systems. *** 233,238 **** @code{g77} doesn't work perfectly on 64-bit configurations such as the Alpha. This problem is expected to be largely resolved as of version 0.5.20, ! and version 0.6 should solve most or all related problems (such as ! 64-bit machines other than DEC Alphas). One known bug that causes a compile-time crash occurs when compiling --- 267,273 ---- @code{g77} doesn't work perfectly on 64-bit configurations such as the Alpha. This problem is expected to be largely resolved as of version 0.5.20, ! and further addressed by 0.5.21. ! Version 0.6 should solve most or all related problems (such as ! 64-bit machines other than Digital Semiconductor (``DEC'') Alphas). One known bug that causes a compile-time crash occurs when compiling diff -rcp2N g77-0.5.20/f/com-rt.def g77-0.5.21/f/com-rt.def *** g77-0.5.20/f/com-rt.def Sun Feb 9 18:52:45 1997 --- g77-0.5.21/f/com-rt.def Tue Sep 2 21:25:25 1997 *************** the Free Software Foundation, 59 Temple *** 34,37 **** --- 34,42 ---- TYPE -- a code for the tree for the type, assigned when first encountered + (NOTE: There's a distinction made between the semantic return + value for the function, and the actual return mechanism; e.g. + `r_abs()' computes a single-precision `float' return value + but returns it as a `double'. This distinction is important + and is flagged via the _F2C_ versus _GNU_ suffix.) ARGS -- a string of codes representing the types of the arguments; the *************** DEFGFRT (FFECOM_gfrtFEND, "f_end", FFECO *** 107,141 **** DEFGFRT (FFECOM_gfrtFREW, "f_rew", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtABORT, "abort_", FFECOM_rttypeVOID_, 0, TRUE, FALSE) ! DEFGFRT (FFECOM_gfrtABS, "r_abs", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtACCESS, "access_", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtACOS, "r_acos", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtAIMAG, "r_imag", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtAINT, "r_int", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtALOG, "r_log", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtALOG10, "r_lg10", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtAMOD, "r_mod", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtANINT, "r_nint", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtASIN, "r_asin", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtATAN, "r_atan", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtATAN2, "r_atn2", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtBESJ0, "j0", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtBESJ1, "j1", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtBESJN, "jn", FFECOM_rttypeDOUBLE_, "id", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtBESY0, "y0", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtBESY1, "y1", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtBESYN, "yn", FFECOM_rttypeDOUBLE_, "id", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtCABS, "c_abs", FFECOM_rttypeDOUBLE_, "&c", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtCCOS, "c_cos", FFECOM_rttypeCOMPLEX_, "&c", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtCEXP, "c_exp", FFECOM_rttypeCOMPLEX_, "&c", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtCHDIR, "chdir_", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtCLOG, "c_log", FFECOM_rttypeCOMPLEX_, "&c", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtCHMOD, "chmod_", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtCONJG, "r_cnjg", FFECOM_rttypeCOMPLEX_, "&c", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtCOS, "r_cos", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtCOSH, "r_cosh", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtCSIN, "c_sin", FFECOM_rttypeCOMPLEX_, "&c", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtCSQRT, "c_sqrt", FFECOM_rttypeCOMPLEX_, "&c", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtCTIME, "ctime_", FFECOM_rttypeCHARACTER_, "j", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDABS, "d_abs", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDACOS, "d_acos", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) --- 112,141 ---- DEFGFRT (FFECOM_gfrtFREW, "f_rew", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtABORT, "G77_abort_0", FFECOM_rttypeVOID_, 0, TRUE, FALSE) ! DEFGFRT (FFECOM_gfrtABS, "r_abs", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtACCESS, "G77_access_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtACOS, "r_acos", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtAIMAG, "r_imag", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtAINT, "r_int", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtALARM, "G77_alarm_0", FFECOM_rttypeINTEGER_, "&i0", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtALOG, "r_log", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtALOG10, "r_lg10", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtAMOD, "r_mod", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtANINT, "r_nint", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtASIN, "r_asin", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtATAN, "r_atan", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtATAN2, "r_atn2", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtCABS, "c_abs", FFECOM_rttypeREAL_F2C_, "&c", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtCCOS, "c_cos", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtCEXP, "c_exp", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtCHDIR, "G77_chdir_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtCLOG, "c_log", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtCHMOD, "G77_chmod_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtCONJG, "r_cnjg", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtCOS, "r_cos", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtCOSH, "r_cosh", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtCSIN, "c_sin", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtCSQRT, "c_sqrt", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtCTIME, "G77_ctime_0", FFECOM_rttypeCHARACTER_, "&j", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDABS, "d_abs", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDACOS, "d_acos", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) *************** DEFGFRT (FFECOM_gfrtDASIN, "d_asin", FFE *** 143,160 **** DEFGFRT (FFECOM_gfrtDATAN, "d_atan", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDATAN2, "d_atn2", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtDATE, "date_", FFECOM_rttypeVOID_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtDBESJ0, "j0", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtDBESJ1, "j1", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtDBESJN, "jn", FFECOM_rttypeDOUBLE_, "id", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtDBESY0, "y0", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtDBESY1, "y1", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtDBESYN, "yn", FFECOM_rttypeDOUBLE_, "id", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDCOS, "d_cos", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDCOSH, "d_cosh", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDDIM, "d_dim", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtDERF, "derf_", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtDERFC, "derfc_", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDEXP, "d_exp", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtDIM, "r_dim", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDINT, "d_int", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDLOG, "d_log", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) --- 143,160 ---- DEFGFRT (FFECOM_gfrtDATAN, "d_atan", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDATAN2, "d_atn2", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtDATE, "G77_date_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtL_BESJ0, "j0", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtL_BESJ1, "j1", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtL_BESJN, "jn", FFECOM_rttypeDOUBLE_, "id", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtL_BESY0, "y0", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtL_BESY1, "y1", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtL_BESYN, "yn", FFECOM_rttypeDOUBLE_, "id", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDCOS, "d_cos", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDCOSH, "d_cosh", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDDIM, "d_dim", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtDERF, "G77_derf_0", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtDERFC, "G77_derfc_0", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDEXP, "d_exp", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtDIM, "r_dim", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDINT, "d_int", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDLOG, "d_log", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) *************** DEFGFRT (FFECOM_gfrtDSQRT, "d_sqrt", FFE *** 169,254 **** DEFGFRT (FFECOM_gfrtDTAN, "d_tan", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDTANH, "d_tanh", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtDTIME, "dtime_", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtERF, "erf_", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtERFC, "erfc_", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtETIME, "etime_", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtEXIT, "exit_", FFECOM_rttypeVOID_, "&i", TRUE, FALSE) ! DEFGFRT (FFECOM_gfrtEXP, "r_exp", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFDATE, "fdate_", FFECOM_rttypeCHARACTER_, 0, FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFGET, "fget_", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFGETC, "fgetc_", FFECOM_rttypeINTEGER_, "&i&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFLUSH, "flush_", FFECOM_rttypeVOID_, 0, FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFLUSH1, "flush1_", FFECOM_rttypeVOID_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFNUM, "fnum_", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFPUT, "fput_", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFPUTC, "fputc_", FFECOM_rttypeINTEGER_, "&i&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFSTAT, "fstat_", FFECOM_rttypeINTEGER_, "&i&", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFTELL, "ftell_", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFSEEK, "fseek_", FFECOM_rttypeINTEGER_, "&i&i&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtGERROR, "gerror_", FFECOM_rttypeVOID_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtGETARG, "getarg_", FFECOM_rttypeVOID_, "&i&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtGETCWD, "getcwd_", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtGETGID, "getgid_", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtGETLOG, "getlog_", FFECOM_rttypeVOID_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtGETPID, "getpid_", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtGETUID, "getuid_", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtGETENV, "getenv_", FFECOM_rttypeVOID_, "&a&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtGMTIME, "gmtime_", FFECOM_rttypeVOID_, "&i&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtHOSTNM, "hostnm_", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE) DEFGFRT (FFECOM_gfrtIABS, "i_abs", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtIARGC, "iargc_", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtIDATE, "idate_", FFECOM_rttypeVOID_, "&i", FALSE, FALSE) DEFGFRT (FFECOM_gfrtIDIM, "i_dim", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) DEFGFRT (FFECOM_gfrtIDNINT, "i_dnnt", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtIERRNO, "ierrno_", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE) DEFGFRT (FFECOM_gfrtINDEX, "i_indx", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtIRAND, "irand_", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) DEFGFRT (FFECOM_gfrtISIGN, "i_sign", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtISATTY, "isatty_", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtITIME, "itime_", FFECOM_rttypeVOID_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtKILL, "kill_", FFECOM_rttypeINTEGER_, "&i&i", FALSE, FALSE) DEFGFRT (FFECOM_gfrtLEN, "i_len", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE) DEFGFRT (FFECOM_gfrtLGE, "l_ge", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE) DEFGFRT (FFECOM_gfrtLGT, "l_gt", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtLINK, "link_", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE) DEFGFRT (FFECOM_gfrtLLE, "l_le", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE) DEFGFRT (FFECOM_gfrtLLT, "l_lt", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtLNBLNK, "lnblnk_", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtLSTAT, "lstat_", FFECOM_rttypeINTEGER_, "&a&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtLTIME, "ltime_", FFECOM_rttypeVOID_, "&i&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtMCLOCK, "mclock_", FFECOM_rttypeLONGINT_, 0, FALSE, FALSE) DEFGFRT (FFECOM_gfrtMOD, "i_mod", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) DEFGFRT (FFECOM_gfrtNINT, "i_nint", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtPERROR, "perror_", FFECOM_rttypeVOID_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtRAND, "rand_", FFECOM_rttypeDOUBLE_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtRENAME, "rename_", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSECNDS, "secnds_", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSECOND, "second_", FFECOM_rttypeDOUBLE_, 0, FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSIGN, "r_sign", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSIGNAL, "signal_", FFECOM_rttypeINTEGER_, "&i0", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSIN, "r_sin", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSINH, "r_sinh", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSLEEP, "sleep_", FFECOM_rttypeVOID_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSQRT, "r_sqrt", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSRAND, "srand_", FFECOM_rttypeVOID_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSTAT, "stat_", FFECOM_rttypeINTEGER_, "&a&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSYMLNK, "symlnk_", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSYSTEM, "system_", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE) DEFGFRT (FFECOM_gfrtSYSTEM_CLOCK, "system_clock_", FFECOM_rttypeVOID_, "&i&i&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtTAN, "r_tan", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtTANH, "r_tanh", FFECOM_rttypeDOUBLE_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtTIME, "time_", FFECOM_rttypeLONGINT_, 0, FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtTTYNAM, "ttynam_", FFECOM_rttypeCHARACTER_, "i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtUNLINK, "unlink_", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtUMASK, "umask_", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtVXTIDATE, "vxtidate_", FFECOM_rttypeVOID_, "&i&i&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtVXTTIME, "vxttime_", FFECOM_rttypeVOID_, "&a", FALSE, FALSE) DEFGFRT (FFECOM_gfrtCDABS, "z_abs", FFECOM_rttypeDOUBLE_, "&e", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtCDCOS, "z_cos", FFECOM_rttypeDBLCMPLX_, "&e", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtCDEXP, "z_exp", FFECOM_rttypeDBLCMPLX_, "&e", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtCDLOG, "z_log", FFECOM_rttypeDBLCMPLX_, "&e", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtDCONJG, "d_cnjg", FFECOM_rttypeDBLCMPLX_, "&e", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtCDSIN, "z_sin", FFECOM_rttypeDBLCMPLX_, "&e", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtCDSQRT, "z_sqrt", FFECOM_rttypeDBLCMPLX_, "&e", FALSE, TRUE) DEFGFRT (FFECOM_gfrtDIMAG, "d_imag", FFECOM_rttypeDOUBLE_, "&e", FALSE, FALSE) --- 169,254 ---- DEFGFRT (FFECOM_gfrtDTAN, "d_tan", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtDTANH, "d_tanh", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtDTIME, "G77_dtime_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtERF, "G77_erf_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtERFC, "G77_erfc_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtETIME, "G77_etime_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtEXIT, "G77_exit_0", FFECOM_rttypeVOID_, "&i", TRUE, FALSE) ! DEFGFRT (FFECOM_gfrtEXP, "r_exp", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFDATE, "G77_fdate_0", FFECOM_rttypeCHARACTER_, 0, FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFGET, "G77_fget_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFGETC, "G77_fgetc_0", FFECOM_rttypeINTEGER_, "&i&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFLUSH, "G77_flush_0", FFECOM_rttypeVOID_, 0, FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFLUSH1, "G77_flush1_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFNUM, "G77_fnum_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFPUT, "G77_fput_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFPUTC, "G77_fputc_0", FFECOM_rttypeINTEGER_, "&i&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFSTAT, "G77_fstat_0", FFECOM_rttypeINTEGER_, "&i&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFTELL, "G77_ftell_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtFSEEK, "G77_fseek_0", FFECOM_rttypeINTEGER_, "&i&i&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtGERROR, "G77_gerror_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtGETARG, "G77_getarg_0", FFECOM_rttypeVOID_, "&i&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtGETCWD, "G77_getcwd_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtGETGID, "G77_getgid_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtGETLOG, "G77_getlog_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtGETPID, "G77_getpid_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtGETUID, "G77_getuid_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtGETENV, "G77_getenv_0", FFECOM_rttypeVOID_, "&a&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtGMTIME, "G77_gmtime_0", FFECOM_rttypeVOID_, "&i&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtHOSTNM, "G77_hostnm_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE) DEFGFRT (FFECOM_gfrtIABS, "i_abs", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtIARGC, "G77_iargc_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtIDATE, "G77_idate_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE) DEFGFRT (FFECOM_gfrtIDIM, "i_dim", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) DEFGFRT (FFECOM_gfrtIDNINT, "i_dnnt", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtIERRNO, "G77_ierrno_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE) DEFGFRT (FFECOM_gfrtINDEX, "i_indx", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtIRAND, "G77_irand_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) DEFGFRT (FFECOM_gfrtISIGN, "i_sign", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtISATTY, "G77_isatty_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtITIME, "G77_itime_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtKILL, "G77_kill_0", FFECOM_rttypeINTEGER_, "&i&i", FALSE, FALSE) DEFGFRT (FFECOM_gfrtLEN, "i_len", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE) DEFGFRT (FFECOM_gfrtLGE, "l_ge", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE) DEFGFRT (FFECOM_gfrtLGT, "l_gt", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtLINK, "G77_link_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE) DEFGFRT (FFECOM_gfrtLLE, "l_le", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE) DEFGFRT (FFECOM_gfrtLLT, "l_lt", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtLNBLNK, "G77_lnblnk_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtLSTAT, "G77_lstat_0", FFECOM_rttypeINTEGER_, "&a&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtLTIME, "G77_ltime_0", FFECOM_rttypeVOID_, "&i&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtMCLOCK, "G77_mclock_0", FFECOM_rttypeLONGINT_, 0, FALSE, FALSE) DEFGFRT (FFECOM_gfrtMOD, "i_mod", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) DEFGFRT (FFECOM_gfrtNINT, "i_nint", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtPERROR, "G77_perror_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtRAND, "G77_rand_0", FFECOM_rttypeREAL_F2C_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtRENAME, "G77_rename_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSECNDS, "G77_secnds_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSECOND, "G77_second_0", FFECOM_rttypeREAL_F2C_, 0, FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSIGN, "r_sign", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtL_SIGNAL, "G77_signal_0", FFECOM_rttypeFTNINT_, "&i0", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSIN, "r_sin", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSINH, "r_sinh", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSLEEP, "G77_sleep_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSQRT, "r_sqrt", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSRAND, "G77_srand_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSTAT, "G77_stat_0", FFECOM_rttypeINTEGER_, "&a&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSYMLNK, "G77_symlnk_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtSYSTEM, "G77_system_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE) DEFGFRT (FFECOM_gfrtSYSTEM_CLOCK, "system_clock_", FFECOM_rttypeVOID_, "&i&i&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtTAN, "r_tan", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtTANH, "r_tanh", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtTIME, "G77_time_0", FFECOM_rttypeLONGINT_, 0, FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtTTYNAM, "G77_ttynam_0", FFECOM_rttypeCHARACTER_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtUNLINK, "G77_unlink_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtUMASK, "G77_umask_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtVXTIDATE, "G77_vxtidate_0", FFECOM_rttypeVOID_, "&i&i&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtVXTTIME, "G77_vxttime_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE) DEFGFRT (FFECOM_gfrtCDABS, "z_abs", FFECOM_rttypeDOUBLE_, "&e", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtCDCOS, "z_cos", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtCDEXP, "z_exp", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtCDLOG, "z_log", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtDCONJG, "d_cnjg", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtCDSIN, "z_sin", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtCDSQRT, "z_sqrt", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE) DEFGFRT (FFECOM_gfrtDIMAG, "d_imag", FFECOM_rttypeDOUBLE_, "&e", FALSE, FALSE) *************** DEFGFRT (FFECOM_gfrtL_TAN, "tan", FFECOM *** 270,281 **** DEFGFRT (FFECOM_gfrtL_TANH, "tanh", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtPOW_CI, "pow_ci", FFECOM_rttypeCOMPLEX_, "&c&i", FALSE, TRUE) DEFGFRT (FFECOM_gfrtPOW_DD, "pow_dd", FFECOM_rttypeDOUBLE_, "&d&d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtPOW_DI, "pow_di", FFECOM_rttypeDOUBLE_, "&d&i", FALSE, FALSE) DEFGFRT (FFECOM_gfrtPOW_II, "pow_ii", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) DEFGFRT (FFECOM_gfrtPOW_QQ, "pow_qq", FFECOM_rttypeLONGINT_, "&j&j", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtPOW_RI, "pow_ri", FFECOM_rttypeDOUBLE_, "&f&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtPOW_ZI, "pow_zi", FFECOM_rttypeDBLCMPLX_, "&e&i", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtPOW_ZZ, "pow_zz", FFECOM_rttypeDBLCMPLX_, "&e&e", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtDIV_CC, "c_div", FFECOM_rttypeCOMPLEX_, "&c", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtDIV_ZZ, "z_div", FFECOM_rttypeDBLCMPLX_, "&e", FALSE, TRUE) --- 270,281 ---- DEFGFRT (FFECOM_gfrtL_TANH, "tanh", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtPOW_CI, "pow_ci", FFECOM_rttypeCOMPLEX_F2C_, "&c&i", FALSE, TRUE) DEFGFRT (FFECOM_gfrtPOW_DD, "pow_dd", FFECOM_rttypeDOUBLE_, "&d&d", FALSE, FALSE) DEFGFRT (FFECOM_gfrtPOW_DI, "pow_di", FFECOM_rttypeDOUBLE_, "&d&i", FALSE, FALSE) DEFGFRT (FFECOM_gfrtPOW_II, "pow_ii", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE) DEFGFRT (FFECOM_gfrtPOW_QQ, "pow_qq", FFECOM_rttypeLONGINT_, "&j&j", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtPOW_RI, "pow_ri", FFECOM_rttypeREAL_F2C_, "&f&i", FALSE, FALSE) ! DEFGFRT (FFECOM_gfrtPOW_ZI, "pow_zi", FFECOM_rttypeDBLCMPLX_F2C_, "&e&i", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtPOW_ZZ, "pow_zz", FFECOM_rttypeDBLCMPLX_F2C_, "&e&e", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtDIV_CC, "c_div", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE) ! DEFGFRT (FFECOM_gfrtDIV_ZZ, "z_div", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE) diff -rcp2N g77-0.5.20/f/com.c g77-0.5.21/f/com.c *** g77-0.5.20/f/com.c Fri Feb 28 06:54:53 1997 --- g77-0.5.21/f/com.c Tue Sep 2 21:25:26 1997 *************** typedef enum *** 346,358 **** { FFECOM_rttypeVOID_, ! FFECOM_rttypeINT_, /* C's `int' type, for libF77/system_.c? */ ! FFECOM_rttypeINTEGER_, ! FFECOM_rttypeLONGINT_, /* C's `long long int' type. */ ! FFECOM_rttypeLOGICAL_, ! FFECOM_rttypeREAL_, ! FFECOM_rttypeCOMPLEX_, FFECOM_rttypeDOUBLE_, /* C's `double' type. */ ! FFECOM_rttypeDOUBLEREAL_, ! FFECOM_rttypeDBLCMPLX_, FFECOM_rttypeCHARACTER_, /* f2c `char *'/`ftnlen' pair. */ FFECOM_rttype_ --- 346,361 ---- { FFECOM_rttypeVOID_, ! FFECOM_rttypeFTNINT_, /* f2c's `ftnint' type. */ ! FFECOM_rttypeINTEGER_, /* f2c's `integer' type. */ ! FFECOM_rttypeLONGINT_, /* f2c's `longint' type. */ ! FFECOM_rttypeLOGICAL_, /* f2c's `logical' type. */ ! FFECOM_rttypeREAL_F2C_, /* f2c's `real' returned as `double'. */ ! FFECOM_rttypeREAL_GNU_, /* `real' returned as such. */ ! FFECOM_rttypeCOMPLEX_F2C_, /* f2c's `complex' returned via 1st arg. */ ! FFECOM_rttypeCOMPLEX_GNU_, /* f2c's `complex' returned directly. */ FFECOM_rttypeDOUBLE_, /* C's `double' type. */ ! FFECOM_rttypeDOUBLEREAL_, /* f2c's `doublereal' type. */ ! FFECOM_rttypeDBLCMPLX_F2C_, /* f2c's `doublecomplex' returned via 1st arg. */ ! FFECOM_rttypeDBLCMPLX_GNU_, /* f2c's `doublecomplex' returned directly. */ FFECOM_rttypeCHARACTER_, /* f2c `char *'/`ftnlen' pair. */ FFECOM_rttype_ *************** static tree ffecom_call_binop_ (tree fn, *** 419,422 **** --- 422,426 ---- static void ffecom_char_args_ (tree *xitem, tree *length, ffebld expr); + static tree ffecom_check_size_overflow_ (ffesymbol s, tree type, bool dummy); static tree ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s); static ffecomConcatList_ *************** static tree ffecom_gen_sfuncdef_ (ffesym *** 448,452 **** ffeinfoBasictype bt, ffeinfoKindtype kt); - static ffeinfoKindtype ffecom_gfrt_kind_type_ (ffecomGfrt ix); static char *ffecom_gfrt_args_ (ffecomGfrt ix); static tree ffecom_gfrt_tree_ (ffecomGfrt ix); --- 452,455 ---- *************** static char *ffecom_gfrt_argstring_[FFEC *** 619,627 **** #undef DEFGFRT }; - - /* Kind type of (complex) function return value. */ - - static ffeinfoKindtype ffecom_gfrt_kt_[FFECOM_gfrt]; - #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ --- 622,625 ---- *************** static tree shadowed_labels; *** 766,770 **** #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ffecom_stabilize_aggregate_ (tree ref) { --- 764,768 ---- #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ffecom_stabilize_aggregate_ (tree ref) { *************** ffecom_stabilize_aggregate_ (tree ref) *** 850,854 **** #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ffecom_convert_to_complex_ (tree type, tree expr) { --- 848,852 ---- #if FFECOM_targetCURRENT == FFECOM_targetGCC ! static tree ffecom_convert_to_complex_ (tree type, tree expr) { *************** ffecom_convert_to_complex_ (tree type, t *** 899,902 **** --- 897,1028 ---- #endif + /* Like gcc's convert(), but crashes if widening might happen. */ + + #if FFECOM_targetCURRENT == FFECOM_targetGCC + static tree + ffecom_convert_narrow_ (type, expr) + tree type, expr; + { + register tree e = expr; + register enum tree_code code = TREE_CODE (type); + + if (type == TREE_TYPE (e) + || TREE_CODE (e) == ERROR_MARK) + return e; + if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (e))) + return fold (build1 (NOP_EXPR, type, e)); + if (TREE_CODE (TREE_TYPE (e)) == ERROR_MARK + || code == ERROR_MARK) + return error_mark_node; + if (TREE_CODE (TREE_TYPE (e)) == VOID_TYPE) + { + assert ("void value not ignored as it ought to be" == NULL); + return error_mark_node; + } + assert (code != VOID_TYPE); + if ((code != RECORD_TYPE) + && (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE)) + assert ("converting COMPLEX to REAL" == NULL); + assert (code != ENUMERAL_TYPE); + if (code == INTEGER_TYPE) + { + assert (TREE_CODE (TREE_TYPE (e)) == INTEGER_TYPE); + assert (TYPE_PRECISION (type) <= TYPE_PRECISION (TREE_TYPE (e))); + return fold (convert_to_integer (type, e)); + } + if (code == POINTER_TYPE) + { + assert (TREE_CODE (TREE_TYPE (e)) == POINTER_TYPE); + return fold (convert_to_pointer (type, e)); + } + if (code == REAL_TYPE) + { + assert (TREE_CODE (TREE_TYPE (e)) == REAL_TYPE); + assert (TYPE_PRECISION (type) <= TYPE_PRECISION (TREE_TYPE (e))); + return fold (convert_to_real (type, e)); + } + if (code == COMPLEX_TYPE) + { + assert (TREE_CODE (TREE_TYPE (e)) == COMPLEX_TYPE); + assert (TYPE_PRECISION (TREE_TYPE (type)) <= TYPE_PRECISION (TREE_TYPE (TREE_TYPE (e)))); + return fold (convert_to_complex (type, e)); + } + if (code == RECORD_TYPE) + { + assert (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE); + assert (TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (type))) + <= TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (e))))); + return fold (ffecom_convert_to_complex_ (type, e)); + } + + assert ("conversion to non-scalar type requested" == NULL); + return error_mark_node; + } + #endif + + /* Like gcc's convert(), but crashes if narrowing might happen. */ + + #if FFECOM_targetCURRENT == FFECOM_targetGCC + static tree + ffecom_convert_widen_ (type, expr) + tree type, expr; + { + register tree e = expr; + register enum tree_code code = TREE_CODE (type); + + if (type == TREE_TYPE (e) + || TREE_CODE (e) == ERROR_MARK) + return e; + if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (e))) + return fold (build1 (NOP_EXPR, type, e)); + if (TREE_CODE (TREE_TYPE (e)) == ERROR_MARK + || code == ERROR_MARK) + return error_mark_node; + if (TREE_CODE (TREE_TYPE (e)) == VOID_TYPE) + { + assert ("void value not ignored as it ought to be" == NULL); + return error_mark_node; + } + assert (code != VOID_TYPE); + if ((code != RECORD_TYPE) + && (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE)) + assert ("narrowing COMPLEX to REAL" == NULL); + assert (code != ENUMERAL_TYPE); + if (code == INTEGER_TYPE) + { + assert (TREE_CODE (TREE_TYPE (e)) == INTEGER_TYPE); + assert (TYPE_PRECISION (type) >= TYPE_PRECISION (TREE_TYPE (e))); + return fold (convert_to_integer (type, e)); + } + if (code == POINTER_TYPE) + { + assert (TREE_CODE (TREE_TYPE (e)) == POINTER_TYPE); + return fold (convert_to_pointer (type, e)); + } + if (code == REAL_TYPE) + { + assert (TREE_CODE (TREE_TYPE (e)) == REAL_TYPE); + assert (TYPE_PRECISION (type) >= TYPE_PRECISION (TREE_TYPE (e))); + return fold (convert_to_real (type, e)); + } + if (code == COMPLEX_TYPE) + { + assert (TREE_CODE (TREE_TYPE (e)) == COMPLEX_TYPE); + assert (TYPE_PRECISION (TREE_TYPE (type)) >= TYPE_PRECISION (TREE_TYPE (TREE_TYPE (e)))); + return fold (convert_to_complex (type, e)); + } + if (code == RECORD_TYPE) + { + assert (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE); + assert (TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (type))) + >= TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (e))))); + return fold (ffecom_convert_to_complex_ (type, e)); + } + + assert ("conversion to non-scalar type requested" == NULL); + return error_mark_node; + } + #endif + /* Handles making a COMPLEX type, either the standard (but buggy?) gbe way, or the safer (but less elegant?) *************** ffecom_build_complex_constant_ (tree typ *** 947,956 **** else { ! #if BUILT_FOR_280 ! bothparts = build_complex (NULL_TREE, realpart, imagpart); ! #else ! bothparts = build_complex (realpart, imagpart); ! #endif ! TREE_TYPE (bothparts) = type; } --- 1073,1077 ---- else { ! bothparts = build_complex (type, realpart, imagpart); } *************** ffecom_arglist_expr_ (char *c, ffebld ex *** 1043,1047 **** { item = ffecom_arg_expr (exprh, &length); ! item = convert (wanted, item); if (ptr) { --- 1164,1168 ---- { item = ffecom_arg_expr (exprh, &length); ! item = ffecom_convert_widen_ (wanted, item); if (ptr) { *************** ffecom_call_ (tree fn, ffeinfoKindtype k *** 1437,1441 **** if ((type != NULL_TREE) && (TREE_TYPE (item) != type)) ! item = convert (type, item); return item; --- 1558,1562 ---- if ((type != NULL_TREE) && (TREE_TYPE (item) != type)) ! item = ffecom_convert_narrow_ (type, item); return item; *************** ffecom_char_args_ (tree *xitem, tree *le *** 1703,1706 **** --- 1824,1828 ---- tree args; ffetargetCharacterSize size = ffeinfo_size (ffebld_info (expr)); + ffecomGfrt ix; if (size == FFETARGET_charactersizeNONE) *************** ffecom_char_args_ (tree *xitem, tree *le *** 1713,1718 **** == FFEINFO_whereINTRINSIC) { - ffecomGfrt ix; - if (size == 1) { /* Invocation of an intrinsic returning CHARACTER*1. */ --- 1835,1838 ---- *************** ffecom_char_args_ (tree *xitem, tree *le *** 1721,1725 **** break; } ! ix = ffeintrin_gfrt (ffebld_symter_implementation (ffebld_left (expr))); assert (ix != FFECOM_gfrt); item = ffecom_gfrt_tree_ (ix); --- 1841,1845 ---- break; } ! ix = ffeintrin_gfrt_direct (ffebld_symter_implementation (ffebld_left (expr))); assert (ix != FFECOM_gfrt); item = ffecom_gfrt_tree_ (ix); *************** ffecom_char_args_ (tree *xitem, tree *le *** 1727,1730 **** --- 1847,1851 ---- else { + ix = FFECOM_gfrt; item = ffesymbol_hook (s).decl_tree; if (item == NULL_TREE) *************** ffecom_char_args_ (tree *xitem, tree *le *** 1758,1763 **** { TREE_CHAIN (args) = build_tree_list (NULL_TREE, *length); ! TREE_CHAIN (TREE_CHAIN (args)) ! = ffecom_list_ptr_to_expr (ffebld_right (expr)); } --- 1879,1893 ---- { TREE_CHAIN (args) = build_tree_list (NULL_TREE, *length); ! if (ffesymbol_where (s) == FFEINFO_whereINTRINSIC) ! { ! TREE_CHAIN (TREE_CHAIN (args)) ! = ffecom_arglist_expr_ (ffecom_gfrt_args_ (ix), ! ffebld_right (expr)); ! } ! else ! { ! TREE_CHAIN (TREE_CHAIN (args)) ! = ffecom_list_ptr_to_expr (ffebld_right (expr)); ! } } *************** ffecom_char_args_ (tree *xitem, tree *le *** 1830,1835 **** --- 1960,2001 ---- *xitem = item; } + #endif + + /* Check the size of the type to be sure it doesn't overflow the + "portable" capacities of the compiler back end. `dummy' types + can generally overflow the normal sizes as long as the computations + themselves don't overflow. A particular target of the back end + must still enforce its size requirements, though, and the back + end takes care of this in stor-layout.c. */ + + #if FFECOM_targetCURRENT == FFECOM_targetGCC + static tree + ffecom_check_size_overflow_ (ffesymbol s, tree type, bool dummy) + { + if (TREE_CODE (type) == ERROR_MARK) + return type; + + if (TYPE_SIZE (type) == NULL_TREE) + return type; + if (TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST) + return type; + + if ((tree_int_cst_sgn (TYPE_SIZE (type)) < 0) + || (!dummy && (TREE_INT_CST_HIGH (TYPE_SIZE (type)) != 0)) + || TREE_OVERFLOW (TYPE_SIZE (type))) + { + ffebad_start (FFEBAD_ARRAY_LARGE); + ffebad_string (ffesymbol_text (s)); + ffebad_here (0, ffesymbol_where_line (s), ffesymbol_where_column (s)); + ffebad_finish (); + + return error_mark_node; + } + + return type; + } #endif + /* Builds a length argument (PARM_DECL). Also wraps type in an array type where the dimension info is (1:size) where is ffesymbol_size(s) if *************** ffecom_do_entry_ (ffesymbol fn, int entr *** 2252,2256 **** if (((g = ffesymbol_global (fn)) != NULL) ! && (ffeglobal_type (g) == gt)) { ffeglobal_set_hook (g, current_function_decl); --- 2418,2423 ---- if (((g = ffesymbol_global (fn)) != NULL) ! && ((ffeglobal_type (g) == gt) ! || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))) { ffeglobal_set_hook (g, current_function_decl); *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 2689,2693 **** to hold pointers to labels. */ ! if (t != NULL_TREE) DECL_IN_SYSTEM_HEADER (t) = 1; /* Don't let -Wunused complain. */ --- 2856,2861 ---- to hold pointers to labels. */ ! if (t != NULL_TREE ! && TREE_CODE (t) == VAR_DECL) DECL_IN_SYSTEM_HEADER (t) = 1; /* Don't let -Wunused complain. */ *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 2917,2921 **** } return ffecom_call_binop_ (ffecom_gfrt_tree_ (code), ! ffecom_gfrt_kind_type_ (code), (ffe_is_f2c_library () && ffecom_gfrt_complex_[code]), --- 3085,3089 ---- } return ffecom_call_binop_ (ffecom_gfrt_tree_ (code), ! ffecom_gfrt_kindtype (code), (ffe_is_f2c_library () && ffecom_gfrt_complex_[code]), *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 3352,3356 **** #endif ! /* Returns the tree that does the intrinsic invocation. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC --- 3520,3528 ---- #endif ! /* Returns the tree that does the intrinsic invocation. ! ! Note: this function applies only to intrinsics returning ! CHARACTER*1 or non-CHARACTER results, and to intrinsic ! subroutines. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3372,3377 **** ffebld arg2; ffebld arg3; - ffecomGfrt ix; ffeintrinImp codegen_imp; assert (ffebld_op (ffebld_left (expr)) == FFEBLD_opSYMTER); --- 3544,3549 ---- ffebld arg2; ffebld arg3; ffeintrinImp codegen_imp; + ffecomGfrt gfrt; assert (ffebld_op (ffebld_left (expr)) == FFEBLD_opSYMTER); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3428,3437 **** passed in as a dummy procedure and called as any old procedure. This method can produce slower code but in some cases it's the easiest way for ! now. ! goto library; ! ix contains the gfrt index of a library function to call, passing the ! argument(s) by value rather than by reference. return expr_tree; --- 3600,3613 ---- passed in as a dummy procedure and called as any old procedure. This method can produce slower code but in some cases it's the easiest way for ! now. However, if a (presumably faster) direct call is available, ! that is used, so this is the easiest way in many more cases now. ! gfrt = FFECOM_gfrtWHATEVER; ! break; ! gfrt contains the gfrt index of a library function to call, passing the ! argument(s) by value rather than by reference. Used when a more ! careful choice of library function is needed than that provided ! by the vanilla `break;'. return expr_tree; *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3444,3482 **** enclosed in comments below the switch statement. */ ! codegen_imp = ffeintrin_codegen_imp (ffebld_symter_implementation ! (ffebld_left (expr))); switch (codegen_imp) { ! case FFEINTRIN_impABS: /* Plus impCABS, impCDABS, impDABS, impIABS. */ if (ffeinfo_basictype (ffebld_info (arg1)) == FFEINFO_basictypeCOMPLEX) { if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtCABS; else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtCDABS; ! else ! { ! assert ("bad ABS COMPLEX kind type" == NULL); ! ix = FFECOM_gfrt; ! } ! goto library; /* :::::::::::::::::::: */ } return ffecom_1 (ABS_EXPR, tree_type, convert (tree_type, ffecom_expr (arg1))); ! case FFEINTRIN_impACOS: /* Plus impDACOS. */ ! if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtL_ACOS; ! else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtL_ACOS; ! else ! { ! assert ("bad ACOS kind type" == NULL); ! ix = FFECOM_gfrt; ! } ! goto library; /* :::::::::::::::::::: */ ! case FFEINTRIN_impAIMAG: /* Plus impDIMAG. */ if (TREE_CODE (arg1_type) == COMPLEX_TYPE) arg1_type = TREE_TYPE (arg1_type); --- 3620,3654 ---- enclosed in comments below the switch statement. */ ! codegen_imp = ffebld_symter_implementation (ffebld_left (expr)); ! gfrt = ffeintrin_gfrt_direct (codegen_imp); ! if (gfrt == FFECOM_gfrt) ! gfrt = ffeintrin_gfrt_indirect (codegen_imp); ! switch (codegen_imp) { ! case FFEINTRIN_impABS: ! case FFEINTRIN_impCABS: ! case FFEINTRIN_impCDABS: ! case FFEINTRIN_impDABS: ! case FFEINTRIN_impIABS: if (ffeinfo_basictype (ffebld_info (arg1)) == FFEINFO_basictypeCOMPLEX) { if (kt == FFEINFO_kindtypeREAL1) ! gfrt = FFECOM_gfrtCABS; else if (kt == FFEINFO_kindtypeREAL2) ! gfrt = FFECOM_gfrtCDABS; ! break; } return ffecom_1 (ABS_EXPR, tree_type, convert (tree_type, ffecom_expr (arg1))); ! case FFEINTRIN_impACOS: ! case FFEINTRIN_impDACOS: ! break; ! case FFEINTRIN_impAIMAG: ! case FFEINTRIN_impDIMAG: ! case FFEINTRIN_impIMAGPART: if (TREE_CODE (arg1_type) == COMPLEX_TYPE) arg1_type = TREE_TYPE (arg1_type); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3489,3493 **** ffecom_expr (arg1))); ! case FFEINTRIN_impAINT: /* Plus impDINT. */ #if 0 /* ~~ someday implement FIX_TRUNC_EXPR yielding same type as arg */ --- 3661,3666 ---- ffecom_expr (arg1))); ! case FFEINTRIN_impAINT: ! case FFEINTRIN_impDINT: #if 0 /* ~~ someday implement FIX_TRUNC_EXPR yielding same type as arg */ *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3519,3523 **** #endif ! case FFEINTRIN_impANINT: /* Plus impDNINT. */ #if 0 /* This way of doing it won't handle real numbers of large magnitudes. */ --- 3692,3697 ---- #endif ! case FFEINTRIN_impANINT: ! case FFEINTRIN_impDNINT: #if 0 /* This way of doing it won't handle real numbers of large magnitudes. */ *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3572,3610 **** #endif ! case FFEINTRIN_impASIN: /* Plus impDASIN. */ ! if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtL_ASIN; ! else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtL_ASIN; ! else ! { ! assert ("bad ASIN kind type" == NULL); ! ix = FFECOM_gfrt; ! } ! goto library; /* :::::::::::::::::::: */ ! ! case FFEINTRIN_impATAN: /* Plus impDATAN. */ ! if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtL_ATAN; ! else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtL_ATAN; ! else ! { ! assert ("bad ATAN kind type" == NULL); ! ix = FFECOM_gfrt; ! } ! goto library; /* :::::::::::::::::::: */ ! ! case FFEINTRIN_impATAN2: /* Plus impDATAN2. */ ! if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtL_ATAN2; ! else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtL_ATAN2; ! else ! { ! assert ("bad ATAN2 kind type" == NULL); ! ix = FFECOM_gfrt; ! } ! goto library; /* :::::::::::::::::::: */ case FFEINTRIN_impCHAR: --- 3746,3756 ---- #endif ! case FFEINTRIN_impASIN: ! case FFEINTRIN_impDASIN: ! case FFEINTRIN_impATAN: ! case FFEINTRIN_impDATAN: ! case FFEINTRIN_impATAN2: ! case FFEINTRIN_impDATAN2: ! break; case FFEINTRIN_impCHAR: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3630,3633 **** --- 3776,3780 ---- case FFEINTRIN_impCMPLX: + case FFEINTRIN_impDCMPLX: if (arg2 == NULL) return *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3647,3651 **** ffecom_expr (arg2)); ! case FFEINTRIN_impCONJG: /* Plus impDCONJG. */ { tree arg1_tree; --- 3794,3799 ---- ffecom_expr (arg2)); ! case FFEINTRIN_impCONJG: ! case FFEINTRIN_impDCONJG: { tree arg1_tree; *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3660,3710 **** } ! case FFEINTRIN_impCOS: /* Plus impCCOS, impCDCOS, impDCOS. */ if (bt == FFEINFO_basictypeCOMPLEX) { if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtCCOS; /* Overlapping result okay. */ else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtCDCOS; /* Overlapping result okay. */ ! else ! { ! assert ("bad COS COMPLEX kind type" == NULL); ! ix = FFECOM_gfrt; ! } } ! else ! { ! if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtL_COS; ! else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtL_COS; ! else ! { ! assert ("bad COS REAL kind type" == NULL); ! ix = FFECOM_gfrt; ! } ! } ! goto library; /* :::::::::::::::::::: */ ! case FFEINTRIN_impCOSH: /* Plus impDCOSH. */ ! if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtL_COSH; ! else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtL_COSH; ! else ! { ! assert ("bad COSH kind type" == NULL); ! ix = FFECOM_gfrt; ! } ! goto library; /* :::::::::::::::::::: */ case FFEINTRIN_impDBLE: case FFEINTRIN_impINT: - case FFEINTRIN_impREAL: case FFEINTRIN_impLONG: case FFEINTRIN_impSHORT: return convert (tree_type, ffecom_expr (arg1)); ! case FFEINTRIN_impDIM: /* Plus impDDIM, impIDIM. */ saved_expr1 = ffecom_save_tree (convert (tree_type, ffecom_expr (arg1))); --- 3808,3846 ---- } ! case FFEINTRIN_impCOS: ! case FFEINTRIN_impCCOS: ! case FFEINTRIN_impCDCOS: ! case FFEINTRIN_impDCOS: if (bt == FFEINFO_basictypeCOMPLEX) { if (kt == FFEINFO_kindtypeREAL1) ! gfrt = FFECOM_gfrtCCOS; /* Overlapping result okay. */ else if (kt == FFEINFO_kindtypeREAL2) ! gfrt = FFECOM_gfrtCDCOS; /* Overlapping result okay. */ } ! break; ! case FFEINTRIN_impCOSH: ! case FFEINTRIN_impDCOSH: ! break; case FFEINTRIN_impDBLE: + case FFEINTRIN_impDFLOAT: + case FFEINTRIN_impDREAL: + case FFEINTRIN_impFLOAT: + case FFEINTRIN_impIDINT: + case FFEINTRIN_impIFIX: + case FFEINTRIN_impINT2: + case FFEINTRIN_impINT8: case FFEINTRIN_impINT: case FFEINTRIN_impLONG: + case FFEINTRIN_impREAL: case FFEINTRIN_impSHORT: + case FFEINTRIN_impSNGL: return convert (tree_type, ffecom_expr (arg1)); ! case FFEINTRIN_impDIM: ! case FFEINTRIN_impDDIM: ! case FFEINTRIN_impIDIM: saved_expr1 = ffecom_save_tree (convert (tree_type, ffecom_expr (arg1))); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3728,3757 **** convert (tree_type, ffecom_expr (arg2))); ! case FFEINTRIN_impEXP: /* Plus impCEXP, impCDEXP, impDEXP. */ if (bt == FFEINFO_basictypeCOMPLEX) { if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtCEXP; /* Overlapping result okay. */ else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtCDEXP; /* Overlapping result okay. */ ! else ! { ! assert ("bad EXP COMPLEX kind type" == NULL); ! ix = FFECOM_gfrt; ! } } ! else ! { ! if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtL_EXP; ! else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtL_EXP; ! else ! { ! assert ("bad EXP REAL kind type" == NULL); ! ix = FFECOM_gfrt; ! } ! } ! goto library; /* :::::::::::::::::::: */ case FFEINTRIN_impICHAR: --- 3864,3879 ---- convert (tree_type, ffecom_expr (arg2))); ! case FFEINTRIN_impEXP: ! case FFEINTRIN_impCDEXP: ! case FFEINTRIN_impCEXP: ! case FFEINTRIN_impDEXP: if (bt == FFEINFO_basictypeCOMPLEX) { if (kt == FFEINFO_kindtypeREAL1) ! gfrt = FFECOM_gfrtCEXP; /* Overlapping result okay. */ else if (kt == FFEINFO_kindtypeREAL2) ! gfrt = FFECOM_gfrtCDEXP; /* Overlapping result okay. */ } ! break; case FFEINTRIN_impICHAR: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3782,3844 **** case FFEINTRIN_impLEN: ! #if 0 /* The simple approach. */ ! break; ! #else /* The more interesting (and more optimal) approach. */ ! return ffecom_intrinsic_len_ (arg1); #endif case FFEINTRIN_impLGE: - break; - case FFEINTRIN_impLGT: - break; - case FFEINTRIN_impLLE: - break; - case FFEINTRIN_impLLT: break; ! case FFEINTRIN_impLOG: /* For impALOG, impCLOG, impCDLOG, impDLOG. */ if (bt == FFEINFO_basictypeCOMPLEX) { if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtCLOG; /* Overlapping result okay. */ ! else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtCDLOG; /* Overlapping result okay. */ ! else ! { ! assert ("bad LOG COMPLEX kind type" == NULL); ! ix = FFECOM_gfrt; ! } ! } ! else ! { ! if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtL_LOG; else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtL_LOG; ! else ! { ! assert ("bad LOG REAL kind type" == NULL); ! ix = FFECOM_gfrt; ! } } ! goto library; /* :::::::::::::::::::: */ - case FFEINTRIN_impLOG10: /* For impALOG10, impDLOG10. */ if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtALOG10; else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtDLOG10; ! else ! { ! assert ("bad LOG10 kind type" == NULL); ! ix = FFECOM_gfrt; ! } ! goto library; /* :::::::::::::::::::: */ ! case FFEINTRIN_impMAX: /* Plus impAMAX0, impAMAX1, impDMAX1, ! impMAX0, impMAX1. */ if (bt != ffeinfo_basictype (ffebld_info (arg1))) arg1_type = ffecom_widest_expr_type_ (ffebld_right (expr)); --- 3904,3951 ---- case FFEINTRIN_impLEN: ! #if 0 ! break; /* The simple approach. */ ! #else ! return ffecom_intrinsic_len_ (arg1); /* The more optimal approach. */ #endif case FFEINTRIN_impLGE: case FFEINTRIN_impLGT: case FFEINTRIN_impLLE: case FFEINTRIN_impLLT: break; ! case FFEINTRIN_impLOG: ! case FFEINTRIN_impALOG: ! case FFEINTRIN_impCDLOG: ! case FFEINTRIN_impCLOG: ! case FFEINTRIN_impDLOG: if (bt == FFEINFO_basictypeCOMPLEX) { if (kt == FFEINFO_kindtypeREAL1) ! gfrt = FFECOM_gfrtCLOG; /* Overlapping result okay. */ else if (kt == FFEINFO_kindtypeREAL2) ! gfrt = FFECOM_gfrtCDLOG; /* Overlapping result okay. */ } ! break; ! ! case FFEINTRIN_impLOG10: ! case FFEINTRIN_impALOG10: ! case FFEINTRIN_impDLOG10: ! if (gfrt != FFECOM_gfrt) ! break; /* Already picked one, stick with it. */ if (kt == FFEINFO_kindtypeREAL1) ! gfrt = FFECOM_gfrtALOG10; else if (kt == FFEINFO_kindtypeREAL2) ! gfrt = FFECOM_gfrtDLOG10; ! break; ! case FFEINTRIN_impMAX: ! case FFEINTRIN_impAMAX0: ! case FFEINTRIN_impAMAX1: ! case FFEINTRIN_impDMAX1: ! case FFEINTRIN_impMAX0: ! case FFEINTRIN_impMAX1: if (bt != ffeinfo_basictype (ffebld_info (arg1))) arg1_type = ffecom_widest_expr_type_ (ffebld_right (expr)); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3860,3865 **** return convert (tree_type, expr_tree); ! case FFEINTRIN_impMIN: /* Plus impAMIN0, impAMIN1, impDMIN1, ! impMIN0, impMIN1. */ if (bt != ffeinfo_basictype (ffebld_info (arg1))) arg1_type = ffecom_widest_expr_type_ (ffebld_right (expr)); --- 3967,3976 ---- return convert (tree_type, expr_tree); ! case FFEINTRIN_impMIN: ! case FFEINTRIN_impAMIN0: ! case FFEINTRIN_impAMIN1: ! case FFEINTRIN_impDMIN1: ! case FFEINTRIN_impMIN0: ! case FFEINTRIN_impMIN1: if (bt != ffeinfo_basictype (ffebld_info (arg1))) arg1_type = ffecom_widest_expr_type_ (ffebld_right (expr)); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3882,3903 **** case FFEINTRIN_impMOD: ! if (bt == FFEINFO_basictypeREAL) ! { ! if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtAMOD; ! else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtDMOD; ! else ! { ! assert ("bad DMOD REAL kind type" == NULL); ! ix = FFECOM_gfrt; ! } ! goto library; /* :::::::::::::::::::: */ ! } ! return ffecom_2 (TRUNC_MOD_EXPR, tree_type, ! convert (tree_type, ffecom_expr (arg1)), ! convert (tree_type, ffecom_expr (arg2))); ! case FFEINTRIN_impNINT: /* Plus IDNINT. */ #if 0 /* ~~ ideally FIX_ROUND_EXPR would be implemented, but it ain't yet */ --- 3993,4011 ---- case FFEINTRIN_impMOD: ! case FFEINTRIN_impAMOD: ! case FFEINTRIN_impDMOD: ! if (bt != FFEINFO_basictypeREAL) ! return ffecom_2 (TRUNC_MOD_EXPR, tree_type, ! convert (tree_type, ffecom_expr (arg1)), ! convert (tree_type, ffecom_expr (arg2))); ! if (kt == FFEINFO_kindtypeREAL1) ! gfrt = FFECOM_gfrtAMOD; ! else if (kt == FFEINFO_kindtypeREAL2) ! gfrt = FFECOM_gfrtDMOD; ! break; ! ! case FFEINTRIN_impNINT: ! case FFEINTRIN_impIDNINT: #if 0 /* ~~ ideally FIX_ROUND_EXPR would be implemented, but it ain't yet */ *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3924,3928 **** #endif ! case FFEINTRIN_impSIGN: /* Plus impDSIGN, impISIGN. */ { tree arg2_tree = ffecom_expr (arg2); --- 4032,4038 ---- #endif ! case FFEINTRIN_impSIGN: ! case FFEINTRIN_impDSIGN: ! case FFEINTRIN_impISIGN: { tree arg2_tree = ffecom_expr (arg2); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 3950,4042 **** return expr_tree; ! case FFEINTRIN_impSIN: /* Plus impCSIN, impCDSIN, impDSIN. */ if (bt == FFEINFO_basictypeCOMPLEX) { if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtCSIN; /* Overlapping result okay. */ else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtCDSIN; /* Overlapping result okay. */ ! else ! { ! assert ("bad SIN COMPLEX kind type" == NULL); ! ix = FFECOM_gfrt; ! } ! } ! else ! { ! if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtL_SIN; ! else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtL_SIN; ! else ! { ! assert ("bad SIN REAL kind type" == NULL); ! ix = FFECOM_gfrt; ! } } ! goto library; /* :::::::::::::::::::: */ ! case FFEINTRIN_impSINH: /* Plus impDSINH. */ ! if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtL_SINH; ! else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtL_SINH; ! else ! { ! assert ("bad SINH kind type" == NULL); ! ix = FFECOM_gfrt; ! } ! goto library; /* :::::::::::::::::::: */ ! case FFEINTRIN_impSQRT: /* Plus impCSQRT, impCDSQRT, impDSQRT. */ if (bt == FFEINFO_basictypeCOMPLEX) { if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtCSQRT; /* Overlapping result okay. */ else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtCDSQRT; /* Overlapping result okay. */ ! else ! { ! assert ("bad SQRT COMPLEX kind type" == NULL); ! ix = FFECOM_gfrt; ! } } ! else ! { ! if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtL_SQRT; ! else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtL_SQRT; ! else ! { ! assert ("bad SQRT REAL kind type" == NULL); ! ix = FFECOM_gfrt; ! } ! } ! goto library; /* :::::::::::::::::::: */ ! ! case FFEINTRIN_impTAN: /* Plus impDTAN. */ ! if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtL_TAN; ! else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtL_TAN; ! else ! { ! assert ("bad TAN kind type" == NULL); ! ix = FFECOM_gfrt; ! } ! goto library; /* :::::::::::::::::::: */ ! case FFEINTRIN_impTANH: /* Plus impDTANH. */ ! if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtL_TANH; ! else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtL_TANH; ! else ! { ! assert ("bad TANH kind type" == NULL); ! ix = FFECOM_gfrt; ! } ! goto library; /* :::::::::::::::::::: */ case FFEINTRIN_impREALPART: --- 4060,4098 ---- return expr_tree; ! case FFEINTRIN_impSIN: ! case FFEINTRIN_impCDSIN: ! case FFEINTRIN_impCSIN: ! case FFEINTRIN_impDSIN: if (bt == FFEINFO_basictypeCOMPLEX) { if (kt == FFEINFO_kindtypeREAL1) ! gfrt = FFECOM_gfrtCSIN; /* Overlapping result okay. */ else if (kt == FFEINFO_kindtypeREAL2) ! gfrt = FFECOM_gfrtCDSIN; /* Overlapping result okay. */ } ! break; ! case FFEINTRIN_impSINH: ! case FFEINTRIN_impDSINH: ! break; ! case FFEINTRIN_impSQRT: ! case FFEINTRIN_impCDSQRT: ! case FFEINTRIN_impCSQRT: ! case FFEINTRIN_impDSQRT: if (bt == FFEINFO_basictypeCOMPLEX) { if (kt == FFEINFO_kindtypeREAL1) ! gfrt = FFECOM_gfrtCSQRT; /* Overlapping result okay. */ else if (kt == FFEINFO_kindtypeREAL2) ! gfrt = FFECOM_gfrtCDSQRT; /* Overlapping result okay. */ } ! break; ! case FFEINTRIN_impTAN: ! case FFEINTRIN_impDTAN: ! case FFEINTRIN_impTANH: ! case FFEINTRIN_impDTANH: ! break; case FFEINTRIN_impREALPART: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4052,4055 **** --- 4108,4112 ---- case FFEINTRIN_impIAND: + case FFEINTRIN_impAND: return ffecom_2 (BIT_AND_EXPR, tree_type, convert (tree_type, *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4059,4062 **** --- 4116,4120 ---- case FFEINTRIN_impIOR: + case FFEINTRIN_impOR: return ffecom_2 (BIT_IOR_EXPR, tree_type, convert (tree_type, *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4066,4069 **** --- 4124,4128 ---- case FFEINTRIN_impIEOR: + case FFEINTRIN_impXOR: return ffecom_2 (BIT_XOR_EXPR, tree_type, convert (tree_type, *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4476,4502 **** return expr_tree; ! case FFEINTRIN_impERF: /* Plus impDERF. */ ! if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtL_ERF; ! else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtL_ERF; ! else ! { ! assert ("bad ERF kind type" == NULL); ! ix = FFECOM_gfrt; ! } ! goto library; /* :::::::::::::::::::: */ ! ! case FFEINTRIN_impERFC: /* Plus impDERFC. */ ! if (kt == FFEINFO_kindtypeREAL1) ! ix = FFECOM_gfrtL_ERFC; ! else if (kt == FFEINFO_kindtypeREAL2) ! ix = FFECOM_gfrtL_ERFC; ! else ! { ! assert ("bad ERFC kind type" == NULL); ! ix = FFECOM_gfrt; ! } ! goto library; /* :::::::::::::::::::: */ case FFEINTRIN_impIARGC: --- 4535,4543 ---- return expr_tree; ! case FFEINTRIN_impDERF: ! case FFEINTRIN_impERF: ! case FFEINTRIN_impDERFC: ! case FFEINTRIN_impERFC: ! break; case FFEINTRIN_impIARGC: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4508,4512 **** return expr_tree; ! case FFEINTRIN_impSIGNAL: { tree arg1_tree; --- 4549,4554 ---- return expr_tree; ! case FFEINTRIN_impSIGNAL_func: ! case FFEINTRIN_impSIGNAL_subr: { tree arg1_tree; *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4524,4528 **** /* 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); --- 4566,4570 ---- /* Pass procedure as a pointer to it, anything else by value. */ if (ffeinfo_kind (ffebld_info (arg2)) == FFEINFO_kindENTITY) ! arg2_tree = convert (integer_type_node, ffecom_expr (arg2)); else arg2_tree = ffecom_ptr_to_expr (arg2); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4542,4549 **** 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); --- 4584,4593 ---- expr_tree ! = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ! ffecom_gfrt_kindtype (gfrt), FALSE, ! ((codegen_imp == FFEINTRIN_impSIGNAL_subr) ? ! NULL_TREE : ! tree_type), arg1_tree, NULL_TREE, NULL, NULL, NULL_TREE, TRUE); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4557,4570 **** return expr_tree; ! case FFEINTRIN_impSYSTEM: ! case FFEINTRIN_impUNLINK: ! case FFEINTRIN_impCHDIR: ! case FFEINTRIN_impFPUT: ! case FFEINTRIN_impFGET: { tree arg1_len = integer_zero_node; tree arg1_tree; tree arg2_tree; - ffecomGfrt gfrt = ffeintrin_gfrt (codegen_imp); ffecom_push_calltemps (); --- 4601,4665 ---- return expr_tree; ! case FFEINTRIN_impALARM: ! { ! tree arg1_tree; ! tree arg2_tree; ! tree arg3_tree; ! ! ffecom_push_calltemps (); ! ! arg1_tree = convert (ffecom_f2c_integer_type_node, ! ffecom_expr (arg1)); ! arg1_tree = ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (arg1_tree)), ! arg1_tree); ! ! /* Pass procedure as a pointer to it, anything else by value. */ ! if (ffeinfo_kind (ffebld_info (arg2)) == FFEINFO_kindENTITY) ! arg2_tree = convert (integer_type_node, 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_ (gfrt), ! ffecom_gfrt_kindtype (gfrt), ! FALSE, ! NULL_TREE, ! arg1_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE); ! ! if (arg3_tree != NULL_TREE) ! expr_tree ! = ffecom_modify (NULL_TREE, arg3_tree, ! convert (TREE_TYPE (arg3_tree), ! expr_tree)); ! } ! return expr_tree; ! ! case FFEINTRIN_impCHDIR_subr: ! case FFEINTRIN_impFDATE_subr: ! case FFEINTRIN_impFGET_subr: ! case FFEINTRIN_impFPUT_subr: ! case FFEINTRIN_impGETCWD_subr: ! case FFEINTRIN_impHOSTNM_subr: ! case FFEINTRIN_impSYSTEM_subr: ! case FFEINTRIN_impUNLINK_subr: { tree arg1_len = integer_zero_node; tree arg1_tree; tree arg2_tree; ffecom_push_calltemps (); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4585,4591 **** expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ! ffecom_gfrt_kind_type_ (gfrt), FALSE, ! ffecom_f2c_integer_type_node, arg1_tree, NULL_TREE, NULL, NULL, NULL_TREE, TRUE); --- 4680,4686 ---- expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ! ffecom_gfrt_kindtype (gfrt), FALSE, ! NULL_TREE, arg1_tree, NULL_TREE, NULL, NULL, NULL_TREE, TRUE); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4610,4615 **** return ! ffecom_call_ (ffecom_gfrt_tree_ (FFECOM_gfrtEXIT), ! ffecom_gfrt_kind_type_ (FFECOM_gfrtEXIT), FALSE, void_type_node, --- 4705,4710 ---- return ! ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ! ffecom_gfrt_kindtype (gfrt), FALSE, void_type_node, *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4619,4643 **** case FFEINTRIN_impFLUSH: if (arg1 == NULL) ! ix = FFECOM_gfrtFLUSH; else ! ix = FFECOM_gfrtFLUSH1; ! goto library; /* :::::::::::::::::::: */ ! case FFEINTRIN_impCHMOD: ! case FFEINTRIN_impLINK: ! case FFEINTRIN_impRENAME: ! case FFEINTRIN_impSYMLNK: { tree arg1_len = integer_zero_node; tree arg1_tree; - tree arg2_len = integer_zero_node; tree arg2_tree; tree arg3_tree; - ffecomGfrt gfrt = ffeintrin_gfrt (codegen_imp); ffecom_push_calltemps (); arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len); ! arg2_tree = ffecom_arg_ptr_to_expr (arg2, &arg2_len); if (arg3 != NULL) arg3_tree = ffecom_expr_rw (arg3); --- 4714,4778 ---- case FFEINTRIN_impFLUSH: if (arg1 == NULL) ! gfrt = FFECOM_gfrtFLUSH; else ! gfrt = FFECOM_gfrtFLUSH1; ! break; ! ! case FFEINTRIN_impCHMOD_subr: ! case FFEINTRIN_impLINK_subr: ! case FFEINTRIN_impRENAME_subr: ! case FFEINTRIN_impSYMLNK_subr: ! { ! tree arg1_len = integer_zero_node; ! tree arg1_tree; ! tree arg2_len = integer_zero_node; ! tree arg2_tree; ! tree arg3_tree; ! ! ffecom_push_calltemps (); ! ! arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len); ! arg2_tree = ffecom_arg_ptr_to_expr (arg2, &arg2_len); ! if (arg3 != NULL) ! arg3_tree = ffecom_expr_rw (arg3); ! else ! arg3_tree = NULL_TREE; ! ! ffecom_pop_calltemps (); ! ! arg1_tree = build_tree_list (NULL_TREE, arg1_tree); ! arg1_len = build_tree_list (NULL_TREE, arg1_len); ! arg2_tree = build_tree_list (NULL_TREE, arg2_tree); ! arg2_len = build_tree_list (NULL_TREE, arg2_len); ! TREE_CHAIN (arg1_tree) = arg2_tree; ! TREE_CHAIN (arg2_tree) = arg1_len; ! TREE_CHAIN (arg1_len) = arg2_len; ! expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ! ffecom_gfrt_kindtype (gfrt), ! FALSE, ! NULL_TREE, ! arg1_tree, ! NULL_TREE, NULL, NULL, NULL_TREE, TRUE); ! if (arg3_tree != NULL_TREE) ! expr_tree = ffecom_modify (NULL_TREE, arg3_tree, ! convert (TREE_TYPE (arg3_tree), ! expr_tree)); ! } ! return expr_tree; ! case FFEINTRIN_impLSTAT_subr: ! case FFEINTRIN_impSTAT_subr: { tree arg1_len = integer_zero_node; tree arg1_tree; tree arg2_tree; tree arg3_tree; ffecom_push_calltemps (); arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len); ! ! arg2_tree = ffecom_ptr_to_expr (arg2); ! if (arg3 != NULL) arg3_tree = ffecom_expr_rw (arg3); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4650,4661 **** arg1_len = build_tree_list (NULL_TREE, arg1_len); arg2_tree = build_tree_list (NULL_TREE, arg2_tree); - arg2_len = build_tree_list (NULL_TREE, arg2_len); TREE_CHAIN (arg1_tree) = arg2_tree; TREE_CHAIN (arg2_tree) = arg1_len; - TREE_CHAIN (arg1_len) = arg2_len; expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ! ffecom_gfrt_kind_type_ (gfrt), FALSE, ! ffecom_f2c_integer_type_node, arg1_tree, NULL_TREE, NULL, NULL, NULL_TREE, TRUE); --- 4785,4794 ---- arg1_len = build_tree_list (NULL_TREE, arg1_len); arg2_tree = build_tree_list (NULL_TREE, arg2_tree); TREE_CHAIN (arg1_tree) = arg2_tree; TREE_CHAIN (arg2_tree) = arg1_len; expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ! ffecom_gfrt_kindtype (gfrt), FALSE, ! NULL_TREE, arg1_tree, NULL_TREE, NULL, NULL, NULL_TREE, TRUE); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4667,4672 **** return expr_tree; ! case FFEINTRIN_impFGETC: ! case FFEINTRIN_impFPUTC: { tree arg1_tree; --- 4800,4805 ---- return expr_tree; ! case FFEINTRIN_impFGETC_subr: ! case FFEINTRIN_impFPUTC_subr: { tree arg1_tree; *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4674,4683 **** tree arg2_len = integer_zero_node; tree arg3_tree; - ffecomGfrt gfrt = ffeintrin_gfrt (codegen_imp); ffecom_push_calltemps (); ! arg1_tree = convert (ffecom_f2c_ptr_to_integer_type_node, ! ffecom_ptr_to_expr (arg1)); arg2_tree = ffecom_arg_ptr_to_expr (arg2, &arg2_len); arg3_tree = ffecom_expr_rw (arg3); --- 4807,4819 ---- tree arg2_len = integer_zero_node; tree arg3_tree; ffecom_push_calltemps (); ! arg1_tree = convert (ffecom_f2c_integer_type_node, ! ffecom_expr (arg1)); ! arg1_tree = ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (arg1_tree)), ! arg1_tree); ! arg2_tree = ffecom_arg_ptr_to_expr (arg2, &arg2_len); arg3_tree = ffecom_expr_rw (arg3); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4692,4698 **** expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ! ffecom_gfrt_kind_type_ (gfrt), FALSE, ! ffecom_f2c_integer_type_node, arg1_tree, NULL_TREE, NULL, NULL, NULL_TREE, TRUE); --- 4828,4834 ---- expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ! ffecom_gfrt_kindtype (gfrt), FALSE, ! NULL_TREE, arg1_tree, NULL_TREE, NULL, NULL, NULL_TREE, TRUE); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4703,4719 **** return expr_tree; ! case FFEINTRIN_impKILL: { tree arg1_tree; tree arg2_tree; tree arg3_tree; - ffecomGfrt gfrt = ffeintrin_gfrt (codegen_imp); ffecom_push_calltemps (); ! arg1_tree = convert (ffecom_f2c_ptr_to_integer_type_node, ! ffecom_ptr_to_expr (arg1)); arg2_tree = convert (ffecom_f2c_ptr_to_integer_type_node, ffecom_ptr_to_expr (arg2)); if (arg3 == NULL) arg3_tree = NULL_TREE; --- 4839,4903 ---- return expr_tree; ! case FFEINTRIN_impFSTAT_subr: { tree arg1_tree; tree arg2_tree; tree arg3_tree; ffecom_push_calltemps (); ! arg1_tree = convert (ffecom_f2c_integer_type_node, ! ffecom_expr (arg1)); ! arg1_tree = ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (arg1_tree)), ! arg1_tree); ! arg2_tree = convert (ffecom_f2c_ptr_to_integer_type_node, ffecom_ptr_to_expr (arg2)); + + if (arg3 == NULL) + arg3_tree = NULL_TREE; + else + arg3_tree = ffecom_expr_rw (arg3); + + ffecom_pop_calltemps (); + + arg1_tree = build_tree_list (NULL_TREE, arg1_tree); + arg2_tree = build_tree_list (NULL_TREE, arg2_tree); + TREE_CHAIN (arg1_tree) = arg2_tree; + expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), + ffecom_gfrt_kindtype (gfrt), + FALSE, + NULL_TREE, + arg1_tree, + NULL_TREE, NULL, NULL, NULL_TREE, TRUE); + if (arg3_tree != NULL_TREE) { + expr_tree = ffecom_modify (NULL_TREE, arg3_tree, + convert (TREE_TYPE (arg3_tree), + expr_tree)); + } + } + return expr_tree; + + case FFEINTRIN_impKILL_subr: + { + tree arg1_tree; + tree arg2_tree; + tree arg3_tree; + + ffecom_push_calltemps (); + + arg1_tree = convert (ffecom_f2c_integer_type_node, + ffecom_expr (arg1)); + arg1_tree = ffecom_1 (ADDR_EXPR, + build_pointer_type (TREE_TYPE (arg1_tree)), + arg1_tree); + + arg2_tree = convert (ffecom_f2c_integer_type_node, + ffecom_expr (arg2)); + arg2_tree = ffecom_1 (ADDR_EXPR, + build_pointer_type (TREE_TYPE (arg2_tree)), + arg2_tree); + if (arg3 == NULL) arg3_tree = NULL_TREE; *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4727,4733 **** TREE_CHAIN (arg1_tree) = arg2_tree; expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ! ffecom_gfrt_kind_type_ (gfrt), FALSE, ! ffecom_f2c_integer_type_node, arg1_tree, NULL_TREE, NULL, NULL, NULL_TREE, TRUE); --- 4911,4917 ---- TREE_CHAIN (arg1_tree) = arg2_tree; expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ! ffecom_gfrt_kindtype (gfrt), FALSE, ! NULL_TREE, arg1_tree, NULL_TREE, NULL, NULL, NULL_TREE, TRUE); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4740,4743 **** --- 4924,4964 ---- return expr_tree; + case FFEINTRIN_impCTIME_subr: + case FFEINTRIN_impTTYNAM_subr: + { + 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); + + arg2_tree = convert (((gfrt == FFEINTRIN_impCTIME_subr) ? + ffecom_f2c_longint_type_node : + ffecom_f2c_integer_type_node), + ffecom_expr (arg2)); + arg2_tree = ffecom_1 (ADDR_EXPR, + build_pointer_type (TREE_TYPE (arg2_tree)), + arg2_tree); + + ffecom_pop_calltemps (); + + arg1_tree = build_tree_list (NULL_TREE, arg1_tree); + arg1_len = build_tree_list (NULL_TREE, arg1_len); + arg2_tree = build_tree_list (NULL_TREE, arg2_tree); + TREE_CHAIN (arg1_len) = arg2_tree; + TREE_CHAIN (arg1_tree) = arg1_len; + + expr_tree + = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), + ffecom_gfrt_kindtype (gfrt), + FALSE, + NULL_TREE, + arg1_tree, + NULL_TREE, NULL, NULL, NULL_TREE, TRUE); + } + return expr_tree; + case FFEINTRIN_impIRAND: case FFEINTRIN_impRAND: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4745,4781 **** { tree arg1_tree; - ffecomGfrt gfrt = ffeintrin_gfrt (codegen_imp); if (arg1 == NULL) ! arg1_tree = ffecom_1 (ADDR_EXPR, ! build_pointer_type ! (ffecom_integer_type_node), ! ffecom_integer_zero_node); else ! arg1_tree = ffecom_ptr_to_expr (arg1); ! arg1_tree = convert (ffecom_f2c_ptr_to_integer_type_node, arg1_tree); arg1_tree = build_tree_list (NULL_TREE, arg1_tree); ! return ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ! ffecom_gfrt_kind_type_ (gfrt), ! FALSE, ! ((codegen_imp == FFEINTRIN_impIRAND) ? ! ffecom_f2c_integer_type_node : ! ffecom_f2c_doublereal_type_node), ! arg1_tree, ! dest_tree, dest, dest_used, ! NULL_TREE, TRUE); } ! case FFEINTRIN_impUMASK: { tree arg1_tree; tree arg2_tree; - ffecomGfrt gfrt = ffeintrin_gfrt (codegen_imp); ffecom_push_calltemps (); ! arg1_tree = convert (ffecom_f2c_ptr_to_integer_type_node, ! ffecom_ptr_to_expr (arg1)); if (arg2 == NULL) arg2_tree = NULL_TREE; --- 4966,5007 ---- { tree arg1_tree; if (arg1 == NULL) ! arg1_tree = ffecom_integer_zero_node; else ! arg1_tree = ffecom_expr (arg1); ! arg1_tree = convert (ffecom_f2c_integer_type_node, arg1_tree); + arg1_tree = ffecom_1 (ADDR_EXPR, + build_pointer_type (TREE_TYPE (arg1_tree)), + arg1_tree); arg1_tree = build_tree_list (NULL_TREE, arg1_tree); ! ! expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ! ffecom_gfrt_kindtype (gfrt), ! FALSE, ! ((codegen_imp == FFEINTRIN_impIRAND) ? ! ffecom_f2c_integer_type_node : ! ffecom_f2c_doublereal_type_node), ! arg1_tree, ! dest_tree, dest, dest_used, ! NULL_TREE, TRUE); } + return expr_tree; ! case FFEINTRIN_impFTELL_subr: ! case FFEINTRIN_impUMASK_subr: { tree arg1_tree; tree arg2_tree; ffecom_push_calltemps (); ! arg1_tree = convert (ffecom_f2c_integer_type_node, ! ffecom_expr (arg1)); ! arg1_tree = ffecom_1 (ADDR_EXPR, ! build_pointer_type (TREE_TYPE (arg1_tree)), ! arg1_tree); ! if (arg2 == NULL) arg2_tree = NULL_TREE; *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4786,4792 **** expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ! ffecom_gfrt_kind_type_ (gfrt), FALSE, ! ffecom_f2c_integer_type_node, build_tree_list (NULL_TREE, arg1_tree), NULL_TREE, NULL, NULL, NULL_TREE, --- 5012,5018 ---- expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ! ffecom_gfrt_kindtype (gfrt), FALSE, ! NULL_TREE, build_tree_list (NULL_TREE, arg1_tree), NULL_TREE, NULL, NULL, NULL_TREE, *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4800,4807 **** return expr_tree; ! case FFEINTRIN_impSECONDSUBR: { tree arg1_tree; - ffecomGfrt gfrt = ffeintrin_gfrt (codegen_imp); ffecom_push_calltemps (); --- 5026,5033 ---- return expr_tree; ! case FFEINTRIN_impCPU_TIME: ! case FFEINTRIN_impSECOND_subr: { tree arg1_tree; ffecom_push_calltemps (); *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4813,4817 **** expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ! ffecom_gfrt_kind_type_ (gfrt), FALSE, NULL_TREE, --- 5039,5043 ---- expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ! ffecom_gfrt_kindtype (gfrt), FALSE, NULL_TREE, *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4826,4829 **** --- 5052,5082 ---- return expr_tree; + case FFEINTRIN_impDTIME_subr: + case FFEINTRIN_impETIME_subr: + { + tree arg1_tree; + tree arg2_tree; + + ffecom_push_calltemps (); + + arg1_tree = ffecom_expr_rw (arg1); + + arg2_tree = ffecom_ptr_to_expr (arg2); + + ffecom_pop_calltemps (); + + expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt), + ffecom_gfrt_kindtype (gfrt), + FALSE, + NULL_TREE, + build_tree_list (NULL_TREE, arg2_tree), + NULL_TREE, NULL, NULL, NULL_TREE, + TRUE); + expr_tree = ffecom_modify (NULL_TREE, arg1_tree, + convert (TREE_TYPE (arg1_tree), + expr_tree)); + } + return expr_tree; + /* Straightforward calls of libf2c routines: */ case FFEINTRIN_impABORT: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4835,4838 **** --- 5088,5093 ---- case FFEINTRIN_impBESY1: case FFEINTRIN_impBESYN: + case FFEINTRIN_impCHDIR_func: + case FFEINTRIN_impCHMOD_func: case FFEINTRIN_impDATE: case FFEINTRIN_impDBESJ0: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4842,4854 **** case FFEINTRIN_impDBESY1: case FFEINTRIN_impDBESYN: ! case FFEINTRIN_impDTIME: ! case FFEINTRIN_impETIME: case FFEINTRIN_impFNUM: ! case FFEINTRIN_impFSTAT: ! case FFEINTRIN_impFTELL: case FFEINTRIN_impFSEEK: ! case FFEINTRIN_impGETARG: case FFEINTRIN_impGERROR: ! case FFEINTRIN_impGETCWD: case FFEINTRIN_impGETENV: case FFEINTRIN_impGETGID: --- 5097,5113 ---- case FFEINTRIN_impDBESY1: case FFEINTRIN_impDBESYN: ! case FFEINTRIN_impDTIME_func: ! case FFEINTRIN_impETIME_func: ! case FFEINTRIN_impFGETC_func: ! case FFEINTRIN_impFGET_func: case FFEINTRIN_impFNUM: ! case FFEINTRIN_impFPUTC_func: ! case FFEINTRIN_impFPUT_func: case FFEINTRIN_impFSEEK: ! case FFEINTRIN_impFSTAT_func: ! case FFEINTRIN_impFTELL_func: case FFEINTRIN_impGERROR: ! case FFEINTRIN_impGETARG: ! case FFEINTRIN_impGETCWD_func: case FFEINTRIN_impGETENV: case FFEINTRIN_impGETGID: *************** ffecom_expr_intrinsic_ (ffebld expr, tre *** 4857,4902 **** case FFEINTRIN_impGETUID: case FFEINTRIN_impGMTIME: ! case FFEINTRIN_impHOSTNM: ! case FFEINTRIN_impIDATE: ! case FFEINTRIN_impIDATEVXT: case FFEINTRIN_impIERRNO: case FFEINTRIN_impISATTY: case FFEINTRIN_impITIME: case FFEINTRIN_impLNBLNK: ! case FFEINTRIN_impLSTAT: case FFEINTRIN_impLTIME: case FFEINTRIN_impMCLOCK: case FFEINTRIN_impPERROR: case FFEINTRIN_impSECNDS: ! case FFEINTRIN_impSECONDFUNC: case FFEINTRIN_impSLEEP: case FFEINTRIN_impSRAND: ! case FFEINTRIN_impSTAT: case FFEINTRIN_impSYSTEM_CLOCK: ! case FFEINTRIN_impTIME: ! case FFEINTRIN_impTIMEVXT: break; ! default: fprintf (stderr, "No %s implementation.\n", ! ffeintrin_name_implementation (ffeintrin_codegen_imp ! (ffebld_symter_implementation (ffebld_left (expr))))); assert ("unimplemented intrinsic" == NULL); return error_mark_node; } ! ix = ffeintrin_gfrt (ffebld_symter_implementation (ffebld_left (expr))); ! ! library: /* :::::::::::::::::::: */ ! ! assert (ix != FFECOM_gfrt); /* Must have an implementation! */ ffecom_push_calltemps (); ! expr_tree = ffecom_arglist_expr_ (ffecom_gfrt_args_ (ix), ffebld_right (expr)); ffecom_pop_calltemps (); ! 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, --- 5116,5169 ---- case FFEINTRIN_impGETUID: case FFEINTRIN_impGMTIME: ! case FFEINTRIN_impHOSTNM_func: ! case FFEINTRIN_impIDATE_unix: ! case FFEINTRIN_impIDATE_vxt: case FFEINTRIN_impIERRNO: case FFEINTRIN_impISATTY: case FFEINTRIN_impITIME: + case FFEINTRIN_impKILL_func: + case FFEINTRIN_impLINK_func: case FFEINTRIN_impLNBLNK: ! case FFEINTRIN_impLSTAT_func: case FFEINTRIN_impLTIME: + case FFEINTRIN_impMCLOCK8: case FFEINTRIN_impMCLOCK: case FFEINTRIN_impPERROR: + case FFEINTRIN_impRENAME_func: case FFEINTRIN_impSECNDS: ! case FFEINTRIN_impSECOND_func: case FFEINTRIN_impSLEEP: case FFEINTRIN_impSRAND: ! case FFEINTRIN_impSTAT_func: ! case FFEINTRIN_impSYMLNK_func: case FFEINTRIN_impSYSTEM_CLOCK: ! case FFEINTRIN_impSYSTEM_func: ! case FFEINTRIN_impTIME8: ! case FFEINTRIN_impTIME_unix: ! case FFEINTRIN_impTIME_vxt: ! case FFEINTRIN_impUMASK_func: ! case FFEINTRIN_impUNLINK_func: break; ! case FFEINTRIN_impCTIME_func: /* CHARACTER functions not handled here. */ ! case FFEINTRIN_impFDATE_func: /* CHARACTER functions not handled here. */ ! case FFEINTRIN_impTTYNAM_func: /* CHARACTER functions not handled here. */ ! case FFEINTRIN_impNONE: ! case FFEINTRIN_imp: /* Hush up gcc warning. */ fprintf (stderr, "No %s implementation.\n", ! ffeintrin_name_implementation (ffebld_symter_implementation (ffebld_left (expr)))); assert ("unimplemented intrinsic" == NULL); return error_mark_node; } ! assert (gfrt != FFECOM_gfrt); /* Must have an implementation! */ ffecom_push_calltemps (); ! expr_tree = ffecom_arglist_expr_ (ffecom_gfrt_args_ (gfrt), ffebld_right (expr)); ffecom_pop_calltemps (); ! return ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ffecom_gfrt_kindtype (gfrt), ! (ffe_is_f2c_library () && ffecom_gfrt_complex_[gfrt]), tree_type, expr_tree, dest_tree, dest, dest_used, *************** ffecom_finish_global_ (ffeglobal global) *** 6283,6287 **** cbt = ffeglobal_hook (global); if ((cbt == NULL_TREE) ! || !ffeglobal_have_size (global)) return global; /* No need to make common, never ref'd. */ --- 6550,6554 ---- cbt = ffeglobal_hook (global); if ((cbt == NULL_TREE) ! || !ffeglobal_common_have_size (global)) return global; /* No need to make common, never ref'd. */ *************** ffecom_finish_global_ (ffeglobal global) *** 6292,6296 **** /* Give the array a size now. */ ! size = build_int_2 (ffeglobal_size (global), 0); cbtype = TREE_TYPE (cbt); --- 6559,6563 ---- /* Give the array a size now. */ ! size = build_int_2 (ffeglobal_common_size (global), 0); cbtype = TREE_TYPE (cbt); *************** ffecom_finish_symbol_transform_ (ffesymb *** 6332,6337 **** && ((ffesymbol_kind (s) != FFEINFO_kindNONE) || ((ffesymbol_where (s) != FFEINFO_whereNONE) ! && (ffesymbol_where (s) != FFEINFO_whereINTRINSIC)))) ! /* Not transformed, and not CHARACTER*(*). */ s = ffecom_sym_transform_ (s); --- 6599,6607 ---- && ((ffesymbol_kind (s) != FFEINFO_kindNONE) || ((ffesymbol_where (s) != FFEINFO_whereNONE) ! && (ffesymbol_where (s) != FFEINFO_whereINTRINSIC))) ! && (ffesymbol_where (s) != FFEINFO_whereDUMMY)) ! /* Not transformed, and not CHARACTER*(*), and not a dummy ! argument, which can happen only if the entry point names ! it "rides in on" are all invalidated for other reasons. */ s = ffecom_sym_transform_ (s); *************** ffecom_gen_sfuncdef_ (ffesymbol s, ffein *** 6594,6608 **** #if FFECOM_targetCURRENT == FFECOM_targetGCC - static ffeinfoKindtype - ffecom_gfrt_kind_type_ (ffecomGfrt ix) - { - if (ffecom_gfrt_[ix] == NULL_TREE) - ffecom_make_gfrt_ (ix); - - return ffecom_gfrt_kt_[ix]; - } - - #endif - #if FFECOM_targetCURRENT == FFECOM_targetGCC static char * ffecom_gfrt_args_ (ffecomGfrt ix) --- 6864,6867 ---- *************** ffecom_init_zero_ (tree decl) *** 6635,6642 **** tree type = TREE_TYPE (decl); - if (TREE_CODE (type) == RECORD_TYPE - || TREE_CODE (type) == UNION_TYPE) - assert ("No -finit-local-zero on structs/unions!!" == NULL); - if (incremental) { --- 6894,6897 ---- *************** ffecom_init_zero_ (tree decl) *** 6654,6657 **** --- 6909,6914 ---- if ((TREE_CODE (type) != ARRAY_TYPE) + && (TREE_CODE (type) != RECORD_TYPE) + && (TREE_CODE (type) != UNION_TYPE) && !incremental) init = convert (type, integer_zero_node); *************** ffecom_make_gfrt_ (ffecomGfrt ix) *** 7157,7161 **** tree t; tree ttype; - ffeinfoKindtype kt; push_obstacks_nochange (); --- 7414,7417 ---- *************** ffecom_make_gfrt_ (ffecomGfrt ix) *** 7166,7228 **** case FFECOM_rttypeVOID_: ttype = void_type_node; - kt = FFEINFO_kindtypeNONE; break; ! case FFECOM_rttypeINT_: ! ttype = integer_type_node; ! kt = FFEINFO_kindtypeINTEGER1; break; case FFECOM_rttypeINTEGER_: ttype = ffecom_f2c_integer_type_node; - kt = FFEINFO_kindtypeINTEGER1; break; case FFECOM_rttypeLONGINT_: ttype = ffecom_f2c_longint_type_node; - kt = FFEINFO_kindtypeINTEGER4; break; case FFECOM_rttypeLOGICAL_: ttype = ffecom_f2c_logical_type_node; - kt = FFEINFO_kindtypeLOGICAL1; break; ! case FFECOM_rttypeREAL_: ! ttype = ffecom_f2c_real_type_node; ! kt = FFEINFO_kindtypeREAL1; break; ! case FFECOM_rttypeCOMPLEX_: ttype = ffecom_f2c_complex_type_node; - kt = FFEINFO_kindtypeREAL1; break; case FFECOM_rttypeDOUBLE_: ttype = double_type_node; - kt = FFEINFO_kindtypeREAL2; break; ! case FFECOM_rttypeDBLCMPLX_: ttype = ffecom_f2c_doublecomplex_type_node; - kt = FFEINFO_kindtypeREAL2; break; case FFECOM_rttypeCHARACTER_: ttype = void_type_node; - kt = FFEINFO_kindtypeCHARACTER1; break; default: ttype = NULL; - kt = FFEINFO_kindtypeANY; assert ("bad rttype" == NULL); break; } - ffecom_gfrt_kt_[ix] = kt; - - if (ffecom_gfrt_complex_[ix] && ffe_is_f2c_library ()) - ttype = void_type_node; ttype = build_function_type (ttype, NULL_TREE); t = build_decl (FUNCTION_DECL, --- 7422,7485 ---- case FFECOM_rttypeVOID_: ttype = void_type_node; break; ! case FFECOM_rttypeFTNINT_: ! ttype = ffecom_f2c_ftnint_type_node; break; case FFECOM_rttypeINTEGER_: ttype = ffecom_f2c_integer_type_node; break; case FFECOM_rttypeLONGINT_: ttype = ffecom_f2c_longint_type_node; break; case FFECOM_rttypeLOGICAL_: ttype = ffecom_f2c_logical_type_node; break; ! case FFECOM_rttypeREAL_F2C_: ! ttype = double_type_node; ! break; ! ! case FFECOM_rttypeREAL_GNU_: ! ttype = float_type_node; ! break; ! ! case FFECOM_rttypeCOMPLEX_F2C_: ! ttype = void_type_node; break; ! case FFECOM_rttypeCOMPLEX_GNU_: ttype = ffecom_f2c_complex_type_node; break; case FFECOM_rttypeDOUBLE_: ttype = double_type_node; break; ! case FFECOM_rttypeDOUBLEREAL_: ! ttype = ffecom_f2c_doublereal_type_node; ! break; ! ! case FFECOM_rttypeDBLCMPLX_F2C_: ! ttype = void_type_node; ! break; ! ! case FFECOM_rttypeDBLCMPLX_GNU_: ttype = ffecom_f2c_doublecomplex_type_node; break; case FFECOM_rttypeCHARACTER_: ttype = void_type_node; break; default: ttype = NULL; assert ("bad rttype" == NULL); break; } ttype = build_function_type (ttype, NULL_TREE); t = build_decl (FUNCTION_DECL, *************** ffecom_member_phase2_ (ffestorag mst, ff *** 7283,7286 **** --- 7540,7545 ---- ffesymbol_basictype (s), ffesymbol_kindtype (s)); + if (type == error_mark_node) + return; t = build_decl (VAR_DECL, *************** ffecom_start_progunit_ () *** 7405,7408 **** --- 7664,7668 ---- ffeglobal g; ffeglobalType gt; + ffeglobalType egt = FFEGLOBAL_type; bool charfunc; bool cmplxfunc; *************** ffecom_start_progunit_ () *** 7456,7459 **** --- 7716,7720 ---- case FFEINFO_kindFUNCTION: gt = FFEGLOBAL_typeFUNC; + egt = FFEGLOBAL_typeEXT; bt = ffesymbol_basictype (fn); kt = ffesymbol_kindtype (fn); *************** ffecom_start_progunit_ () *** 7492,7495 **** --- 7753,7757 ---- case FFEINFO_kindSUBROUTINE: gt = FFEGLOBAL_typeSUBR; + egt = FFEGLOBAL_typeEXT; bt = FFEINFO_basictypeNONE; kt = FFEINFO_kindtypeNONE; *************** ffecom_start_progunit_ () *** 7533,7537 **** if (!altentries && ((g = ffesymbol_global (fn)) != NULL) ! && (ffeglobal_type (g) == gt)) { ffeglobal_set_hook (g, current_function_decl); --- 7795,7800 ---- if (!altentries && ((g = ffesymbol_global (fn)) != NULL) ! && ((ffeglobal_type (g) == gt) ! || (ffeglobal_type (g) == egt))) { ffeglobal_set_hook (g, current_function_decl); *************** ffecom_sym_transform_ (ffesymbol s) *** 7693,7698 **** if (((g = ffesymbol_global (s)) != NULL) && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR) ! || (ffeglobal_type (g) == FFEGLOBAL_typeFUNC)) ! && (ffeglobal_hook (g) != NULL_TREE)) { t = ffeglobal_hook (g); --- 7956,7963 ---- if (((g = ffesymbol_global (s)) != NULL) && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR) ! || (ffeglobal_type (g) == FFEGLOBAL_typeFUNC) ! || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)) ! && (ffeglobal_hook (g) != NULL_TREE) ! && ffe_is_globals ()) { t = ffeglobal_hook (g); *************** ffecom_sym_transform_ (ffesymbol s) *** 7700,7704 **** } ! yes = suspend_momentary (); t = build_decl (FUNCTION_DECL, --- 7965,7970 ---- } ! push_obstacks_nochange (); ! end_temporary_allocation (); t = build_decl (FUNCTION_DECL, *************** ffecom_sym_transform_ (ffesymbol s) *** 7713,7721 **** if ((g != NULL) && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR) ! || (ffeglobal_type (g) == FFEGLOBAL_typeFUNC))) ffeglobal_set_hook (g, t); ! if (current_function_decl != NULL_TREE) ! resume_momentary (yes); break; --- 7979,7988 ---- if ((g != NULL) && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR) ! || (ffeglobal_type (g) == FFEGLOBAL_typeFUNC) ! || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))) ffeglobal_set_hook (g, t); ! resume_temporary_allocation (); ! pop_obstacks (); break; *************** ffecom_sym_transform_ (ffesymbol s) *** 7756,7759 **** --- 8023,8032 ---- resume_momentary (yes); + if (type == error_mark_node) + { + t = error_mark_node; + break; + } + if ((st != NULL) && (ffestorag_parent (st) != NULL)) *************** ffecom_sym_transform_ (ffesymbol s) *** 7818,7822 **** != FFEINFO_kindBLOCKDATA) && (ffesymbol_is_save (s) || ffe_is_saveall ()))) ! TREE_STATIC (t) = 1; /* SAVEd in proc, make static. */ else TREE_STATIC (t) = 0; /* No need to make static. */ --- 8091,8095 ---- != FFEINFO_kindBLOCKDATA) && (ffesymbol_is_save (s) || ffe_is_saveall ()))) ! TREE_STATIC (t) = !ffesymbol_attr (s, FFESYMBOL_attrADJUSTABLE); else TREE_STATIC (t) = 0; /* No need to make static. */ *************** ffecom_sym_transform_ (ffesymbol s) *** 7846,7853 **** finish_decl (t, initexpr, FALSE); ! if (st != NULL) ! assert (ffestorag_size (st) * BITS_PER_UNIT ! == (ffetargetOffset) ! TREE_INT_CST_LOW (DECL_SIZE (t))); resume_momentary (yes); --- 8119,8132 ---- finish_decl (t, initexpr, FALSE); ! if ((st != NULL) && (DECL_SIZE (t) != error_mark_node)) ! { ! tree size_tree; ! ! size_tree = size_binop (CEIL_DIV_EXPR, ! DECL_SIZE (t), ! size_int (BITS_PER_UNIT)); ! assert (TREE_INT_CST_HIGH (size_tree) == 0); ! assert (TREE_INT_CST_LOW (size_tree) == ffestorag_size (st)); ! } resume_momentary (yes); *************** ffecom_sym_transform_ (ffesymbol s) *** 7941,7947 **** --- 8220,8230 ---- if (bt == FFEINFO_basictypeCHARACTER) tlen = ffecom_char_enhance_arg_ (&type, s); + type = ffecom_check_size_overflow_ (s, type, TRUE); for (dl = ffesymbol_dims (s); dl != NULL; dl = ffebld_trail (dl)) { + if (type == error_mark_node) + break; + dim = ffebld_head (dl); assert (ffebld_op (dim) == FFEBLD_opBOUNDS); *************** ffecom_sym_transform_ (ffesymbol s) *** 8133,8139 **** build_range_type (ffecom_integer_type_node, low, high)); } if ((ffesymbol_sfdummyparent (s) == NULL) ! || (ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER)) { type = build_pointer_type (type); --- 8416,8430 ---- build_range_type (ffecom_integer_type_node, low, high)); + type = ffecom_check_size_overflow_ (s, type, TRUE); } + + if (type == error_mark_node) + { + t = error_mark_node; + break; + } + if ((ffesymbol_sfdummyparent (s) == NULL) ! || (ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER)) { type = build_pointer_type (type); *************** ffecom_sym_transform_ (ffesymbol s) *** 8258,8262 **** if ((ct == NULL_TREE) ! || (st == NULL)) t = error_mark_node; else --- 8549,8554 ---- if ((ct == NULL_TREE) ! || (st == NULL) ! || (type == error_mark_node)) t = error_mark_node; else *************** ffecom_sym_transform_ (ffesymbol s) *** 8321,8326 **** if (((g = ffesymbol_global (s)) != NULL) ! && (ffeglobal_type (g) == FFEGLOBAL_typeFUNC) ! && (ffeglobal_hook (g) != NULL_TREE)) { t = ffeglobal_hook (g); --- 8613,8620 ---- if (((g = ffesymbol_global (s)) != NULL) ! && ((ffeglobal_type (g) == FFEGLOBAL_typeFUNC) ! || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)) ! && (ffeglobal_hook (g) != NULL_TREE) ! && ffe_is_globals ()) { t = ffeglobal_hook (g); *************** ffecom_sym_transform_ (ffesymbol s) *** 8328,8332 **** } ! yes = suspend_momentary (); if (ffesymbol_is_f2c (s) --- 8622,8627 ---- } ! push_obstacks_nochange (); ! end_temporary_allocation (); if (ffesymbol_is_f2c (s) *************** ffecom_sym_transform_ (ffesymbol s) *** 8346,8354 **** if ((g != NULL) ! && (ffeglobal_type (g) == FFEGLOBAL_typeFUNC)) ffeglobal_set_hook (g, t); ! if (current_function_decl != NULL_TREE) ! resume_momentary (yes); break; --- 8641,8650 ---- if ((g != NULL) ! && ((ffeglobal_type (g) == FFEGLOBAL_typeFUNC) ! || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))) ffeglobal_set_hook (g, t); ! resume_temporary_allocation (); ! pop_obstacks (); break; *************** ffecom_sym_transform_ (ffesymbol s) *** 8404,8409 **** if (((g = ffesymbol_global (s)) != NULL) ! && (ffeglobal_type (g) == FFEGLOBAL_typeSUBR) ! && (ffeglobal_hook (g) != NULL_TREE)) { t = ffeglobal_hook (g); --- 8700,8707 ---- if (((g = ffesymbol_global (s)) != NULL) ! && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR) ! || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)) ! && (ffeglobal_hook (g) != NULL_TREE) ! && ffe_is_globals ()) { t = ffeglobal_hook (g); *************** ffecom_sym_transform_ (ffesymbol s) *** 8411,8415 **** } ! yes = suspend_momentary (); t = build_decl (FUNCTION_DECL, --- 8709,8714 ---- } ! push_obstacks_nochange (); ! end_temporary_allocation (); t = build_decl (FUNCTION_DECL, *************** ffecom_sym_transform_ (ffesymbol s) *** 8423,8431 **** if ((g != NULL) ! && (ffeglobal_type (g) == FFEGLOBAL_typeSUBR)) ffeglobal_set_hook (g, t); ! if (current_function_decl != NULL_TREE) ! resume_momentary (yes); break; --- 8722,8731 ---- if ((g != NULL) ! && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR) ! || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))) ffeglobal_set_hook (g, t); ! resume_temporary_allocation (); ! pop_obstacks (); break; *************** ffecom_sym_transform_ (ffesymbol s) *** 8496,8500 **** assert (!ffecom_transform_only_dummies_); ! yes = suspend_momentary (); t = build_decl (FUNCTION_DECL, --- 8796,8801 ---- assert (!ffecom_transform_only_dummies_); ! push_obstacks_nochange (); ! end_temporary_allocation (); t = build_decl (FUNCTION_DECL, *************** ffecom_sym_transform_ (ffesymbol s) *** 8507,8512 **** finish_decl (t, NULL_TREE, FALSE); ! if (current_function_decl != NULL_TREE) ! resume_momentary (yes); break; --- 8808,8813 ---- finish_decl (t, NULL_TREE, FALSE); ! resume_temporary_allocation (); ! pop_obstacks (); break; *************** ffecom_transform_common_ (ffesymbol s) *** 8774,8777 **** --- 9075,9081 ---- ffeglobal_size_common (s, ffestorag_size (st)); + if (!ffeglobal_common_init (g)) + is_init = FALSE; /* No explicit init, don't let erroneous joins init. */ + cbt = ffeglobal_hook (g); *************** ffecom_transform_common_ (ffesymbol s) *** 8815,8819 **** integer_one_node, build_int_2 ! (ffeglobal_size (g), 0))); else --- 9119,9123 ---- integer_one_node, build_int_2 ! (ffeglobal_common_size (g), 0))); else *************** ffecom_transform_common_ (ffesymbol s) *** 8860,8868 **** if (init) { assert (DECL_SIZE (cbt) != NULL_TREE); assert (TREE_CODE (DECL_SIZE (cbt)) == INTEGER_CST); ! assert (TREE_INT_CST_HIGH (DECL_SIZE (cbt)) == 0); ! assert (TREE_INT_CST_LOW (DECL_SIZE (cbt)) ! == (ffeglobal_size (g) * BITS_PER_UNIT)); } --- 9164,9176 ---- if (init) { + tree size_tree; + assert (DECL_SIZE (cbt) != NULL_TREE); assert (TREE_CODE (DECL_SIZE (cbt)) == INTEGER_CST); ! size_tree = size_binop (CEIL_DIV_EXPR, ! DECL_SIZE (cbt), ! size_int (BITS_PER_UNIT)); ! assert (TREE_INT_CST_HIGH (size_tree) == 0); ! assert (TREE_INT_CST_LOW (size_tree) == ffeglobal_common_size (g)); } *************** ffecom_transform_equiv_ (ffestorag eqst) *** 8978,8983 **** ffestorag_set_init (eqst, ffebld_new_any ()); ! assert (ffestorag_size (eqst) * BITS_PER_UNIT ! == (ffetargetOffset) TREE_INT_CST_LOW (DECL_SIZE (eqt))); ffestorag_set_hook (eqst, eqt); --- 9286,9298 ---- ffestorag_set_init (eqst, ffebld_new_any ()); ! { ! tree size_tree; ! ! size_tree = size_binop (CEIL_DIV_EXPR, ! DECL_SIZE (eqt), ! size_int (BITS_PER_UNIT)); ! assert (TREE_INT_CST_HIGH (size_tree) == 0); ! assert (TREE_INT_CST_LOW (size_tree) == ffestorag_size (eqst)); ! } ffestorag_set_hook (eqst, eqt); *************** ffecom_tree_divide_ (tree tree_type, tre *** 9370,9374 **** return ffecom_call_ (ffecom_gfrt_tree_ (ix), ! ffecom_gfrt_kind_type_ (ix), ffe_is_f2c_library (), tree_type, --- 9685,9689 ---- return ffecom_call_ (ffecom_gfrt_tree_ (ix), ! ffecom_gfrt_kindtype (ix), ffe_is_f2c_library (), tree_type, *************** ffecom_tree_divide_ (tree tree_type, tre *** 9400,9404 **** return ffecom_call_ (ffecom_gfrt_tree_ (ix), ! ffecom_gfrt_kind_type_ (ix), ffe_is_f2c_library (), tree_type, --- 9715,9719 ---- return ffecom_call_ (ffecom_gfrt_tree_ (ix), ! ffecom_gfrt_kindtype (ix), ffe_is_f2c_library (), tree_type, *************** ffecom_type_localvar_ (ffesymbol s, ffei *** 9451,9458 **** --- 9766,9777 ---- ffecom_f2c_ftnlen_one_node, hight)); + type = ffecom_check_size_overflow_ (s, type, FALSE); } for (dl = ffesymbol_dims (s); dl != NULL; dl = ffebld_trail (dl)) { + if (type == error_mark_node) + break; + dim = ffebld_head (dl); assert (ffebld_op (dim) == FFEBLD_opBOUNDS); *************** ffecom_type_localvar_ (ffesymbol s, ffei *** 9475,9478 **** --- 9794,9798 ---- build_range_type (ffecom_integer_type_node, lowt, hight)); + type = ffecom_check_size_overflow_ (s, type, FALSE); } *************** tree *** 10648,10652 **** ffecom_call_gfrt (ffecomGfrt ix, tree args) { ! 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, --- 10968,10973 ---- ffecom_call_gfrt (ffecomGfrt ix, tree args) { ! return ffecom_call_ (ffecom_gfrt_tree_ (ix), ! ffecom_gfrt_kindtype (ix), ffe_is_f2c_library () && ffecom_gfrt_complex_[ix], NULL_TREE, args, NULL_TREE, NULL, *************** ffecom_end_transition () *** 11054,11057 **** --- 11375,11379 ---- ffecom_transform_common_ (ffebld_symter (ffebld_head (item))); + ffecom_list_common_ = NULL; #endif } *************** ffecom_get_invented_identifier (char *pa *** 11274,11283 **** } ! #endif ! /* ffecom_init_0 -- Initialize ! ffecom_init_0(); */ - #if FFECOM_targetCURRENT == FFECOM_targetGCC void ffecom_init_0 () --- 11596,11691 ---- } ! ffeinfoBasictype ! ffecom_gfrt_basictype (ffecomGfrt gfrt) ! { ! assert (gfrt < FFECOM_gfrt); ! switch (ffecom_gfrt_type_[gfrt]) ! { ! case FFECOM_rttypeVOID_: ! return FFEINFO_basictypeNONE; ! ! case FFECOM_rttypeFTNINT_: ! return FFEINFO_basictypeINTEGER; ! ! case FFECOM_rttypeINTEGER_: ! return FFEINFO_basictypeINTEGER; ! ! case FFECOM_rttypeLONGINT_: ! return FFEINFO_basictypeINTEGER; ! ! case FFECOM_rttypeLOGICAL_: ! return FFEINFO_basictypeLOGICAL; ! ! case FFECOM_rttypeREAL_F2C_: ! case FFECOM_rttypeREAL_GNU_: ! return FFEINFO_basictypeREAL; ! ! case FFECOM_rttypeCOMPLEX_F2C_: ! case FFECOM_rttypeCOMPLEX_GNU_: ! return FFEINFO_basictypeCOMPLEX; ! ! case FFECOM_rttypeDOUBLE_: ! case FFECOM_rttypeDOUBLEREAL_: ! return FFEINFO_basictypeREAL; ! ! case FFECOM_rttypeDBLCMPLX_F2C_: ! case FFECOM_rttypeDBLCMPLX_GNU_: ! return FFEINFO_basictypeCOMPLEX; ! ! case FFECOM_rttypeCHARACTER_: ! return FFEINFO_basictypeCHARACTER; ! ! default: ! return FFEINFO_basictypeANY; ! } ! } ! ! ffeinfoKindtype ! ffecom_gfrt_kindtype (ffecomGfrt gfrt) ! { ! assert (gfrt < FFECOM_gfrt); ! ! switch (ffecom_gfrt_type_[gfrt]) ! { ! case FFECOM_rttypeVOID_: ! return FFEINFO_kindtypeNONE; ! ! case FFECOM_rttypeFTNINT_: ! return FFEINFO_kindtypeINTEGER1; ! ! case FFECOM_rttypeINTEGER_: ! return FFEINFO_kindtypeINTEGER1; ! ! case FFECOM_rttypeLONGINT_: ! return FFEINFO_kindtypeINTEGER4; ! ! case FFECOM_rttypeLOGICAL_: ! return FFEINFO_kindtypeLOGICAL1; ! ! case FFECOM_rttypeREAL_F2C_: ! case FFECOM_rttypeREAL_GNU_: ! return FFEINFO_kindtypeREAL1; ! ! case FFECOM_rttypeCOMPLEX_F2C_: ! case FFECOM_rttypeCOMPLEX_GNU_: ! return FFEINFO_kindtypeREAL1; ! ! case FFECOM_rttypeDOUBLE_: ! case FFECOM_rttypeDOUBLEREAL_: ! return FFEINFO_kindtypeREAL2; ! ! case FFECOM_rttypeDBLCMPLX_F2C_: ! case FFECOM_rttypeDBLCMPLX_GNU_: ! return FFEINFO_kindtypeREAL2; ! ! case FFECOM_rttypeCHARACTER_: ! return FFEINFO_kindtypeCHARACTER1; ! ! default: ! return FFEINFO_kindtypeANY; ! } ! } void ffecom_init_0 () *************** ffecom_init_0 () *** 11780,11789 **** else if (0 && ffe_is_do_internal_checks ()) fprintf (stderr, "Pointer type kt=%d\n", ffecom_pointer_kind_); - #if 0 type = ffetype_new (); ffetype_set_kind (ffeinfo_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGERDEFAULT), ! 0, type); ! #endif if (ffe_is_ugly_assign ()) --- 12188,12195 ---- else if (0 && ffe_is_do_internal_checks ()) fprintf (stderr, "Pointer type kt=%d\n", ffecom_pointer_kind_); type = ffetype_new (); ffetype_set_kind (ffeinfo_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGERDEFAULT), ! 7, type); if (ffe_is_ugly_assign ()) *************** ffecom_ptr_to_expr (ffebld expr) *** 12547,12551 **** ffecomGfrt ix; ! ix = ffeintrin_gfrt (ffebld_symter_implementation (expr)); assert (ix != FFECOM_gfrt); if ((item = ffecom_gfrt_[ix]) == NULL_TREE) --- 12953,12957 ---- ffecomGfrt ix; ! ix = ffeintrin_gfrt_indirect (ffebld_symter_implementation (expr)); assert (ix != FFECOM_gfrt); if ((item = ffecom_gfrt_[ix]) == NULL_TREE) *************** duplicate_decls (tree newdecl, tree oldd *** 13469,13475 **** register unsigned olddecl_uid = DECL_UID (olddecl); ! bcopy ((char *) newdecl + sizeof (struct tree_common), ! (char *) olddecl + sizeof (struct tree_common), ! sizeof (struct tree_decl) - sizeof (struct tree_common)); DECL_UID (olddecl) = olddecl_uid; } --- 13875,13881 ---- register unsigned olddecl_uid = DECL_UID (olddecl); ! memcpy ((char *) olddecl + sizeof (struct tree_common), ! (char *) newdecl + sizeof (struct tree_common), ! sizeof (struct tree_decl) - sizeof (struct tree_common)); DECL_UID (olddecl) = olddecl_uid; } *************** open_include_file (filename, searchptr) *** 15340,15344 **** { dir = (char *) xmalloc (p - filename + 1); ! bcopy (filename, dir, p - filename); dir[p - filename] = '\0'; from = p + 1; --- 15746,15750 ---- { dir = (char *) xmalloc (p - filename + 1); ! memcpy (dir, filename, p - filename); dir[p - filename] = '\0'; from = p + 1; *************** ffecom_file_ (char *name) *** 15554,15558 **** fp = &instack[++indepth]; ! bzero ((char *) fp, sizeof (FILE_BUF)); if (name == NULL) name = ""; --- 15960,15964 ---- fp = &instack[++indepth]; ! memset ((char *) fp, 0, sizeof (FILE_BUF)); if (name == NULL) name = ""; *************** ffecom_open_include_ (char *name, ffewhe *** 15814,15818 **** fp = &instack[indepth + 1]; ! bzero ((char *) fp, sizeof (FILE_BUF)); fp->nominal_fname = fp->fname = fname; fp->dir = searchptr; --- 16220,16224 ---- fp = &instack[indepth + 1]; ! memset ((char *) fp, 0, sizeof (FILE_BUF)); fp->nominal_fname = fp->fname = fname; fp->dir = searchptr; diff -rcp2N g77-0.5.20/f/com.h g77-0.5.21/f/com.h *** g77-0.5.20/f/com.h Sat Feb 8 07:56:44 1997 --- g77-0.5.21/f/com.h Thu Aug 7 15:24:30 1997 *************** void ffecom_finish_progunit (void); *** 304,307 **** --- 304,309 ---- tree ffecom_get_invented_identifier (char *pattern, char *text, int number); + ffeinfoKindtype ffecom_gfrt_basictype (ffecomGfrt ix); + ffeinfoKindtype ffecom_gfrt_kindtype (ffecomGfrt ix); void ffecom_init_0 (void); void ffecom_init_2 (void); diff -rcp2N g77-0.5.20/f/config-lang.in g77-0.5.21/f/config-lang.in *** g77-0.5.20/f/config-lang.in Wed Feb 5 05:53:55 1997 --- g77-0.5.21/f/config-lang.in Tue Sep 2 21:25:26 1997 *************** case "$srcdir" in *** 99,100 **** --- 99,130 ---- echo ;; esac + + case "$host" in + hppa*-*-hpux10) + echo + echo "The GCC \`fixincludes' step (which involves running a sed script)" + echo "typically fails on HP-UX 10 because of a bug in the vendor's" + echo "implementation of sed. Currently the only known workaround is to" + echo "install GNU sed before building gcc. The file sed-2.05.bin.hpux10" + echo "in mirrors of the GNU distribution is a suitable precompiled" + echo "binary." + echo ;; + rs6000-ibm-aix4.1*) + echo + echo "G77 has been observed to not build on (at least) the configuration" + echo "rs6000-ibm-aix4.1.4.0 with the native linker -- it crashes. There" + echo "may be an IBM bug fix for this (we don't know) but the build should" + echo "work if you add \`-mminimal-toc' to the compilation flags, i.e. add" + echo "something like \`BOOT_CFLAGS=\"-O2 -mminimal-toc -g\"' to the \`make" + echo "bootstrap' command line. Probably building with the GNU linker (from" + echo "the binutils package) installed and configuring \`--with-gnu-ld' will work." + echo ;; + mips-sgi-irix6*) + echo + echo Consult + echo "" + echo "regarding building under IRIX-6.2/6.3/6.4. Note that you *must*" + echo "have the SGI IDO bought and installed (sigh)." + echo ;; + *) ;; + esac diff -rcp2N g77-0.5.20/f/equiv.c g77-0.5.21/f/equiv.c *** g77-0.5.20/f/equiv.c Thu Feb 27 04:52:14 1997 --- g77-0.5.21/f/equiv.c Fri Jul 11 00:07:51 1997 *************** again: /* :::::::::::::::::::: */ *** 793,797 **** Check the list to make sure only one common symbol is involved (even if multiple times) and agrees with the common symbol for the equivalence ! object (or it has no common symbol until now). Prepend (aka append, it doesn't matter) the list to the list of lists for the equivalence object. Otherwise report an error and return. */ --- 793,797 ---- Check the list to make sure only one common symbol is involved (even if multiple times) and agrees with the common symbol for the equivalence ! object (or it has no common symbol until now). Prepend (or append, it doesn't matter) the list to the list of lists for the equivalence object. Otherwise report an error and return. */ *************** ffeequiv_add (ffeequiv eq, ffebld list, *** 802,805 **** --- 802,831 ---- ffebld item; ffesymbol symbol; + ffesymbol common = ffeequiv_common (eq); + + for (item = list; item != NULL; item = ffebld_trail (item)) + { + symbol = ffeequiv_symbol (ffebld_head (item)); + + if (ffesymbol_common (symbol) != NULL) /* Is symbol known in COMMON yet? */ + { + if (common == NULL) + common = ffesymbol_common (symbol); + else if (common != ffesymbol_common (symbol)) + { + /* Yes, and symbol disagrees with others on the COMMON area. */ + ffebad_start (FFEBAD_EQUIV_COMMON); + ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); + ffebad_string (ffesymbol_text (common)); + ffebad_string (ffesymbol_text (ffesymbol_common (symbol))); + ffebad_finish (); + return; + } + } + } + + if ((common != NULL) + && (ffeequiv_common (eq) == NULL)) /* Is COMMON involved already? */ + ffeequiv_set_common (eq, common); /* No, but it is now. */ for (item = list; item != NULL; item = ffebld_trail (item)) *************** ffeequiv_add (ffeequiv eq, ffebld list, *** 828,850 **** if (ffesymbol_is_save (ffesymbol_common (symbol))) ! ffeequiv_update_save (eq); /* EQUIVALENCE is in a SAVEd COMMON ! block. */ if (ffesymbol_is_init (ffesymbol_common (symbol))) ! ffeequiv_update_init (eq); /* EQUIVALENCE is in a init'd COMMON ! block. */ ! ! if (ffeequiv_common (eq) == NULL) /* Is COMMON involved already? */ ! /* No, but there is now. */ ! ffeequiv_set_common (eq, ffesymbol_common (symbol)); ! else if (ffeequiv_common (eq) != ffesymbol_common (symbol)) ! { ! /* Yes, and it isn't the same as our new COMMON area. */ ! ffebad_start (FFEBAD_EQUIV_COMMON); ! ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); ! ffebad_string (ffesymbol_text (ffeequiv_common (eq))); ! ffebad_string (ffesymbol_text (ffesymbol_common (symbol))); ! ffebad_finish (); ! return; ! } } --- 854,860 ---- if (ffesymbol_is_save (ffesymbol_common (symbol))) ! ffeequiv_update_save (eq); /* EQUIVALENCE is in a SAVEd COMMON block. */ if (ffesymbol_is_init (ffesymbol_common (symbol))) ! ffeequiv_update_init (eq); /* EQUIVALENCE is in a init'd COMMON block. */ } diff -rcp2N g77-0.5.20/f/expr.c g77-0.5.21/f/expr.c *** g77-0.5.20/f/expr.c Sat Feb 22 18:28:58 1997 --- g77-0.5.21/f/expr.c Fri Aug 1 02:21:56 1997 *************** the Free Software Foundation, 59 Temple *** 37,40 **** --- 37,41 ---- #include "bld.h" #include "com.h" + #include "global.h" #include "implic.h" #include "intrin.h" *************** static ffeexprContext ffeexpr_context_ou *** 288,291 **** --- 289,293 ---- static ffeexprDotdot_ ffeexpr_dotdot_ (ffelexToken t); static ffeexprExpr_ ffeexpr_expr_new_ (void); + static void ffeexpr_fulfill_call_ (ffebld *expr, ffelexToken t); static bool ffeexpr_isdigits_ (char *p); static ffelexHandler ffeexpr_token_first_lhs_ (ffelexToken t); *************** ffeexpr_cb_close_paren_ (ffelexToken ft, *** 7242,7278 **** ffeexprExpr_ e; ! /* First push the (parenthesized) expression as an operand onto the ! expression stack. */ ! e = ffeexpr_expr_new_ (); ! e->type = FFEEXPR_exprtypeOPERAND_; ! e->u.operand = ffebld_new_paren (expr); ! ffebld_set_info (e->u.operand, ffeinfo_use (ffebld_info (expr))); ! e->u.operand = ffeexpr_collapse_paren (e->u.operand, ft); ! e->token = ffeexpr_stack_->tokens[0]; ! ffeexpr_exprstack_push_operand_ (e); ! /* Now, if the token is a close parenthese, we're in great shape so return ! the next handler. */ ! if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN) ! { ! return (ffelexHandler) ffeexpr_token_binary_; } ! /* Oops, naughty user didn't specify the close paren! */ ! ! if (ffest_ffebad_start (FFEBAD_MISSING_CLOSE_PAREN)) { ! ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); ! ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]), ! ffelex_token_where_column (ffeexpr_stack_->tokens[0])); ! ffebad_finish (); } ! return ! (ffelexHandler) ffeexpr_find_close_paren_ (t, ! (ffelexHandler) ! ffeexpr_token_binary_); } --- 7244,7297 ---- ffeexprExpr_ e; ! if (ffelex_token_type (t) != FFELEX_typeCLOSE_PAREN) ! { ! /* Oops, naughty user didn't specify the close paren! */ ! if (ffest_ffebad_start (FFEBAD_MISSING_CLOSE_PAREN)) ! { ! ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); ! ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]), ! ffelex_token_where_column (ffeexpr_stack_->tokens[0])); ! ffebad_finish (); ! } ! e = ffeexpr_expr_new_ (); ! e->type = FFEEXPR_exprtypeOPERAND_; ! e->u.operand = ffebld_new_any (); ! ffebld_set_info (e->u.operand, ffeinfo_new_any ()); ! ffeexpr_exprstack_push_operand_ (e); ! return ! (ffelexHandler) ffeexpr_find_close_paren_ (t, ! (ffelexHandler) ! ffeexpr_token_binary_); } ! if (expr->op == FFEBLD_opIMPDO) { ! if (ffest_ffebad_start (FFEBAD_IMPDO_PAREN)) ! { ! ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[0]), ! ffelex_token_where_column (ffeexpr_stack_->tokens[0])); ! ffebad_finish (); ! } ! } ! else ! { ! expr = ffebld_new_paren (expr); ! ffebld_set_info (expr, ffeinfo_use (ffebld_info (ffebld_left (expr)))); } ! /* Now push the (parenthesized) expression as an operand onto the ! expression stack. */ ! ! e = ffeexpr_expr_new_ (); ! e->type = FFEEXPR_exprtypeOPERAND_; ! e->u.operand = expr; ! e->u.operand = ffeexpr_collapse_paren (e->u.operand, ft); ! e->token = ffeexpr_stack_->tokens[0]; ! ffeexpr_exprstack_push_operand_ (e); ! ! return (ffelexHandler) ffeexpr_token_binary_; } *************** ffeexpr_cb_comma_i_1_ (ffelexToken ft, f *** 7827,7830 **** --- 7846,7856 ---- ffeexpr_stack_->expr = ffebld_new_impdo (ffeexpr_stack_->expr, NULL); + ffebld_set_info (ffeexpr_stack_->expr, + ffeinfo_new (FFEINFO_basictypeNONE, + FFEINFO_kindtypeNONE, + 0, + FFEINFO_kindNONE, + FFEINFO_whereNONE, + FFETARGET_charactersizeNONE)); ffebld_init_list (&(ffebld_right (ffeexpr_stack_->expr)), &ffeexpr_stack_->bottom); *************** ffeexpr_cb_comma_i_4_ (ffelexToken ft UN *** 8017,8021 **** } ! return (ffelexHandler) ffeexpr_cb_comma_i_5_; } --- 8043,8049 ---- } ! if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN) ! return (ffelexHandler) ffeexpr_cb_comma_i_5_; ! return (ffelexHandler) ffeexpr_cb_comma_i_5_ (t); } *************** ffeexpr_cb_end_notloc_ (ffelexToken ft, *** 8191,8201 **** break; } ! ffebld_set_info (e->u.operand, ! ffeinfo_new (FFEINFO_basictypeNONE, ! FFEINFO_kindtypeNONE, ! 0, ! FFEINFO_kindNONE, ! FFEINFO_whereNONE, ! FFETARGET_charactersizeNONE)); #if 0 /* ~~ */ e->u.operand = ffeexpr_collapse_percent_ ? ? ? (e->u.operand, ft); --- 8219,8223 ---- break; } ! ffebld_set_info (e->u.operand, ffebld_info (expr)); #if 0 /* ~~ */ e->u.operand = ffeexpr_collapse_percent_ ? ? ? (e->u.operand, ft); *************** ffeexpr_token_first_rhs_3_ (ffelexToken *** 9216,9219 **** --- 9238,9248 ---- else ffeexpr_stack_->expr = ffebld_new_labtok (ffelex_token_use (t)); + ffebld_set_info (ffeexpr_stack_->expr, + ffeinfo_new (FFEINFO_basictypeNONE, + FFEINFO_kindtypeNONE, + 0, + FFEINFO_kindNONE, + FFEINFO_whereNONE, + FFETARGET_charactersizeNONE)); return (ffelexHandler) ffeexpr_token_first_rhs_4_; *************** ffeexpr_expr_new_ () *** 9436,9439 **** --- 9465,9601 ---- } + /* Verify that call to global is valid, and register whatever + new information about a global might be discoverable by looking + at the call. */ + + static void + ffeexpr_fulfill_call_ (ffebld *expr, ffelexToken t) + { + int n_args; + ffebld list; + ffebld item; + ffesymbol s; + + assert ((ffebld_op (*expr) == FFEBLD_opSUBRREF) + || (ffebld_op (*expr) == FFEBLD_opFUNCREF)); + + if (ffebld_op (ffebld_left (*expr)) != FFEBLD_opSYMTER) + return; + + if (ffesymbol_retractable ()) + return; + + s = ffebld_symter (ffebld_left (*expr)); + if (ffesymbol_global (s) == NULL) + return; + + for (n_args = 0, list = ffebld_right (*expr); + list != NULL; + list = ffebld_trail (list), ++n_args) + ; + + if (ffeglobal_proc_ref_nargs (s, n_args, t)) + { + ffeglobalArgSummary as; + ffeinfoBasictype bt; + ffeinfoKindtype kt; + bool array; + bool fail = FALSE; + + for (n_args = 0, list = ffebld_right (*expr); + list != NULL; + list = ffebld_trail (list), ++n_args) + { + item = ffebld_head (list); + if (item != NULL) + { + bt = ffeinfo_basictype (ffebld_info (item)); + kt = ffeinfo_kindtype (ffebld_info (item)); + array = (ffeinfo_rank (ffebld_info (item)) > 0); + switch (ffebld_op (item)) + { + case FFEBLD_opLABTOK: + case FFEBLD_opLABTER: + as = FFEGLOBAL_argsummaryALTRTN; + break; + + case FFEBLD_opPERCENT_LOC: + as = FFEGLOBAL_argsummaryPTR; + break; + + case FFEBLD_opPERCENT_VAL: + as = FFEGLOBAL_argsummaryVAL; + break; + + case FFEBLD_opPERCENT_REF: + as = FFEGLOBAL_argsummaryREF; + break; + + case FFEBLD_opPERCENT_DESCR: + as = FFEGLOBAL_argsummaryDESCR; + break; + + case FFEBLD_opFUNCREF: + if ((ffebld_op (ffebld_left (item)) == FFEBLD_opSYMTER) + && (ffesymbol_specific (ffebld_symter (ffebld_left (item))) + == FFEINTRIN_specLOC)) + { + as = FFEGLOBAL_argsummaryPTR; + break; + } + /* Fall through. */ + default: + if (ffebld_op (item) == FFEBLD_opSYMTER) + { + as = FFEGLOBAL_argsummaryNONE; + + switch (ffeinfo_kind (ffebld_info (item))) + { + case FFEINFO_kindFUNCTION: + as = FFEGLOBAL_argsummaryFUNC; + break; + + case FFEINFO_kindSUBROUTINE: + as = FFEGLOBAL_argsummarySUBR; + break; + + case FFEINFO_kindNONE: + as = FFEGLOBAL_argsummaryPROC; + break; + + default: + break; + } + + if (as != FFEGLOBAL_argsummaryNONE) + break; + } + + if (bt == FFEINFO_basictypeCHARACTER) + as = FFEGLOBAL_argsummaryDESCR; + else + as = FFEGLOBAL_argsummaryREF; + break; + } + } + else + { + array = FALSE; + as = FFEGLOBAL_argsummaryNONE; + bt = FFEINFO_basictypeNONE; + kt = FFEINFO_kindtypeNONE; + } + + if (! ffeglobal_proc_ref_arg (s, n_args, as, bt, kt, array, t)) + fail = TRUE; + } + if (! fail) + return; + } + + *expr = ffebld_new_any (); + ffebld_set_info (*expr, ffeinfo_new_any ()); + } + /* Check whether rest of string is all decimal digits. */ *************** ffeexpr_reduced_bool1_ (ffebld reduced, *** 9948,9952 **** { if ((rbt != FFEINFO_basictypeANY) ! && ffebad_start (FFEBAD_BOOL_ARG_TYPE)) { ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token)); --- 10110,10114 ---- { if ((rbt != FFEINFO_basictypeANY) ! && ffebad_start (FFEBAD_NOT_ARG_TYPE)) { ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token)); *************** ffeexpr_reduced_bool1_ (ffebld reduced, *** 9958,9962 **** { if ((rkd != FFEINFO_kindANY) ! && ffebad_start (FFEBAD_BOOL_ARG_KIND)) { ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token)); --- 10120,10124 ---- { if ((rkd != FFEINFO_kindANY) ! && ffebad_start (FFEBAD_NOT_ARG_KIND)) { ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token)); *************** ffeexpr_token_name_lhs_ (ffelexToken t) *** 14835,14838 **** --- 14997,15001 ---- case FFEINFO_whereNONE: + case FFEINFO_whereANY: break; *************** just_name: /* :::::::::::::::::::: */ *** 15041,15051 **** else if (ffesymbol_specific (s) != FFEINTRIN_specNONE) ffeintrin_fulfill_specific (&expr, &info, NULL, e->token); ! ffebld_set_info (expr, ! ffeinfo_new (ffeinfo_basictype (info), ! ffeinfo_kindtype (info), ! 0, ! FFEINFO_kindENTITY, ! FFEINFO_whereFLEETING, ! ffeinfo_size (info))); } } --- 15204,15220 ---- else if (ffesymbol_specific (s) != FFEINTRIN_specNONE) ffeintrin_fulfill_specific (&expr, &info, NULL, e->token); ! else ! ffeexpr_fulfill_call_ (&expr, e->token); ! ! if (ffebld_op (expr) != FFEBLD_opANY) ! ffebld_set_info (expr, ! ffeinfo_new (ffeinfo_basictype (info), ! ffeinfo_kindtype (info), ! 0, ! FFEINFO_kindENTITY, ! FFEINFO_whereFLEETING, ! ffeinfo_size (info))); ! else ! ffebld_set_info (expr, ffeinfo_new_any ()); } } *************** ffeexpr_token_name_rhs_ (ffelexToken t) *** 15255,15259 **** ffeexpr_token_funsubstr_); - case FFEEXPR_parentypeSUBROUTINE_: /* Invalid case. */ case FFEEXPR_parentypeANY_: ffebld_set_info (e->u.operand, ffesymbol_info (s)); --- 15424,15427 ---- *************** ffeexpr_sym_lhs_call_ (ffesymbol s, ffel *** 16454,16462 **** FFEINFO_kindtypeNONE, 0, ! FFEINFO_kindNONE, FFEINFO_whereINTRINSIC, FFETARGET_charactersizeNONE)); ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD); ffesymbol_resolve_intrin (s); s = ffecom_sym_learned (s); ffesymbol_signal_unreported (s); /* For debugging purposes. */ --- 16622,16631 ---- FFEINFO_kindtypeNONE, 0, ! FFEINFO_kindSUBROUTINE, FFEINFO_whereINTRINSIC, FFETARGET_charactersizeNONE)); ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD); ffesymbol_resolve_intrin (s); + ffesymbol_reference (s, t, FALSE); s = ffecom_sym_learned (s); ffesymbol_signal_unreported (s); /* For debugging purposes. */ *************** ffeexpr_sym_lhs_call_ (ffesymbol s, ffel *** 16490,16496 **** ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD); ffesymbol_resolve_intrin (s); s = ffecom_sym_learned (s); - if (where == FFEINFO_whereGLOBAL) - ffesymbol_globalize (s); ffesymbol_signal_unreported (s); /* For debugging purposes. */ } --- 16659,16664 ---- ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD); ffesymbol_resolve_intrin (s); + ffesymbol_reference (s, t, FALSE); s = ffecom_sym_learned (s); ffesymbol_signal_unreported (s); /* For debugging purposes. */ } *************** ffeexpr_sym_lhs_extfunc_ (ffesymbol s, f *** 16850,16856 **** ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD); ffesymbol_resolve_intrin (s); s = ffecom_sym_learned (s); - if (where == FFEINFO_whereGLOBAL) - ffesymbol_globalize (s); ffesymbol_signal_unreported (s); /* For debugging purposes. */ } --- 17018,17023 ---- ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD); ffesymbol_resolve_intrin (s); + ffesymbol_reference (s, t, FALSE); s = ffecom_sym_learned (s); ffesymbol_signal_unreported (s); /* For debugging purposes. */ } *************** ffeexpr_sym_rhs_actualarg_ (ffesymbol s, *** 17133,17138 **** ffesymbol_set_state (s, ns); s = ffecom_sym_learned (s); ! if (where == FFEINFO_whereGLOBAL) ! ffesymbol_globalize (s); ffesymbol_signal_unreported (s); /* For debugging purposes. */ } --- 17300,17304 ---- ffesymbol_set_state (s, ns); s = ffecom_sym_learned (s); ! ffesymbol_reference (s, t, FALSE); ffesymbol_signal_unreported (s); /* For debugging purposes. */ } *************** ffeexpr_declare_parenthesized_ (ffelexTo *** 17429,17432 **** --- 17595,17599 ---- case FFEEXPR_contextHEAPSTAT: case FFEEXPR_contextNULLIFY: + case FFEEXPR_contextINCLUDE: case FFEEXPR_contextDATAIMPDOITEM_: case FFEEXPR_contextLOC_: *************** ffeexpr_declare_parenthesized_ (ffelexTo *** 17746,17758 **** default: - bad = TRUE; - /* Fall through. */ case FFEINFO_kindANY: *paren_type = FFEEXPR_parentypeANY_; break; } ! if (bad && (k != FFEINFO_kindANY)) ! ffesymbol_error (s, t); return s; --- 17913,17929 ---- default: case FFEINFO_kindANY: + bad = TRUE; *paren_type = FFEEXPR_parentypeANY_; break; } ! if (bad) ! { ! if (k == FFEINFO_kindANY) ! ffest_shutdown (); ! else ! ffesymbol_error (s, t); ! } return s; *************** ffeexpr_declare_parenthesized_ (ffelexTo *** 17871,17883 **** default: - bad = TRUE; - /* Fall through. */ case FFEINFO_kindANY: *paren_type = FFEEXPR_parentypeANY_; break; } ! if (bad && (k != FFEINFO_kindANY)) ! ffesymbol_error (s, t); return s; --- 18042,18058 ---- default: case FFEINFO_kindANY: + bad = TRUE; *paren_type = FFEEXPR_parentypeANY_; break; } ! if (bad) ! { ! if (k == FFEINFO_kindANY) ! ffest_shutdown (); ! else ! ffesymbol_error (s, t); ! } return s; *************** ffeexpr_paren_rhs_let_ (ffesymbol s, ffe *** 18001,18012 **** ffesymbol_set_implementation (s, imp); ffesymbol_set_info (s, ! ffeinfo_new (FFEINFO_basictypeNONE, ! FFEINFO_kindtypeNONE, 0, ! FFEINFO_kindNONE, FFEINFO_whereINTRINSIC, ! FFETARGET_charactersizeNONE)); ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD); ffesymbol_resolve_intrin (s); s = ffecom_sym_learned (s); ffesymbol_signal_unreported (s); /* For debugging purposes. */ --- 18176,18188 ---- ffesymbol_set_implementation (s, imp); ffesymbol_set_info (s, ! ffeinfo_new (ffesymbol_basictype (s), ! ffesymbol_kindtype (s), 0, ! FFEINFO_kindFUNCTION, FFEINFO_whereINTRINSIC, ! ffesymbol_size (s))); ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD); ffesymbol_resolve_intrin (s); + ffesymbol_reference (s, t, FALSE); s = ffecom_sym_learned (s); ffesymbol_signal_unreported (s); /* For debugging purposes. */ *************** ffeexpr_paren_rhs_let_ (ffesymbol s, ffe *** 18050,18064 **** ffesymbol_set_implementation (s, imp); ffesymbol_set_info (s, ! ffeinfo_new (FFEINFO_basictypeNONE, ! FFEINFO_kindtypeNONE, 0, ! FFEINFO_kindNONE, FFEINFO_whereINTRINSIC, ! FFETARGET_charactersizeNONE)); ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD); ffesymbol_resolve_intrin (s); s = ffecom_sym_learned (s); ffesymbol_signal_unreported (s); /* For debugging purposes. */ - return s; } --- 18226,18240 ---- ffesymbol_set_implementation (s, imp); ffesymbol_set_info (s, ! ffeinfo_new (ffesymbol_basictype (s), ! ffesymbol_kindtype (s), 0, ! FFEINFO_kindFUNCTION, FFEINFO_whereINTRINSIC, ! ffesymbol_size (s))); ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD); ffesymbol_resolve_intrin (s); s = ffecom_sym_learned (s); + ffesymbol_reference (s, t, FALSE); ffesymbol_signal_unreported (s); /* For debugging purposes. */ return s; } *************** ffeexpr_paren_rhs_let_ (ffesymbol s, ffe *** 18091,18094 **** --- 18267,18271 ---- return s; /* Still not sure, let caller deal with it based on (...). */ + ffesymbol_set_info (s, ffeinfo_new (ffesymbol_basictype (s), *************** ffeexpr_paren_rhs_let_ (ffesymbol s, ffe *** 18101,18106 **** ffesymbol_resolve_intrin (s); s = ffecom_sym_learned (s); ! if (where == FFEINFO_whereGLOBAL) ! ffesymbol_globalize (s); ffesymbol_signal_unreported (s); /* For debugging purposes. */ } --- 18278,18282 ---- ffesymbol_resolve_intrin (s); s = ffecom_sym_learned (s); ! ffesymbol_reference (s, t, FALSE); ffesymbol_signal_unreported (s); /* For debugging purposes. */ } *************** ffeexpr_token_arguments_ (ffelexToken ft *** 18300,18310 **** ffeintrin_fulfill_specific (&reduced, &info, &check_intrin, ffeexpr_stack_->tokens[0]); ! ffebld_set_info (reduced, ! ffeinfo_new (ffeinfo_basictype (info), ! ffeinfo_kindtype (info), ! 0, ! FFEINFO_kindENTITY, ! FFEINFO_whereFLEETING, ! ffeinfo_size (info))); } if (ffebld_op (reduced) == FFEBLD_opFUNCREF) --- 18476,18492 ---- ffeintrin_fulfill_specific (&reduced, &info, &check_intrin, ffeexpr_stack_->tokens[0]); ! else ! ffeexpr_fulfill_call_ (&reduced, ffeexpr_stack_->tokens[0]); ! ! if (ffebld_op (reduced) != FFEBLD_opANY) ! ffebld_set_info (reduced, ! ffeinfo_new (ffeinfo_basictype (info), ! ffeinfo_kindtype (info), ! 0, ! FFEINFO_kindENTITY, ! FFEINFO_whereFLEETING, ! ffeinfo_size (info))); ! else ! ffebld_set_info (reduced, ffeinfo_new_any ()); } if (ffebld_op (reduced) == FFEBLD_opFUNCREF) *************** ffeexpr_token_arguments_ (ffelexToken ft *** 18333,18336 **** --- 18515,18519 ---- if ((ffeexpr_stack_->previous != NULL) + && (ffeexpr_stack_->previous->exprstack->type == FFEEXPR_exprtypeOPERAND_) && ((reduced = ffeexpr_stack_->previous->exprstack->u.operand) != NULL) && (ffebld_op (reduced) == FFEBLD_opSYMTER) *************** ffeexpr_token_elements_ (ffelexToken ft, *** 18579,18599 **** if (ffebld_op (array->u.operand) == FFEBLD_opANY) ! reduced = ffebld_new_any (); ! else ! reduced = ffebld_new_arrayref (array->u.operand, ffeexpr_stack_->expr); ! if (ffeexpr_stack_->constant) ! where = FFEINFO_whereFLEETING_CADDR; ! else if (ffeexpr_stack_->immediate) ! where = FFEINFO_whereFLEETING_IADDR; else ! where = FFEINFO_whereFLEETING; ! ffebld_set_info (reduced, ! ffeinfo_new (ffeinfo_basictype (info), ! ffeinfo_kindtype (info), ! 0, ! FFEINFO_kindENTITY, ! where, ! ffeinfo_size (info))); ! reduced = ffeexpr_collapse_arrayref (reduced, ffeexpr_stack_->tokens[0]); ffeexpr_stack_->exprstack = array->previous; /* Pops not-quite-operand off --- 18762,18787 ---- if (ffebld_op (array->u.operand) == FFEBLD_opANY) ! { ! reduced = ffebld_new_any (); ! ffebld_set_info (reduced, ffeinfo_new_any ()); ! } else ! { ! reduced = ffebld_new_arrayref (array->u.operand, ffeexpr_stack_->expr); ! if (ffeexpr_stack_->constant) ! where = FFEINFO_whereFLEETING_CADDR; ! else if (ffeexpr_stack_->immediate) ! where = FFEINFO_whereFLEETING_IADDR; ! else ! where = FFEINFO_whereFLEETING; ! ffebld_set_info (reduced, ! ffeinfo_new (ffeinfo_basictype (info), ! ffeinfo_kindtype (info), ! 0, ! FFEINFO_kindENTITY, ! where, ! ffeinfo_size (info))); ! reduced = ffeexpr_collapse_arrayref (reduced, ffeexpr_stack_->tokens[0]); ! } ffeexpr_stack_->exprstack = array->previous; /* Pops not-quite-operand off *************** ffeexpr_token_funsubstr_ (ffelexToken ft *** 19142,19151 **** ffesymbol_set_implementation (s, imp); ffesymbol_set_info (s, ! ffeinfo_new (FFEINFO_basictypeNONE, ! FFEINFO_kindtypeNONE, 0, ! FFEINFO_kindNONE, FFEINFO_whereINTRINSIC, ! FFETARGET_charactersizeNONE)); } else --- 19330,19339 ---- ffesymbol_set_implementation (s, imp); ffesymbol_set_info (s, ! ffeinfo_new (ffesymbol_basictype (s), ! ffesymbol_kindtype (s), 0, ! FFEINFO_kindFUNCTION, FFEINFO_whereINTRINSIC, ! ffesymbol_size (s))); } else *************** ffeexpr_token_funsubstr_ (ffelexToken ft *** 19167,19170 **** --- 19355,19359 ---- ffesymbol_size (s))); } + ffebld_set_info (symter, ffeinfo_use (ffesymbol_info (s))); *************** ffeexpr_token_funsubstr_ (ffelexToken ft *** 19172,19179 **** ffesymbol_resolve_intrin (s); s = ffecom_sym_learned (s); ! if (ffesymbol_where (s) == FFEINFO_whereGLOBAL) ! ffesymbol_globalize (s); ffesymbol_signal_unreported (s); /* For debugging purposes. */ - ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom); return (ffelexHandler) ffeexpr_token_arguments_ (ft, expr, t); --- 19361,19366 ---- ffesymbol_resolve_intrin (s); s = ffecom_sym_learned (s); ! ffesymbol_reference (s, ffeexpr_stack_->tokens[0], FALSE); ffesymbol_signal_unreported (s); /* For debugging purposes. */ ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom); return (ffelexHandler) ffeexpr_token_arguments_ (ft, expr, t); diff -rcp2N g77-0.5.20/f/g77.1 g77-0.5.21/f/g77.1 *** g77-0.5.20/f/g77.1 Mon Feb 24 23:08:05 1997 --- g77-0.5.21/f/g77.1 Tue Sep 9 06:11:33 1997 *************** *** 1,6 **** ! .\" Copyright (c) 1995, 1996 Free Software Foundation -*-Text-*- .\" See section COPYING for conditions for redistribution .\" FIXME: no info here on predefines. Should there be? extra for F77... ! .TH G77 1 "1997-02-24" "GNU Tools" "GNU Tools" .de BP .sp --- 1,6 ---- ! .\" Copyright (c) 1995-1997 Free Software Foundation -*-Text-*- .\" See section COPYING for conditions for redistribution .\" FIXME: no info here on predefines. Should there be? extra for F77... ! .TH G77 1 "1997-09-09" "GNU Tools" "GNU Tools" .de BP .sp *************** *** 9,13 **** .. .SH NAME ! g77 \- GNU project F77 Compiler (v0.5.18) .SH SYNOPSIS .RB g77 " [" \c --- 9,13 ---- .. .SH NAME ! g77 \- GNU project Fortran Compiler (v0.5.21) .SH SYNOPSIS .RB g77 " [" \c *************** g77 \- GNU project F77 Compiler (v0.5.18 *** 15,20 **** .SH WARNING The information in this man page is an extract from the full ! documentation of the GNU Fortran compiler (version 0.5.18), ! and is limited to the meaning of the options. .PP This man page is not up to date, since no volunteers want to --- 15,20 ---- .SH WARNING The information in this man page is an extract from the full ! documentation of the GNU Fortran compiler (version 0.5.21), ! and is limited to the meaning of some of the options. .PP This man page is not up to date, since no volunteers want to *************** maintain it. If you find a discrepancy *** 22,29 **** software, please check the Info file, which is the authoritative documentation. ! .PP ! The version of GNU Fortran documented by the Info file is 0.5.20, ! which includes substantial improvements and changes since 0.5.18, ! the version documented in this man page. .PP If we find that the things in this man page that are out of date cause --- 22,29 ---- software, please check the Info file, which is the authoritative documentation. ! .\" .PP ! .\" The version of GNU Fortran documented by the Info file is 0.5.21, ! .\" which includes substantial improvements and changes since 0.5.21, ! .\" the version documented in this man page. .PP If we find that the things in this man page that are out of date cause *************** For complete and current documentation, *** 38,42 **** \&\|' or the manual .I ! Using and Porting GNU Fortran (for version 0.5.18)\c \&. Both are made from the Texinfo source file .BR g77.texi . --- 38,42 ---- \&\|' or the manual .I ! Using and Porting GNU Fortran (for version 0.5.21)\c \&. Both are made from the Texinfo source file .BR g77.texi . *************** The C and F77 compilers are integrated; *** 70,74 **** .B g77 is a program to call ! .B gcc with options to recognize F77. .B gcc processes input files --- 70,76 ---- .B g77 is a program to call ! .B gcc ! with options to recognize programs written in Fortran (ANSI FORTRAN 77, ! also called F77). .B gcc processes input files *************** through one or more of four stages: prep *** 76,94 **** assembly, and linking. This man page contains full descriptions for .I only ! F77 specific aspects of the compiler, though it also contains summaries of some general-purpose options. For a fuller explanation of the compiler, see .BR gcc ( 1 ). ! For complete documentation on GNU Fortran, type ! .BR info g77 F77 source files use the suffix `\|\c .B .f\c \&\|'; F77 files to be preprocessed by .BR cpp ( 1 ) use the suffix `\|\c .B .F\c ! \&\|'. .SH OPTIONS There are many command-line options, including options to control --- 78,107 ---- assembly, and linking. This man page contains full descriptions for .I only ! F77-specific aspects of the compiler, though it also contains summaries of some general-purpose options. For a fuller explanation of the compiler, see .BR gcc ( 1 ). ! For complete documentation on GNU Fortran, type `\|\c ! .B info g77\c ! \&\|'. F77 source files use the suffix `\|\c .B .f\c + \&\|' or `\|\c + .B .for\c \&\|'; F77 files to be preprocessed by .BR cpp ( 1 ) use the suffix `\|\c .B .F\c ! \&\|' or `\|\c ! .B .fpp\c ! \&\|'; Ratfor source files use the suffix `\|\c ! .B .r\c ! \&\|' (though ! .B ratfor ! itself is not supplied as part of ! .B g77\c ! \&). .SH OPTIONS There are many command-line options, including options to control *************** to disable actual invocation of *** 243,250 **** is the name of a UNIX command that simply returns success status). The command ! .RB ` "gcc -v" ' ! is the appropriate one to determine the g77 and GCC version numbers; ! it will produce an irrelevant error message from ! .RB ` ld '. .TP .B \-Wall --- 256,261 ---- is the name of a UNIX command that simply returns success status). The command ! .RB ` "g77 -v" ' ! is the appropriate one to determine the g77 and GCC version numbers. .TP .B \-Wall *************** file.F preprocessed Fortran source fi *** 266,269 **** --- 277,282 ---- file.fpp preprocessed Fortran source file .br + file.r Ratfor source file (ratfor not included) + .br file.s assembly language file .br *************** files *** 293,302 **** \fILIBDIR\fR/include standard gcc directory for .B #include ! files .I LIBDIR is usually .B /usr/local/lib/\c .IR machine / version . ! .br .I TMPDIR comes from the environment variable --- 306,317 ---- \fILIBDIR\fR/include standard gcc directory for .B #include ! .br ! files. ! .sp .I LIBDIR is usually .B /usr/local/lib/\c .IR machine / version . ! .sp .I TMPDIR comes from the environment variable *************** if available, else *** 310,317 **** gcc(1), cpp(1), as(1), ld(1), gdb(1), adb(1), dbx(1), sdb(1). .br ! .RB "`\|" g77 "\|', `\|" gcc "\|', `\|" cpp \|', ! .RB `\| as \|', `\| ld \|', and ! .RB `\| gdb \|' entries in .B info\c --- 325,332 ---- gcc(1), cpp(1), as(1), ld(1), gdb(1), adb(1), dbx(1), sdb(1). .br ! .RB "`\|" g77 "\|', `\|" gcc "\|', `\|" cpp "\|'," ! .RB "`\|" as "\|', `\|" ld "\|'," and ! .RB "`\|" gdb "\|'" entries in .B info\c *************** entries in *** 319,323 **** .br .I ! Using and Porting GNU Fortran (for version 0.5.18)\c , James Craig Burley; .I --- 334,338 ---- .br .I ! Using and Porting GNU Fortran (for version 0.5.21)\c , James Craig Burley; .I *************** gld: the GNU linker\c *** 338,347 **** .SH BUGS ! For instructions on how to report bugs, see the file ! .B DOC ! in the g77 distribution. .SH COPYING ! Copyright (c) 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. .PP Permission is granted to make and distribute verbatim copies of --- 353,362 ---- .SH BUGS ! For instructions on how to report bugs, type `\|\c ! .B info g77 -n Bugs\c ! \&\|'. .SH COPYING ! Copyright (c) 1991-1997 Free Software Foundation, Inc. .PP Permission is granted to make and distribute verbatim copies of diff -rcp2N g77-0.5.20/f/g77.c g77-0.5.21/f/g77.c *** g77-0.5.20/f/g77.c Fri Feb 21 14:23:15 1997 --- g77-0.5.21/f/g77.c Fri Jul 11 00:07:55 1997 *************** the Free Software Foundation, 59 Temple *** 30,37 **** before passing it to `gcc': ! 1. Put `-xf77' or `-xf77-cpp-input' before each list of foo.f or foo.F ! source files and put `-xnone' after that list, if necessary. ! This shouldn't normally be necessary, but it is done in case ! gcc.c normally treats .f/.F files as, say, to be compiled by f2c. 2. Make sure `-lf2c -lm' is at the end of the list. --- 30,38 ---- before passing it to `gcc': ! 1. Put `-xf77', `-xf77-cpp-input' or `-xratfor' before each list ! of foo.f, foo.F or foo.r source files and put `-xnone' after ! that list, if necessary. This shouldn't normally be necessary, ! but it is done in case gcc.c normally treats .f/.F files as, ! say, to be compiled by f2c. 2. Make sure `-lf2c -lm' is at the end of the list. *************** typedef enum *** 253,256 **** --- 254,258 ---- OPTION_P, /* Aka --print-*-name. */ OPTION_S, /* Aka --assemble. */ + OPTION_syntax_only, /* -fsyntax-only. */ OPTION_v, /* Aka --verbose. */ OPTION_version, /* --version. */ *************** lookup_option (xopt, xskip, xarg, text) *** 780,786 **** ; ! if (text[1] != '-') ! skip = 0; ! else if (strcmp (text, "--assemble") == 0) opt = OPTION_S; else if (strcmp (text, "--compile") == 0) --- 782,786 ---- ; ! if (strcmp (text, "--assemble") == 0) opt = OPTION_S; else if (strcmp (text, "--compile") == 0) *************** lookup_option (xopt, xskip, xarg, text) *** 824,827 **** --- 824,829 ---- || (strcmp (text, "-nodefaultlibs") == 0)) opt = OPTION_nostdlib; + else if (strcmp (text, "-fsyntax-only") == 0) + opt = OPTION_syntax_only; else if (opteq (&skip, &arg, text, "--use-version") == 0) opt = OPTION_V; *************** main (argc, argv) *** 1166,1170 **** 1 => -xfoo in effect on input/output 2 => -xnone in effect on input, -xf77 on output ! 3 => -xnone in effect on input, -xf77-cpp-input on output. */ int saw_speclang = 0; --- 1168,1173 ---- 1 => -xfoo in effect on input/output 2 => -xnone in effect on input, -xf77 on output ! 3 => -xnone in effect on input, -xf77-cpp-input on output. ! 4 => -xnone in effect on input, -xratfor on output. */ int saw_speclang = 0; *************** main (argc, argv) *** 1239,1242 **** --- 1242,1246 ---- case OPTION_c: case OPTION_S: + case OPTION_syntax_only: case OPTION_E: case OPTION_M: *************** main (argc, argv) *** 1261,1265 **** case OPTION_v: if (!verbose) ! printf ("g77 version %s\n", ffezzz_version_string); verbose = 1; break; --- 1265,1269 ---- case OPTION_v: if (!verbose) ! fprintf (stderr, "g77 version %s\n", ffezzz_version_string); verbose = 1; break; *************** main (argc, argv) *** 1278,1282 **** printf ("\ GNU Fortran %s\n\ ! Copyright (C) 1996 Free Software Foundation, Inc.\n\ For more version information on components of the GNU Fortran\n\ compilation system, especially useful when reporting bugs,\n\ --- 1282,1286 ---- printf ("\ GNU Fortran %s\n\ ! Copyright (C) 1997 Free Software Foundation, Inc.\n\ For more version information on components of the GNU Fortran\n\ compilation system, especially useful when reporting bugs,\n\ *************** Report bugs to fortran@gnu.ai.mit.edu.\n *** 1401,1418 **** && (len = strlen (argv[i])) > 2 && ((argv[i][len - 1] == 'F') ! || (argv[i][len - 1] == 'f')) && argv[i][len - 2] == '.') ! { /* filename.f or filename.F. */ if (saw_library == 1) /* -l. */ append_arg ("-lm"); saw_library = 0; ! want_speclang = (argv[i][len - 1] == 'F') + 2; ! if (saw_speclang != want_speclang) { ! if (want_speclang == 2) ! append_arg ("-xf77"); ! else ! append_arg ("-xf77-cpp-input"); saw_speclang = want_speclang; } --- 1405,1445 ---- && (len = strlen (argv[i])) > 2 && ((argv[i][len - 1] == 'F') ! || (argv[i][len - 1] == 'f') ! || (argv[i][len - 1] == 'r')) && argv[i][len - 2] == '.') ! { /* filename.f or filename.F. or filename.r */ if (saw_library == 1) /* -l. */ append_arg ("-lm"); saw_library = 0; ! switch (argv[i][len - 1]) ! { ! case 'f': ! want_speclang = 2; ! break; ! case 'F': ! want_speclang = 3; ! break; ! case 'r': ! want_speclang = 4; ! break; ! default: ! break; ! } if (saw_speclang != want_speclang) { ! switch (want_speclang) ! { ! case 2: ! append_arg ("-xf77"); ! break; ! case 3: ! append_arg ("-xf77-cpp-input"); ! break; ! case 4: ! append_arg ("-xratfor"); ! break; ! default: ! break; ! } saw_speclang = want_speclang; } diff -rcp2N g77-0.5.20/f/g77.texi g77-0.5.21/f/g77.texi *** g77-0.5.20/f/g77.texi Sat Mar 1 04:06:54 1997 --- g77-0.5.21/f/g77.texi Tue Sep 9 06:11:34 1997 *************** was contributed to Craig by David Ronis *** 103,116 **** @center James Craig Burley @sp 3 ! @center Last updated 1997-02-28 @sp 1 @c The version number appears some more times in this file. ! @center for version 0.5.20 @page @vskip 0pt plus 1filll Copyright @copyright{} 1995-1997 Free Software Foundation, Inc. @sp 2 ! For GNU Fortran Version 0.5.20* @sp 1 Published by the Free Software Foundation @* --- 103,116 ---- @center James Craig Burley @sp 3 ! @center Last updated 1997-09-09 @sp 1 @c The version number appears some more times in this file. ! @center for version 0.5.21 @page @vskip 0pt plus 1filll Copyright @copyright{} 1995-1997 Free Software Foundation, Inc. @sp 2 ! For GNU Fortran Version 0.5.21* @sp 1 Published by the Free Software Foundation @* *************** original English. *** 157,161 **** This manual documents how to run, install and port the GNU Fortran compiler, as well as its new features and incompatibilities, and how to ! report bugs. It corresponds to GNU Fortran version 0.5.20. @end ifset @end ifset --- 157,161 ---- This manual documents how to run, install and port the GNU Fortran compiler, as well as its new features and incompatibilities, and how to ! report bugs. It corresponds to GNU Fortran version 0.5.21. @end ifset @end ifset *************** report bugs. It corresponds to GNU Fort *** 164,173 **** This manual documents how to run and install the GNU Fortran compiler, as well as its new features and incompatibilities, and how to report ! bugs. It corresponds to GNU Fortran version 0.5.20. @end ifclear @ifclear USING This manual documents how to port the GNU Fortran compiler, as well as its new features and incompatibilities, and how to report ! bugs. It corresponds to GNU Fortran version 0.5.20. @end ifclear --- 164,173 ---- This manual documents how to run and install the GNU Fortran compiler, as well as its new features and incompatibilities, and how to report ! bugs. It corresponds to GNU Fortran version 0.5.21. @end ifclear @ifclear USING This manual documents how to port the GNU Fortran compiler, as well as its new features and incompatibilities, and how to report ! bugs. It corresponds to GNU Fortran version 0.5.21. @end ifclear *************** for more information. *** 619,623 **** @item ! The run-time library used by GNU Fortran is a minor repackaging of the @code{libf2c} library (combined from the @code{libF77} and @code{libI77} libraries) provided as part of @code{f2c}, available for --- 619,623 ---- @item ! The run-time library used by GNU Fortran is a repackaged version of the @code{libf2c} library (combined from the @code{libF77} and @code{libI77} libraries) provided as part of @code{f2c}, available for *************** care of all this for you.) *** 1158,1164 **** The @code{f771} program represents most of what is unique to GNU Fortran. ! While the @code{libf2c} component is really part of @code{f2c}, a ! free Fortran-to-C converter distributed by Bellcore (AT&T), and ! the @code{g77} command is just a small front-end to @code{gcc}, @code{f771} is a combination of two rather large chunks of code. --- 1158,1165 ---- The @code{f771} program represents most of what is unique to GNU Fortran. ! While much of the @code{libf2c} component is really part of @code{f2c}, ! a free Fortran-to-C converter distributed by Bellcore (AT&T), ! plus @code{libU77}, provided by Dave Love, ! and the @code{g77} command is just a small front-end to @code{gcc}, @code{f771} is a combination of two rather large chunks of code. *************** by type. Explanations are in the follow *** 1362,1366 **** @smallexample -fsyntax-only -pedantic -pedantic-errors -fpedantic ! -w -Wimplicit -Wunused -Wuninitialized -Wall -Wsurprising -Werror -W @end smallexample --- 1363,1368 ---- @smallexample -fsyntax-only -pedantic -pedantic-errors -fpedantic ! -w -Wno-globals -Wimplicit -Wunused -Wuninitialized ! -Wall -Wsurprising -Werror -W @end smallexample *************** by type. Explanations are in the follow *** 1402,1405 **** --- 1404,1408 ---- -falias-check -fargument-alias -fargument-noalias -fno-argument-noalias-global + -fno-globals @end smallexample @end table *************** information on suffixes recognized by GN *** 1453,1456 **** --- 1456,1462 ---- Fortran source code that should not be preprocessed. + Such source code cannot contain any preprocessor directives, such + as @code{#include}, @code{#define}, @code{#if}, and so on. + @cindex preprocessor @cindex C preprocessor *************** Fortran source code that should not be p *** 1465,1468 **** --- 1471,1486 ---- Fortran source code that must be preprocessed (by the C preprocessor @code{cpp}, which is part of GNU CC). + + Note that preprocessing is not extended to the contents of + files included by the @code{INCLUDE} directive---the @code{#include} + preprocessor directive must be used instead. + + @cindex Ratfor preprocessor + @cindex programs, ratfor + @cindex .r filename suffix + @item @var{file}.r + Ratfor source code, which must be preprocessed by the @code{ratfor} + command, which is available separately (as it is not yet part of + the GNU Fortran distribution). @end table *************** such constants are interpreted by the C *** 1496,1499 **** --- 1514,1529 ---- compiler. + Another example of a problem that results from using the C preprocessor + is that a Fortran comment line that happens to contain any + characters ``interesting'' to the C preprocessor, + such as a backslash at the end of the line, + is not recognized by the preprocessor as a comment line, + so instead of being passed through ``raw'', + the line is edited according to the rules for the preprocessor. + For example, the backslash at the end of the line is removed, + along with the subsequent newline, resulting in the next + line being effectively commented out---unfortunate if that + line is a non-comment line of important code! + @emph{Note:} The @samp{-traditional} and @samp{-undef} flags are supplied to @code{cpp} by default, to avoid unpleasant surprises. *************** Specify status of VXT intrinsics. *** 2128,2132 **** @cindex fixed-form line length Set column after which characters are ignored in typical fixed-form ! lines in the source file. @cindex card image --- 2158,2163 ---- @cindex fixed-form line length Set column after which characters are ignored in typical fixed-form ! lines in the source file, and through which spaces are assumed (as ! if padded to that length) after the ends of short fixed-form lines. @cindex card image *************** to them to fill out the line. *** 2140,2143 **** --- 2171,2176 ---- @samp{-ffixed-line-length-0} means the same thing as @samp{-ffixed-line-length-none}. + + @xref{Source Form}, for more information. @end table *************** Like @samp{-pedantic}, but applies only *** 2206,2209 **** --- 2239,2257 ---- Inhibit all warning messages. + @cindex -Wno-globals option + @cindex options, -Wno-globals + @item -Wno-globals + @cindex global names, warning + @cindex warnings, global names + Inhibit warnings about use of a name as both a global name + (a subroutine, function, or block data program unit, or a + common block) and implicitly as the name of an intrinsic + in a source file. + + Also inhibit warnings about inconsistent invocations and/or + definitions of global procedures (function and subroutines). + Such inconsistencies include different numbers of arguments + and different types of arguments. + @cindex -Wimplicit option @cindex options, -Wimplicit *************** Noticeably improves performance of @code *** 2523,2527 **** heavy use of @code{REAL(KIND=2)} (@code{DOUBLE PRECISION}) data on some systems. ! In particular, systems using Pentium, Pentium Pro, 585, and 686 implementations of the i386 architecture execute programs faster when --- 2571,2575 ---- heavy use of @code{REAL(KIND=2)} (@code{DOUBLE PRECISION}) data on some systems. ! In particular, systems using Pentium, Pentium Pro, 586, and 686 implementations of the i386 architecture execute programs faster when *************** this option does not apply, generally sp *** 2538,2545 **** code compiled by @code{g77}. ! @emph{Also note:} Apparently due to a @code{gcc} backend bug, ! @samp{-malign-double} does not align stack-allocated data (such as ! local variables neither @code{SAVE}d nor reckoned to take up too ! much space to put on the stack). @emph{Also also note:} The negative form of @samp{-malign-double} --- 2586,2592 ---- code compiled by @code{g77}. ! @emph{Also note:} @code{g77} fixes a @code{gcc} backend bug to allow ! @samp{-malign-double} to work generally, not just with ! statically-allocated data. @emph{Also also note:} The negative form of @samp{-malign-double} *************** Each of these might improve performance *** 2634,2638 **** Analysis of Fortran code optimization and the resulting optimizations triggered by the above options were ! contributed by Toon Moene (@code{toon@@moene.indiv.nluug.nl}). These three options are intended to be removed someday, once --- 2681,2685 ---- Analysis of Fortran code optimization and the resulting optimizations triggered by the above options were ! contributed by Toon Moene (@email{toon@@moene.indiv.nluug.nl}). These three options are intended to be removed someday, once *************** is not requested, it is not described in *** 2674,2677 **** --- 2721,2735 ---- information on how @code{g77} processes the @code{INCLUDE} directive. + However, the @code{INCLUDE} directive does not apply + preprocessing to the contents of the included file itself. + + Therefore, any file that contains preprocessor directives + (such as @code{#include}, @code{#define}, and @code{#if}) + must be included via the @code{#include} directive, not + via the @code{INCLUDE} directive. + Therefore, any file containing preprocessor directives, + if included, is necessarily included by a file that itself + contains preprocessor directives. + @node Directory Options @section Options for Directory Search *************** when the preproecssor is used. *** 2688,2692 **** @cindex directive, INCLUDE Some of these options also affect how @code{g77} searches ! for files specified via the @code{INCLUDE} directive. These options are: --- 2746,2752 ---- @cindex directive, INCLUDE Some of these options also affect how @code{g77} searches ! for files specified via the @code{INCLUDE} directive, ! although files included by that directive are not, ! themselves, preprocessed. These options are: *************** good idea to also use @samp{-fno-automat *** 2770,2778 **** @cindex compatibility, @code{f2c} Do not generate code designed to be compatible with code generated ! by @code{f2c}. This does not affect the generation of code that interfaces with the @code{libf2c} library. @strong{Caution:} If @samp{-fno-f2c} is used when compiling any source file used in a program, it must be used when compiling --- 2830,2865 ---- @cindex compatibility, @code{f2c} Do not generate code designed to be compatible with code generated ! by @code{f2c}; use the GNU calling conventions instead. ! ! The @code{f2c} calling conventions require functions that return ! type @code{REAL(KIND=1)} to actually return the C type @code{double}, ! and functions that return type @code{COMPLEX} to return the ! values via an extra argument in the calling sequence that points ! to where to store the return value. ! Under the GNU calling conventions, such functions simply return ! their results as they would in GNU C---@code{REAL(KIND=1)} functions ! return the C type @code{float}, and @code{COMPLEX} functions ! return the GNU C type @code{complex} (or its @code{struct} ! equivalent). This does not affect the generation of code that interfaces with the @code{libf2c} library. + However, because the @code{libf2c} library uses @code{f2c} + calling conventions, @code{g77} rejects attempts to pass + intrinsics implemented by routines in this library as actual + arguments when @samp{-fno-f2c} is used, to avoid bugs when + they are actually called by code expecting the GNU calling + conventions to work. + + For example, @samp{INTRINSIC ABS;CALL FOO(ABS)} is + rejected when @samp{-fno-f2c} is in force. + (Future versions of the @code{g77} run-time library might + offer routines that provide GNU-callable versions of the + routines that implement the @code{f2c}-callable intrinsics + that may be passed as actual arguments, so that + valid programs need not be rejected when @samp{-fno-f2c} + is used.) + @strong{Caution:} If @samp{-fno-f2c} is used when compiling any source file used in a program, it must be used when compiling *************** Treat initial values of zero as if they *** 2898,2902 **** As of version 0.5.18, @code{g77} normally treats @code{DATA} and ! other statements that are used specify initial values of zero for variables and arrays as if no values were actually specified, in the sense that no diagnostics regarding multiple initializations --- 2985,2989 ---- As of version 0.5.18, @code{g77} normally treats @code{DATA} and ! other statements that are used to specify initial values of zero for variables and arrays as if no values were actually specified, in the sense that no diagnostics regarding multiple initializations *************** options are in effect (and when optimiza *** 3054,3057 **** --- 3141,3183 ---- of compiling Fortran code that depends on the ability to alias dummy arguments. + + @cindex -fno-globals option + @cindex options, -fno-globals + @item -fno-globals + @cindex global names, warning + @cindex warnings, global names + Disable diagnostics about inter-procedural + analysis problems, such as disagreements about the + type of a function or a procedure's argument, + that might cause a compiler crash when attempting + to inline a reference to a procedure within a + program unit. + (The diagnostics themselves are still produced, but + as warnings, unless @samp{-Wno-globals} is specified, + in which case no relevant diagnostics are produced.) + + Further, this option disables such inlining, to + avoid compiler crashes resulting from incorrect + code that would otherwise be diagnosed. + + As such, this option might be quite useful when + compiling existing, ``working'' code that happens + to have a few bugs that do not generally show + themselves, but @code{g77} exposes via a + diagnostic. + + Use of this option therefore has the effect of + instructing @code{g77} to behave more like it did + up through version 0.5.19.1, when it paid little or + no attention to disagreements between program units + about a procedure's type and argument information, + and when it performed no inlining of procedures + (except statement functions). + + Without this option, @code{g77} defaults to performing + the potentially inlining procedures as it started doing + in version 0.5.20, but as of version 0.5.21, it also + diagnoses disagreements that might cause such inlining + to crash the compiler. @end table *************** such changes to @code{g77}. *** 3126,3134 **** To find out about existing bugs and ongoing plans for GNU ! Fortran, retrieve @url{ftp://alpha.gnu.ai.mit.edu/g77.plan} or, if you cannot do that, email @email{fortran@@gnu.ai.mit.edu} asking for a recent copy of the GNU Fortran @file{.plan} file. @heading In 0.5.20: @itemize @bullet --- 3252,3332 ---- To find out about existing bugs and ongoing plans for GNU ! Fortran, retrieve @uref{ftp://alpha.gnu.ai.mit.edu/g77.plan} or, if you cannot do that, email @email{fortran@@gnu.ai.mit.edu} asking for a recent copy of the GNU Fortran @file{.plan} file. + @heading In 0.5.21: + @itemize @bullet + @item + When the @samp{-W} option is specified, @code{gcc}, @code{g77}, + and other GNU compilers that incorporate the @code{gcc} + back end as modified by @code{g77}, issue + a warning about integer division by constant zero. + + @item + New option @samp{-Wno-globals} disables warnings + about ``suspicious'' use of a name both as a global + name and as the implicit name of an intrinsic, and + warnings about disagreements over the number or natures of + arguments passed to global procedures, or the + natures of the procedures themselves. + + The default is to issue such warnings, which are + new as of this version of @code{g77}. + + @item + New option @samp{-fno-globals} disables diagnostics + about potentially fatal disagreements + analysis problems, such as disagreements over the + number or natures of arguments passed to global + procedures, or the natures of those procedures themselves. + + The default is to issue such diagnostics and flag + the compilation as unsuccessful. + With this option, the diagnostics are issued as + warnings, or, if @samp{-Wno-globals} is specified, + are not issued at all. + + This option also disables inlining of global procedures, + to avoid compiler crashes resulting from coding errors + that these diagnostics normally would identify. + + @item + Fix @code{libU77} routines that accept file names + to strip trailing spaces from them, for consistency + with other implementations. + + @item + Fix @code{SIGNAL} intrinsic so it accepts an + optional third @samp{Status} argument. + + @item + Make many changes to @code{libU77} intrinsics to + support existing code more directly. + + Such changes include allowing both subroutine and + function forms of many routines, changing @code{MCLOCK()} + and @code{TIME()} to return @code{INTEGER(KIND=1)} values, + introducing @code{MCLOCK8()} and @code{TIME8()} to + return @code{INTEGER(KIND=2)} values, + and placing functions that are intended to perform + side effects in a new intrinsic group, @code{badu77}. + + @item + Add options @samp{-fbadu77-intrinsics-delete}, + @samp{-fbadu77-intrinsics-hide}, and so on. + + @item + Add @code{INT2} and @code{INT8} intrinsics. + + @item + Add @code{CPU_TIME} intrinsic. + + @item + @code{CTIME} intrinsic now accepts any @code{INTEGER} + argument, not just @code{INTEGER(KIND=2)}. + @end itemize + @heading In 0.5.20: @itemize @bullet *************** way through the compilation process inst *** 3498,3506 **** @cindex standard, ANSI FORTRAN 77 @cindex ANSI FORTRAN 77 standard GNU Fortran supports a variety of extensions to, and dialects of, the Fortran language. Its primary base is the ANSI FORTRAN 77 standard, currently available on ! the network at @url{http://kumo.swcp.com/fortran/F77_std/f77_std.html} ! or in @url{ftp://ftp.ast.cam.ac.uk/pub/michael/}. It offers some extensions that are popular among users of UNIX @code{f77} and @code{f2c} compilers, some that --- 3696,3705 ---- @cindex standard, ANSI FORTRAN 77 @cindex ANSI FORTRAN 77 standard + @cindex reference works GNU Fortran supports a variety of extensions to, and dialects of, the Fortran language. Its primary base is the ANSI FORTRAN 77 standard, currently available on ! the network at @uref{http://kumo.swcp.com/fortran/F77_std/f77_std.html} ! or in @uref{ftp://ftp.ast.cam.ac.uk/pub/michael/}. It offers some extensions that are popular among users of UNIX @code{f77} and @code{f2c} compilers, some that *************** newer Fortran 90 standard, and some that *** 3510,3513 **** --- 3709,3717 ---- by GNU Fortran. + @cindex textbooks + (If you need a text on Fortran, + a few freely available electronic references have pointers from + @uref{http://www.fortran.com/fortran/Books/}.) + Part of what defines a particular implementation of a Fortran system, such as @code{g77}, is the particular characteristics *************** of both new documentation and new suppor *** 3587,3591 **** However, it might occasionally mean removing a feature from the language itself to ``dialect'' status. ! In such a case, the documentation be adjusted to reflect the change, and @code{g77} itself would likely be changed to require one or more command-line options to continue supporting --- 3791,3795 ---- However, it might occasionally mean removing a feature from the language itself to ``dialect'' status. ! In such a case, the documentation would be adjusted to reflect the change, and @code{g77} itself would likely be changed to require one or more command-line options to continue supporting *************** variables of each outer implied-@code{DO *** 3772,3778 **** this fragment is disallowed by @code{g77}: ! @example DATA (A, I= 1, 1) /1./ ! @end example @noindent --- 3976,3982 ---- this fragment is disallowed by @code{g77}: ! @smallexample DATA (A, I= 1, 1) /1./ ! @end smallexample @noindent *************** This restriction avoids the confusion *** 4036,4042 **** that can result when reading a line such as: ! @example IF (VALIDP) CALL FOO; CALL BAR ! @end example @noindent --- 4240,4246 ---- that can result when reading a line such as: ! @smallexample IF (VALIDP) CALL FOO; CALL BAR ! @end smallexample @noindent *************** for the benefit of those readers who are *** 4588,4594 **** The following notation specifies the storage size for a type: ! @example @var{generic-type}*@var{n} ! @end example @noindent --- 4792,4798 ---- The following notation specifies the storage size for a type: ! @smallexample @var{generic-type}*@var{n} ! @end smallexample @noindent *************** for the benefit of those readers who are *** 4666,4672 **** The following notation specifies the kind-type selector of a type: ! @example @var{generic-type}(KIND=@var{n}) ! @end example @noindent --- 4870,4876 ---- The following notation specifies the kind-type selector of a type: ! @smallexample @var{generic-type}(KIND=@var{n}) ! @end smallexample @noindent *************** The values of @var{n} assigned so far ar *** 4747,4762 **** @table @code @item KIND=0 ! This is valid only as @code{INTEGER(KIND=0)} and ! denotes the @code{INTEGER} type that has the smallest ! storage size that holds a pointer on the system. ! A pointer representable by this type is capable of uniquely ! addressing a @code{CHARACTER*1} variable, array, array element, ! or substring. ! ! (Typically this is equivalent to @code{INTEGER*4} or, ! on 64-bit systems, @code{INTEGER*8}. ! In a compatible C implementation, it typically would ! be the same size and semantics of the C type @code{void *}.) @item KIND=1 --- 4951,4960 ---- @table @code @item KIND=0 ! This value is reserved for future use. ! The planned future use is for this value to designate, ! explicitly, context-sensitive kind-type selection. ! For example, the expression @samp{1D0 * 0.1_0} would ! be equivalent to @samp{1D0 * 0.1D0}. @item KIND=1 *************** as much storage as the default types. *** 4816,4819 **** --- 5014,5032 ---- These are not necessarily supported by every GNU Fortran implementation. + + @item KIND=7 + @cindex pointers + This is valid only as @code{INTEGER(KIND=7)} and + denotes the @code{INTEGER} type that has the smallest + storage size that holds a pointer on the system. + + A pointer representable by this type is capable of uniquely + addressing a @code{CHARACTER*1} variable, array, array element, + or substring. + + (Typically this is equivalent to @code{INTEGER*4} or, + on 64-bit systems, @code{INTEGER*8}. + In a compatible C implementation, it typically would + be the same size and semantics of the C type @code{void *}.) @end table *************** This could lead to the GNU Fortran langu *** 4901,4910 **** A @dfn{typeless constant} has one of the following forms: ! @example '@var{binary-digits}'B '@var{octal-digits}'O '@var{hexadecimal-digits}'Z '@var{hexadecimal-digits}'X ! @end example @noindent --- 5114,5123 ---- A @dfn{typeless constant} has one of the following forms: ! @smallexample '@var{binary-digits}'B '@var{octal-digits}'O '@var{hexadecimal-digits}'Z '@var{hexadecimal-digits}'X ! @end smallexample @noindent *************** and @samp{1D0} is always type @code{REAL *** 4938,4947 **** An integer constant also may have one of the following forms: ! @example B'@var{binary-digits}' O'@var{octal-digits}' Z'@var{hexadecimal-digits}' X'@var{hexadecimal-digits}' ! @end example @noindent --- 5151,5160 ---- An integer constant also may have one of the following forms: ! @smallexample B'@var{binary-digits}' O'@var{octal-digits}' Z'@var{hexadecimal-digits}' X'@var{hexadecimal-digits}' ! @end smallexample @noindent *************** In this case, an apostrophe within the c *** 4962,4966 **** a single apostrophe, while a double quote is represented in the source text of the constant by two consecutive double ! quotes with no intervening blanks. @cindex zero-length CHARACTER --- 5175,5179 ---- a single apostrophe, while a double quote is represented in the source text of the constant by two consecutive double ! quotes with no intervening spaces. @cindex zero-length CHARACTER *************** that yields the value of the location of *** 5002,5006 **** The size of the type of the expression depends on the system---typically, it is equivalent to either @code{INTEGER(KIND=1)} or @code{INTEGER(KIND=2)}, ! though it is actually type @code{INTEGER(KIND=0)}. The argument to @code{%LOC()} must be suitable as the --- 5215,5219 ---- The size of the type of the expression depends on the system---typically, it is equivalent to either @code{INTEGER(KIND=1)} or @code{INTEGER(KIND=2)}, ! though it is actually type @code{INTEGER(KIND=7)}. The argument to @code{%LOC()} must be suitable as the *************** These names are local to the program uni *** 5149,5155 **** as follows: ! @example @var{construct-name}: @var{block-statement} ! @end example @noindent --- 5362,5368 ---- as follows: ! @smallexample @var{construct-name}: @var{block-statement} ! @end smallexample @noindent *************** are given arguments that do not conform *** 5508,5515 **** --- 5721,5733 ---- @smallexample PROGRAM JCB002 + C Version 1: + C Modified 1997-05-21 (Burley) to accommodate compilers that implement + C INT(I1-I2) as INT(I1)-INT(I2) given INTEGER*2 I1,I2. C + C Version 0: C Written by James Craig Burley 1997-02-20. C Contact via Internet email: burley@@gnu.ai.mit.edu C + C Purpose: C Determine how compilers handle non-standard IDIM C on INTEGER*2 operands, which presumably can be *************** C *** 5526,5529 **** --- 5744,5748 ---- INTEGER*2 ISMALL, ILARGE INTEGER*2 ITOOLG, ITWO + INTEGER*2 ITMP LOGICAL L2, L3, L4 C *************** C *** 5558,5570 **** I1 = IDIM (ILARGE, ISMALL) * ITWO + ITOOLG C ! C Try first interpretation. C I2 = (INT (ILARGE) - INT (ISMALL)) * ITWO + ITOOLG C ! C Try second interpretation. C ! I3 = (INT (ILARGE - ISMALL)) * ITWO + ITOOLG C ! C Try third interpretation. C I4 = (ILARGE - ISMALL) * ITWO + ITOOLG --- 5777,5790 ---- I1 = IDIM (ILARGE, ISMALL) * ITWO + ITOOLG C ! C Calculate result for first interpretation. C I2 = (INT (ILARGE) - INT (ISMALL)) * ITWO + ITOOLG C ! C Calculate result for second interpretation. C ! ITMP = ILARGE - ISMALL ! I3 = (INT (ITMP)) * ITWO + ITOOLG C ! C Calculate result for third interpretation. C I4 = (ILARGE - ISMALL) * ITWO + ITOOLG *************** C *** 5600,5613 **** @end smallexample ! It is possible that a future version of the GNU Fortran language ! will permit specific intrinsic invocations with wrong-typed ! arguments (such as @code{IDIM} in the above example) if the vast ! majority of production compilers agree on the interpretation of such invocations. ! Especially if you know of a compiler that does not implement ! interpretation 3 above (output @samp{Interp 3: @dots{}}), please ! let us know the details (compiler product, version, machine, results, ! and so on). @node REAL() and AIMAG() of Complex --- 5820,5865 ---- @end smallexample ! No future version of the GNU Fortran language ! will likely permit specific intrinsic invocations with wrong-typed ! arguments (such as @code{IDIM} in the above example), since ! it has been determined that disagreements exist among ! many production compilers on the interpretation of such invocations. + These disagreements strongly suggest that Fortran programmers, + and certainly existing Fortran programs, disagree about the + meaning of such invocations. + + The first version of @samp{JCB002} didn't accommodate some compilers' + treatment of @samp{INT(I1-I2)} where @samp{I1} and @samp{I2} are + @code{INTEGER*2}. + In such a case, these compilers apparently convert both + operands to @code{INTEGER*4} and then do an @code{INTEGER*4} subtraction, + instead of doing an @code{INTEGER*2} subtraction on the + original values in @samp{I1} and @samp{I2}. + + However, the results of the careful analyses done on the outputs + of programs compiled by these various compilers show that they + all implement either @samp{Interp 1} or @samp{Interp 2} above. + + Specifically, it is believed that the new version of @samp{JCB002} + above will confirm that: + + @itemize @bullet + @item + Digital Semiconductor (``DEC'') Alpha OSF/1, HP-UX 10.0.1, AIX 3.2.5 + @code{f77} compilers all implement @samp{Interp 1}. + + @item + IRIX 5.3 @code{f77} compiler implements @samp{Interp 2}. + + @item + Solaris 2.5, SunOS 4.1.3, DECstation ULTRIX 4.3, + and IRIX 6.1 @code{f77} compilers all implement @samp{Interp 3}. + @end itemize ! If you get different results than the above for the stated ! compilers, or have results for other compilers that might be ! worth adding to the above list, please let us know the details ! (compiler product, version, machine, results, and so on). @node REAL() and AIMAG() of Complex *************** CMPLX(SNGL(D1), SNGL(D2)) *** 5687,5690 **** --- 5939,5946 ---- @end example + (It was necessary for Fortran 90 to specify this behavior + for @code{DOUBLE PRECISION} arguments, since that is + the behavior mandated by FORTRAN 77.) + The GNU Fortran language also provides the @code{DCMPLX()} intrinsic, which is provided by some FORTRAN 77 compilers to construct *************** Fortran 90 extends the @code{CMPLX()} in *** 5697,5701 **** an extra argument used to specify the desired kind of complex result. ! However, this solution is somewhat awkward to use. The GNU Fortran language provides a simple way to build a complex --- 5953,5958 ---- an extra argument used to specify the desired kind of complex result. ! However, this solution is somewhat awkward to use, and ! @code{g77} currently does not support it. The GNU Fortran language provides a simple way to build a complex *************** substring reference). *** 5799,5809 **** and definable by, invocation of the intrinsic (a combination of the requirements of @code{INTENT(IN)} and @code{INTENT(OUT)}. @end itemize @ifinfo ! (Note that the blank lines appearing in the menu below are not intentional---they result from a bug in the GNU @code{makeinfo} program@dots{}a program that, if it ! did not exist, this document would be in far worse shape!) @end ifinfo --- 6056,6069 ---- and definable by, invocation of the intrinsic (a combination of the requirements of @code{INTENT(IN)} and @code{INTENT(OUT)}. + + @item + @xref{Kind Notation} for explanation of @code{KIND}. @end itemize @ifinfo ! (Note that the empty lines appearing in the menu below are not intentional---they result from a bug in the GNU @code{makeinfo} program@dots{}a program that, if it ! did not exist, would leave this document in far worse shape!) @end ifinfo *************** did not exist, this document would be in *** 5824,5827 **** --- 6084,6088 ---- @set familyF2C @set familyF2U + @clear familyBADU77 @include intdoc.texi *************** are explicitly left to the implementatio *** 5904,5908 **** standards. GNU Fortran currently tries to be somewhat like a few popular compilers ! (@code{f2c}, DEC Fortran, and so on), though a cleaner default definition along with more flexibility offered by command-line options is likely to be offered --- 6165,6169 ---- standards. GNU Fortran currently tries to be somewhat like a few popular compilers ! (@code{f2c}, Digital (``DEC'') Fortran, and so on), though a cleaner default definition along with more flexibility offered by command-line options is likely to be offered *************** not spaces, to accommodate existing code *** 6001,6004 **** --- 6262,6270 ---- treated truncated text as commentary (especially in columns 73 through 80). + @xref{Fortran Dialect Options,,Options Controlling Fortran Dialect}, + for information on the @samp{-ffixed-line-length-@var{n}} option, + which can be used to set the line length applicable to fixed-form + source files. + @node Ampersands @subsection Ampersand Continuation Line *************** lines as normal lines.) *** 6051,6055 **** @cindex $ ! Dollar signs (@samp{$}) are allow in symbol names (after the first character) when the @samp{-fdollar-ok} option is specified. --- 6317,6321 ---- @cindex $ ! Dollar signs (@samp{$}) are allowed in symbol names (after the first character) when the @samp{-fdollar-ok} option is specified. *************** of work!} *** 7004,7007 **** --- 7270,7274 ---- @menu + * Compiler Limits:: * Compiler Types:: * Compiler Constants:: *************** of work!} *** 7009,7012 **** --- 7276,7311 ---- @end menu + @node Compiler Limits + @section Compiler Limits + @cindex limits, compiler + @cindex compiler limits + + @code{g77}, as with GNU tools in general, imposes few arbitrary restrictions + on lengths of identifiers, number of continuation lines, number of external + symbols in a program, and so on. + + @cindex options, -Nl + @cindex -Nl option + @cindex options, -Nx + @cindex -Nx option + For example, some other Fortran compiler have an option + (such as @samp{-Nl@var{x}}) to increase the limit on the + number of continuation lines. + Also, some Fortran compilation systems have an option + (such as @samp{-Nx@var{x}}) to increase the limit on the + number of external symbols. + + @code{g77}, @code{gcc}, and GNU @code{ld} (the GNU linker) have + no equivalent options, since they do not impose arbitrary + limits in these areas. + + @cindex rank, maximum + @cindex maximum rank + @cindex number of dimensions, maximum + @cindex maximum number of dimensions + @code{g77} does currently limit the number of dimensions in an array + to the same degree as do the Fortran standards---seven (7). + This restriction might well be lifted in a future version. + @node Compiler Types @section Compiler Types *************** The groups are: *** 7300,7303 **** --- 7599,7606 ---- @cindex groups of intrinsics @table @code + @item badu77 + UNIX intrinsics having inappropriate forms (usually functions that + have intended side effects). + @item gnu Intrinsics the GNU Fortran language supports that are extensions to *************** This set of intrinsics is described belo *** 7330,7334 **** @ifinfo ! (Note that the blank lines appearing in the menu below are not intentional---they result from a bug in the @code{makeinfo} program.) --- 7633,7637 ---- @ifinfo ! (Note that the empty lines appearing in the menu below are not intentional---they result from a bug in the @code{makeinfo} program.) *************** are not intentional---they result from a *** 7351,7354 **** --- 7654,7658 ---- @clear familyF2C @clear familyF2U + @set familyBADU77 @include intdoc.texi *************** options @code{g77} passes by running @sa *** 7564,7568 **** @cindex Netlib Even if you don't actually use it as a compiler, @samp{f2c} from ! @url{ftp://ftp.netlib.org/f2c/src}, can be a useful tool when you're interfacing (linking) Fortran and C@. @xref{f2c Skeletons and Prototypes,,Generating Skeletons and Prototypes with @code{f2c}}. --- 7868,7872 ---- @cindex Netlib Even if you don't actually use it as a compiler, @samp{f2c} from ! @uref{ftp://ftp.netlib.org/f2c/src}, can be a useful tool when you're interfacing (linking) Fortran and C@. @xref{f2c Skeletons and Prototypes,,Generating Skeletons and Prototypes with @code{f2c}}. *************** build the @file{src} directory from the *** 7574,7578 **** Something else that might be useful is @samp{cfortran.h} from ! @url{ftp://zebra/desy.de/cfortran}. This is a fairly general tool which can be used to generate interfaces for calling in both directions --- 7878,7882 ---- Something else that might be useful is @samp{cfortran.h} from ! @uref{ftp://zebra/desy.de/cfortran}. This is a fairly general tool which can be used to generate interfaces for calling in both directions *************** the return type of a @code{REAL} @code{F *** 7618,7622 **** Fortran.@footnote{The files generated like this can also be used for inter-unit consistency checking of dummy and actual arguments, although ! the @samp{ftnchek} tool from @url{ftp://ftp.netlib.org/fortran} is probably better for this purpose.} If the Fortran code containing any --- 7922,7927 ---- Fortran.@footnote{The files generated like this can also be used for inter-unit consistency checking of dummy and actual arguments, although ! the @samp{ftnchek} tool from @uref{ftp://ftp.netlib.org/fortran} ! or @uref{ftp://ftp.dsm.fordham.edu} is probably better for this purpose.} If the Fortran code containing any *************** of @samp{F_err} in @file{f/runtime/libI7 *** 8604,8608 **** @code{g77} source tree. ! @example 100: "error in format" 101: "illegal unit number" --- 8909,8913 ---- @code{g77} source tree. ! @smallexample 100: "error in format" 101: "illegal unit number" *************** of @samp{F_err} in @file{f/runtime/libI7 *** 8636,8640 **** 129: "can't append to file" 130: "non-positive record number" ! @end example @node Collected Fortran Wisdom --- 8941,8946 ---- 129: "can't append to file" 130: "non-positive record number" ! 131: "I/O started while already doing I/O" ! @end smallexample @node Collected Fortran Wisdom *************** yet support multiple entry points. *** 8799,8806 **** Another example is that, given ! @example COMMON A, B EQUIVALENCE (B, C) ! @end example @noindent --- 9105,9112 ---- Another example is that, given ! @smallexample COMMON A, B EQUIVALENCE (B, C) ! @end smallexample @noindent *************** Here is the recommended approach to modi *** 8918,8927 **** a program unit such as the following: ! @example BLOCK DATA FOO COMMON /VARS/ X, Y, Z DATA X, Y, Z / 3., 4., 5. / END ! @end example @noindent --- 9224,9233 ---- a program unit such as the following: ! @smallexample BLOCK DATA FOO COMMON /VARS/ X, Y, Z DATA X, Y, Z / 3., 4., 5. / END ! @end smallexample @noindent *************** to force the area to be initialized. *** 8933,8947 **** For example, change a program unit that starts with ! @example INTEGER FUNCTION CURX() COMMON /VARS/ X, Y, Z CURX = X END ! @end example @noindent so that it uses the @code{EXTERNAL} statement, as in: ! @example INTEGER FUNCTION CURX() COMMON /VARS/ X, Y, Z --- 9239,9253 ---- For example, change a program unit that starts with ! @smallexample INTEGER FUNCTION CURX() COMMON /VARS/ X, Y, Z CURX = X END ! @end smallexample @noindent so that it uses the @code{EXTERNAL} statement, as in: ! @smallexample INTEGER FUNCTION CURX() COMMON /VARS/ X, Y, Z *************** EXTERNAL FOO *** 8949,8953 **** CURX = X END ! @end example @noindent --- 9255,9259 ---- CURX = X END ! @end smallexample @noindent *************** The number of trips for a loop is calcul *** 8975,8981 **** @var{end}, and @var{increment} values specified in a statement such as: ! @example DO @var{iter} = @var{start}, @var{end}, @var{increment} ! @end example @noindent --- 9281,9287 ---- @var{end}, and @var{increment} values specified in a statement such as: ! @smallexample DO @var{iter} = @var{start}, @var{end}, @var{increment} ! @end smallexample @noindent *************** not executed at all. *** 9000,9004 **** @item The type used to @emph{calculate} the trip count ! the same type as @var{iter}, but the final calculation, and thus the type of the trip count itself, always is @code{INTEGER(KIND=1)}. --- 9306,9310 ---- @item The type used to @emph{calculate} the trip count ! is the same type as @var{iter}, but the final calculation, and thus the type of the trip count itself, always is @code{INTEGER(KIND=1)}. *************** For example, on a system with the canoni *** 9011,9017 **** implementation of @code{INTEGER(KIND=1)}, the following loop will not work: ! @example DO I = -2000000000, 2000000000 ! @end example @noindent --- 9317,9323 ---- implementation of @code{INTEGER(KIND=1)}, the following loop will not work: ! @smallexample DO I = -2000000000, 2000000000 ! @end smallexample @noindent *************** the range of @code{INTEGER(KIND=1)} on m *** 9023,9027 **** Instead, the above loop should be constructed this way: ! @example I = -2000000000 DO --- 9329,9333 ---- Instead, the above loop should be constructed this way: ! @smallexample I = -2000000000 DO *************** DO *** 9030,9034 **** I = I + 1 END DO ! @end example @noindent --- 9336,9340 ---- I = I + 1 END DO ! @end smallexample @noindent *************** but the magnitude of @samp{ABS(@var{end} *** 9051,9057 **** exceeds that range. For example: ! @example DO I = 2147483600, 2147483647 ! @end example @noindent --- 9357,9363 ---- exceeds that range. For example: ! @smallexample DO I = 2147483600, 2147483647 ! @end smallexample @noindent *************** by @code{g77}, but the use, by some comp *** 9060,9066 **** more C-like implementation akin to ! @example for (i = 2147483600; i <= 2147483647; ++i) ! @end example @noindent --- 9366,9372 ---- more C-like implementation akin to ! @smallexample for (i = 2147483600; i <= 2147483647; ++i) ! @end smallexample @noindent *************** is shown in the following program, which *** 9400,9404 **** the expected results when executed: ! @example I = 1 CALL FOO(I, I) --- 9706,9710 ---- the expected results when executed: ! @smallexample I = 1 CALL FOO(I, I) *************** K = J * K *** 9411,9415 **** PRINT *, J, K END ! @end example The above program attempts to use the temporary aliasing of the --- 9717,9721 ---- PRINT *, J, K END ! @end smallexample The above program attempts to use the temporary aliasing of the *************** work on all its implementations, *** 9690,9699 **** but particular implementations (such as Pentium Pro) perform better with more strict alignment. ! There are a variety of approaches to use to address this problem, ! in any combination: @itemize @bullet @item Order your @code{COMMON} and @code{EQUIVALENCE} areas such that the variables and arrays with the widest alignment --- 9996,10009 ---- but particular implementations (such as Pentium Pro) perform better with more strict alignment. + (Such behavior isn't unique to the Intel x86 architecture.) + Other architectures might @emph{demand} 64-bit alignment + of 64-bit data. ! There are a variety of approaches to use to address this problem: @itemize @bullet @item + @cindex COMMON, layout + @cindex layout of common blocks Order your @code{COMMON} and @code{EQUIVALENCE} areas such that the variables and arrays with the widest alignment *************** occupied by each entity to determine whe *** 9725,9759 **** actual alignment of each subsequent entity meets the alignment guidelines for the type of that entity. @item Use the (x86-specific) @samp{-malign-double} option when compiling ! programs. ! This will align only static data (entities in @code{COMMON} or ! local entities with the @code{SAVE} attribute), ! but it should probably always be ! used with Fortran code on the 586 and 686 architectures for best ! performance. ! ! This feature of @samp{-malign-double} means it may actually be best to ! use it with @samp{-fno-automatic} even though the latter usually ! produces worse code; at least, doing so will tend to produce more ! consistent run times. ! ! Using @samp{-malign-double} and @samp{-fno-automatic} together is ! apparently the only way to ensure that all doubles are correctly aligned ! on GNU x86 systems without having to change @code{g77} itself as ! described in the next item. ! (Note that the @code{gcc} C extension @samp{__attribute__ ((aligned (8))} ! also won't double-align the datum to which it is applied if that is allocated ! on the stack.) ! It isn't clear whether this deficiency also applies to ! non-GNU based x86 systems (Solaris, DGUX et al), but it probably does. ! ! @item ! Change the definition of the @samp{STACK_BOUNDARY} macro in ! @file{gcc/config/i386/i386.h} from @samp{32} to ! @samp{(TARGET_ALIGN_DOUBLE ? 64 : 32)}, and rebuild ! @code{g77}. ! @xref{Installation,,Installing GNU Fortran}, for more information. @item --- 10035,10060 ---- actual alignment of each subsequent entity meets the alignment guidelines for the type of that entity. + + If you don't ensure correct alignment of @code{COMMON} elements, the + compiler may be forced by some systems to violate the Fortran semantics by + adding padding to get @code{DOUBLE PRECISION} data properly aligned. + If the unfortunate practice is employed of overlaying different types of + data in the @code{COMMON} block, the different variants + of this block may become misaligned with respect to each other. + Even if your platform doesn't require strict alignment, + @code{COMMON} should be laid out as above for portability. + (Unfortunately the FORTRAN 77 standard didn't anticipate this + possible requirement, which is compiler-independent on a given platform.) @item + @cindex -malign-double option + @cindex options, -malign-double Use the (x86-specific) @samp{-malign-double} option when compiling ! programs for the Pentium and Pentium Pro architectures (called 586 ! and 686 in the @code{gcc} configuration subsystem). ! The warning about this in the @code{gcc} manual isn't ! generally relevant to Fortran, ! but using it will force @code{COMMON} to be padded if necessary to align ! @code{DOUBLE PRECISION} data. @item *************** Ensure that @file{crt0.o} or @file{crt1. *** 9761,9789 **** on your system guarantees a 64-bit aligned stack for @code{main()}. ! Some experimentation might be needed to determine this, and ! access to source code to fix this. ! While arranging this may typically ! get more data properly aligned, it won't, by itself, ! ensure they all are. ! ! One approach to testing this is to write a @code{main()} program ! in C or assembler that outputs the address of the stack pointer ! (and/or frame pointer), and visually inspect the output to see ! if the stack is 64-bit aligned. ! If it is, try renaming the executable to longer and shorter names ! and running the program again. ! If the name of the executable is placed on the stack by @file{crt0.o} ! or @file{crt1.o}, ! the location of the stack should move, and this might help determine ! whether it is kept on a 64-bit boundary. ! @end itemize ! ! Yes, this is all more complicated than it should be. ! The problems are best solved in @code{gcc} and the ! libraries for the operating systems on such systems, ! which need to be continuously updated to provide the ! best alignment for newly released processors. ! Managing this while remaining compatible with ABIs ! on various systems can be challenging. @node Prefer Automatic Uninitialized Variables --- 10062,10076 ---- on your system guarantees a 64-bit aligned stack for @code{main()}. ! The recent one from GNU (@code{glibc2}) will do this on x86 systems, ! but we don't know of any other x86 setups where it will be right. ! Read your system's documentation to determine if ! it is appropriate to upgrade to a more recent version ! to obtain the optimal alignment. ! @end itemize ! ! Progress is being made on making this work ! ``out of the box'' on future versions of @code{g77}, ! @code{gcc}, and some of the relevant operating systems ! (such as GNU/Linux). @node Prefer Automatic Uninitialized Variables *************** For instance, the flags recommended for *** 9849,9856 **** (Pentium(Pro)) chips for building the Linux kernel are: ! @example -m486 -malign-loops=2 -malign-jumps=2 -malign-functions=2 -fomit-frame-pointer ! @end example @noindent @samp{-fomit-frame-pointer} will, however, inhibit debugging --- 10136,10143 ---- (Pentium(Pro)) chips for building the Linux kernel are: ! @smallexample -m486 -malign-loops=2 -malign-jumps=2 -malign-functions=2 -fomit-frame-pointer ! @end smallexample @noindent @samp{-fomit-frame-pointer} will, however, inhibit debugging *************** or installing @code{g77} is not provided *** 9876,9879 **** --- 10163,10170 ---- @xref{Problems Installing}. + To find out about major bugs discovered in the current release and + possible workarounds for them, retrieve + @uref{ftp://alpha.gnu.ai.mit.edu/g77.plan}. + (Note that some of this portion of the manual is lifted directly from the @code{gcc} manual, with minor modifications *************** gcc,Using and Porting GNU CC}.) *** 9885,9889 **** @menu ! * But-bugs:: Bugs really in other programs. * Actual Bugs:: Bugs and misfeatures we will fix later. * Missing Features:: Features we already know we want to add later. --- 10176,10180 ---- @menu ! * But-bugs:: Bugs really in other programs or elsewhere. * Actual Bugs:: Bugs and misfeatures we will fix later. * Missing Features:: Features we already know we want to add later. *************** Some of these already are fixed in new v *** 9903,9906 **** --- 10194,10199 ---- software; some still need to be fixed; some are problems with how @code{g77} is installed or is being used; + some are the result of bad hardware that causes software + to misbehave in sometimes bizarre ways; some just cannot be addressed at this time until more is known about the problem. *************** might be @emph{thought} to indicate bugs *** 9921,9924 **** --- 10214,10218 ---- @menu + * Signal 11 and Friends:: Strange behavior by any software. * Cannot Link Fortran Programs:: Unresolved references. * Large Common Blocks:: Problems on older GNU/Linux systems. *************** might be @emph{thought} to indicate bugs *** 9926,9929 **** --- 10220,10224 ---- * NeXTStep Problems:: Misbehaving executables. * Stack Overflow:: More misbehaving executables. + * Nothing Happens:: Less behaving executables. * Strange Behavior at Run Time:: Executables misbehaving due to bugs in your program. *************** might be @emph{thought} to indicate bugs *** 9931,9934 **** --- 10226,10284 ---- @end menu + @node Signal 11 and Friends + @subsection Signal 11 and Friends + @cindex signal 11 + @cindex hardware errors + + A whole variety of strange behaviors can occur when the + software, or the way you are using the software, + stresses the hardware in a way that triggers hardware bugs. + This might seem hard to believe, but it happens frequently + enough that there exist documents explaining in detail + what the various causes of the problems are, what + typical symptoms look like, and so on. + + Generally these problems are referred to in this document + as ``signal 11'' crashes, because the Linux kernel, running + on the most popular hardware (the Intel x86 line), often + stresses the hardware more than other popular operating + systems. + When hardware problems do occur under GNU/Linux on x86 + systems, these often manifest themselves as ``signal 11'' + problems, as illustrated by the following diagnostic: + + @smallexample + sh# @kbd{g77 myprog.f} + gcc: Internal compiler error: program f771 got fatal signal 11 + sh# + @end smallexample + + It is @emph{very} important to remember that the above + message is @emph{not} the only one that indicates a + hardware problem, nor does it always indicate a hardware + problem. + + In particular, on systems other than those running the Linux + kernel, the message might appear somewhat or very different, + as it will if the error manifests itself while running a + program other than the @code{g77} compiler. + For example, + it will appear somewhat different when running your program, + when running Emacs, and so on. + + How to cope with such problems is well beyond the scope + of this manual. + + However, users of Linux-based systems (such as GNU/Linux) + should review @uref{http://www.bitwizard.nl/sig11}, a source + of detailed information on diagnosing hardware problems, + by recognizing their common symptoms. + + Users of other operating systems and hardware might + find this reference useful as well. + If you know of similar material for another hardware/software + combination, please let us know so we can consider including + a reference to it in future versions of this manual. + @node Cannot Link Fortran Programs @subsection Cannot Link Fortran Programs *************** a stack overflow probably indicates a pr *** 10100,10103 **** --- 10450,10504 ---- simply too large for the system, or buggy.) + @node Nothing Happens + @subsection Nothing Happens + @cindex nothing happens + @cindex naming programs @samp{test} + @cindex @samp{test} programs + @cindex programs named @samp{test} + It is occasionally reported that a ``simple'' program, + such as a ``Hello, World!'' program, does nothing when + it is run, even though the compiler reported no errors, + despite the program containing nothing other than a + simple @code{PRINT} statement. + + This most often happens because the program has been + compiled and linked on a UNIX system and named @samp{test}, + though other names can lead to similarly unexpected + run-time behavior on various systems. + + Essentially this problem boils down to giving + your program a name that is already known to + the shell you are using to identify some other program, + which the shell continues to execute instead of your + program when you invoke it via, for example: + + @smallexample + sh# @kbd{test} + sh# + @end smallexample + + Under UNIX and many other system, a simple command name + invokes a searching mechanism that might well not choose + the program located in the current working directory if + there is another alternative (such as the @code{test} + command commonly installed on UNIX systems). + + The reliable way to invoke a program you just linked in + the current directory under UNIX is to specify it using + an explicit pathname, as in: + + @smallexample + sh# @kbd{./test} + Hello, World! + sh# + @end smallexample + + Users who encounter this problem should take the time to + read up on how their shell searches for commands, how to + set their search path, and so on. + The relevant UNIX commands to learn about include + @code{man}, @code{info} (on GNU systems), @code{setenv} (or + @code{set} and @code{env}), @code{which}, and @code{find}. + @node Strange Behavior at Run Time @subsection Strange Behavior at Run Time *************** bugs that lead to these behaviors is, ul *** 10141,10144 **** --- 10542,10564 ---- responsibility, as difficult as that task can sometimes be. + @cindex `infinite spaces' printed + @cindex spaces, endless printing of + @cindex libc, non-ANSI or non-default + @cindex C library + @cindex linking against non-standard library + @cindex Solaris + One runtime problem that has been observed might have a simple solution. + If a formatted @code{WRITE} produces an endless stream of spaces, check + that your program is linked against the correct version of the C library. + The configuration process takes care to account for your + system's normal @file{libc} not being ANSI-standard, which will + otherwise cause this behaviour. + If your system's default library is + ANSI-standard and you subsequently link against a non-ANSI one, there + might be problems such as this one. + + Specifically, on Solaris2 systems, + avoid picking up the @code{BSD} library from @file{/usr/ucblib}. + @node Floating-point Errors @subsection Floating-point Errors *************** worrying about. *** 10194,10201 **** For example, consider the following program: ! @example PRINT *, 0.2 END ! @end example When compiled by @code{g77}, the above program might output --- 10614,10621 ---- For example, consider the following program: ! @smallexample PRINT *, 0.2 END ! @end smallexample When compiled by @code{g77}, the above program might output *************** computed when the program is changed to *** 10241,10248 **** double-precision constant: ! @example PRINT *, 0.2D0 END ! @end example Future versions of @code{g77} and/or @code{libf2c} might convert --- 10661,10668 ---- double-precision constant: ! @smallexample PRINT *, 0.2D0 END ! @end smallexample Future versions of @code{g77} and/or @code{libf2c} might convert *************** GNU Fortran language: *** 10276,10279 **** --- 10696,10700 ---- * Expressions in FORMAT Statements:: * Explicit Assembler Code:: + * Q Edit Descriptor:: GNU Fortran dialects: *************** Better diagnostics: *** 10304,10307 **** --- 10725,10729 ---- * Invalid Use of Hollerith Constant:: * Dummy Array Without Dimensioning Dummy:: + * Invalid FORMAT Specifiers:: * Ambiguous Dialects:: * Unused Labels:: *************** references, etc. *** 10506,10513 **** For example, @code{g77} currently does not accept the following: ! @example SUBROUTINE X(M, N) INTEGER N(10), M(N(2), N(1)) ! @end example @node POINTER Statements --- 10928,10935 ---- For example, @code{g77} currently does not accept the following: ! @smallexample SUBROUTINE X(M, N) INTEGER N(10), M(N(2), N(1)) ! @end smallexample @node POINTER Statements *************** in @code{PARAMETER} statements on the li *** 10524,10527 **** --- 10946,10961 ---- important things to add to @code{g77}. + In the meantime, consider using the @code{INTEGER(KIND=7)} + declaration to specify that a variable must be + able to hold a pointer. + This construct is not portable to other non-GNU compilers, + but it is portable to all machines GNU Fortran supports + when @code{g77} is used. + + @xref{Functions and Subroutines}, for information on + @code{%VAL()}, @code{%REF()}, and @code{%DESCR()} + constructs, which are useful for passing pointers to + procedures written in languages other than Fortran. + @node Sensible Non-standard Constructs @subsection Sensible Non-standard Constructs *************** this construct when the expression is co *** 10600,10607 **** example: ! @example PARAMETER (IWIDTH = 12) 10 FORMAT (I) ! @end example In the meantime, at least for output (@code{PRINT} and --- 11034,11041 ---- example: ! @smallexample PARAMETER (IWIDTH = 12) 10 FORMAT (I) ! @end smallexample In the meantime, at least for output (@code{PRINT} and *************** as well, but not all can. *** 10616,10631 **** For example, this can be rewritten: ! @example READ 20, I 20 FORMAT (I) ! @end example However, this cannot, in general, be rewritten, especially when @code{ERR=} and @code{END=} constructs are employed: ! @example READ 30, J, I 30 FORMAT (I) ! @end example @node Explicit Assembler Code --- 11050,11065 ---- For example, this can be rewritten: ! @smallexample READ 20, I 20 FORMAT (I) ! @end smallexample However, this cannot, in general, be rewritten, especially when @code{ERR=} and @code{END=} constructs are employed: ! @smallexample READ 30, J, I 30 FORMAT (I) ! @end smallexample @node Explicit Assembler Code *************** when @code{ERR=} and @code{END=} constru *** 10635,10638 **** --- 11069,11085 ---- code to specify explicit assembler code. + @node Q Edit Descriptor + @subsection Q Edit Descriptor + @cindex FORMAT statement + @cindex Q edit descriptor + + The @code{Q} edit descriptor in @code{FORMAT}s isn't supported. + (This is meant to get the number of characters remaining in an input record.) + Supporting this requires a significant redesign or replacement + of @code{libf2c}. + + A workaround might be using internal I/O or the stream-based intrinsics. + @xref{FGetC Intrinsic (subroutine)}. + @node Old-style PARAMETER Statements @subsection Old-style PARAMETER Statements *************** involving internal files (CHARACTER vari *** 10717,10721 **** For example, replace a code fragment like ! @example INTEGER*1 LINE(80) @dots{} --- 11164,11168 ---- For example, replace a code fragment like ! @smallexample INTEGER*1 LINE(80) @dots{} *************** For example, replace a code fragment lik *** 10723,10732 **** @dots{} 9000 FORMAT (1X, 3(F10.5)) ! @end example @noindent with: ! @example CHARACTER*80 LINE @dots{} --- 11170,11179 ---- @dots{} 9000 FORMAT (1X, 3(F10.5)) ! @end smallexample @noindent with: ! @smallexample CHARACTER*80 LINE @dots{} *************** with: *** 10734,10742 **** @dots{} 9000 FORMAT (1X, 3(F10.5)) ! @end example Similarly, replace a code fragment like ! @example INTEGER*1 LINE(80) @dots{} --- 11181,11189 ---- @dots{} 9000 FORMAT (1X, 3(F10.5)) ! @end smallexample Similarly, replace a code fragment like ! @smallexample INTEGER*1 LINE(80) @dots{} *************** Similarly, replace a code fragment like *** 10744,10753 **** @dots{} 9000 FORMAT (1X, 'OUTPUT IS ', 3(F10.5)) ! @end example @noindent with: ! @example CHARACTER*80 LINE @dots{} --- 11191,11200 ---- @dots{} 9000 FORMAT (1X, 'OUTPUT IS ', 3(F10.5)) ! @end smallexample @noindent with: ! @smallexample CHARACTER*80 LINE @dots{} *************** with: *** 10755,10759 **** @dots{} 9000 FORMAT (1X, 'OUTPUT IS ', 3(F10.5)) ! @end example It is entirely possible that @code{ENCODE} and @code{DECODE} will --- 11202,11206 ---- @dots{} 9000 FORMAT (1X, 'OUTPUT IS ', 3(F10.5)) ! @end smallexample It is entirely possible that @code{ENCODE} and @code{DECODE} will *************** a character constant is continued onto t *** 10771,10778 **** source file, as in the following example: ! @example 10 PRINT *,'HOW MANY 1 SPACES?' ! @end example @noindent --- 11218,11225 ---- source file, as in the following example: ! @smallexample 10 PRINT *,'HOW MANY 1 SPACES?' ! @end smallexample @noindent *************** There are several out there worth evalua *** 10801,10804 **** --- 11248,11253 ---- Such a preprocessor would recognize Hollerith constants, properly parse comments and character constants, and so on. + It might also recognize, process, and thus preprocess + files included via the @code{INCLUDE} directive. @node Bit Operations on Floating-point Data *************** For example, this program is rejected by *** 10817,10825 **** the intrinsic @code{IAND} does not accept @code{REAL} arguments: ! @example DATA A/7.54/, B/9.112/ PRINT *, IAND(A, B) END ! @end example @node POSIX Standard --- 11266,11274 ---- the intrinsic @code{IAND} does not accept @code{REAL} arguments: ! @smallexample DATA A/7.54/, B/9.112/ PRINT *, IAND(A, B) END ! @end smallexample @node POSIX Standard *************** is, it shouldn't gratuitously make bad o *** 10902,10910 **** For example: ! @example INTRINSIC ZABS CALL FOO(ZABS) END ! @end example @noindent --- 11351,11359 ---- For example: ! @smallexample INTRINSIC ZABS CALL FOO(ZABS) END ! @end smallexample @noindent *************** For example, this code is invalid, so @c *** 10944,10953 **** the invalid assignment to @samp{NOTHER}: ! @example EQUIVALENCE (I, NOTHER) DO I = 1, 100 IF (I.EQ. 10) NOTHER = 20 END DO ! @end example @node Better Pedantic Compilation --- 11393,11402 ---- the invalid assignment to @samp{NOTHER}: ! @smallexample EQUIVALENCE (I, NOTHER) DO I = 1, 100 IF (I.EQ. 10) NOTHER = 20 END DO ! @end smallexample @node Better Pedantic Compilation *************** constants to @code{REAL(KIND=2)} based o *** 10974,10982 **** For example, it would warn about cases like this: ! @example DOUBLE PRECISION FOO PARAMETER (TZPHI = 9.435784839284958) FOO = TZPHI * 3D0 ! @end example @node Invalid Use of Hollerith Constant --- 11423,11431 ---- For example, it would warn about cases like this: ! @smallexample DOUBLE PRECISION FOO PARAMETER (TZPHI = 9.435784839284958) FOO = TZPHI * 3D0 ! @end smallexample @node Invalid Use of Hollerith Constant *************** below, since it includes @samp{ARRAY} bu *** 11008,11016 **** list of arguments: ! @example SUBROUTINE PRIMARY(ARRAY, ISIZE) REAL ARRAY(ISIZE) ENTRY ALT(ARRAY) ! @end example @node Ambiguous Dialects --- 11457,11477 ---- list of arguments: ! @smallexample SUBROUTINE PRIMARY(ARRAY, ISIZE) REAL ARRAY(ISIZE) ENTRY ALT(ARRAY) ! @end smallexample ! ! @node Invalid FORMAT Specifiers ! @subsection Invalid FORMAT Specifiers ! ! @code{g77} should check @code{FORMAT} specifiers for validity ! as it does @code{FORMAT} statements. ! ! For example, a diagnostic would be produced for: ! ! @smallexample ! PRINT 'HI THERE!' !User meant PRINT *, 'HI THERE!' ! @end smallexample @node Ambiguous Dialects *************** being interpreted either way in particul *** 11275,11282 **** starting a program unit with: ! @example CHARACTER BACKSL PARAMETER (BACKSL = '\\') ! @end example @noindent --- 11736,11743 ---- starting a program unit with: ! @smallexample CHARACTER BACKSL PARAMETER (BACKSL = '\\') ! @end smallexample @noindent *************** for (non-standard) typeless constants su *** 11378,11384 **** For example, consider the following statement: ! @example PRINT *, 9.435784839284958 * 2D0 ! @end example @noindent --- 11839,11845 ---- For example, consider the following statement: ! @smallexample PRINT *, 9.435784839284958 * 2D0 ! @end smallexample @noindent *************** apparently innocuous change to the sourc *** 11404,11408 **** the computational results. Consider: ! @example REAL ALMOST, CLOSE DOUBLE PRECISION FIVE --- 11865,11869 ---- the computational results. Consider: ! @smallexample REAL ALMOST, CLOSE DOUBLE PRECISION FIVE *************** PRINT *, ALMOST - FIVE *** 11414,11418 **** PRINT *, CLOSE - FIVE END ! @end example @noindent --- 11875,11879 ---- PRINT *, CLOSE - FIVE END ! @end smallexample @noindent *************** unlikely to be consensus on how it works *** 11476,11485 **** following sample program: ! @example LOGICAL L,M,N DATA L,M,N /3*.FALSE./ IF (L.AND.M.EQ.N) PRINT *,'L.AND.M.EQ.N' END ! @end example The issue raised by the above sample program is: what is the --- 11937,11946 ---- following sample program: ! @smallexample LOGICAL L,M,N DATA L,M,N /3*.FALSE./ IF (L.AND.M.EQ.N) PRINT *,'L.AND.M.EQ.N' END ! @end smallexample The issue raised by the above sample program is: what is the *************** For example, an expression like this may *** 11534,11540 **** from one compiler to another: ! @example J = IFUNC() - IFUNC() ! @end example @noindent --- 11995,12001 ---- from one compiler to another: ! @smallexample J = IFUNC() - IFUNC() ! @end smallexample @noindent *************** for improvement of GNU Fortran are welco *** 11770,11773 **** --- 12231,12291 ---- @end itemize + Many, perhaps most, bug reports against @code{g77} turn out to + be bugs in the user's code. + While we find such bug reports educational, they sometimes take + a considerable amount of time to track down or at least respond + to---time we could be spending making @code{g77}, not some user's + code, better. + + Some steps you can take to verify that the bug is not certainly + in the code you're compiling with @code{g77}: + + @itemize @bullet + @item + Compile your code using the @code{g77} options @samp{-W -Wall -O}. + These options enable many useful warning; the @samp{-O} option + enables flow analysis that enables the uninitialized-variable + warning. + + If you investigate the warnings and find evidence of possible bugs + in your code, fix them first and retry @code{g77}. + + @item + Compile your code using the @code{g77} options @samp{-finit-local-zero}, + @samp{-fno-automatic}, @samp{-ffloat-store}, and various + combinations thereof. + + If your code works with any of these combinations, that is not + proof that the bug isn't in @code{g77}---a @code{g77} bug exposed + by your code might simply be avoided, or have a different, more subtle + effect, when different options are used---but it can be a + strong indicator that your code is making unawarranted assumptions + about the Fortran dialect and/or underlying machine it is + being compiled and run on. + + @xref{Overly Convenient Options,,Overly Convenient Command-Line Options}, + for information on the @samp{-fno-automatic} and + @samp{-finit-local-zero} options and how to convert + their use into selective changes in your own code. + + @item + @pindex ftncheck + Validate your code with @code{ftnchek} or a similar code-checking + tool. + @code{ftncheck} can be found at @uref{ftp://ftp.netlib.org/fortran} + or @uref{ftp://ftp.dsm.fordham.edu}. + + @item + Try your code out using other Fortran compilers, such as @code{f2c}. + If it does not work on at least one other compiler (assuming the + compiler supports the features the code needs), that is a strong + indicator of a bug in the code. + + However, even if your code works on many compilers @emph{except} + @code{g77}, that does @emph{not} mean the bug is in @code{g77}. + It might mean the bug is in your code, and that @code{g77} simply + exposes it more readily than other compilers. + @end itemize + @node Bug Lists @section Where to Report Bugs *************** It is not worth repeating them here. *** 12587,12590 **** --- 13105,13114 ---- @item + @cindex concatenation + @cindex CHARACTER*(*) + Support arbitrary operands for concatenation, even in contexts where + run-time allocation is required. + + @item Consider adding a @code{NUMERIC} type to designate typeless numeric constants, named and unnamed. *************** For example, don't output 20 unnecessary *** 12805,12814 **** first necessary one for: ! @example INTEGER X(20) CONTINUE DATA (X(I), J= 1, 20) /20*5/ END ! @end example @noindent --- 13329,13338 ---- first necessary one for: ! @smallexample INTEGER X(20) CONTINUE DATA (X(I), J= 1, 20) /20*5/ END ! @end smallexample @noindent *************** brackets in the diagnostic. *** 12833,12839 **** For example: ! @example foo.f:5: Invalid statement [info -f g77 M FOOEY] ! @end example More details about the above diagnostic is found in the @code{g77} Info --- 13357,13363 ---- For example: ! @smallexample foo.f:5: Invalid statement [info -f g77 M FOOEY] ! @end smallexample More details about the above diagnostic is found in the @code{g77} Info *************** as the above is just a sample, no such s *** 12858,12861 **** --- 13382,13389 ---- @menu * CMPAMBIG:: Ambiguous use of intrinsic. + * EXPIMP:: Intrinsic used explicitly and implicitly. + * INTGLOB:: Intrinsic also used as name of global. + * LEX:: Various lexer messages + * GLOBALS:: Disagreements about globals. @end menu *************** as the above is just a sample, no such s *** 12864,12870 **** @noindent ! @example Ambiguous use of intrinsic @var{intrinsic} @dots{} ! @end example The type of the argument to the invocation of the @var{intrinsic} --- 13392,13398 ---- @noindent ! @smallexample Ambiguous use of intrinsic @var{intrinsic} @dots{} ! @end smallexample The type of the argument to the invocation of the @var{intrinsic} *************** wider type. *** 12912,12920 **** For example: ! @example DOUBLE COMPLEX Z @dots{} R(1) = T * REAL(Z) ! @end example The above example suggests the programmer expected the real part --- 13440,13448 ---- For example: ! @smallexample DOUBLE COMPLEX Z @dots{} R(1) = T * REAL(Z) ! @end smallexample The above example suggests the programmer expected the real part *************** or is assigned to a @code{REAL(KIND=2)} *** 12952,12961 **** For example: ! @example DOUBLE COMPLEX Z DOUBLE PRECISION R, T @dots{} R(1) = T * REAL(Z) ! @end example The above example suggests the programmer expected the real part --- 13480,13489 ---- For example: ! @smallexample DOUBLE COMPLEX Z DOUBLE PRECISION R, T @dots{} R(1) = T * REAL(Z) ! @end smallexample The above example suggests the programmer expected the real part *************** expects the Fortran 90 interpretation, y *** 12974,12978 **** @itemize @bullet @item ! Change it to @samp{DBLE(@var{intrinsic}(@var{expr}))}, if it expected the Fortran 90 interpretation. --- 13502,13508 ---- @itemize @bullet @item ! Change it to @samp{DBLE(@var{expr})} (if @var{intrinsic} is ! @samp{REAL}) or @samp{DIMAG(@var{expr})} (if @var{intrinsic} ! is @samp{AIMAG}) if it expected the Fortran 90 interpretation. *************** This assumes @var{expr} is @code{COMPLEX *** 12980,12984 **** some other type, such as @code{COMPLEX*32}, you should use the appropriate intrinsic, such as the one to convert to @code{REAL*16} ! (perhaps @code{DBLEQ()}), in place of @code{DBLE()}. @item --- 13510,13515 ---- some other type, such as @code{COMPLEX*32}, you should use the appropriate intrinsic, such as the one to convert to @code{REAL*16} ! (perhaps @code{DBLEQ()} in place of @code{DBLE()}, and ! @code{QIMAG()} in place of @code{DIMAG()}). @item *************** C *** 13058,13061 **** --- 13589,13886 ---- If the above program prints contradictory results on a particular compiler, run away! + + @node EXPIMP + @section @code{EXPIMP} + + @noindent + @smallexample + Intrinsic @var{intrinsic} referenced @dots{} + @end smallexample + + The @var{intrinsic} is explicitly declared in one program + unit in the source file and implicitly used as an intrinsic + in another program unit in the same source file. + + This diagnostic is designed to catch cases where a program + might depend on using the name @var{intrinsic} as an intrinsic + in one program unit and as a global name (such as the name + of a subroutine or function) in another, but @code{g77} recognizes + the name as an intrinsic in both cases. + + After verifying that the program unit making implicit use + of the intrinsic is indeed written expecting the intrinsic, + add an @samp{INTRINSIC @var{intrinsic}} statement to that + program unit to prevent this warning. + + This and related warnings are disabled by using + the @samp{-Wno-globals} option when compiling. + + Note that this warning is not issued for standard intrinsics. + Standard intrinsics include those described in the FORTRAN 77 + standard and, if @samp{-ff90} is specified, those described + in the Fortran 90 standard. + Such intrinsics are not as likely to be confused with user + procedures as intrinsics provided as extensions to the + standard by @code{g77}. + + @node INTGLOB + @section @code{INTGLOB} + + @noindent + @smallexample + Same name `@var{intrinsic}' given @dots{} + @end smallexample + + The name @var{intrinsic} is used for a global entity (a common + block or a program unit) in one program unit and implicitly + used as an intrinsic in another program unit. + + This diagnostic is designed to catch cases where a program + intends to use a name entirely as a global name, but @code{g77} + recognizes the name as an intrinsic in the program unit that + references the name, a situation that would likely produce + incorrect code. + + For example: + + @smallexample + INTEGER FUNCTION TIME() + @dots{} + END + @dots{} + PROGRAM SAMP + INTEGER TIME + PRINT *, 'Time is ', TIME() + END + @end smallexample + + The above example defines a program unit named @samp{TIME}, but + the reference to @samp{TIME} in the main program unit @samp{SAMP} + is normally treated by @code{g77} as a reference to the intrinsic + @code{TIME()} (unless a command-line option that prevents such + treatment has been specified). + + As a result, the program @samp{SAMP} will @emph{not} + invoke the @samp{TIME} function in the same source file. + + Since @code{g77} recognizes @code{libU77} procedures as + intrinsics, and since some existing code uses the same names + for its own procedures as used by some @code{libU77} + procedures, this situation is expected to arise often enough + to make this sort of warning worth issuing. + + After verifying that the program unit making implicit use + of the intrinsic is indeed written expecting the intrinsic, + add an @samp{INTRINSIC @var{intrinsic}} statement to that + program unit to prevent this warning. + + Or, if you believe the program unit is designed to invoke the + program-defined procedure instead of the intrinsic (as + recognized by @code{g77}), add an @samp{EXTERNAL @var{intrinsic}} + statement to the program unit that references the name to + prevent this warning. + + This and related warnings are disabled by using + the @samp{-Wno-globals} option when compiling. + + Note that this warning is not issued for standard intrinsics. + Standard intrinsics include those described in the FORTRAN 77 + standard and, if @samp{-ff90} is specified, those described + in the Fortran 90 standard. + Such intrinsics are not as likely to be confused with user + procedures as intrinsics provided as extensions to the + standard by @code{g77}. + + @node LEX + @section @code{LEX} + + @noindent + @smallexample + Unrecognized character @dots{} + Invalid first character @dots{} + Line too long @dots{} + Non-numeric character @dots{} + Continuation indicator @dots{} + Label at @dots{} invalid with continuation line indicator @dots{} + Character constant @dots{} + Continuation line @dots{} + Statement at @dots{} begins with invalid token + @end smallexample + + Although the diagnostics identify specific problems, they can + be produced when general problems such as the following occur: + + @itemize @bullet + @item + The source file contains something other than Fortran code. + + If the code in the file does not look like many of the examples + elsewhere in this document, it might not be Fortran code. + (Note that Fortran code often is written in lower case letters, + while the examples in this document use upper case letters, + for stylistic reasons.) + + For example, if the file contains lots of strange-looking + characters, it might be APL source code; if it contains lots + of parentheses, it might be Lisp source code; if it + contains lots of bugs, it might be C++ source code. + + @item + The source file contains free-form Fortran code, but @samp{-ffree-form} + was not specified on the command line to compile it. + + Free form is a newer form for Fortran code. + The older, classic form is called fixed form. + + Fixed-form code is visually fairly distinctive, because + numerical labels and comments are all that appear in + the first five columns of a line, the sixth column is + reserved to denote continuation lines, + and actual statements start at or beyond column 7. + Spaces generally are not significant, so if you + see statements such as @samp{REALX,Y} and @samp{DO10I=1,100}, + you are looking at fixed-form code. + Comment lines are indicated by the letter @samp{C} or the symbol + @samp{*} in column 1. + (Some code uses @samp{!} or @samp{/*} to begin in-line comments, + which many compilers support.) + + Free-form code is distinguished from fixed-form source + primarily by the fact that statements may start anywhere. + (If lots of statements start in columns 1 through 6, + that's a strong indicator of free-form source.) + Consecutive keywords must be separated by spaces, so + @samp{REALX,Y} is not valid, while @samp{REAL X,Y} is. + There are no comment lines per se, but @samp{!} starts a + comment anywhere in a line (other than within a character or + hollerith constant). + + @xref{Source Form}, for more information. + + @item + The source file is in fixed form and has been edited without + sensitivity to the column requirements. + + Statements in fixed-form code must be entirely contained within + columns 7 through 72 on a given line. + Starting them ``early'' is more likely to result in diagnostics + than finishing them ``late'', though both kinds of errors are + often caught at compile time. + + For example, if the following code fragment is edited by following + the commented instructions literally, the result, shown afterward, + would produce a diagnostic when compiled: + + @smallexample + C On XYZZY systems, remove "C" on next line: + C CALL XYZZY_RESET + @end smallexample + + The result of editing the above line might be: + + @smallexample + C On XYZZY systems, remove "C" on next line: + CALL XYZZY_RESET + @end smallexample + + However, that leaves the first @samp{C} in the @samp{CALL} + statement in column 6, making it a comment line, which is + not really what the author intended, and which is likely + to result in one of the above-listed diagnostics. + + @emph{Replacing} the @samp{C} in column 1 with a space + is the proper change to make, to ensure the @samp{CALL} + keyword starts in or after column 7. + + Another common mistake like this is to forget that fixed-form + source lines are significant through only column 72, and that, + normally, any text beyond column 72 is ignored or is diagnosed + at compile time. + + @xref{Source Form}, for more information. + + @item + The source file requires preprocessing, and the preprocessing + is not being specified at compile time. + + A source file containing lines beginning with @code{#define}, + @code{#include}, @code{#if}, and so on is likely one that + requires preprocessing. + + If the file's suffix is @samp{.f} or @samp{.for}, the file + will normally be compiled @emph{without} preprocessing by @code{g77}. + + Change the file's suffix from @samp{.f} to @samp{.F} (or, on + systems with case-insensitive file names, to @samp{.fpp}) or + from @samp{.for} to @samp{.fpp}. + @code{g77} compiles files with such names @emph{with} + preprocessing. + + Or, learn how to use @code{gcc}'s @samp{-x} option to specify + the language @samp{f77-cpp-input} for Fortran files that + require preprocessing. + @xref{Overall Options,,gcc,Using and Porting GNU CC}. + + @item + The source file is preprocessed, and the results of preprocessing + result in syntactic errors that are not necessarily obvious to + someone examining the source file itself. + + Examples of errors resulting from preprocessor macro expansion + include exceeding the line-length limit, improperly starting, + terminating, or incorporating the apostrophe or double-quote in + a character constant, improperly forming a hollerith constant, + and so on. + + @xref{Overall Options,,Options Controlling the Kind of Output}, + for suggestions about how to use, and not use, preprocessing + for Fortran code. + @end itemize + + @node GLOBALS + @section @code{GLOBALS} + + @noindent + @smallexample + Global name @var{name} defined at @dots{} already defined@dots{} + Global name @var{name} at @dots{} has different type@dots{} + Too many arguments passed to @var{name} at @dots{} + Too few arguments passed to @var{name} at @dots{} + Argument #@var{n} of @var{name} is @dots{} + @end smallexample + + These messages all identify disagreements about the + global procedure named @var{name} among different program + units (usually including @var{name} itself). + + These disagreements, if not diagnosed, could result in a + compiler crash if the compiler attempted to inline a reference + to @var{name} within a calling program unit that disagreed + with the @var{name} program unit regarding whether the + procedure is a subroutine or function, the type of the + return value of the procedure (if it is a function), the + number of arguments the procedure accepts, or the type + of each argument. + + Such disagreements @emph{should} be fixed in the Fortran + code itself. + However, if that is not immediately practical, and the code + has been working for some time, it is possible it will work + when compiled by @code{g77} with the @samp{-fno-globals} option. + + The @samp{-fno-globals} option disables these diagnostics, and + also disables all inlining of references to global procedures + to avoid compiler crashes. + The diagnostics are actually produced, but as warnings, unless + the @samp{-Wno-globals} option also is specified. + + After using @samp{-fno-globals} to work around these problems, + it is wise to stop using that option and address them by fixing + the Fortran code, because such problems, while they might not + actually result in bugs on some systems, indicate that the code + is not as portable as it could be. + In particular, the code might appear to work on a particular + system, but have bugs that affect the reliability of the data + without exhibiting any other outward manifestations of the bugs. @end ifset diff -rcp2N g77-0.5.20/f/gbe/2.7.2.2.diff g77-0.5.21/f/gbe/2.7.2.2.diff *** g77-0.5.20/f/gbe/2.7.2.2.diff Fri Feb 28 06:54:54 1997 --- g77-0.5.21/f/gbe/2.7.2.2.diff Thu Jan 1 00:00:00 1970 *************** *** 1,4100 **** - IMPORTANT: After applying this patch, you must rebuild the - Info documentation derived from the Texinfo files in the - gcc distribution, as this patch does not include patches - to any derived files (due to differences in the way gcc - version 2.7.2.2 is obtained by users). Use the following - command sequence after applying this patch: - - cd gcc-2.7.2.2; make -f Makefile.in gcc.info - - If that fails due to `makeinfo' not being installed, obtain - texinfo-3.9.tar.gz from a GNU distribution site, unpack, - build, and install it, and try the above command sequence - again. - - - diff -rcp2N gcc-2.7.2.2/ChangeLog gcc-2.7.2.2.f.2/ChangeLog - *** gcc-2.7.2.2/ChangeLog Thu Feb 20 19:24:10 1997 - --- gcc-2.7.2.2.f.2/ChangeLog Thu Feb 27 23:04:00 1997 - *************** - *** 1,2 **** - --- 1,69 ---- - + Wed Feb 26 13:09:33 1997 Michael Meissner - + - + * reload.c (debug_reload): Fix format string to print - + reload_nocombine[r]. - + - + Sun Feb 23 15:26:53 1997 Craig Burley - + - + * fold-const.c (multiple_of_p): Clean up and improve. - + (fold): Clean up invocation of multiple_of_p. - + - + Sat Feb 8 04:53:27 1997 Craig Burley - + - + From Fri, 07 Feb 1997 22:02:21 -0500: - + * alias.c (init_alias_analysis): Reduce amount of time - + needed to simplify the reg_base_value array in the - + typical case (especially involving function inlining). - + - + Fri Jan 10 17:22:17 1997 Craig Burley - + - + Minor improvements/fixes to better alias handling: - + * Makefile.in (alias.o): Fix typo in rule (was RLT_H). - + * cse.c, sched.c: Fix up some indenting. - + * toplev.c: Add -fargument-alias flag, so Fortran users - + can turn C-style aliasing on once g77 defaults to - + -fargument-noalias-global. - + - + Integrate patch for better alias handling from - + John Carr : - + * Makefile.in (OBJS, alias.o): New module and rule. - + * alias.c: New source module. - + * calls.c (expand_call): Recognize alias status of calls - + to malloc(). - + * combine.c (distribute_notes): New REG_NOALIAS note. - + * rtl.h (REG_NOALIAS): Ditto. - + Many other changes for new alias.c module. - + * cse.c: Many changes, and much code moved into alias.c. - + * flags.h (flag_alias_check, flag_argument_noalias): - + New flags. - + * toplev.c: New flags and related options. - + * local-alloc.c (validate_equiv_mem_from_store): - + Caller of true_dependence changed. - + * loop.c (NUM_STORES): Increase to 50 from 20. - + (prescan_loop): "const" functions don't alter unknown addresses. - + (invariant_p): Caller of true_dependence changed. - + (record_giv): Zero new unrolled and shared flags. - + (emit_iv_add_mult): Record base value for register. - + * sched.c: Many changes, mostly moving code to alias.c. - + (sched_note_set): SCHED_SORT macro def form, but not function, - + inexplicably changed. - + * unroll.c: Record base values for registers, etc. - + - + Fri Jan 3 04:01:00 1997 Craig Burley - + - + * loop.c (check_final_value): Handle insns with no luid's - + appropriately, instead of crashing on INSN_LUID macro - + invocations. - + - + Mon Dec 23 00:49:19 1996 Craig Burley - + - + * config/alpha/alpha.md: Fix pattern that matches if_then_else - + involving DF target, DF comparison, SF source. - + - + Fri Dec 20 15:42:52 1996 Craig Burley - + - + * fold-const.c (multiple_of_p): New function. - + (fold): Use new function to turn *_DIV_EXPR into EXACT_DIV_EXPR. - + - Sat Jun 29 12:33:39 1996 Richard Kenner - - diff -rcp2N gcc-2.7.2.2/Makefile.in gcc-2.7.2.2.f.2/Makefile.in - *** gcc-2.7.2.2/Makefile.in Sun Nov 26 14:44:25 1995 - --- gcc-2.7.2.2.f.2/Makefile.in Sun Feb 23 16:36:34 1997 - *************** OBJS = toplev.o version.o tree.o print-t - *** 519,523 **** - integrate.o jump.o cse.o loop.o unroll.o flow.o stupid.o combine.o \ - regclass.o local-alloc.o global.o reload.o reload1.o caller-save.o \ - ! insn-peep.o reorg.o sched.o final.o recog.o reg-stack.o \ - insn-opinit.o insn-recog.o insn-extract.o insn-output.o insn-emit.o \ - insn-attrtab.o $(out_object_file) getpwd.o convert.o $(EXTRA_OBJS) - --- 519,523 ---- - integrate.o jump.o cse.o loop.o unroll.o flow.o stupid.o combine.o \ - regclass.o local-alloc.o global.o reload.o reload1.o caller-save.o \ - ! insn-peep.o reorg.o alias.o sched.o final.o recog.o reg-stack.o \ - insn-opinit.o insn-recog.o insn-extract.o insn-output.o insn-emit.o \ - insn-attrtab.o $(out_object_file) getpwd.o convert.o $(EXTRA_OBJS) - *************** reorg.o : reorg.c $(CONFIG_H) $(RTL_H) c - *** 1238,1241 **** - --- 1238,1242 ---- - basic-block.h regs.h insn-config.h insn-attr.h insn-flags.h recog.h \ - flags.h output.h - + alias.o : $(CONFIG_H) $(RTL_H) flags.h hard-reg-set.h regs.h - sched.o : sched.c $(CONFIG_H) $(RTL_H) basic-block.h regs.h hard-reg-set.h \ - flags.h insn-config.h insn-attr.h - diff -rcp2N gcc-2.7.2.2/alias.c gcc-2.7.2.2.f.2/alias.c - *** gcc-2.7.2.2/alias.c Wed Dec 31 19:00:00 1969 - --- gcc-2.7.2.2.f.2/alias.c Sat Feb 8 04:53:07 1997 - *************** - *** 0 **** - --- 1,989 ---- - + /* Alias analysis for GNU C, by John Carr (jfc@mit.edu). - + Derived in part from sched.c */ - + #include "config.h" - + #include "rtl.h" - + #include "expr.h" - + #include "regs.h" - + #include "hard-reg-set.h" - + #include "flags.h" - + - + static rtx canon_rtx PROTO((rtx)); - + static int rtx_equal_for_memref_p PROTO((rtx, rtx)); - + static rtx find_symbolic_term PROTO((rtx)); - + static int memrefs_conflict_p PROTO((int, rtx, int, rtx, - + HOST_WIDE_INT)); - + - + /* Set up all info needed to perform alias analysis on memory references. */ - + - + #define SIZE_FOR_MODE(X) (GET_MODE_SIZE (GET_MODE (X))) - + - + /* reg_base_value[N] gives an address to which register N is related. - + If all sets after the first add or subtract to the current value - + or otherwise modify it so it does not point to a different top level - + object, reg_base_value[N] is equal to the address part of the source - + of the first set. The value will be a SYMBOL_REF, a LABEL_REF, or - + (address (reg)) to indicate that the address is derived from an - + argument or fixed register. */ - + rtx *reg_base_value; - + unsigned int reg_base_value_size; /* size of reg_base_value array */ - + #define REG_BASE_VALUE(X) \ - + (REGNO (X) < reg_base_value_size ? reg_base_value[REGNO (X)] : 0) - + - + /* Vector indexed by N giving the initial (unchanging) value known - + for pseudo-register N. */ - + rtx *reg_known_value; - + - + /* Indicates number of valid entries in reg_known_value. */ - + static int reg_known_value_size; - + - + /* Vector recording for each reg_known_value whether it is due to a - + REG_EQUIV note. Future passes (viz., reload) may replace the - + pseudo with the equivalent expression and so we account for the - + dependences that would be introduced if that happens. */ - + /* ??? This is a problem only on the Convex. The REG_EQUIV notes created in - + assign_parms mention the arg pointer, and there are explicit insns in the - + RTL that modify the arg pointer. Thus we must ensure that such insns don't - + get scheduled across each other because that would invalidate the REG_EQUIV - + notes. One could argue that the REG_EQUIV notes are wrong, but solving - + the problem in the scheduler will likely give better code, so we do it - + here. */ - + char *reg_known_equiv_p; - + - + /* Inside SRC, the source of a SET, find a base address. */ - + - + /* When copying arguments into pseudo-registers, record the (ADDRESS) - + expression for the argument directly so that even if the argument - + register is changed later (e.g. for a function call) the original - + value is noted. */ - + static int copying_arguments; - + - + static rtx - + find_base_value (src) - + register rtx src; - + { - + switch (GET_CODE (src)) - + { - + case SYMBOL_REF: - + case LABEL_REF: - + return src; - + - + case REG: - + if (copying_arguments && REGNO (src) < FIRST_PSEUDO_REGISTER) - + return reg_base_value[REGNO (src)]; - + return src; - + - + case MEM: - + /* Check for an argument passed in memory. Only record in the - + copying-arguments block; it is too hard to track changes - + otherwise. */ - + if (copying_arguments - + && (XEXP (src, 0) == arg_pointer_rtx - + || (GET_CODE (XEXP (src, 0)) == PLUS - + && XEXP (XEXP (src, 0), 0) == arg_pointer_rtx))) - + return gen_rtx (ADDRESS, VOIDmode, src); - + return 0; - + - + case CONST: - + src = XEXP (src, 0); - + if (GET_CODE (src) != PLUS && GET_CODE (src) != MINUS) - + break; - + /* fall through */ - + case PLUS: - + case MINUS: - + /* Guess which operand to set the register equivalent to. */ - + /* If the first operand is a symbol or the second operand is - + an integer, the first operand is the base address. */ - + if (GET_CODE (XEXP (src, 0)) == SYMBOL_REF - + || GET_CODE (XEXP (src, 0)) == LABEL_REF - + || GET_CODE (XEXP (src, 1)) == CONST_INT) - + return XEXP (src, 0); - + /* If an operand is a register marked as a pointer, it is the base. */ - + if (GET_CODE (XEXP (src, 0)) == REG - + && REGNO_POINTER_FLAG (REGNO (XEXP (src, 0)))) - + src = XEXP (src, 0); - + else if (GET_CODE (XEXP (src, 1)) == REG - + && REGNO_POINTER_FLAG (REGNO (XEXP (src, 1)))) - + src = XEXP (src, 1); - + else - + return 0; - + if (copying_arguments && REGNO (src) < FIRST_PSEUDO_REGISTER) - + return reg_base_value[REGNO (src)]; - + return src; - + - + case AND: - + /* If the second operand is constant set the base - + address to the first operand. */ - + if (GET_CODE (XEXP (src, 1)) == CONST_INT - + && GET_CODE (XEXP (src, 0)) == REG) - + { - + src = XEXP (src, 0); - + if (copying_arguments && REGNO (src) < FIRST_PSEUDO_REGISTER) - + return reg_base_value[REGNO (src)]; - + return src; - + } - + return 0; - + - + case HIGH: - + return XEXP (src, 0); - + } - + - + return 0; - + } - + - + /* Called from init_alias_analysis indirectly through note_stores. */ - + - + /* while scanning insns to find base values, reg_seen[N] is nonzero if - + register N has been set in this function. */ - + static char *reg_seen; - + - + static - + void record_set (dest, set) - + rtx dest, set; - + { - + register int regno; - + rtx src; - + - + if (GET_CODE (dest) != REG) - + return; - + - + regno = REGNO (dest); - + - + if (set) - + { - + /* A CLOBBER wipes out any old value but does not prevent a previously - + unset register from acquiring a base address (i.e. reg_seen is not - + set). */ - + if (GET_CODE (set) == CLOBBER) - + { - + reg_base_value[regno] = 0; - + return; - + } - + src = SET_SRC (set); - + } - + else - + { - + static int unique_id; - + if (reg_seen[regno]) - + { - + reg_base_value[regno] = 0; - + return; - + } - + reg_seen[regno] = 1; - + reg_base_value[regno] = gen_rtx (ADDRESS, Pmode, - + GEN_INT (unique_id++)); - + return; - + } - + - + /* This is not the first set. If the new value is not related to the - + old value, forget the base value. Note that the following code is - + not detected: - + extern int x, y; int *p = &x; p += (&y-&x); - + ANSI C does not allow computing the difference of addresses - + of distinct top level objects. */ - + if (reg_base_value[regno]) - + switch (GET_CODE (src)) - + { - + case PLUS: - + case MINUS: - + if (XEXP (src, 0) != dest && XEXP (src, 1) != dest) - + reg_base_value[regno] = 0; - + break; - + case AND: - + if (XEXP (src, 0) != dest || GET_CODE (XEXP (src, 1)) != CONST_INT) - + reg_base_value[regno] = 0; - + break; - + case LO_SUM: - + if (XEXP (src, 0) != dest) - + reg_base_value[regno] = 0; - + break; - + default: - + reg_base_value[regno] = 0; - + break; - + } - + /* If this is the first set of a register, record the value. */ - + else if ((regno >= FIRST_PSEUDO_REGISTER || ! fixed_regs[regno]) - + && ! reg_seen[regno] && reg_base_value[regno] == 0) - + reg_base_value[regno] = find_base_value (src); - + - + reg_seen[regno] = 1; - + } - + - + /* Called from loop optimization when a new pseudo-register is created. */ - + void - + record_base_value (regno, val) - + int regno; - + rtx val; - + { - + if (!flag_alias_check || regno >= reg_base_value_size) - + return; - + if (GET_CODE (val) == REG) - + { - + if (REGNO (val) < reg_base_value_size) - + reg_base_value[regno] = reg_base_value[REGNO (val)]; - + return; - + } - + reg_base_value[regno] = find_base_value (val); - + } - + - + static rtx - + canon_rtx (x) - + rtx x; - + { - + /* Recursively look for equivalences. */ - + if (GET_CODE (x) == REG && REGNO (x) >= FIRST_PSEUDO_REGISTER - + && REGNO (x) < reg_known_value_size) - + return reg_known_value[REGNO (x)] == x - + ? x : canon_rtx (reg_known_value[REGNO (x)]); - + else if (GET_CODE (x) == PLUS) - + { - + rtx x0 = canon_rtx (XEXP (x, 0)); - + rtx x1 = canon_rtx (XEXP (x, 1)); - + - + if (x0 != XEXP (x, 0) || x1 != XEXP (x, 1)) - + { - + /* We can tolerate LO_SUMs being offset here; these - + rtl are used for nothing other than comparisons. */ - + if (GET_CODE (x0) == CONST_INT) - + return plus_constant_for_output (x1, INTVAL (x0)); - + else if (GET_CODE (x1) == CONST_INT) - + return plus_constant_for_output (x0, INTVAL (x1)); - + return gen_rtx (PLUS, GET_MODE (x), x0, x1); - + } - + } - + /* This gives us much better alias analysis when called from - + the loop optimizer. Note we want to leave the original - + MEM alone, but need to return the canonicalized MEM with - + all the flags with their original values. */ - + else if (GET_CODE (x) == MEM) - + { - + rtx addr = canon_rtx (XEXP (x, 0)); - + if (addr != XEXP (x, 0)) - + { - + rtx new = gen_rtx (MEM, GET_MODE (x), addr); - + MEM_VOLATILE_P (new) = MEM_VOLATILE_P (x); - + RTX_UNCHANGING_P (new) = RTX_UNCHANGING_P (x); - + MEM_IN_STRUCT_P (new) = MEM_IN_STRUCT_P (x); - + x = new; - + } - + } - + return x; - + } - + - + /* Return 1 if X and Y are identical-looking rtx's. - + - + We use the data in reg_known_value above to see if two registers with - + different numbers are, in fact, equivalent. */ - + - + static int - + rtx_equal_for_memref_p (x, y) - + rtx x, y; - + { - + register int i; - + register int j; - + register enum rtx_code code; - + register char *fmt; - + - + if (x == 0 && y == 0) - + return 1; - + if (x == 0 || y == 0) - + return 0; - + x = canon_rtx (x); - + y = canon_rtx (y); - + - + if (x == y) - + return 1; - + - + code = GET_CODE (x); - + /* Rtx's of different codes cannot be equal. */ - + if (code != GET_CODE (y)) - + return 0; - + - + /* (MULT:SI x y) and (MULT:HI x y) are NOT equivalent. - + (REG:SI x) and (REG:HI x) are NOT equivalent. */ - + - + if (GET_MODE (x) != GET_MODE (y)) - + return 0; - + - + /* REG, LABEL_REF, and SYMBOL_REF can be compared nonrecursively. */ - + - + if (code == REG) - + return REGNO (x) == REGNO (y); - + if (code == LABEL_REF) - + return XEXP (x, 0) == XEXP (y, 0); - + if (code == SYMBOL_REF) - + return XSTR (x, 0) == XSTR (y, 0); - + - + /* For commutative operations, the RTX match if the operand match in any - + order. Also handle the simple binary and unary cases without a loop. */ - + if (code == EQ || code == NE || GET_RTX_CLASS (code) == 'c') - + return ((rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)) - + && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1))) - + || (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 1)) - + && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 0)))); - + else if (GET_RTX_CLASS (code) == '<' || GET_RTX_CLASS (code) == '2') - + return (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)) - + && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1))); - + else if (GET_RTX_CLASS (code) == '1') - + return rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)); - + - + /* Compare the elements. If any pair of corresponding elements - + fail to match, return 0 for the whole things. */ - + - + fmt = GET_RTX_FORMAT (code); - + for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--) - + { - + switch (fmt[i]) - + { - + case 'w': - + if (XWINT (x, i) != XWINT (y, i)) - + return 0; - + break; - + - + case 'n': - + case 'i': - + if (XINT (x, i) != XINT (y, i)) - + return 0; - + break; - + - + case 'V': - + case 'E': - + /* Two vectors must have the same length. */ - + if (XVECLEN (x, i) != XVECLEN (y, i)) - + return 0; - + - + /* And the corresponding elements must match. */ - + for (j = 0; j < XVECLEN (x, i); j++) - + if (rtx_equal_for_memref_p (XVECEXP (x, i, j), XVECEXP (y, i, j)) == 0) - + return 0; - + break; - + - + case 'e': - + if (rtx_equal_for_memref_p (XEXP (x, i), XEXP (y, i)) == 0) - + return 0; - + break; - + - + case 'S': - + case 's': - + if (strcmp (XSTR (x, i), XSTR (y, i))) - + return 0; - + break; - + - + case 'u': - + /* These are just backpointers, so they don't matter. */ - + break; - + - + case '0': - + break; - + - + /* It is believed that rtx's at this level will never - + contain anything but integers and other rtx's, - + except for within LABEL_REFs and SYMBOL_REFs. */ - + default: - + abort (); - + } - + } - + return 1; - + } - + - + /* Given an rtx X, find a SYMBOL_REF or LABEL_REF within - + X and return it, or return 0 if none found. */ - + - + static rtx - + find_symbolic_term (x) - + rtx x; - + { - + register int i; - + register enum rtx_code code; - + register char *fmt; - + - + code = GET_CODE (x); - + if (code == SYMBOL_REF || code == LABEL_REF) - + return x; - + if (GET_RTX_CLASS (code) == 'o') - + return 0; - + - + fmt = GET_RTX_FORMAT (code); - + for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--) - + { - + rtx t; - + - + if (fmt[i] == 'e') - + { - + t = find_symbolic_term (XEXP (x, i)); - + if (t != 0) - + return t; - + } - + else if (fmt[i] == 'E') - + break; - + } - + return 0; - + } - + - + static rtx - + find_base_term (x) - + rtx x; - + { - + switch (GET_CODE (x)) - + { - + case REG: - + return REG_BASE_VALUE (x); - + - + case HIGH: - + return find_base_value (XEXP (x, 0)); - + - + case CONST: - + x = XEXP (x, 0); - + if (GET_CODE (x) != PLUS && GET_CODE (x) != MINUS) - + return 0; - + /* fall through */ - + case LO_SUM: - + case PLUS: - + case MINUS: - + { - + rtx tmp = find_base_term (XEXP (x, 0)); - + if (tmp) - + return tmp; - + return find_base_term (XEXP (x, 1)); - + } - + - + case AND: - + if (GET_CODE (XEXP (x, 0)) == REG && GET_CODE (XEXP (x, 1)) == CONST_INT) - + return REG_BASE_VALUE (XEXP (x, 0)); - + return 0; - + - + case SYMBOL_REF: - + case LABEL_REF: - + return x; - + - + default: - + return 0; - + } - + } - + - + /* Return 0 if the addresses X and Y are known to point to different - + objects, 1 if they might be pointers to the same object. */ - + - + static int - + base_alias_check (x, y) - + rtx x, y; - + { - + rtx x_base = find_base_term (x); - + rtx y_base = find_base_term (y); - + - + /* If either base address is unknown or the base addresses are equal, - + nothing is known about aliasing. */ - + if (x_base == 0 || y_base == 0 || rtx_equal_p (x_base, y_base)) - + return 1; - + - + /* The base addresses of the read and write are different - + expressions. If they are both symbols there is no - + conflict. */ - + if (GET_CODE (x_base) != ADDRESS && GET_CODE (y_base) != ADDRESS) - + return 0; - + - + /* If one address is a stack reference there can be no alias: - + stack references using different base registers do not alias, - + a stack reference can not alias a parameter, and a stack reference - + can not alias a global. */ - + if ((GET_CODE (x_base) == ADDRESS && GET_MODE (x_base) == Pmode) - + || (GET_CODE (y_base) == ADDRESS && GET_MODE (y_base) == Pmode)) - + return 0; - + - + if (! flag_argument_noalias) - + return 1; - + - + if (flag_argument_noalias > 1) - + return 0; - + - + /* Weak noalias assertion (arguments are distinct, but may match globals). */ - + return ! (GET_MODE (x_base) == VOIDmode && GET_MODE (y_base) == VOIDmode); - + } - + - + /* Return nonzero if X and Y (memory addresses) could reference the - + same location in memory. C is an offset accumulator. When - + C is nonzero, we are testing aliases between X and Y + C. - + XSIZE is the size in bytes of the X reference, - + similarly YSIZE is the size in bytes for Y. - + - + If XSIZE or YSIZE is zero, we do not know the amount of memory being - + referenced (the reference was BLKmode), so make the most pessimistic - + assumptions. - + - + We recognize the following cases of non-conflicting memory: - + - + (1) addresses involving the frame pointer cannot conflict - + with addresses involving static variables. - + (2) static variables with different addresses cannot conflict. - + - + Nice to notice that varying addresses cannot conflict with fp if no - + local variables had their addresses taken, but that's too hard now. */ - + - + - + static int - + memrefs_conflict_p (xsize, x, ysize, y, c) - + register rtx x, y; - + int xsize, ysize; - + HOST_WIDE_INT c; - + { - + if (GET_CODE (x) == HIGH) - + x = XEXP (x, 0); - + else if (GET_CODE (x) == LO_SUM) - + x = XEXP (x, 1); - + else - + x = canon_rtx (x); - + if (GET_CODE (y) == HIGH) - + y = XEXP (y, 0); - + else if (GET_CODE (y) == LO_SUM) - + y = XEXP (y, 1); - + else - + y = canon_rtx (y); - + - + if (rtx_equal_for_memref_p (x, y)) - + { - + if (xsize == 0 || ysize == 0) - + return 1; - + if (c >= 0 && xsize > c) - + return 1; - + if (c < 0 && ysize+c > 0) - + return 1; - + return 0; - + } - + - + if (y == frame_pointer_rtx || y == hard_frame_pointer_rtx - + || y == stack_pointer_rtx) - + { - + rtx t = y; - + int tsize = ysize; - + y = x; ysize = xsize; - + x = t; xsize = tsize; - + } - + - + if (x == frame_pointer_rtx || x == hard_frame_pointer_rtx - + || x == stack_pointer_rtx) - + { - + rtx y1; - + - + if (CONSTANT_P (y)) - + return 0; - + - + if (GET_CODE (y) == PLUS - + && canon_rtx (XEXP (y, 0)) == x - + && (y1 = canon_rtx (XEXP (y, 1))) - + && GET_CODE (y1) == CONST_INT) - + { - + c += INTVAL (y1); - + return (xsize == 0 || ysize == 0 - + || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); - + } - + - + if (GET_CODE (y) == PLUS - + && (y1 = canon_rtx (XEXP (y, 0))) - + && CONSTANT_P (y1)) - + return 0; - + - + return 1; - + } - + - + if (GET_CODE (x) == PLUS) - + { - + /* The fact that X is canonicalized means that this - + PLUS rtx is canonicalized. */ - + rtx x0 = XEXP (x, 0); - + rtx x1 = XEXP (x, 1); - + - + if (GET_CODE (y) == PLUS) - + { - + /* The fact that Y is canonicalized means that this - + PLUS rtx is canonicalized. */ - + rtx y0 = XEXP (y, 0); - + rtx y1 = XEXP (y, 1); - + - + if (rtx_equal_for_memref_p (x1, y1)) - + return memrefs_conflict_p (xsize, x0, ysize, y0, c); - + if (rtx_equal_for_memref_p (x0, y0)) - + return memrefs_conflict_p (xsize, x1, ysize, y1, c); - + if (GET_CODE (x1) == CONST_INT) - + if (GET_CODE (y1) == CONST_INT) - + return memrefs_conflict_p (xsize, x0, ysize, y0, - + c - INTVAL (x1) + INTVAL (y1)); - + else - + return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1)); - + else if (GET_CODE (y1) == CONST_INT) - + return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1)); - + - + /* Handle case where we cannot understand iteration operators, - + but we notice that the base addresses are distinct objects. */ - + /* ??? Is this still necessary? */ - + x = find_symbolic_term (x); - + if (x == 0) - + return 1; - + y = find_symbolic_term (y); - + if (y == 0) - + return 1; - + return rtx_equal_for_memref_p (x, y); - + } - + else if (GET_CODE (x1) == CONST_INT) - + return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1)); - + } - + else if (GET_CODE (y) == PLUS) - + { - + /* The fact that Y is canonicalized means that this - + PLUS rtx is canonicalized. */ - + rtx y0 = XEXP (y, 0); - + rtx y1 = XEXP (y, 1); - + - + if (GET_CODE (y1) == CONST_INT) - + return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1)); - + else - + return 1; - + } - + - + if (GET_CODE (x) == GET_CODE (y)) - + switch (GET_CODE (x)) - + { - + case MULT: - + { - + /* Handle cases where we expect the second operands to be the - + same, and check only whether the first operand would conflict - + or not. */ - + rtx x0, y0; - + rtx x1 = canon_rtx (XEXP (x, 1)); - + rtx y1 = canon_rtx (XEXP (y, 1)); - + if (! rtx_equal_for_memref_p (x1, y1)) - + return 1; - + x0 = canon_rtx (XEXP (x, 0)); - + y0 = canon_rtx (XEXP (y, 0)); - + if (rtx_equal_for_memref_p (x0, y0)) - + return (xsize == 0 || ysize == 0 - + || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); - + - + /* Can't properly adjust our sizes. */ - + if (GET_CODE (x1) != CONST_INT) - + return 1; - + xsize /= INTVAL (x1); - + ysize /= INTVAL (x1); - + c /= INTVAL (x1); - + return memrefs_conflict_p (xsize, x0, ysize, y0, c); - + } - + } - + - + /* Treat an access through an AND (e.g. a subword access on an Alpha) - + as an access with indeterminate size. */ - + if (GET_CODE (x) == AND && GET_CODE (XEXP (x, 1)) == CONST_INT) - + return memrefs_conflict_p (0, XEXP (x, 0), ysize, y, c); - + if (GET_CODE (y) == AND && GET_CODE (XEXP (y, 1)) == CONST_INT) - + return memrefs_conflict_p (xsize, x, 0, XEXP (y, 0), c); - + - + if (CONSTANT_P (x)) - + { - + if (GET_CODE (x) == CONST_INT && GET_CODE (y) == CONST_INT) - + { - + c += (INTVAL (y) - INTVAL (x)); - + return (xsize == 0 || ysize == 0 - + || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); - + } - + - + if (GET_CODE (x) == CONST) - + { - + if (GET_CODE (y) == CONST) - + return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)), - + ysize, canon_rtx (XEXP (y, 0)), c); - + else - + return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)), - + ysize, y, c); - + } - + if (GET_CODE (y) == CONST) - + return memrefs_conflict_p (xsize, x, ysize, - + canon_rtx (XEXP (y, 0)), c); - + - + if (CONSTANT_P (y)) - + return (rtx_equal_for_memref_p (x, y) - + && (xsize == 0 || ysize == 0 - + || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0))); - + - + return 1; - + } - + return 1; - + } - + - + /* Functions to compute memory dependencies. - + - + Since we process the insns in execution order, we can build tables - + to keep track of what registers are fixed (and not aliased), what registers - + are varying in known ways, and what registers are varying in unknown - + ways. - + - + If both memory references are volatile, then there must always be a - + dependence between the two references, since their order can not be - + changed. A volatile and non-volatile reference can be interchanged - + though. - + - + A MEM_IN_STRUCT reference at a non-QImode varying address can never - + conflict with a non-MEM_IN_STRUCT reference at a fixed address. We must - + allow QImode aliasing because the ANSI C standard allows character - + pointers to alias anything. We are assuming that characters are - + always QImode here. */ - + - + /* Read dependence: X is read after read in MEM takes place. There can - + only be a dependence here if both reads are volatile. */ - + - + int - + read_dependence (mem, x) - + rtx mem; - + rtx x; - + { - + return MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem); - + } - + - + /* True dependence: X is read after store in MEM takes place. */ - + - + int - + true_dependence (mem, mem_mode, x, varies) - + rtx mem; - + enum machine_mode mem_mode; - + rtx x; - + int (*varies)(); - + { - + rtx x_addr, mem_addr; - + - + if (MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) - + return 1; - + - + x_addr = XEXP (x, 0); - + mem_addr = XEXP (mem, 0); - + - + if (flag_alias_check && ! base_alias_check (x_addr, mem_addr)) - + return 0; - + - + /* If X is an unchanging read, then it can't possibly conflict with any - + non-unchanging store. It may conflict with an unchanging write though, - + because there may be a single store to this address to initialize it. - + Just fall through to the code below to resolve the case where we have - + both an unchanging read and an unchanging write. This won't handle all - + cases optimally, but the possible performance loss should be - + negligible. */ - + if (RTX_UNCHANGING_P (x) && ! RTX_UNCHANGING_P (mem)) - + return 0; - + - + x_addr = canon_rtx (x_addr); - + mem_addr = canon_rtx (mem_addr); - + if (mem_mode == VOIDmode) - + mem_mode = GET_MODE (mem); - + - + if (! memrefs_conflict_p (mem_mode, mem_addr, SIZE_FOR_MODE (x), x_addr, 0)) - + return 0; - + - + /* If both references are struct references, or both are not, nothing - + is known about aliasing. - + - + If either reference is QImode or BLKmode, ANSI C permits aliasing. - + - + If both addresses are constant, or both are not, nothing is known - + about aliasing. */ - + if (MEM_IN_STRUCT_P (x) == MEM_IN_STRUCT_P (mem) - + || mem_mode == QImode || mem_mode == BLKmode - + || GET_MODE (x) == QImode || GET_MODE (mem) == BLKmode - + || varies (x_addr) == varies (mem_addr)) - + return 1; - + - + /* One memory reference is to a constant address, one is not. - + One is to a structure, the other is not. - + - + If either memory reference is a variable structure the other is a - + fixed scalar and there is no aliasing. */ - + if ((MEM_IN_STRUCT_P (mem) && varies (mem_addr)) - + || (MEM_IN_STRUCT_P (x) && varies (x))) - + return 0; - + - + return 1; - + } - + - + /* Anti dependence: X is written after read in MEM takes place. */ - + - + int - + anti_dependence (mem, x) - + rtx mem; - + rtx x; - + { - + if (MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) - + return 1; - + - + if (flag_alias_check && ! base_alias_check (XEXP (x, 0), XEXP (mem, 0))) - + return 0; - + - + /* If MEM is an unchanging read, then it can't possibly conflict with - + the store to X, because there is at most one store to MEM, and it must - + have occurred somewhere before MEM. */ - + x = canon_rtx (x); - + mem = canon_rtx (mem); - + if (RTX_UNCHANGING_P (mem)) - + return 0; - + - + return (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0), - + SIZE_FOR_MODE (x), XEXP (x, 0), 0) - + && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem) - + && GET_MODE (mem) != QImode - + && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x)) - + && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x) - + && GET_MODE (x) != QImode - + && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem))); - + } - + - + /* Output dependence: X is written after store in MEM takes place. */ - + - + int - + output_dependence (mem, x) - + register rtx mem; - + register rtx x; - + { - + if (MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) - + return 1; - + - + if (flag_alias_check && !base_alias_check (XEXP (x, 0), XEXP (mem, 0))) - + return 0; - + - + x = canon_rtx (x); - + mem = canon_rtx (mem); - + return (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0), - + SIZE_FOR_MODE (x), XEXP (x, 0), 0) - + && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem) - + && GET_MODE (mem) != QImode - + && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x)) - + && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x) - + && GET_MODE (x) != QImode - + && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem))); - + } - + - + void - + init_alias_analysis () - + { - + int maxreg = max_reg_num (); - + register int i; - + register rtx insn; - + rtx note; - + rtx set; - + int changed; - + - + reg_known_value_size = maxreg; - + - + reg_known_value - + = (rtx *) oballoc ((maxreg - FIRST_PSEUDO_REGISTER) * sizeof (rtx)) - + - FIRST_PSEUDO_REGISTER; - + reg_known_equiv_p = - + oballoc (maxreg - FIRST_PSEUDO_REGISTER) - FIRST_PSEUDO_REGISTER; - + bzero ((char *) (reg_known_value + FIRST_PSEUDO_REGISTER), - + (maxreg-FIRST_PSEUDO_REGISTER) * sizeof (rtx)); - + bzero (reg_known_equiv_p + FIRST_PSEUDO_REGISTER, - + (maxreg - FIRST_PSEUDO_REGISTER) * sizeof (char)); - + - + if (flag_alias_check) - + { - + /* Overallocate reg_base_value to allow some growth during loop - + optimization. Loop unrolling can create a large number of - + registers. */ - + reg_base_value_size = maxreg * 2; - + reg_base_value = (rtx *)oballoc (reg_base_value_size * sizeof (rtx)); - + reg_seen = (char *)alloca (reg_base_value_size); - + bzero (reg_base_value, reg_base_value_size * sizeof (rtx)); - + bzero (reg_seen, reg_base_value_size); - + - + /* Mark all hard registers which may contain an address. - + The stack, frame and argument pointers may contain an address. - + An argument register which can hold a Pmode value may contain - + an address even if it is not in BASE_REGS. - + - + The address expression is VOIDmode for an argument and - + Pmode for other registers. */ - + for (i = 0; i < FIRST_PSEUDO_REGISTER; i++) - + if (FUNCTION_ARG_REGNO_P (i) && HARD_REGNO_MODE_OK (i, Pmode)) - + reg_base_value[i] = gen_rtx (ADDRESS, VOIDmode, - + gen_rtx (REG, Pmode, i)); - + - + reg_base_value[STACK_POINTER_REGNUM] - + = gen_rtx (ADDRESS, Pmode, stack_pointer_rtx); - + reg_base_value[ARG_POINTER_REGNUM] - + = gen_rtx (ADDRESS, Pmode, arg_pointer_rtx); - + reg_base_value[FRAME_POINTER_REGNUM] - + = gen_rtx (ADDRESS, Pmode, frame_pointer_rtx); - + reg_base_value[HARD_FRAME_POINTER_REGNUM] - + = gen_rtx (ADDRESS, Pmode, hard_frame_pointer_rtx); - + } - + - + copying_arguments = 1; - + /* Fill in the entries with known constant values. */ - + for (insn = get_insns (); insn; insn = NEXT_INSN (insn)) - + { - + if (flag_alias_check && GET_RTX_CLASS (GET_CODE (insn)) == 'i') - + { - + /* If this insn has a noalias note, process it, Otherwise, - + scan for sets. A simple set will have no side effects - + which could change the base value of any other register. */ - + rtx noalias_note; - + if (GET_CODE (PATTERN (insn)) == SET - + && (noalias_note = find_reg_note (insn, REG_NOALIAS, NULL_RTX))) - + record_set(SET_DEST (PATTERN (insn)), 0); - + else - + note_stores (PATTERN (insn), record_set); - + } - + else if (GET_CODE (insn) == NOTE - + && NOTE_LINE_NUMBER (insn) == NOTE_INSN_FUNCTION_BEG) - + copying_arguments = 0; - + - + if ((set = single_set (insn)) != 0 - + && GET_CODE (SET_DEST (set)) == REG - + && REGNO (SET_DEST (set)) >= FIRST_PSEUDO_REGISTER - + && (((note = find_reg_note (insn, REG_EQUAL, 0)) != 0 - + && reg_n_sets[REGNO (SET_DEST (set))] == 1) - + || (note = find_reg_note (insn, REG_EQUIV, NULL_RTX)) != 0) - + && GET_CODE (XEXP (note, 0)) != EXPR_LIST) - + { - + int regno = REGNO (SET_DEST (set)); - + reg_known_value[regno] = XEXP (note, 0); - + reg_known_equiv_p[regno] = REG_NOTE_KIND (note) == REG_EQUIV; - + } - + } - + - + /* Fill in the remaining entries. */ - + for (i = FIRST_PSEUDO_REGISTER; i < maxreg; i++) - + if (reg_known_value[i] == 0) - + reg_known_value[i] = regno_reg_rtx[i]; - + - + if (! flag_alias_check) - + return; - + - + /* Simplify the reg_base_value array so that no register refers to - + another register, except to special registers indirectly through - + ADDRESS expressions. - + - + In theory this loop can take as long as O(registers^2), but unless - + there are very long dependency chains it will run in close to linear - + time. */ - + do - + { - + changed = 0; - + for (i = FIRST_PSEUDO_REGISTER; i < reg_base_value_size; i++) - + { - + rtx base = reg_base_value[i]; - + if (base && GET_CODE (base) == REG) - + { - + int base_regno = REGNO (base); - + if (base_regno == i) /* register set from itself */ - + reg_base_value[i] = 0; - + else - + reg_base_value[i] = reg_base_value[base_regno]; - + changed = 1; - + } - + } - + } - + while (changed); - + - + reg_seen = 0; - + } - + - + void - + end_alias_analysis () - + { - + reg_known_value = 0; - + reg_base_value = 0; - + reg_base_value_size = 0; - + } - diff -rcp2N gcc-2.7.2.2/calls.c gcc-2.7.2.2.f.2/calls.c - *** gcc-2.7.2.2/calls.c Thu Oct 26 21:53:43 1995 - --- gcc-2.7.2.2.f.2/calls.c Fri Jan 10 23:18:21 1997 - *************** expand_call (exp, target, ignore) - *** 564,567 **** - --- 564,569 ---- - /* Nonzero if it is plausible that this is a call to alloca. */ - int may_be_alloca; - + /* Nonzero if this is a call to malloc or a related function. */ - + int is_malloc; - /* Nonzero if this is a call to setjmp or a related function. */ - int returns_twice; - *************** expand_call (exp, target, ignore) - *** 852,855 **** - --- 854,858 ---- - returns_twice = 0; - is_longjmp = 0; - + is_malloc = 0; - - if (name != 0 && IDENTIFIER_LENGTH (DECL_NAME (fndecl)) <= 15) - *************** expand_call (exp, target, ignore) - *** 891,894 **** - --- 894,901 ---- - && ! strcmp (tname, "longjmp")) - is_longjmp = 1; - + /* Only recognize malloc when alias analysis is enabled. */ - + else if (tname[0] == 'm' && flag_alias_check - + && ! strcmp(tname, "malloc")) - + is_malloc = 1; - } - - *************** expand_call (exp, target, ignore) - *** 1363,1367 **** - /* Now we are about to start emitting insns that can be deleted - if a libcall is deleted. */ - ! if (is_const) - start_sequence (); - - --- 1370,1374 ---- - /* Now we are about to start emitting insns that can be deleted - if a libcall is deleted. */ - ! if (is_const || is_malloc) - start_sequence (); - - *************** expand_call (exp, target, ignore) - *** 1951,1954 **** - --- 1958,1975 ---- - end_sequence (); - emit_insns (insns); - + } - + else if (is_malloc) - + { - + rtx temp = gen_reg_rtx (GET_MODE (valreg)); - + rtx last, insns; - + - + emit_move_insn (temp, valreg); - + last = get_last_insn (); - + REG_NOTES (last) = - + gen_rtx (EXPR_LIST, REG_NOALIAS, temp, REG_NOTES (last)); - + insns = get_insns (); - + end_sequence (); - + emit_insns (insns); - + valreg = temp; - } - - diff -rcp2N gcc-2.7.2.2/combine.c gcc-2.7.2.2.f.2/combine.c - *** gcc-2.7.2.2/combine.c Sun Nov 26 14:32:07 1995 - --- gcc-2.7.2.2.f.2/combine.c Fri Jan 10 23:18:21 1997 - *************** distribute_notes (notes, from_insn, i3, - *** 10648,10651 **** - --- 10648,10652 ---- - case REG_EQUIV: - case REG_NONNEG: - + case REG_NOALIAS: - /* These notes say something about results of an insn. We can - only support them if they used to be on I3 in which case they - diff -rcp2N gcc-2.7.2.2/config/alpha/alpha.c gcc-2.7.2.2.f.2/config/alpha/alpha.c - *** gcc-2.7.2.2/config/alpha/alpha.c Thu Feb 20 19:24:11 1997 - --- gcc-2.7.2.2.f.2/config/alpha/alpha.c Sun Feb 23 15:35:33 1997 - *************** output_prolog (file, size) - *** 1370,1373 **** - --- 1370,1378 ---- - - alpha_function_needs_gp = 0; - + #ifdef __linux__ - + if(profile_flag) { - + alpha_function_needs_gp = 1; - + } - + #endif - for (insn = get_insns (); insn; insn = NEXT_INSN (insn)) - if ((GET_CODE (insn) == CALL_INSN) - diff -rcp2N gcc-2.7.2.2/config/alpha/alpha.h gcc-2.7.2.2.f.2/config/alpha/alpha.h - *** gcc-2.7.2.2/config/alpha/alpha.h Thu Feb 20 19:24:12 1997 - --- gcc-2.7.2.2.f.2/config/alpha/alpha.h Sun Feb 23 15:35:34 1997 - *************** extern int target_flags; - *** 112,116 **** - --- 112,118 ---- - {"", TARGET_DEFAULT | TARGET_CPU_DEFAULT} } - - + #ifndef TARGET_DEFAULT - #define TARGET_DEFAULT 3 - + #endif - - #ifndef TARGET_CPU_DEFAULT - diff -rcp2N gcc-2.7.2.2/config/alpha/alpha.md gcc-2.7.2.2.f.2/config/alpha/alpha.md - *** gcc-2.7.2.2/config/alpha/alpha.md Fri Oct 27 06:49:59 1995 - --- gcc-2.7.2.2.f.2/config/alpha/alpha.md Mon Dec 23 00:43:55 1996 - *************** - *** 1746,1752 **** - (if_then_else:DF - (match_operator 3 "signed_comparison_operator" - ! [(match_operand:DF 1 "reg_or_fp0_operand" "fG,fG") - (match_operand:DF 2 "fp0_operand" "G,G")]) - ! (float_extend:DF (match_operand:SF 4 "reg_or_fp0_operand" "fG,0")) - (match_operand:DF 5 "reg_or_fp0_operand" "0,fG")))] - "TARGET_FP" - --- 1746,1752 ---- - (if_then_else:DF - (match_operator 3 "signed_comparison_operator" - ! [(match_operand:DF 4 "reg_or_fp0_operand" "fG,fG") - (match_operand:DF 2 "fp0_operand" "G,G")]) - ! (float_extend:DF (match_operand:SF 1 "reg_or_fp0_operand" "fG,0")) - (match_operand:DF 5 "reg_or_fp0_operand" "0,fG")))] - "TARGET_FP" - diff -rcp2N gcc-2.7.2.2/config/alpha/linux.h gcc-2.7.2.2.f.2/config/alpha/linux.h - *** gcc-2.7.2.2/config/alpha/linux.h Wed Dec 31 19:00:00 1969 - --- gcc-2.7.2.2.f.2/config/alpha/linux.h Thu Dec 19 12:31:08 1996 - *************** - *** 0 **** - --- 1,72 ---- - + /* Definitions of target machine for GNU compiler, for Alpha Linux, - + using ECOFF. - + Copyright (C) 1995 Free Software Foundation, Inc. - + Contributed by Bob Manson. - + Derived from work contributed by Cygnus Support, - + (c) 1993 Free Software Foundation. - + - + This file is part of GNU CC. - + - + GNU CC 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 CC 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 CC; see the file COPYING. If not, write to - + the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ - + - + #define TARGET_DEFAULT (3 | MASK_GAS) - + - + #include "alpha/alpha.h" - + - + #undef TARGET_VERSION - + #define TARGET_VERSION fprintf (stderr, " (Linux/Alpha)"); - + - + #undef CPP_PREDEFINES - + #define CPP_PREDEFINES "\ - + -D__alpha -D__alpha__ -D__linux__ -D__linux -D_LONGLONG -Dlinux -Dunix \ - + -Asystem(linux) -Acpu(alpha) -Amachine(alpha)" - + - + /* We don't actually need any of these; the MD_ vars are ignored - + anyway for cross-compilers, and the other specs won't get picked up - + 'coz the user is supposed to do ld -r (hmm, perhaps that should be - + the default). In any case, setting them thus will catch some - + common user errors. */ - + - + #undef MD_EXEC_PREFIX - + #undef MD_STARTFILE_PREFIX - + - + #undef LIB_SPEC - + #define LIB_SPEC "%{pg:-lgmon} %{pg:-lc_p} %{!pg:-lc}" - + - + #undef LINK_SPEC - + #define LINK_SPEC \ - + "-G 8 %{O*:-O3} %{!O*:-O1}" - + - + #undef ASM_SPEC - + #define ASM_SPEC "-nocpp" - + - + /* Can't do stabs */ - + #undef SDB_DEBUGGING_INFO - + - + /* Prefer dbx. */ - + #undef PREFERRED_DEBUGGING_TYPE - + #define PREFERRED_DEBUGGING_TYPE DBX_DEBUG - + - + #undef FUNCTION_PROFILER - + - + #define FUNCTION_PROFILER(FILE, LABELNO) \ - + do { \ - + fputs ("\tlda $27,_mcount\n", (FILE)); \ - + fputs ("\tjsr $26,($27),_mcount\n", (FILE)); \ - + fputs ("\tldgp $29,0($26)\n", (FILE)); \ - + } while (0); - + - + /* Generate calls to memcpy, etc., not bcopy, etc. */ - + #define TARGET_MEM_FUNCTIONS - diff -rcp2N gcc-2.7.2.2/config/alpha/t-linux gcc-2.7.2.2.f.2/config/alpha/t-linux - *** gcc-2.7.2.2/config/alpha/t-linux Wed Dec 31 19:00:00 1969 - --- gcc-2.7.2.2.f.2/config/alpha/t-linux Thu Dec 19 12:31:08 1996 - *************** - *** 0 **** - --- 1,3 ---- - + # Our header files are supposed to be correct, nein? - + FIXINCLUDES = - + STMP_FIXPROTO = - diff -rcp2N gcc-2.7.2.2/config/alpha/x-linux gcc-2.7.2.2.f.2/config/alpha/x-linux - *** gcc-2.7.2.2/config/alpha/x-linux Wed Dec 31 19:00:00 1969 - --- gcc-2.7.2.2.f.2/config/alpha/x-linux Thu Dec 19 12:31:08 1996 - *************** - *** 0 **** - --- 1 ---- - + CLIB=-lbfd -liberty - diff -rcp2N gcc-2.7.2.2/config/alpha/xm-alpha.h gcc-2.7.2.2.f.2/config/alpha/xm-alpha.h - *** gcc-2.7.2.2/config/alpha/xm-alpha.h Thu Aug 31 17:52:27 1995 - --- gcc-2.7.2.2.f.2/config/alpha/xm-alpha.h Thu Dec 19 12:31:08 1996 - *************** Boston, MA 02111-1307, USA. */ - *** 46,51 **** - --- 46,53 ---- - #include - #else - + #ifndef __alpha__ - extern void *alloca (); - #endif - + #endif - - /* The host compiler has problems with enum bitfields since it makes - *************** extern void *malloc (), *realloc (), *ca - *** 68,72 **** - --- 70,76 ---- - /* OSF/1 has vprintf. */ - - + #ifndef linux /* 1996/02/22 mauro@craftwork.com -- unreliable with Linux */ - #define HAVE_VPRINTF - + #endif - - /* OSF/1 has putenv. */ - diff -rcp2N gcc-2.7.2.2/config/alpha/xm-linux.h gcc-2.7.2.2.f.2/config/alpha/xm-linux.h - *** gcc-2.7.2.2/config/alpha/xm-linux.h Wed Dec 31 19:00:00 1969 - --- gcc-2.7.2.2.f.2/config/alpha/xm-linux.h Thu Dec 19 12:31:08 1996 - *************** - *** 0 **** - --- 1,8 ---- - + #ifndef _XM_LINUX_H - + #define _XM_LINUX_H - + - + #include "xm-alpha.h" - + - + #define DONT_DECLARE_SYS_SIGLIST - + #define USE_BFD - + #endif - diff -rcp2N gcc-2.7.2.2/config/x-linux gcc-2.7.2.2.f.2/config/x-linux - *** gcc-2.7.2.2/config/x-linux Tue Mar 28 07:43:37 1995 - --- gcc-2.7.2.2.f.2/config/x-linux Thu Dec 19 12:31:08 1996 - *************** BOOT_CFLAGS = -O $(CFLAGS) -Iinclude - *** 13,14 **** - --- 13,17 ---- - # Don't run fixproto - STMP_FIXPROTO = - + - + # Don't install "assert.h" in gcc. We use the one in glibc. - + INSTALL_ASSERT_H = - diff -rcp2N gcc-2.7.2.2/config/x-linux-aout gcc-2.7.2.2.f.2/config/x-linux-aout - *** gcc-2.7.2.2/config/x-linux-aout Wed Dec 31 19:00:00 1969 - --- gcc-2.7.2.2.f.2/config/x-linux-aout Thu Dec 19 12:31:08 1996 - *************** - *** 0 **** - --- 1,14 ---- - + # It is defined in config/xm-linux.h. - + # X_CFLAGS = -DPOSIX - + - + # The following is needed when compiling stages 2 and 3 because gcc's - + # limits.h must be picked up before /usr/include/limits.h. This is because - + # each does an #include_next of the other if the other hasn't been included. - + # /usr/include/limits.h loses if it gets found first because /usr/include is - + # at the end of the search order. When a new version of gcc is released, - + # gcc's limits.h hasn't been installed yet and hence isn't found. - + - + BOOT_CFLAGS = -O $(CFLAGS) -Iinclude - + - + # Don't run fixproto - + STMP_FIXPROTO = - diff -rcp2N gcc-2.7.2.2/configure gcc-2.7.2.2.f.2/configure - *** gcc-2.7.2.2/configure Thu Feb 20 19:24:33 1997 - --- gcc-2.7.2.2.f.2/configure Sun Feb 23 16:15:12 1997 - *************** exec_prefix='$(prefix)' - *** 82,85 **** - --- 82,86 ---- - # The default g++ include directory is $(libdir)/g++-include. - gxx_include_dir='$(libdir)/g++-include' - + #gxx_include_dir='$(exec_prefix)/include/g++' - - # Default --program-transform-name to nothing. - *************** for machine in $canon_build $canon_host - *** 548,551 **** - --- 549,559 ---- - use_collect2=yes - ;; - + alpha-*-linux*) - + tm_file=alpha/linux.h - + tmake_file=alpha/t-linux - + xmake_file=alpha/x-linux - + fixincludes=Makefile.in - + xm_file=alpha/xm-linux.h - + ;; - alpha-dec-osf[23456789]*) - tm_file=alpha/osf2.h - *************** for machine in $canon_build $canon_host - *** 985,989 **** - cpu_type=i386 # with a.out format using pre BFD linkers - xm_file=i386/xm-linux.h - ! xmake_file=x-linux - tm_file=i386/linux-oldld.h - fixincludes=Makefile.in # The headers are ok already. - --- 993,997 ---- - cpu_type=i386 # with a.out format using pre BFD linkers - xm_file=i386/xm-linux.h - ! xmake_file=x-linux-aout - tm_file=i386/linux-oldld.h - fixincludes=Makefile.in # The headers are ok already. - *************** for machine in $canon_build $canon_host - *** 994,998 **** - cpu_type=i386 # with a.out format - xm_file=i386/xm-linux.h - ! xmake_file=x-linux - tm_file=i386/linux-aout.h - fixincludes=Makefile.in # The headers are ok already. - --- 1002,1006 ---- - cpu_type=i386 # with a.out format - xm_file=i386/xm-linux.h - ! xmake_file=x-linux-aout - tm_file=i386/linux-aout.h - fixincludes=Makefile.in # The headers are ok already. - *************** for machine in $canon_build $canon_host - *** 1003,1007 **** - cpu_type=i386 # with ELF format, using GNU libc v1. - xm_file=i386/xm-linux.h - ! xmake_file=x-linux - tmake_file=t-linux-libc1 - tm_file=i386/linux.h - --- 1011,1015 ---- - cpu_type=i386 # with ELF format, using GNU libc v1. - xm_file=i386/xm-linux.h - ! xmake_file=x-linux-aout - tmake_file=t-linux-libc1 - tm_file=i386/linux.h - diff -rcp2N gcc-2.7.2.2/cse.c gcc-2.7.2.2.f.2/cse.c - *** gcc-2.7.2.2/cse.c Sun Nov 26 14:47:05 1995 - --- gcc-2.7.2.2.f.2/cse.c Fri Jan 10 23:18:22 1997 - *************** static struct table_elt *last_jump_equiv - *** 520,544 **** - static int constant_pool_entries_cost; - - - /* Bits describing what kind of values in memory must be invalidated - - for a particular instruction. If all three bits are zero, - - no memory refs need to be invalidated. Each bit is more powerful - - than the preceding ones, and if a bit is set then the preceding - - bits are also set. - - - - Here is how the bits are set: - - Pushing onto the stack invalidates only the stack pointer, - - writing at a fixed address invalidates only variable addresses, - - writing in a structure element at variable address - - invalidates all but scalar variables, - - and writing in anything else at variable address invalidates everything. */ - - - - struct write_data - - { - - int sp : 1; /* Invalidate stack pointer. */ - - int var : 1; /* Invalidate variable addresses. */ - - int nonscalar : 1; /* Invalidate all but scalar variables. */ - - int all : 1; /* Invalidate all memory refs. */ - - }; - - - /* Define maximum length of a branch path. */ - - --- 520,523 ---- - *************** static void merge_equiv_classes PROTO((s - *** 626,632 **** - struct table_elt *)); - static void invalidate PROTO((rtx, enum machine_mode)); - static void remove_invalid_refs PROTO((int)); - static void rehash_using_reg PROTO((rtx)); - ! static void invalidate_memory PROTO((struct write_data *)); - static void invalidate_for_call PROTO((void)); - static rtx use_related_value PROTO((rtx, struct table_elt *)); - --- 605,612 ---- - struct table_elt *)); - static void invalidate PROTO((rtx, enum machine_mode)); - + static int cse_rtx_varies_p PROTO((rtx)); - static void remove_invalid_refs PROTO((int)); - static void rehash_using_reg PROTO((rtx)); - ! static void invalidate_memory PROTO((void)); - static void invalidate_for_call PROTO((void)); - static rtx use_related_value PROTO((rtx, struct table_elt *)); - *************** static void set_nonvarying_address_compo - *** 638,644 **** - HOST_WIDE_INT *)); - static int refers_to_p PROTO((rtx, rtx)); - - static int refers_to_mem_p PROTO((rtx, rtx, HOST_WIDE_INT, - - HOST_WIDE_INT)); - - static int cse_rtx_addr_varies_p PROTO((rtx)); - static rtx canon_reg PROTO((rtx, rtx)); - static void find_best_addr PROTO((rtx, rtx *)); - --- 618,621 ---- - *************** static void record_jump_cond PROTO((enum - *** 656,661 **** - rtx, rtx, int)); - static void cse_insn PROTO((rtx, int)); - ! static void note_mem_written PROTO((rtx, struct write_data *)); - ! static void invalidate_from_clobbers PROTO((struct write_data *, rtx)); - static rtx cse_process_notes PROTO((rtx, rtx)); - static void cse_around_loop PROTO((rtx)); - --- 633,638 ---- - rtx, rtx, int)); - static void cse_insn PROTO((rtx, int)); - ! static int note_mem_written PROTO((rtx)); - ! static void invalidate_from_clobbers PROTO((rtx)); - static rtx cse_process_notes PROTO((rtx, rtx)); - static void cse_around_loop PROTO((rtx)); - *************** invalidate (x, full_mode) - *** 1512,1517 **** - register int i; - register struct table_elt *p; - - rtx base; - - HOST_WIDE_INT start, end; - - /* If X is a register, dependencies on its contents - --- 1489,1492 ---- - *************** invalidate (x, full_mode) - *** 1605,1611 **** - full_mode = GET_MODE (x); - - - set_nonvarying_address_components (XEXP (x, 0), GET_MODE_SIZE (full_mode), - - &base, &start, &end); - - - for (i = 0; i < NBUCKETS; i++) - { - --- 1580,1583 ---- - *************** invalidate (x, full_mode) - *** 1614,1618 **** - { - next = p->next_same_hash; - ! if (refers_to_mem_p (p->exp, base, start, end)) - remove_from_table (p, i); - } - --- 1586,1594 ---- - { - next = p->next_same_hash; - ! /* Invalidate ASM_OPERANDS which reference memory (this is easier - ! than checking all the aliases). */ - ! if (p->in_memory - ! && (GET_CODE (p->exp) != MEM - ! || true_dependence (x, full_mode, p->exp, cse_rtx_varies_p))) - remove_from_table (p, i); - } - *************** rehash_using_reg (x) - *** 1695,1722 **** - } - - - /* Remove from the hash table all expressions that reference memory, - - or some of them as specified by *WRITES. */ - - - - static void - - invalidate_memory (writes) - - struct write_data *writes; - - { - - register int i; - - register struct table_elt *p, *next; - - int all = writes->all; - - int nonscalar = writes->nonscalar; - - - - for (i = 0; i < NBUCKETS; i++) - - for (p = table[i]; p; p = next) - - { - - next = p->next_same_hash; - - if (p->in_memory - - && (all - - || (nonscalar && p->in_struct) - - || cse_rtx_addr_varies_p (p->exp))) - - remove_from_table (p, i); - - } - - } - - - /* Remove from the hash table any expression that is a call-clobbered - register. Also update their TICK values. */ - --- 1671,1674 ---- - *************** invalidate_for_call () - *** 1756,1759 **** - --- 1708,1717 ---- - next = p->next_same_hash; - - + if (p->in_memory) - + { - + remove_from_table (p, hash); - + continue; - + } - + - if (GET_CODE (p->exp) != REG - || REGNO (p->exp) >= FIRST_PSEUDO_REGISTER) - *************** set_nonvarying_address_components (addr, - *** 2395,2477 **** - } - - ! /* Return 1 iff any subexpression of X refers to memory - ! at an address of BASE plus some offset - ! such that any of the bytes' offsets fall between START (inclusive) - ! and END (exclusive). - ! - ! The value is undefined if X is a varying address (as determined by - ! cse_rtx_addr_varies_p). This function is not used in such cases. - ! - ! When used in the cse pass, `qty_const' is nonzero, and it is used - ! to treat an address that is a register with a known constant value - ! as if it were that constant value. - ! In the loop pass, `qty_const' is zero, so this is not done. */ - ! - ! static int - ! refers_to_mem_p (x, base, start, end) - ! rtx x, base; - ! HOST_WIDE_INT start, end; - ! { - ! register HOST_WIDE_INT i; - ! register enum rtx_code code; - ! register char *fmt; - ! - ! repeat: - ! if (x == 0) - ! return 0; - ! - ! code = GET_CODE (x); - ! if (code == MEM) - ! { - ! register rtx addr = XEXP (x, 0); /* Get the address. */ - ! rtx mybase; - ! HOST_WIDE_INT mystart, myend; - ! - ! set_nonvarying_address_components (addr, GET_MODE_SIZE (GET_MODE (x)), - ! &mybase, &mystart, &myend); - ! - ! - ! /* refers_to_mem_p is never called with varying addresses. - ! If the base addresses are not equal, there is no chance - ! of the memory addresses conflicting. */ - ! if (! rtx_equal_p (mybase, base)) - ! return 0; - ! - ! return myend > start && mystart < end; - ! } - ! - ! /* X does not match, so try its subexpressions. */ - ! - ! fmt = GET_RTX_FORMAT (code); - ! for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--) - ! if (fmt[i] == 'e') - ! { - ! if (i == 0) - ! { - ! x = XEXP (x, 0); - ! goto repeat; - ! } - ! else - ! if (refers_to_mem_p (XEXP (x, i), base, start, end)) - ! return 1; - ! } - ! else if (fmt[i] == 'E') - ! { - ! int j; - ! for (j = 0; j < XVECLEN (x, i); j++) - ! if (refers_to_mem_p (XVECEXP (x, i, j), base, start, end)) - ! return 1; - ! } - ! - ! return 0; - ! } - ! - ! /* Nonzero if X refers to memory at a varying address; - except that a register which has at the moment a known constant value - isn't considered variable. */ - - static int - ! cse_rtx_addr_varies_p (x) - ! rtx x; - { - /* We need not check for X and the equivalence class being of the same - --- 2353,2363 ---- - } - - ! /* Nonzero if X, a memory address, refers to a varying address; - except that a register which has at the moment a known constant value - isn't considered variable. */ - - static int - ! cse_rtx_varies_p (x) - ! register rtx x; - { - /* We need not check for X and the equivalence class being of the same - *************** cse_rtx_addr_varies_p (x) - *** 2479,2497 **** - doesn't vary in any mode. */ - - ! if (GET_CODE (x) == MEM - ! && GET_CODE (XEXP (x, 0)) == REG - ! && REGNO_QTY_VALID_P (REGNO (XEXP (x, 0))) - ! && GET_MODE (XEXP (x, 0)) == qty_mode[reg_qty[REGNO (XEXP (x, 0))]] - ! && qty_const[reg_qty[REGNO (XEXP (x, 0))]] != 0) - return 0; - - ! if (GET_CODE (x) == MEM - ! && GET_CODE (XEXP (x, 0)) == PLUS - ! && GET_CODE (XEXP (XEXP (x, 0), 1)) == CONST_INT - ! && GET_CODE (XEXP (XEXP (x, 0), 0)) == REG - ! && REGNO_QTY_VALID_P (REGNO (XEXP (XEXP (x, 0), 0))) - ! && (GET_MODE (XEXP (XEXP (x, 0), 0)) - ! == qty_mode[reg_qty[REGNO (XEXP (XEXP (x, 0), 0))]]) - ! && qty_const[reg_qty[REGNO (XEXP (XEXP (x, 0), 0))]]) - return 0; - - --- 2365,2381 ---- - doesn't vary in any mode. */ - - ! if (GET_CODE (x) == REG - ! && REGNO_QTY_VALID_P (REGNO (x)) - ! && GET_MODE (x) == qty_mode[reg_qty[REGNO (x)]] - ! && qty_const[reg_qty[REGNO (x)]] != 0) - return 0; - - ! if (GET_CODE (x) == PLUS - ! && GET_CODE (XEXP (x, 1)) == CONST_INT - ! && GET_CODE (XEXP (x, 0)) == REG - ! && REGNO_QTY_VALID_P (REGNO (XEXP (x, 0))) - ! && (GET_MODE (XEXP (x, 0)) - ! == qty_mode[reg_qty[REGNO (XEXP (x, 0))]]) - ! && qty_const[reg_qty[REGNO (XEXP (x, 0))]]) - return 0; - - *************** cse_rtx_addr_varies_p (x) - *** 2501,2519 **** - load fp minus a constant into a register, then a MEM which is the - sum of the two `constant' registers. */ - ! if (GET_CODE (x) == MEM - ! && GET_CODE (XEXP (x, 0)) == PLUS - ! && GET_CODE (XEXP (XEXP (x, 0), 0)) == REG - ! && GET_CODE (XEXP (XEXP (x, 0), 1)) == REG - ! && REGNO_QTY_VALID_P (REGNO (XEXP (XEXP (x, 0), 0))) - ! && (GET_MODE (XEXP (XEXP (x, 0), 0)) - ! == qty_mode[reg_qty[REGNO (XEXP (XEXP (x, 0), 0))]]) - ! && qty_const[reg_qty[REGNO (XEXP (XEXP (x, 0), 0))]] - ! && REGNO_QTY_VALID_P (REGNO (XEXP (XEXP (x, 0), 1))) - ! && (GET_MODE (XEXP (XEXP (x, 0), 1)) - ! == qty_mode[reg_qty[REGNO (XEXP (XEXP (x, 0), 1))]]) - ! && qty_const[reg_qty[REGNO (XEXP (XEXP (x, 0), 1))]]) - return 0; - - ! return rtx_addr_varies_p (x); - } - - --- 2385,2402 ---- - load fp minus a constant into a register, then a MEM which is the - sum of the two `constant' registers. */ - ! if (GET_CODE (x) == PLUS - ! && GET_CODE (XEXP (x, 0)) == REG - ! && GET_CODE (XEXP (x, 1)) == REG - ! && REGNO_QTY_VALID_P (REGNO (XEXP (x, 0))) - ! && (GET_MODE (XEXP (x, 0)) - ! == qty_mode[reg_qty[REGNO (XEXP (x, 0))]]) - ! && qty_const[reg_qty[REGNO (XEXP (x, 0))]] - ! && REGNO_QTY_VALID_P (REGNO (XEXP (x, 1))) - ! && (GET_MODE (XEXP (x, 1)) - ! == qty_mode[reg_qty[REGNO (XEXP (x, 1))]]) - ! && qty_const[reg_qty[REGNO (XEXP (x, 1))]]) - return 0; - - ! return rtx_varies_p (x); - } - - *************** cse_insn (insn, in_libcall_block) - *** 6105,6110 **** - rtx this_insn_cc0 = 0; - enum machine_mode this_insn_cc0_mode; - - struct write_data writes_memory; - - static struct write_data init = {0, 0, 0, 0}; - - rtx src_eqv = 0; - --- 5988,5991 ---- - *************** cse_insn (insn, in_libcall_block) - *** 6118,6122 **** - - this_insn = insn; - - writes_memory = init; - - /* Find all the SETs and CLOBBERs in this instruction. - --- 5999,6002 ---- - *************** cse_insn (insn, in_libcall_block) - *** 6220,6225 **** - else if (GET_CODE (y) == CLOBBER) - { - ! /* If we clobber memory, take note of that, - ! and canon the address. - This does nothing when a register is clobbered - because we have already invalidated the reg. */ - --- 6100,6104 ---- - else if (GET_CODE (y) == CLOBBER) - { - ! /* If we clobber memory, canon the address. - This does nothing when a register is clobbered - because we have already invalidated the reg. */ - *************** cse_insn (insn, in_libcall_block) - *** 6227,6231 **** - { - canon_reg (XEXP (y, 0), NULL_RTX); - ! note_mem_written (XEXP (y, 0), &writes_memory); - } - } - --- 6106,6110 ---- - { - canon_reg (XEXP (y, 0), NULL_RTX); - ! note_mem_written (XEXP (y, 0)); - } - } - *************** cse_insn (insn, in_libcall_block) - *** 6249,6253 **** - { - canon_reg (XEXP (x, 0), NULL_RTX); - ! note_mem_written (XEXP (x, 0), &writes_memory); - } - } - --- 6128,6132 ---- - { - canon_reg (XEXP (x, 0), NULL_RTX); - ! note_mem_written (XEXP (x, 0)); - } - } - *************** cse_insn (insn, in_libcall_block) - *** 6674,6678 **** - } - #endif /* LOAD_EXTEND_OP */ - ! - if (src == src_folded) - src_folded = 0; - --- 6553,6557 ---- - } - #endif /* LOAD_EXTEND_OP */ - ! - if (src == src_folded) - src_folded = 0; - *************** cse_insn (insn, in_libcall_block) - *** 6860,6864 **** - || (GET_CODE (src_folded) != MEM - && ! src_folded_force_flag)) - ! && GET_MODE_CLASS (mode) != MODE_CC) - { - src_folded_force_flag = 1; - --- 6739,6744 ---- - || (GET_CODE (src_folded) != MEM - && ! src_folded_force_flag)) - ! && GET_MODE_CLASS (mode) != MODE_CC - ! && mode != VOIDmode) - { - src_folded_force_flag = 1; - *************** cse_insn (insn, in_libcall_block) - *** 6984,6993 **** - { - dest = fold_rtx (dest, insn); - ! - ! /* Decide whether we invalidate everything in memory, - ! or just things at non-fixed places. - ! Writing a large aggregate must invalidate everything - ! because we don't know how long it is. */ - ! note_mem_written (dest, &writes_memory); - } - - --- 6864,6868 ---- - { - dest = fold_rtx (dest, insn); - ! note_mem_written (dest); - } - - *************** cse_insn (insn, in_libcall_block) - *** 7234,7238 **** - sets[i].src_elt = src_eqv_elt; - - ! invalidate_from_clobbers (&writes_memory, x); - - /* Some registers are invalidated by subroutine calls. Memory is - --- 7109,7113 ---- - sets[i].src_elt = src_eqv_elt; - - ! invalidate_from_clobbers (x); - - /* Some registers are invalidated by subroutine calls. Memory is - *************** cse_insn (insn, in_libcall_block) - *** 7241,7248 **** - if (GET_CODE (insn) == CALL_INSN) - { - - static struct write_data everything = {0, 1, 1, 1}; - - - if (! CONST_CALL_P (insn)) - ! invalidate_memory (&everything); - invalidate_for_call (); - } - --- 7116,7121 ---- - if (GET_CODE (insn) == CALL_INSN) - { - if (! CONST_CALL_P (insn)) - ! invalidate_memory (); - invalidate_for_call (); - } - *************** cse_insn (insn, in_libcall_block) - *** 7265,7270 **** - we have just done an invalidate_memory that covers even those. */ - if (GET_CODE (dest) == REG || GET_CODE (dest) == SUBREG - ! || (GET_CODE (dest) == MEM && ! writes_memory.all - ! && ! cse_rtx_addr_varies_p (dest))) - invalidate (dest, VOIDmode); - else if (GET_CODE (dest) == STRICT_LOW_PART - --- 7138,7142 ---- - we have just done an invalidate_memory that covers even those. */ - if (GET_CODE (dest) == REG || GET_CODE (dest) == SUBREG - ! || GET_CODE (dest) == MEM) - invalidate (dest, VOIDmode); - else if (GET_CODE (dest) == STRICT_LOW_PART - *************** cse_insn (insn, in_libcall_block) - *** 7532,7580 **** - } - - - /* Store 1 in *WRITES_PTR for those categories of memory ref - - that must be invalidated when the expression WRITTEN is stored in. - - If WRITTEN is null, say everything must be invalidated. */ - - - static void - ! note_mem_written (written, writes_ptr) - ! rtx written; - ! struct write_data *writes_ptr; - ! { - ! static struct write_data everything = {0, 1, 1, 1}; - ! - ! if (written == 0) - ! *writes_ptr = everything; - ! else if (GET_CODE (written) == MEM) - ! { - ! /* Pushing or popping the stack invalidates just the stack pointer. */ - ! rtx addr = XEXP (written, 0); - ! if ((GET_CODE (addr) == PRE_DEC || GET_CODE (addr) == PRE_INC - ! || GET_CODE (addr) == POST_DEC || GET_CODE (addr) == POST_INC) - ! && GET_CODE (XEXP (addr, 0)) == REG - ! && REGNO (XEXP (addr, 0)) == STACK_POINTER_REGNUM) - ! { - ! writes_ptr->sp = 1; - ! return; - ! } - ! else if (GET_MODE (written) == BLKmode) - ! *writes_ptr = everything; - ! /* (mem (scratch)) means clobber everything. */ - ! else if (GET_CODE (addr) == SCRATCH) - ! *writes_ptr = everything; - ! else if (cse_rtx_addr_varies_p (written)) - ! { - ! /* A varying address that is a sum indicates an array element, - ! and that's just as good as a structure element - ! in implying that we need not invalidate scalar variables. - ! However, we must allow QImode aliasing of scalars, because the - ! ANSI C standard allows character pointers to alias anything. */ - ! if (! ((MEM_IN_STRUCT_P (written) - ! || GET_CODE (XEXP (written, 0)) == PLUS) - ! && GET_MODE (written) != QImode)) - ! writes_ptr->all = 1; - ! writes_ptr->nonscalar = 1; - ! } - ! writes_ptr->var = 1; - } - } - - --- 7404,7447 ---- - } - - static void - ! invalidate_memory () - ! { - ! register int i; - ! register struct table_elt *p, *next; - ! - ! for (i = 0; i < NBUCKETS; i++) - ! for (p = table[i]; p; p = next) - ! { - ! next = p->next_same_hash; - ! if (p->in_memory) - ! remove_from_table (p, i); - ! } - ! } - ! - ! static int - ! note_mem_written (mem) - ! register rtx mem; - ! { - ! if (mem == 0 || GET_CODE(mem) != MEM ) - ! return 0; - ! else - ! { - ! register rtx addr = XEXP (mem, 0); - ! /* Pushing or popping the stack invalidates just the stack pointer. */ - ! if ((GET_CODE (addr) == PRE_DEC || GET_CODE (addr) == PRE_INC - ! || GET_CODE (addr) == POST_DEC || GET_CODE (addr) == POST_INC) - ! && GET_CODE (XEXP (addr, 0)) == REG - ! && REGNO (XEXP (addr, 0)) == STACK_POINTER_REGNUM) - ! { - ! if (reg_tick[STACK_POINTER_REGNUM] >= 0) - ! reg_tick[STACK_POINTER_REGNUM]++; - ! - ! /* This should be *very* rare. */ - ! if (TEST_HARD_REG_BIT (hard_regs_in_table, STACK_POINTER_REGNUM)) - ! invalidate (stack_pointer_rtx, VOIDmode); - ! return 1; - } - + return 0; - + } - } - - *************** note_mem_written (written, writes_ptr) - *** 7584,7612 **** - alias with something that is SET or CLOBBERed. - - - W points to the writes_memory for this insn, a struct write_data - - saying which kinds of memory references must be invalidated. - X is the pattern of the insn. */ - - static void - ! invalidate_from_clobbers (w, x) - ! struct write_data *w; - rtx x; - { - - /* If W->var is not set, W specifies no action. - - If W->all is set, this step gets all memory refs - - so they can be ignored in the rest of this function. */ - - if (w->var) - - invalidate_memory (w); - - - - if (w->sp) - - { - - if (reg_tick[STACK_POINTER_REGNUM] >= 0) - - reg_tick[STACK_POINTER_REGNUM]++; - - - - /* This should be *very* rare. */ - - if (TEST_HARD_REG_BIT (hard_regs_in_table, STACK_POINTER_REGNUM)) - - invalidate (stack_pointer_rtx, VOIDmode); - - } - - - if (GET_CODE (x) == CLOBBER) - { - --- 7451,7460 ---- - alias with something that is SET or CLOBBERed. - - X is the pattern of the insn. */ - - static void - ! invalidate_from_clobbers (x) - rtx x; - { - if (GET_CODE (x) == CLOBBER) - { - *************** invalidate_from_clobbers (w, x) - *** 7615,7619 **** - { - if (GET_CODE (ref) == REG || GET_CODE (ref) == SUBREG - ! || (GET_CODE (ref) == MEM && ! w->all)) - invalidate (ref, VOIDmode); - else if (GET_CODE (ref) == STRICT_LOW_PART - --- 7463,7467 ---- - { - if (GET_CODE (ref) == REG || GET_CODE (ref) == SUBREG - ! || GET_CODE (ref) == MEM) - invalidate (ref, VOIDmode); - else if (GET_CODE (ref) == STRICT_LOW_PART - *************** invalidate_from_clobbers (w, x) - *** 7634,7638 **** - { - if (GET_CODE (ref) == REG || GET_CODE (ref) == SUBREG - ! || (GET_CODE (ref) == MEM && !w->all)) - invalidate (ref, VOIDmode); - else if (GET_CODE (ref) == STRICT_LOW_PART - --- 7482,7486 ---- - { - if (GET_CODE (ref) == REG || GET_CODE (ref) == SUBREG - ! || GET_CODE (ref) == MEM) - invalidate (ref, VOIDmode); - else if (GET_CODE (ref) == STRICT_LOW_PART - *************** cse_around_loop (loop_start) - *** 7800,7807 **** - } - - - /* Variable used for communications between the next two routines. */ - - - - static struct write_data skipped_writes_memory; - - - /* Process one SET of an insn that was skipped. We ignore CLOBBERs - since they are done elsewhere. This function is called via note_stores. */ - --- 7648,7651 ---- - *************** invalidate_skipped_set (dest, set) - *** 7812,7815 **** - --- 7656,7675 ---- - rtx dest; - { - + enum rtx_code code = GET_CODE (dest); - + - + if (code == MEM - + && ! note_mem_written (dest) /* If this is not a stack push ... */ - + /* There are times when an address can appear varying and be a PLUS - + during this scan when it would be a fixed address were we to know - + the proper equivalences. So invalidate all memory if there is - + a BLKmode or nonscalar memory reference or a reference to a - + variable address. */ - + && (MEM_IN_STRUCT_P (dest) || GET_MODE (dest) == BLKmode - + || cse_rtx_varies_p (XEXP (dest, 0)))) - + { - + invalidate_memory (); - + return; - + } - + - if (GET_CODE (set) == CLOBBER - #ifdef HAVE_cc0 - *************** invalidate_skipped_set (dest, set) - *** 7819,7837 **** - return; - - ! if (GET_CODE (dest) == MEM) - ! note_mem_written (dest, &skipped_writes_memory); - ! - ! /* There are times when an address can appear varying and be a PLUS - ! during this scan when it would be a fixed address were we to know - ! the proper equivalences. So promote "nonscalar" to be "all". */ - ! if (skipped_writes_memory.nonscalar) - ! skipped_writes_memory.all = 1; - ! - ! if (GET_CODE (dest) == REG || GET_CODE (dest) == SUBREG - ! || (! skipped_writes_memory.all && ! cse_rtx_addr_varies_p (dest))) - ! invalidate (dest, VOIDmode); - ! else if (GET_CODE (dest) == STRICT_LOW_PART - ! || GET_CODE (dest) == ZERO_EXTRACT) - invalidate (XEXP (dest, 0), GET_MODE (dest)); - } - - --- 7679,7686 ---- - return; - - ! if (code == STRICT_LOW_PART || code == ZERO_EXTRACT) - invalidate (XEXP (dest, 0), GET_MODE (dest)); - + else if (code == REG || code == SUBREG || code == MEM) - + invalidate (dest, VOIDmode); - } - - *************** invalidate_skipped_block (start) - *** 7845,7850 **** - { - rtx insn; - - static struct write_data init = {0, 0, 0, 0}; - - static struct write_data everything = {0, 1, 1, 1}; - - for (insn = start; insn && GET_CODE (insn) != CODE_LABEL; - --- 7694,7697 ---- - *************** invalidate_skipped_block (start) - *** 7854,7867 **** - continue; - - - skipped_writes_memory = init; - - - if (GET_CODE (insn) == CALL_INSN) - { - invalidate_for_call (); - - skipped_writes_memory = everything; - } - - note_stores (PATTERN (insn), invalidate_skipped_set); - - invalidate_from_clobbers (&skipped_writes_memory, PATTERN (insn)); - } - } - --- 7701,7712 ---- - continue; - - if (GET_CODE (insn) == CALL_INSN) - { - + if (! CONST_CALL_P (insn)) - + invalidate_memory (); - invalidate_for_call (); - } - - note_stores (PATTERN (insn), invalidate_skipped_set); - } - } - *************** cse_set_around_loop (x, insn, loop_start - *** 7913,7920 **** - { - struct table_elt *src_elt; - - static struct write_data init = {0, 0, 0, 0}; - - struct write_data writes_memory; - - - - writes_memory = init; - - /* If this is a SET, see if we can replace SET_SRC, but ignore SETs that - --- 7758,7761 ---- - *************** cse_set_around_loop (x, insn, loop_start - *** 7976,7991 **** - - /* Now invalidate anything modified by X. */ - ! note_mem_written (SET_DEST (x), &writes_memory); - ! - ! if (writes_memory.var) - ! invalidate_memory (&writes_memory); - ! - ! /* See comment on similar code in cse_insn for explanation of these tests. */ - ! if (GET_CODE (SET_DEST (x)) == REG || GET_CODE (SET_DEST (x)) == SUBREG - ! || (GET_CODE (SET_DEST (x)) == MEM && ! writes_memory.all - ! && ! cse_rtx_addr_varies_p (SET_DEST (x)))) - ! invalidate (SET_DEST (x), VOIDmode); - ! else if (GET_CODE (SET_DEST (x)) == STRICT_LOW_PART - ! || GET_CODE (SET_DEST (x)) == ZERO_EXTRACT) - invalidate (XEXP (SET_DEST (x), 0), GET_MODE (SET_DEST (x))); - } - --- 7817,7828 ---- - - /* Now invalidate anything modified by X. */ - ! note_mem_written (SET_DEST (x)); - ! - ! /* See comment on similar code in cse_insn for explanation of these tests. */ - ! if (GET_CODE (SET_DEST (x)) == REG || GET_CODE (SET_DEST (x)) == SUBREG - ! || GET_CODE (SET_DEST (x)) == MEM) - ! invalidate (SET_DEST (x), VOIDmode); - ! else if (GET_CODE (SET_DEST (x)) == STRICT_LOW_PART - ! || GET_CODE (SET_DEST (x)) == ZERO_EXTRACT) - invalidate (XEXP (SET_DEST (x), 0), GET_MODE (SET_DEST (x))); - } - *************** cse_main (f, nregs, after_loop, file) - *** 8234,8237 **** - --- 8071,8075 ---- - - init_recog (); - + init_alias_analysis (); - - max_reg = nregs; - diff -rcp2N gcc-2.7.2.2/flags.h gcc-2.7.2.2.f.2/flags.h - *** gcc-2.7.2.2/flags.h Thu Jun 15 07:34:11 1995 - --- gcc-2.7.2.2.f.2/flags.h Fri Jan 10 23:18:22 1997 - *************** extern int flag_unroll_loops; - *** 204,207 **** - --- 204,221 ---- - extern int flag_unroll_all_loops; - - + /* Nonzero forces all invariant computations in loops to be moved - + outside the loop. */ - + - + extern int flag_move_all_movables; - + - + /* Nonzero forces all general induction variables in loops to be - + strength reduced. */ - + - + extern int flag_reduce_all_givs; - + - + /* Nonzero gets another run of loop_optimize performed. */ - + - + extern int flag_rerun_loop_opt; - + - /* Nonzero for -fcse-follow-jumps: - have cse follow jumps to do a more extensive job. */ - *************** extern int flag_gnu_linker; - *** 339,342 **** - --- 353,369 ---- - /* Tag all structures with __attribute__(packed) */ - extern int flag_pack_struct; - + - + /* 1 if alias checking is enabled: symbols do not alias each other - + and parameters do not alias the current stack frame. */ - + extern int flag_alias_check; - + - + /* This flag is only tested if alias checking is enabled. - + 0 if pointer arguments may alias each other. True in C. - + 1 if pointer arguments may not alias each other but may alias - + global variables. - + 2 if pointer arguments may not alias each other and may not - + alias global variables. True in Fortran. - + The value is ignored if flag_alias_check is 0. */ - + extern int flag_argument_noalias; - - /* Other basic status info about current function. */ - diff -rcp2N gcc-2.7.2.2/fold-const.c gcc-2.7.2.2.f.2/fold-const.c - *** gcc-2.7.2.2/fold-const.c Fri Sep 15 18:26:12 1995 - --- gcc-2.7.2.2.f.2/fold-const.c Sun Feb 23 15:25:58 1997 - *************** static tree unextend PROTO((tree, int, i - *** 80,83 **** - --- 80,84 ---- - static tree fold_truthop PROTO((enum tree_code, tree, tree, tree)); - static tree strip_compound_expr PROTO((tree, tree)); - + static int multiple_of_p PROTO((tree, tree, tree)); - - #ifndef BRANCH_COST - *************** strip_compound_expr (t, s) - *** 3065,3068 **** - --- 3066,3169 ---- - } - - + /* Determine if first argument is a multiple of second argument. - + Return 0 if it is not, or is not easily determined to so be. - + - + An example of the sort of thing we care about (at this point -- - + this routine could surely be made more general, and expanded - + to do what the *_DIV_EXPR's fold() cases do now) is discovering - + that - + - + SAVE_EXPR (I) * SAVE_EXPR (J * 8) - + - + is a multiple of - + - + SAVE_EXPR (J * 8) - + - + when we know that the two `SAVE_EXPR (J * 8)' nodes are the - + same node (which means they will have the same value at run - + time, even though we don't know when they'll be assigned). - + - + This code also handles discovering that - + - + SAVE_EXPR (I) * SAVE_EXPR (J * 8) - + - + is a multiple of - + - + 8 - + - + (of course) so we don't have to worry about dealing with a - + possible remainder. - + - + Note that we _look_ inside a SAVE_EXPR only to determine - + how it was calculated; it is not safe for fold() to do much - + of anything else with the internals of a SAVE_EXPR, since - + fold() cannot know when it will be evaluated at run time. - + For example, the latter example above _cannot_ be implemented - + as - + - + SAVE_EXPR (I) * J - + - + or any variant thereof, since the value of J at evaluation time - + of the original SAVE_EXPR is not necessarily the same at the time - + the new expression is evaluated. The only optimization of this - + sort that would be valid is changing - + - + SAVE_EXPR (I) * SAVE_EXPR (SAVE_EXPR (J) * 8) - + divided by - + 8 - + - + to - + - + SAVE_EXPR (I) * SAVE_EXPR (J) - + - + (where the same SAVE_EXPR (J) is used in the original and the - + transformed version). */ - + - + static int - + multiple_of_p (type, top, bottom) - + tree type; - + tree top; - + tree bottom; - + { - + if (operand_equal_p (top, bottom, 0)) - + return 1; - + - + if (TREE_CODE (type) != INTEGER_TYPE) - + return 0; - + - + switch (TREE_CODE (top)) - + { - + case MULT_EXPR: - + return (multiple_of_p (type, TREE_OPERAND (top, 0), bottom) - + || multiple_of_p (type, TREE_OPERAND (top, 1), bottom)); - + - + case PLUS_EXPR: - + case MINUS_EXPR: - + return (multiple_of_p (type, TREE_OPERAND (top, 0), bottom) - + && multiple_of_p (type, TREE_OPERAND (top, 1), bottom)); - + - + case NOP_EXPR: - + /* Punt if conversion from non-integral or wider integral type. */ - + if ((TREE_CODE (TREE_TYPE (TREE_OPERAND (top, 0))) != INTEGER_TYPE) - + || (TYPE_PRECISION (type) - + < TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (top, 0))))) - + return 0; - + /* Fall through. */ - + case SAVE_EXPR: - + return multiple_of_p (type, TREE_OPERAND (top, 0), bottom); - + - + case INTEGER_CST: - + if ((TREE_CODE (bottom) != INTEGER_CST) - + || (tree_int_cst_sgn (top) < 0) - + || (tree_int_cst_sgn (bottom) < 0)) - + return 0; - + return integer_zerop (const_binop (TRUNC_MOD_EXPR, - + top, bottom, 0)); - + - + default: - + return 0; - + } - + } - + - /* Perform constant folding and related simplification of EXPR. - The related simplifications include x*1 => x, x*0 => 0, etc., - *************** fold (expr) - *** 4010,4013 **** - --- 4111,4121 ---- - case FLOOR_DIV_EXPR: - case CEIL_DIV_EXPR: - + if (integer_onep (arg1)) - + return non_lvalue (convert (type, arg0)); - + /* If arg0 is a multiple of arg1, then rewrite to the fastest div - + operation, EXACT_DIV_EXPR. Otherwise, handle folding of - + general divide. */ - + if (multiple_of_p (type, arg0, arg1)) - + return fold (build (EXACT_DIV_EXPR, type, arg0, arg1)); - case EXACT_DIV_EXPR: - if (integer_onep (arg1)) - diff -rcp2N gcc-2.7.2.2/gcc.texi gcc-2.7.2.2.f.2/gcc.texi - *** gcc-2.7.2.2/gcc.texi Thu Feb 20 19:24:19 1997 - --- gcc-2.7.2.2.f.2/gcc.texi Sun Feb 23 16:16:49 1997 - *************** original English. - *** 149,152 **** - --- 149,153 ---- - @sp 3 - @center Last updated 29 June 1996 - + @center (Revised for GNU Fortran 1997-01-10) - @sp 1 - @c The version number appears twice more in this file. - diff -rcp2N gcc-2.7.2.2/glimits.h gcc-2.7.2.2.f.2/glimits.h - *** gcc-2.7.2.2/glimits.h Wed Sep 29 17:30:54 1993 - --- gcc-2.7.2.2.f.2/glimits.h Thu Dec 19 12:31:08 1996 - *************** - *** 64,68 **** - (Same as `int'). */ - #ifndef __LONG_MAX__ - ! #define __LONG_MAX__ 2147483647L - #endif - #undef LONG_MIN - --- 64,72 ---- - (Same as `int'). */ - #ifndef __LONG_MAX__ - ! # ifndef __alpha__ - ! # define __LONG_MAX__ 2147483647L - ! # else - ! # define __LONG_MAX__ 9223372036854775807LL - ! # endif /* __alpha__ */ - #endif - #undef LONG_MIN - diff -rcp2N gcc-2.7.2.2/invoke.texi gcc-2.7.2.2.f.2/invoke.texi - *** gcc-2.7.2.2/invoke.texi Tue Oct 3 11:40:43 1995 - --- gcc-2.7.2.2.f.2/invoke.texi Sun Feb 23 16:18:06 1997 - *************** - *** 1,3 **** - ! @c Copyright (C) 1988, 89, 92, 93, 94, 1995 Free Software Foundation, Inc. - @c This is part of the GCC manual. - @c For copying conditions, see the file gcc.texi. - --- 1,3 ---- - ! @c Copyright (C) 1988, 89, 92-95, 1997 Free Software Foundation, Inc. - @c This is part of the GCC manual. - @c For copying conditions, see the file gcc.texi. - *************** in the following sections. - *** 149,152 **** - --- 149,153 ---- - -fschedule-insns2 -fstrength-reduce -fthread-jumps - -funroll-all-loops -funroll-loops - + -fmove-all-movables -freduce-all-givs -frerun-loop-opt - -O -O0 -O1 -O2 -O3 - @end smallexample - *************** in addition to the above: - *** 331,334 **** - --- 332,337 ---- - -fshort-double -fvolatile -fvolatile-global - -fverbose-asm -fpack-struct +e0 +e1 - + -fargument-alias -fargument-noalias - + -fargument-noalias-global - @end smallexample - @end table - *************** and usually makes programs run more slow - *** 1941,1944 **** - --- 1944,1992 ---- - implies @samp{-fstrength-reduce} as well as @samp{-frerun-cse-after-loop}. - - + @item -fmove-all-movables - + Forces all invariant computations in loops to be moved - + outside the loop. - + This option is provided primarily to improve performance - + for some Fortran code, though it might improve code written - + in other languages. - + - + @emph{Note:} When compiling programs written in Fortran, - + this option is enabled by default. - + - + Analysis of Fortran code optimization and the resulting - + optimizations triggered by this option, and the - + @samp{-freduce-all-givs} and @samp{-frerun-loop-opt} - + options as well, were - + contributed by Toon Moene (@code{toon@@moene.indiv.nluug.nl}). - + - + These three options are intended to be removed someday, once - + they have helped determine the efficacy of various - + approaches to improving the performance of Fortran code. - + - + Please let us (@code{fortran@@gnu.ai.mit.edu}) - + know how use of these options affects - + the performance of your production code. - + We're very interested in code that runs @emph{slower} - + when these options are @emph{enabled}. - + - + @item -freduce-all-givs - + Forces all general-induction variables in loops to be - + strength-reduced. - + This option is provided primarily to improve performance - + for some Fortran code, though it might improve code written - + in other languages. - + - + @emph{Note:} When compiling programs written in Fortran, - + this option is enabled by default. - + - + @item -frerun-loop-opt - + Runs loop optimizations a second time. - + This option is provided primarily to improve performance - + for some Fortran code, though it might improve code written - + in other languages. - + - + @emph{Note:} When compiling programs written in Fortran, - + this option is enabled by default. - + - @item -fno-peephole - Disable any machine-specific peephole optimizations. - *************** compilation). - *** 4229,4232 **** - --- 4277,4352 ---- - With @samp{+e1}, G++ actually generates the code implementing virtual - functions defined in the code, and makes them publicly visible. - + - + @cindex aliasing of parameters - + @cindex parameters, aliased - + @item -fargument-alias - + @item -fargument-noalias - + @item -fargument-noalias-global - + Specify the possible relationships among parameters and between - + parameters and global data. - + - + @samp{-fargument-alias} specifies that arguments (parameters) may - + alias each other and may alias global storage. - + @samp{-fargument-noalias} specifies that arguments do not alias - + each other, but may alias global storage. - + @samp{-fargument-noalias-global} specifies that arguments do not - + alias each other and do not alias global storage. - + - + For code written in C, C++, and Objective-C, @samp{-fargument-alias} - + is the default. - + For code written in Fortran, @samp{-fargument-noalias-global} is - + the default, though this is pertinent only on systems where - + @code{g77} is installed. - + (See the documentation for other compilers for information on the - + defaults for their respective languages.) - + - + Normally, @code{gcc} assumes that a write through a pointer - + passed as a parameter to the current function might modify a - + value pointed to by another pointer passed as a parameter, or - + in global storage. - + - + For example, consider this code: - + - + @example - + void x(int *i, int *j) - + @{ - + extern int k; - + - + ++*i; - + ++*j; - + ++k; - + @} - + @end example - + - + When compiling the above function, @code{gcc} assumes that @samp{i} might - + be a pointer to the same variable as @samp{j}, and that either @samp{i}, - + @samp{j}, or both might be a pointer to @samp{k}. - + - + Therefore, @code{gcc} does not assume it can generate code to read - + @samp{*i}, @samp{*j}, and @samp{k} into separate registers, increment - + each register, then write the incremented values back out. - + - + Instead, @code{gcc} must generate code that reads @samp{*i}, - + increments it, and writes it back before reading @samp{*j}, - + in case @samp{i} and @samp{j} are aliased, and, similarly, - + that writes @samp{*j} before reading @samp{k}. - + The result is code that, on many systems, takes longer to execute, - + due to the way many processors schedule instruction execution. - + - + Compiling the above code with the @samp{-fargument-noalias} option - + allows @code{gcc} to assume that @samp{i} and @samp{j} do not alias - + each other, but either might alias @samp{k}. - + - + Compiling the above code with the @samp{-fargument-noalias-global} - + option allows @code{gcc} to assume that no combination of @samp{i}, - + @samp{j}, and @samp{k} are aliases for each other. - + - + @emph{Note:} Use the @samp{-fargument-noalias} and - + @samp{-fargument-noalias-global} options with care. - + While they can result in faster executables, they can - + also result in executables with subtle bugs, bugs that - + show up only when compiled for specific target systems, - + or bugs that show up only when compiled by specific versions - + of @code{g77}. - @end table - - diff -rcp2N gcc-2.7.2.2/local-alloc.c gcc-2.7.2.2.f.2/local-alloc.c - *** gcc-2.7.2.2/local-alloc.c Mon Aug 21 13:15:44 1995 - --- gcc-2.7.2.2.f.2/local-alloc.c Fri Jan 10 23:18:22 1997 - *************** validate_equiv_mem_from_store (dest, set - *** 545,549 **** - && reg_overlap_mentioned_p (dest, equiv_mem)) - || (GET_CODE (dest) == MEM - ! && true_dependence (dest, equiv_mem))) - equiv_mem_modified = 1; - } - --- 545,549 ---- - && reg_overlap_mentioned_p (dest, equiv_mem)) - || (GET_CODE (dest) == MEM - ! && true_dependence (dest, VOIDmode, equiv_mem, rtx_varies_p))) - equiv_mem_modified = 1; - } - *************** memref_referenced_p (memref, x) - *** 630,634 **** - - case MEM: - ! if (true_dependence (memref, x)) - return 1; - break; - --- 630,634 ---- - - case MEM: - ! if (true_dependence (memref, VOIDmode, x, rtx_varies_p)) - return 1; - break; - diff -rcp2N gcc-2.7.2.2/loop.c gcc-2.7.2.2.f.2/loop.c - *** gcc-2.7.2.2/loop.c Thu Feb 20 19:24:20 1997 - --- gcc-2.7.2.2.f.2/loop.c Sun Feb 23 15:35:42 1997 - *************** int *loop_number_exit_count; - *** 111,116 **** - unsigned HOST_WIDE_INT loop_n_iterations; - - ! /* Nonzero if there is a subroutine call in the current loop. - ! (unknown_address_altered is also nonzero in this case.) */ - - static int loop_has_call; - --- 111,115 ---- - unsigned HOST_WIDE_INT loop_n_iterations; - - ! /* Nonzero if there is a subroutine call in the current loop. */ - - static int loop_has_call; - *************** static char *moved_once; - *** 160,164 **** - here, we just turn on unknown_address_altered. */ - - ! #define NUM_STORES 20 - static rtx loop_store_mems[NUM_STORES]; - - --- 159,163 ---- - here, we just turn on unknown_address_altered. */ - - ! #define NUM_STORES 50 - static rtx loop_store_mems[NUM_STORES]; - - *************** move_movables (movables, threshold, insn - *** 1629,1632 **** - --- 1628,1632 ---- - - if (already_moved[regno] - + || flag_move_all_movables - || (threshold * savings * m->lifetime) >= insn_count - || (m->forces && m->forces->done - *************** prescan_loop (start, end) - *** 2199,2203 **** - else if (GET_CODE (insn) == CALL_INSN) - { - ! unknown_address_altered = 1; - loop_has_call = 1; - } - --- 2199,2204 ---- - else if (GET_CODE (insn) == CALL_INSN) - { - ! if (! CONST_CALL_P (insn)) - ! unknown_address_altered = 1; - loop_has_call = 1; - } - *************** invariant_p (x) - *** 2777,2781 **** - /* See if there is any dependence between a store and this load. */ - for (i = loop_store_mems_idx - 1; i >= 0; i--) - ! if (true_dependence (loop_store_mems[i], x)) - return 0; - - --- 2778,2782 ---- - /* See if there is any dependence between a store and this load. */ - for (i = loop_store_mems_idx - 1; i >= 0; i--) - ! if (true_dependence (loop_store_mems[i], VOIDmode, x, rtx_varies_p)) - return 0; - - *************** strength_reduce (scan_start, end, loop_t - *** 3821,3826 **** - exit. */ - - ! if (v->lifetime * threshold * benefit < insn_count - ! && ! bl->reversed) - { - if (loop_dump_stream) - --- 3822,3827 ---- - exit. */ - - ! if ( ! flag_reduce_all_givs && v->lifetime * threshold * benefit < insn_count - ! && ! bl->reversed ) - { - if (loop_dump_stream) - *************** record_giv (v, insn, src_reg, dest_reg, - *** 4375,4378 **** - --- 4376,4381 ---- - v->final_value = 0; - v->same_insn = 0; - + v->unrolled = 0; - + v->shared = 0; - - /* The v->always_computable field is used in update_giv_derive, to - *************** check_final_value (v, loop_start, loop_e - *** 4652,4657 **** - if (GET_CODE (p) == JUMP_INSN && JUMP_LABEL (p) - && LABEL_NAME (JUMP_LABEL (p)) - ! && ((INSN_LUID (JUMP_LABEL (p)) < INSN_LUID (v->insn) - ! && INSN_LUID (JUMP_LABEL (p)) > INSN_LUID (loop_start)) - || (INSN_LUID (JUMP_LABEL (p)) > INSN_LUID (last_giv_use) - && INSN_LUID (JUMP_LABEL (p)) < INSN_LUID (loop_end)))) - --- 4655,4663 ---- - if (GET_CODE (p) == JUMP_INSN && JUMP_LABEL (p) - && LABEL_NAME (JUMP_LABEL (p)) - ! && ((INSN_UID (JUMP_LABEL (p)) >= max_uid_for_loop) - ! || (INSN_UID (v->insn) >= max_uid_for_loop) - ! || (INSN_UID (last_giv_use) >= max_uid_for_loop) - ! || (INSN_LUID (JUMP_LABEL (p)) < INSN_LUID (v->insn) - ! && INSN_LUID (JUMP_LABEL (p)) > INSN_LUID (loop_start)) - || (INSN_LUID (JUMP_LABEL (p)) > INSN_LUID (last_giv_use) - && INSN_LUID (JUMP_LABEL (p)) < INSN_LUID (loop_end)))) - *************** emit_iv_add_mult (b, m, a, reg, insert_b - *** 5560,5563 **** - --- 5566,5571 ---- - - emit_insn_before (seq, insert_before); - + - + record_base_value (REGNO (reg), b); - } - - diff -rcp2N gcc-2.7.2.2/loop.h gcc-2.7.2.2.f.2/loop.h - *** gcc-2.7.2.2/loop.h Fri Jul 14 08:23:28 1995 - --- gcc-2.7.2.2.f.2/loop.h Fri Jan 10 23:18:23 1997 - *************** struct induction - *** 89,92 **** - --- 89,95 ---- - we won't use it to eliminate a biv, it - would probably lose. */ - + unsigned unrolled : 1; /* 1 if new register has been allocated in - + unrolled loop. */ - + unsigned shared : 1; - int lifetime; /* Length of life of this giv */ - int times_used; /* # times this giv is used. */ - diff -rcp2N gcc-2.7.2.2/real.c gcc-2.7.2.2.f.2/real.c - *** gcc-2.7.2.2/real.c Tue Aug 15 17:57:18 1995 - --- gcc-2.7.2.2.f.2/real.c Thu Dec 19 12:31:09 1996 - *************** make_nan (nan, sign, mode) - *** 5625,5633 **** - } - - ! /* Convert an SFmode target `float' value to a REAL_VALUE_TYPE. - ! This is the inverse of the function `etarsingle' invoked by - REAL_VALUE_TO_TARGET_SINGLE. */ - - REAL_VALUE_TYPE - ereal_from_float (f) - HOST_WIDE_INT f; - --- 5625,5699 ---- - } - - ! /* This is the inverse of the function `etarsingle' invoked by - REAL_VALUE_TO_TARGET_SINGLE. */ - - REAL_VALUE_TYPE - + ereal_unto_float (f) - + long f; - + { - + REAL_VALUE_TYPE r; - + unsigned EMUSHORT s[2]; - + unsigned EMUSHORT e[NE]; - + - + /* Convert 32 bit integer to array of 16 bit pieces in target machine order. - + This is the inverse operation to what the function `endian' does. */ - + if (REAL_WORDS_BIG_ENDIAN) - + { - + s[0] = (unsigned EMUSHORT) (f >> 16); - + s[1] = (unsigned EMUSHORT) f; - + } - + else - + { - + s[0] = (unsigned EMUSHORT) f; - + s[1] = (unsigned EMUSHORT) (f >> 16); - + } - + /* Convert and promote the target float to E-type. */ - + e24toe (s, e); - + /* Output E-type to REAL_VALUE_TYPE. */ - + PUT_REAL (e, &r); - + return r; - + } - + - + - + /* This is the inverse of the function `etardouble' invoked by - + REAL_VALUE_TO_TARGET_DOUBLE. */ - + - + REAL_VALUE_TYPE - + ereal_unto_double (d) - + long d[]; - + { - + REAL_VALUE_TYPE r; - + unsigned EMUSHORT s[4]; - + unsigned EMUSHORT e[NE]; - + - + /* Convert array of HOST_WIDE_INT to equivalent array of 16-bit pieces. */ - + if (REAL_WORDS_BIG_ENDIAN) - + { - + s[0] = (unsigned EMUSHORT) (d[0] >> 16); - + s[1] = (unsigned EMUSHORT) d[0]; - + s[2] = (unsigned EMUSHORT) (d[1] >> 16); - + s[3] = (unsigned EMUSHORT) d[1]; - + } - + else - + { - + /* Target float words are little-endian. */ - + s[0] = (unsigned EMUSHORT) d[0]; - + s[1] = (unsigned EMUSHORT) (d[0] >> 16); - + s[2] = (unsigned EMUSHORT) d[1]; - + s[3] = (unsigned EMUSHORT) (d[1] >> 16); - + } - + /* Convert target double to E-type. */ - + e53toe (s, e); - + /* Output E-type to REAL_VALUE_TYPE. */ - + PUT_REAL (e, &r); - + return r; - + } - + - + - + /* Convert an SFmode target `float' value to a REAL_VALUE_TYPE. - + This is somewhat like ereal_unto_float, but the input types - + for these are different. */ - + - + REAL_VALUE_TYPE - ereal_from_float (f) - HOST_WIDE_INT f; - *************** ereal_from_float (f) - *** 5658,5663 **** - - /* Convert a DFmode target `double' value to a REAL_VALUE_TYPE. - ! This is the inverse of the function `etardouble' invoked by - ! REAL_VALUE_TO_TARGET_DOUBLE. - - The DFmode is stored as an array of HOST_WIDE_INT in the target's - --- 5724,5729 ---- - - /* Convert a DFmode target `double' value to a REAL_VALUE_TYPE. - ! This is somewhat like ereal_unto_double, but the input types - ! for these are different. - - The DFmode is stored as an array of HOST_WIDE_INT in the target's - diff -rcp2N gcc-2.7.2.2/real.h gcc-2.7.2.2.f.2/real.h - *** gcc-2.7.2.2/real.h Thu Jun 15 07:57:56 1995 - --- gcc-2.7.2.2.f.2/real.h Thu Dec 19 12:31:09 1996 - *************** extern void ereal_to_decimal PROTO((REAL - *** 152,155 **** - --- 152,157 ---- - extern int ereal_cmp PROTO((REAL_VALUE_TYPE, REAL_VALUE_TYPE)); - extern int ereal_isneg PROTO((REAL_VALUE_TYPE)); - + extern REAL_VALUE_TYPE ereal_unto_float PROTO((long)); - + extern REAL_VALUE_TYPE ereal_unto_double PROTO((long *)); - extern REAL_VALUE_TYPE ereal_from_float PROTO((HOST_WIDE_INT)); - extern REAL_VALUE_TYPE ereal_from_double PROTO((HOST_WIDE_INT *)); - *************** extern REAL_VALUE_TYPE real_value_trunca - *** 197,200 **** - --- 199,208 ---- - /* IN is a REAL_VALUE_TYPE. OUT is a long. */ - #define REAL_VALUE_TO_TARGET_SINGLE(IN, OUT) ((OUT) = etarsingle ((IN))) - + - + /* Inverse of REAL_VALUE_TO_TARGET_DOUBLE. */ - + #define REAL_VALUE_UNTO_TARGET_DOUBLE(d) (ereal_unto_double (d)) - + - + /* Inverse of REAL_VALUE_TO_TARGET_SINGLE. */ - + #define REAL_VALUE_UNTO_TARGET_SINGLE(f) (ereal_unto_float (f)) - - /* d is an array of HOST_WIDE_INT that holds a double precision - diff -rcp2N gcc-2.7.2.2/reload.c gcc-2.7.2.2.f.2/reload.c - *** gcc-2.7.2.2/reload.c Sat Nov 11 08:23:54 1995 - --- gcc-2.7.2.2.f.2/reload.c Thu Feb 27 23:03:05 1997 - *************** - *** 1,4 **** - /* Search an insn for pseudo regs that must be in hard regs and are not. - ! Copyright (C) 1987, 88, 89, 92, 93, 94, 1995 Free Software Foundation, Inc. - - This file is part of GNU CC. - --- 1,4 ---- - /* Search an insn for pseudo regs that must be in hard regs and are not. - ! Copyright (C) 1987, 88, 89, 92-5, 1996 Free Software Foundation, Inc. - - This file is part of GNU CC. - *************** static int push_secondary_reload PROTO(( - *** 292,295 **** - --- 292,296 ---- - enum machine_mode, enum reload_type, - enum insn_code *)); - + static enum reg_class find_valid_class PROTO((enum machine_mode, int)); - static int push_reload PROTO((rtx, rtx, rtx *, rtx *, enum reg_class, - enum machine_mode, enum machine_mode, - *************** push_secondary_reload (in_p, x, opnum, o - *** 361,364 **** - --- 362,368 ---- - mode and object being reloaded. */ - if (GET_CODE (x) == SUBREG - + #ifdef CLASS_CANNOT_CHANGE_SIZE - + && reload_class != CLASS_CANNOT_CHANGE_SIZE - + #endif - && (GET_MODE_SIZE (GET_MODE (x)) - > GET_MODE_SIZE (GET_MODE (SUBREG_REG (x))))) - *************** clear_secondary_mem () - *** 689,692 **** - --- 693,728 ---- - #endif /* SECONDARY_MEMORY_NEEDED */ - - + /* Find the largest class for which every register number plus N is valid in - + M1 (if in range). Abort if no such class exists. */ - + - + static enum reg_class - + find_valid_class (m1, n) - + enum machine_mode m1; - + int n; - + { - + int class; - + int regno; - + enum reg_class best_class; - + int best_size = 0; - + - + for (class = 1; class < N_REG_CLASSES; class++) - + { - + int bad = 0; - + for (regno = 0; regno < FIRST_PSEUDO_REGISTER && ! bad; regno++) - + if (TEST_HARD_REG_BIT (reg_class_contents[class], regno) - + && TEST_HARD_REG_BIT (reg_class_contents[class], regno + n) - + && ! HARD_REGNO_MODE_OK (regno + n, m1)) - + bad = 1; - + - + if (! bad && reg_class_size[class] > best_size) - + best_class = class, best_size = reg_class_size[class]; - + } - + - + if (best_size == 0) - + abort (); - + - + return best_class; - + } - + - /* Record one reload that needs to be performed. - IN is an rtx saying where the data are to be found before this instruction. - *************** push_reload (in, out, inloc, outloc, cla - *** 894,898 **** - && GET_CODE (SUBREG_REG (in)) == REG - && REGNO (SUBREG_REG (in)) < FIRST_PSEUDO_REGISTER - ! && (! HARD_REGNO_MODE_OK (REGNO (SUBREG_REG (in)), inmode) - || (GET_MODE_SIZE (inmode) <= UNITS_PER_WORD - && (GET_MODE_SIZE (GET_MODE (SUBREG_REG (in))) - --- 930,935 ---- - && GET_CODE (SUBREG_REG (in)) == REG - && REGNO (SUBREG_REG (in)) < FIRST_PSEUDO_REGISTER - ! && (! HARD_REGNO_MODE_OK (REGNO (SUBREG_REG (in)) + SUBREG_WORD (in), - ! inmode) - || (GET_MODE_SIZE (inmode) <= UNITS_PER_WORD - && (GET_MODE_SIZE (GET_MODE (SUBREG_REG (in))) - *************** push_reload (in, out, inloc, outloc, cla - *** 909,913 **** - output before the outer reload. */ - push_reload (SUBREG_REG (in), NULL_RTX, &SUBREG_REG (in), NULL_PTR, - ! GENERAL_REGS, VOIDmode, VOIDmode, 0, 0, opnum, type); - dont_remove_subreg = 1; - } - --- 946,951 ---- - output before the outer reload. */ - push_reload (SUBREG_REG (in), NULL_RTX, &SUBREG_REG (in), NULL_PTR, - ! find_valid_class (inmode, SUBREG_WORD (in)), - ! VOIDmode, VOIDmode, 0, 0, opnum, type); - dont_remove_subreg = 1; - } - *************** push_reload (in, out, inloc, outloc, cla - *** 982,986 **** - && GET_CODE (SUBREG_REG (out)) == REG - && REGNO (SUBREG_REG (out)) < FIRST_PSEUDO_REGISTER - ! && (! HARD_REGNO_MODE_OK (REGNO (SUBREG_REG (out)), outmode) - || (GET_MODE_SIZE (outmode) <= UNITS_PER_WORD - && (GET_MODE_SIZE (GET_MODE (SUBREG_REG (out))) - --- 1020,1025 ---- - && GET_CODE (SUBREG_REG (out)) == REG - && REGNO (SUBREG_REG (out)) < FIRST_PSEUDO_REGISTER - ! && (! HARD_REGNO_MODE_OK (REGNO (SUBREG_REG (out)) + SUBREG_WORD (out), - ! outmode) - || (GET_MODE_SIZE (outmode) <= UNITS_PER_WORD - && (GET_MODE_SIZE (GET_MODE (SUBREG_REG (out))) - *************** push_reload (in, out, inloc, outloc, cla - *** 998,1002 **** - dont_remove_subreg = 1; - push_reload (SUBREG_REG (out), SUBREG_REG (out), &SUBREG_REG (out), - ! &SUBREG_REG (out), ALL_REGS, VOIDmode, VOIDmode, 0, 0, - opnum, RELOAD_OTHER); - } - --- 1037,1043 ---- - dont_remove_subreg = 1; - push_reload (SUBREG_REG (out), SUBREG_REG (out), &SUBREG_REG (out), - ! &SUBREG_REG (out), - ! find_valid_class (outmode, SUBREG_WORD (out)), - ! VOIDmode, VOIDmode, 0, 0, - opnum, RELOAD_OTHER); - } - *************** find_equiv_reg (goal, insn, class, other - *** 5518,5522 **** - and is also a register that appears in the address of GOAL. */ - - ! if (goal_mem && value == SET_DEST (PATTERN (where)) - && refers_to_regno_for_reload_p (valueno, - (valueno - --- 5559,5563 ---- - and is also a register that appears in the address of GOAL. */ - - ! if (goal_mem && value == SET_DEST (single_set (where)) - && refers_to_regno_for_reload_p (valueno, - (valueno - *************** debug_reload() - *** 5900,5904 **** - - if (reload_nocombine[r]) - ! fprintf (stderr, ", can combine", reload_nocombine[r]); - - if (reload_secondary_p[r]) - --- 5941,5945 ---- - - if (reload_nocombine[r]) - ! fprintf (stderr, ", can't combine %d", reload_nocombine[r]); - - if (reload_secondary_p[r]) - diff -rcp2N gcc-2.7.2.2/rtl.h gcc-2.7.2.2.f.2/rtl.h - *** gcc-2.7.2.2/rtl.h Thu Jun 15 08:03:16 1995 - --- gcc-2.7.2.2.f.2/rtl.h Fri Jan 10 23:18:23 1997 - *************** enum reg_note { REG_DEAD = 1, REG_INC = - *** 349,353 **** - REG_NONNEG = 8, REG_NO_CONFLICT = 9, REG_UNUSED = 10, - REG_CC_SETTER = 11, REG_CC_USER = 12, REG_LABEL = 13, - ! REG_DEP_ANTI = 14, REG_DEP_OUTPUT = 15 }; - - /* Define macros to extract and insert the reg-note kind in an EXPR_LIST. */ - --- 349,353 ---- - REG_NONNEG = 8, REG_NO_CONFLICT = 9, REG_UNUSED = 10, - REG_CC_SETTER = 11, REG_CC_USER = 12, REG_LABEL = 13, - ! REG_DEP_ANTI = 14, REG_DEP_OUTPUT = 15, REG_NOALIAS = 16 }; - - /* Define macros to extract and insert the reg-note kind in an EXPR_LIST. */ - *************** extern char *reg_note_name[]; - *** 432,436 **** - #define NOTE_INSN_FUNCTION_BEG -13 - - - - #if 0 /* These are not used, and I don't know what they were for. --rms. */ - #define NOTE_DECL_NAME(INSN) ((INSN)->fld[3].rtstr) - --- 432,435 ---- - *************** extern char *note_insn_name[]; - *** 576,579 **** - --- 575,579 ---- - /* For a TRAP_IF rtx, TRAP_CONDITION is an expression. */ - #define TRAP_CONDITION(RTX) ((RTX)->fld[0].rtx) - + #define TRAP_CODE(RTX) ((RTX)->fld[1].rtint) - - /* 1 in a SYMBOL_REF if it addresses this function's constants pool. */ - *************** extern rtx eliminate_constant_term PROTO - *** 817,820 **** - --- 817,830 ---- - extern rtx expand_complex_abs PROTO((enum machine_mode, rtx, rtx, int)); - extern enum machine_mode choose_hard_reg_mode PROTO((int, int)); - + extern int rtx_varies_p PROTO((rtx)); - + extern int may_trap_p PROTO((rtx)); - + extern int side_effects_p PROTO((rtx)); - + extern int volatile_refs_p PROTO((rtx)); - + extern int volatile_insn_p PROTO((rtx)); - + extern void remove_note PROTO((rtx, rtx)); - + extern void note_stores PROTO((rtx, void (*)())); - + extern int refers_to_regno_p PROTO((int, int, rtx, rtx *)); - + extern int reg_overlap_mentioned_p PROTO((rtx, rtx)); - + - - /* Maximum number of parallel sets and clobbers in any insn in this fn. - *************** extern rtx *regno_reg_rtx; - *** 967,968 **** - --- 977,985 ---- - - extern int rtx_to_tree_code PROTO((enum rtx_code)); - + - + extern int true_dependence PROTO((rtx, enum machine_mode, rtx, int (*)())); - + extern int read_dependence PROTO((rtx, rtx)); - + extern int anti_dependence PROTO((rtx, rtx)); - + extern int output_dependence PROTO((rtx, rtx)); - + extern void init_alias_analysis PROTO((void)); - + extern void end_alias_analysis PROTO((void)); - diff -rcp2N gcc-2.7.2.2/sched.c gcc-2.7.2.2.f.2/sched.c - *** gcc-2.7.2.2/sched.c Thu Jun 15 08:06:39 1995 - --- gcc-2.7.2.2.f.2/sched.c Fri Jan 10 23:18:24 1997 - *************** Boston, MA 02111-1307, USA. */ - *** 126,129 **** - --- 126,132 ---- - #include "insn-attr.h" - - + extern char *reg_known_equiv_p; - + extern rtx *reg_known_value; - + - #ifdef INSN_SCHEDULING - /* Arrays set up by scheduling for the same respective purposes as - *************** static int *sched_reg_live_length; - *** 143,146 **** - --- 146,150 ---- - by splitting insns. */ - static rtx *reg_last_uses; - + static int reg_last_uses_size; - static rtx *reg_last_sets; - static regset reg_pending_sets; - *************** struct sometimes - *** 294,302 **** - - /* Forward declarations. */ - - static rtx canon_rtx PROTO((rtx)); - - static int rtx_equal_for_memref_p PROTO((rtx, rtx)); - - static rtx find_symbolic_term PROTO((rtx)); - - static int memrefs_conflict_p PROTO((int, rtx, int, rtx, - - HOST_WIDE_INT)); - static void add_dependence PROTO((rtx, rtx, enum reg_note)); - static void remove_dependence PROTO((rtx, rtx)); - --- 298,301 ---- - *************** void schedule_insns PROTO((FILE *)); - *** 346,885 **** - #endif /* INSN_SCHEDULING */ - - - #define SIZE_FOR_MODE(X) (GET_MODE_SIZE (GET_MODE (X))) - - - - /* Vector indexed by N giving the initial (unchanging) value known - - for pseudo-register N. */ - - static rtx *reg_known_value; - - - - /* Vector recording for each reg_known_value whether it is due to a - - REG_EQUIV note. Future passes (viz., reload) may replace the - - pseudo with the equivalent expression and so we account for the - - dependences that would be introduced if that happens. */ - - /* ??? This is a problem only on the Convex. The REG_EQUIV notes created in - - assign_parms mention the arg pointer, and there are explicit insns in the - - RTL that modify the arg pointer. Thus we must ensure that such insns don't - - get scheduled across each other because that would invalidate the REG_EQUIV - - notes. One could argue that the REG_EQUIV notes are wrong, but solving - - the problem in the scheduler will likely give better code, so we do it - - here. */ - - static char *reg_known_equiv_p; - - - - /* Indicates number of valid entries in reg_known_value. */ - - static int reg_known_value_size; - - - - static rtx - - canon_rtx (x) - - rtx x; - - { - - if (GET_CODE (x) == REG && REGNO (x) >= FIRST_PSEUDO_REGISTER - - && REGNO (x) <= reg_known_value_size) - - return reg_known_value[REGNO (x)]; - - else if (GET_CODE (x) == PLUS) - - { - - rtx x0 = canon_rtx (XEXP (x, 0)); - - rtx x1 = canon_rtx (XEXP (x, 1)); - - - - if (x0 != XEXP (x, 0) || x1 != XEXP (x, 1)) - - { - - /* We can tolerate LO_SUMs being offset here; these - - rtl are used for nothing other than comparisons. */ - - if (GET_CODE (x0) == CONST_INT) - - return plus_constant_for_output (x1, INTVAL (x0)); - - else if (GET_CODE (x1) == CONST_INT) - - return plus_constant_for_output (x0, INTVAL (x1)); - - return gen_rtx (PLUS, GET_MODE (x), x0, x1); - - } - - } - - return x; - - } - - - - /* Set up all info needed to perform alias analysis on memory references. */ - - - - void - - init_alias_analysis () - - { - - int maxreg = max_reg_num (); - - rtx insn; - - rtx note; - - rtx set; - - - - reg_known_value_size = maxreg; - - - - reg_known_value - - = (rtx *) oballoc ((maxreg-FIRST_PSEUDO_REGISTER) * sizeof (rtx)) - - - FIRST_PSEUDO_REGISTER; - - bzero ((char *) (reg_known_value + FIRST_PSEUDO_REGISTER), - - (maxreg-FIRST_PSEUDO_REGISTER) * sizeof (rtx)); - - - - reg_known_equiv_p - - = (char *) oballoc ((maxreg -FIRST_PSEUDO_REGISTER) * sizeof (char)) - - - FIRST_PSEUDO_REGISTER; - - bzero (reg_known_equiv_p + FIRST_PSEUDO_REGISTER, - - (maxreg - FIRST_PSEUDO_REGISTER) * sizeof (char)); - - - - /* Fill in the entries with known constant values. */ - - for (insn = get_insns (); insn; insn = NEXT_INSN (insn)) - - if ((set = single_set (insn)) != 0 - - && GET_CODE (SET_DEST (set)) == REG - - && REGNO (SET_DEST (set)) >= FIRST_PSEUDO_REGISTER - - && (((note = find_reg_note (insn, REG_EQUAL, 0)) != 0 - - && reg_n_sets[REGNO (SET_DEST (set))] == 1) - - || (note = find_reg_note (insn, REG_EQUIV, NULL_RTX)) != 0) - - && GET_CODE (XEXP (note, 0)) != EXPR_LIST) - - { - - int regno = REGNO (SET_DEST (set)); - - reg_known_value[regno] = XEXP (note, 0); - - reg_known_equiv_p[regno] = REG_NOTE_KIND (note) == REG_EQUIV; - - } - - - - /* Fill in the remaining entries. */ - - while (--maxreg >= FIRST_PSEUDO_REGISTER) - - if (reg_known_value[maxreg] == 0) - - reg_known_value[maxreg] = regno_reg_rtx[maxreg]; - - } - - - - /* Return 1 if X and Y are identical-looking rtx's. - - - - We use the data in reg_known_value above to see if two registers with - - different numbers are, in fact, equivalent. */ - - - - static int - - rtx_equal_for_memref_p (x, y) - - rtx x, y; - - { - - register int i; - - register int j; - - register enum rtx_code code; - - register char *fmt; - - - - if (x == 0 && y == 0) - - return 1; - - if (x == 0 || y == 0) - - return 0; - - x = canon_rtx (x); - - y = canon_rtx (y); - - - - if (x == y) - - return 1; - - - - code = GET_CODE (x); - - /* Rtx's of different codes cannot be equal. */ - - if (code != GET_CODE (y)) - - return 0; - - - - /* (MULT:SI x y) and (MULT:HI x y) are NOT equivalent. - - (REG:SI x) and (REG:HI x) are NOT equivalent. */ - - - - if (GET_MODE (x) != GET_MODE (y)) - - return 0; - - - - /* REG, LABEL_REF, and SYMBOL_REF can be compared nonrecursively. */ - - - - if (code == REG) - - return REGNO (x) == REGNO (y); - - if (code == LABEL_REF) - - return XEXP (x, 0) == XEXP (y, 0); - - if (code == SYMBOL_REF) - - return XSTR (x, 0) == XSTR (y, 0); - - - - /* For commutative operations, the RTX match if the operand match in any - - order. Also handle the simple binary and unary cases without a loop. */ - - if (code == EQ || code == NE || GET_RTX_CLASS (code) == 'c') - - return ((rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)) - - && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1))) - - || (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 1)) - - && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 0)))); - - else if (GET_RTX_CLASS (code) == '<' || GET_RTX_CLASS (code) == '2') - - return (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)) - - && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1))); - - else if (GET_RTX_CLASS (code) == '1') - - return rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)); - - - - /* Compare the elements. If any pair of corresponding elements - - fail to match, return 0 for the whole things. */ - - - - fmt = GET_RTX_FORMAT (code); - - for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--) - - { - - switch (fmt[i]) - - { - - case 'w': - - if (XWINT (x, i) != XWINT (y, i)) - - return 0; - - break; - - - - case 'n': - - case 'i': - - if (XINT (x, i) != XINT (y, i)) - - return 0; - - break; - - - - case 'V': - - case 'E': - - /* Two vectors must have the same length. */ - - if (XVECLEN (x, i) != XVECLEN (y, i)) - - return 0; - - - - /* And the corresponding elements must match. */ - - for (j = 0; j < XVECLEN (x, i); j++) - - if (rtx_equal_for_memref_p (XVECEXP (x, i, j), XVECEXP (y, i, j)) == 0) - - return 0; - - break; - - - - case 'e': - - if (rtx_equal_for_memref_p (XEXP (x, i), XEXP (y, i)) == 0) - - return 0; - - break; - - - - case 'S': - - case 's': - - if (strcmp (XSTR (x, i), XSTR (y, i))) - - return 0; - - break; - - - - case 'u': - - /* These are just backpointers, so they don't matter. */ - - break; - - - - case '0': - - break; - - - - /* It is believed that rtx's at this level will never - - contain anything but integers and other rtx's, - - except for within LABEL_REFs and SYMBOL_REFs. */ - - default: - - abort (); - - } - - } - - return 1; - - } - - - - /* Given an rtx X, find a SYMBOL_REF or LABEL_REF within - - X and return it, or return 0 if none found. */ - - - - static rtx - - find_symbolic_term (x) - - rtx x; - - { - - register int i; - - register enum rtx_code code; - - register char *fmt; - - - - code = GET_CODE (x); - - if (code == SYMBOL_REF || code == LABEL_REF) - - return x; - - if (GET_RTX_CLASS (code) == 'o') - - return 0; - - - - fmt = GET_RTX_FORMAT (code); - - for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--) - - { - - rtx t; - - - - if (fmt[i] == 'e') - - { - - t = find_symbolic_term (XEXP (x, i)); - - if (t != 0) - - return t; - - } - - else if (fmt[i] == 'E') - - break; - - } - - return 0; - - } - - - - /* Return nonzero if X and Y (memory addresses) could reference the - - same location in memory. C is an offset accumulator. When - - C is nonzero, we are testing aliases between X and Y + C. - - XSIZE is the size in bytes of the X reference, - - similarly YSIZE is the size in bytes for Y. - - - - If XSIZE or YSIZE is zero, we do not know the amount of memory being - - referenced (the reference was BLKmode), so make the most pessimistic - - assumptions. - - - - We recognize the following cases of non-conflicting memory: - - - - (1) addresses involving the frame pointer cannot conflict - - with addresses involving static variables. - - (2) static variables with different addresses cannot conflict. - - - - Nice to notice that varying addresses cannot conflict with fp if no - - local variables had their addresses taken, but that's too hard now. */ - - - - /* ??? In Fortran, references to a array parameter can never conflict with - - another array parameter. */ - - - - static int - - memrefs_conflict_p (xsize, x, ysize, y, c) - - rtx x, y; - - int xsize, ysize; - - HOST_WIDE_INT c; - - { - - if (GET_CODE (x) == HIGH) - - x = XEXP (x, 0); - - else if (GET_CODE (x) == LO_SUM) - - x = XEXP (x, 1); - - else - - x = canon_rtx (x); - - if (GET_CODE (y) == HIGH) - - y = XEXP (y, 0); - - else if (GET_CODE (y) == LO_SUM) - - y = XEXP (y, 1); - - else - - y = canon_rtx (y); - - - - if (rtx_equal_for_memref_p (x, y)) - - return (xsize == 0 || ysize == 0 || - - (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); - - - - if (y == frame_pointer_rtx || y == hard_frame_pointer_rtx - - || y == stack_pointer_rtx) - - { - - rtx t = y; - - int tsize = ysize; - - y = x; ysize = xsize; - - x = t; xsize = tsize; - - } - - - - if (x == frame_pointer_rtx || x == hard_frame_pointer_rtx - - || x == stack_pointer_rtx) - - { - - rtx y1; - - - - if (CONSTANT_P (y)) - - return 0; - - - - if (GET_CODE (y) == PLUS - - && canon_rtx (XEXP (y, 0)) == x - - && (y1 = canon_rtx (XEXP (y, 1))) - - && GET_CODE (y1) == CONST_INT) - - { - - c += INTVAL (y1); - - return (xsize == 0 || ysize == 0 - - || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); - - } - - - - if (GET_CODE (y) == PLUS - - && (y1 = canon_rtx (XEXP (y, 0))) - - && CONSTANT_P (y1)) - - return 0; - - - - return 1; - - } - - - - if (GET_CODE (x) == PLUS) - - { - - /* The fact that X is canonicalized means that this - - PLUS rtx is canonicalized. */ - - rtx x0 = XEXP (x, 0); - - rtx x1 = XEXP (x, 1); - - - - if (GET_CODE (y) == PLUS) - - { - - /* The fact that Y is canonicalized means that this - - PLUS rtx is canonicalized. */ - - rtx y0 = XEXP (y, 0); - - rtx y1 = XEXP (y, 1); - - - - if (rtx_equal_for_memref_p (x1, y1)) - - return memrefs_conflict_p (xsize, x0, ysize, y0, c); - - if (rtx_equal_for_memref_p (x0, y0)) - - return memrefs_conflict_p (xsize, x1, ysize, y1, c); - - if (GET_CODE (x1) == CONST_INT) - - if (GET_CODE (y1) == CONST_INT) - - return memrefs_conflict_p (xsize, x0, ysize, y0, - - c - INTVAL (x1) + INTVAL (y1)); - - else - - return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1)); - - else if (GET_CODE (y1) == CONST_INT) - - return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1)); - - - - /* Handle case where we cannot understand iteration operators, - - but we notice that the base addresses are distinct objects. */ - - x = find_symbolic_term (x); - - if (x == 0) - - return 1; - - y = find_symbolic_term (y); - - if (y == 0) - - return 1; - - return rtx_equal_for_memref_p (x, y); - - } - - else if (GET_CODE (x1) == CONST_INT) - - return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1)); - - } - - else if (GET_CODE (y) == PLUS) - - { - - /* The fact that Y is canonicalized means that this - - PLUS rtx is canonicalized. */ - - rtx y0 = XEXP (y, 0); - - rtx y1 = XEXP (y, 1); - - - - if (GET_CODE (y1) == CONST_INT) - - return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1)); - - else - - return 1; - - } - - - - if (GET_CODE (x) == GET_CODE (y)) - - switch (GET_CODE (x)) - - { - - case MULT: - - { - - /* Handle cases where we expect the second operands to be the - - same, and check only whether the first operand would conflict - - or not. */ - - rtx x0, y0; - - rtx x1 = canon_rtx (XEXP (x, 1)); - - rtx y1 = canon_rtx (XEXP (y, 1)); - - if (! rtx_equal_for_memref_p (x1, y1)) - - return 1; - - x0 = canon_rtx (XEXP (x, 0)); - - y0 = canon_rtx (XEXP (y, 0)); - - if (rtx_equal_for_memref_p (x0, y0)) - - return (xsize == 0 || ysize == 0 - - || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); - - - - /* Can't properly adjust our sizes. */ - - if (GET_CODE (x1) != CONST_INT) - - return 1; - - xsize /= INTVAL (x1); - - ysize /= INTVAL (x1); - - c /= INTVAL (x1); - - return memrefs_conflict_p (xsize, x0, ysize, y0, c); - - } - - } - - - - if (CONSTANT_P (x)) - - { - - if (GET_CODE (x) == CONST_INT && GET_CODE (y) == CONST_INT) - - { - - c += (INTVAL (y) - INTVAL (x)); - - return (xsize == 0 || ysize == 0 - - || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); - - } - - - - if (GET_CODE (x) == CONST) - - { - - if (GET_CODE (y) == CONST) - - return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)), - - ysize, canon_rtx (XEXP (y, 0)), c); - - else - - return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)), - - ysize, y, c); - - } - - if (GET_CODE (y) == CONST) - - return memrefs_conflict_p (xsize, x, ysize, - - canon_rtx (XEXP (y, 0)), c); - - - - if (CONSTANT_P (y)) - - return (rtx_equal_for_memref_p (x, y) - - && (xsize == 0 || ysize == 0 - - || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0))); - - - - return 1; - - } - - return 1; - - } - - - - /* Functions to compute memory dependencies. - - - - Since we process the insns in execution order, we can build tables - - to keep track of what registers are fixed (and not aliased), what registers - - are varying in known ways, and what registers are varying in unknown - - ways. - - - - If both memory references are volatile, then there must always be a - - dependence between the two references, since their order can not be - - changed. A volatile and non-volatile reference can be interchanged - - though. - - - - A MEM_IN_STRUCT reference at a non-QImode varying address can never - - conflict with a non-MEM_IN_STRUCT reference at a fixed address. We must - - allow QImode aliasing because the ANSI C standard allows character - - pointers to alias anything. We are assuming that characters are - - always QImode here. */ - - - - /* Read dependence: X is read after read in MEM takes place. There can - - only be a dependence here if both reads are volatile. */ - - - - int - - read_dependence (mem, x) - - rtx mem; - - rtx x; - - { - - return MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem); - - } - - - - /* True dependence: X is read after store in MEM takes place. */ - - - - int - - true_dependence (mem, x) - - rtx mem; - - rtx x; - - { - - /* If X is an unchanging read, then it can't possibly conflict with any - - non-unchanging store. It may conflict with an unchanging write though, - - because there may be a single store to this address to initialize it. - - Just fall through to the code below to resolve the case where we have - - both an unchanging read and an unchanging write. This won't handle all - - cases optimally, but the possible performance loss should be - - negligible. */ - - if (RTX_UNCHANGING_P (x) && ! RTX_UNCHANGING_P (mem)) - - return 0; - - - - return ((MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) - - || (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0), - - SIZE_FOR_MODE (x), XEXP (x, 0), 0) - - && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem) - - && GET_MODE (mem) != QImode - - && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x)) - - && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x) - - && GET_MODE (x) != QImode - - && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem)))); - - } - - - - /* Anti dependence: X is written after read in MEM takes place. */ - - - - int - - anti_dependence (mem, x) - - rtx mem; - - rtx x; - - { - - /* If MEM is an unchanging read, then it can't possibly conflict with - - the store to X, because there is at most one store to MEM, and it must - - have occurred somewhere before MEM. */ - - if (RTX_UNCHANGING_P (mem)) - - return 0; - - - - return ((MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) - - || (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0), - - SIZE_FOR_MODE (x), XEXP (x, 0), 0) - - && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem) - - && GET_MODE (mem) != QImode - - && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x)) - - && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x) - - && GET_MODE (x) != QImode - - && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem)))); - - } - - - - /* Output dependence: X is written after store in MEM takes place. */ - - - - int - - output_dependence (mem, x) - - rtx mem; - - rtx x; - - { - - return ((MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) - - || (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0), - - SIZE_FOR_MODE (x), XEXP (x, 0), 0) - - && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem) - - && GET_MODE (mem) != QImode - - && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x)) - - && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x) - - && GET_MODE (x) != QImode - - && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem)))); - - } - - - /* Helper functions for instruction scheduling. */ - - --- 345,348 ---- - *************** sched_analyze_2 (x, insn) - *** 1922,1926 **** - /* If a dependency already exists, don't create a new one. */ - if (! find_insn_list (XEXP (pending, 0), LOG_LINKS (insn))) - ! if (true_dependence (XEXP (pending_mem, 0), x)) - add_dependence (insn, XEXP (pending, 0), 0); - - --- 1385,1390 ---- - /* If a dependency already exists, don't create a new one. */ - if (! find_insn_list (XEXP (pending, 0), LOG_LINKS (insn))) - ! if (true_dependence (XEXP (pending_mem, 0), VOIDmode, - ! x, rtx_varies_p)) - add_dependence (insn, XEXP (pending, 0), 0); - - *************** sched_analyze_insn (x, insn, loop_notes) - *** 2021,2025 **** - register RTX_CODE code = GET_CODE (x); - rtx link; - ! int maxreg = max_reg_num (); - int i; - - --- 1485,1489 ---- - register RTX_CODE code = GET_CODE (x); - rtx link; - ! int maxreg = reg_last_uses_size; - int i; - - *************** sched_analyze_insn (x, insn, loop_notes) - *** 2058,2062 **** - if (loop_notes) - { - ! int max_reg = max_reg_num (); - rtx link; - - --- 1522,1526 ---- - if (loop_notes) - { - ! int max_reg = reg_last_uses_size; - rtx link; - - *************** sched_analyze (head, tail) - *** 2202,2207 **** - && NOTE_LINE_NUMBER (NEXT_INSN (insn)) == NOTE_INSN_SETJMP) - { - ! int max_reg = max_reg_num (); - ! for (i = 0; i < max_reg; i++) - { - for (u = reg_last_uses[i]; u; u = XEXP (u, 1)) - --- 1666,1670 ---- - && NOTE_LINE_NUMBER (NEXT_INSN (insn)) == NOTE_INSN_SETJMP) - { - ! for (i = 0; i < reg_last_uses_size; i++) - { - for (u = reg_last_uses[i]; u; u = XEXP (u, 1)) - *************** sched_note_set (b, x, death) - *** 2372,2380 **** - - #define SCHED_SORT(READY, NEW_READY, OLD_READY) \ - ! do { if ((NEW_READY) - (OLD_READY) == 1) \ - ! swap_sort (READY, NEW_READY); \ - ! else if ((NEW_READY) - (OLD_READY) > 1) \ - ! qsort (READY, NEW_READY, sizeof (rtx), rank_for_schedule); } \ - ! while (0) - - /* Returns a positive value if y is preferred; returns a negative value if - --- 1835,1842 ---- - - #define SCHED_SORT(READY, NEW_READY, OLD_READY) \ - ! if ((NEW_READY) - (OLD_READY) == 1) \ - ! swap_sort (READY, NEW_READY); \ - ! else if ((NEW_READY) - (OLD_READY) > 1) \ - ! qsort (READY, NEW_READY, sizeof (rtx), rank_for_schedule); else \ - - /* Returns a positive value if y is preferred; returns a negative value if - *************** schedule_block (b, file) - *** 3174,3178 **** - b, INSN_UID (basic_block_head[b]), INSN_UID (basic_block_end[b])); - - ! i = max_reg_num (); - reg_last_uses = (rtx *) alloca (i * sizeof (rtx)); - bzero ((char *) reg_last_uses, i * sizeof (rtx)); - --- 2636,2640 ---- - b, INSN_UID (basic_block_head[b]), INSN_UID (basic_block_end[b])); - - ! reg_last_uses_size = i = max_reg_num (); - reg_last_uses = (rtx *) alloca (i * sizeof (rtx)); - bzero ((char *) reg_last_uses, i * sizeof (rtx)); - *************** schedule_insns (dump_file) - *** 4718,4721 **** - --- 4180,4198 ---- - max_regno * sizeof (short)); - init_alias_analysis (); - + #if 0 - + if (dump_file) - + { - + extern rtx *reg_base_value; - + extern int reg_base_value_size; - + int i; - + for (i = 0; i < reg_base_value_size; i++) - + if (reg_base_value[i]) - + { - + fprintf (dump_file, ";; reg_base_value[%d] = ", i); - + print_rtl (dump_file, reg_base_value[i]); - + fputc ('\n', dump_file); - + } - + } - + #endif - } - else - *************** schedule_insns (dump_file) - *** 4726,4731 **** - bb_dead_regs = 0; - bb_live_regs = 0; - ! if (! flag_schedule_insns) - ! init_alias_analysis (); - } - - --- 4203,4207 ---- - bb_dead_regs = 0; - bb_live_regs = 0; - ! init_alias_analysis (); - } - - diff -rcp2N gcc-2.7.2.2/toplev.c gcc-2.7.2.2.f.2/toplev.c - *** gcc-2.7.2.2/toplev.c Fri Oct 20 17:56:35 1995 - --- gcc-2.7.2.2.f.2/toplev.c Fri Jan 10 23:18:24 1997 - *************** int flag_unroll_loops; - *** 388,391 **** - --- 388,405 ---- - int flag_unroll_all_loops; - - + /* Nonzero forces all invariant computations in loops to be moved - + outside the loop. */ - + - + int flag_move_all_movables = 0; - + - + /* Nonzero forces all general induction variables in loops to be - + strength reduced. */ - + - + int flag_reduce_all_givs = 0; - + - + /* Nonzero gets another run of loop_optimize performed. */ - + - + int flag_rerun_loop_opt = 0; - + - /* Nonzero for -fwritable-strings: - store string constants in data segment and don't uniquize them. */ - *************** int flag_gnu_linker = 1; - *** 522,525 **** - --- 536,550 ---- - int flag_pack_struct = 0; - - + /* 1 if alias checking is on (by default, when -O). */ - + int flag_alias_check = 0; - + - + /* 0 if pointer arguments may alias each other. True in C. - + 1 if pointer arguments may not alias each other but may alias - + global variables. - + 2 if pointer arguments may not alias each other and may not - + alias global variables. True in Fortran. - + This defaults to 0 for C. */ - + int flag_argument_noalias = 0; - + - /* Table of language-independent -f options. - STRING is the option name. VARIABLE is the address of the variable. - *************** struct { char *string; int *variable; in - *** 542,545 **** - --- 567,573 ---- - {"unroll-loops", &flag_unroll_loops, 1}, - {"unroll-all-loops", &flag_unroll_all_loops, 1}, - + {"move-all-movables", &flag_move_all_movables, 1}, - + {"reduce-all-givs", &flag_reduce_all_givs, 1}, - + {"rerun-loop-opt", &flag_rerun_loop_opt, 1}, - {"writable-strings", &flag_writable_strings, 1}, - {"peephole", &flag_no_peephole, 0}, - *************** struct { char *string; int *variable; in - *** 568,572 **** - {"gnu-linker", &flag_gnu_linker, 1}, - {"pack-struct", &flag_pack_struct, 1}, - ! {"bytecode", &output_bytecode, 1} - }; - - --- 596,604 ---- - {"gnu-linker", &flag_gnu_linker, 1}, - {"pack-struct", &flag_pack_struct, 1}, - ! {"bytecode", &output_bytecode, 1}, - ! {"alias-check", &flag_alias_check, 1}, - ! {"argument-alias", &flag_argument_noalias, 0}, - ! {"argument-noalias", &flag_argument_noalias, 1}, - ! {"argument-noalias-global", &flag_argument_noalias, 2} - }; - - *************** rest_of_compilation (decl) - *** 2894,2897 **** - --- 2926,2931 ---- - { - loop_optimize (insns, loop_dump_file); - + if (flag_rerun_loop_opt) - + loop_optimize (insns, loop_dump_file); - }); - } - *************** main (argc, argv, envp) - *** 3383,3386 **** - --- 3417,3421 ---- - flag_omit_frame_pointer = 1; - #endif - + flag_alias_check = 1; - } - - diff -rcp2N gcc-2.7.2.2/unroll.c gcc-2.7.2.2.f.2/unroll.c - *** gcc-2.7.2.2/unroll.c Sat Aug 19 17:33:26 1995 - --- gcc-2.7.2.2.f.2/unroll.c Fri Jan 10 23:18:24 1997 - *************** unroll_loop (loop_end, insn_count, loop_ - *** 995,1000 **** - for (j = FIRST_PSEUDO_REGISTER; j < max_reg_before_loop; j++) - if (local_regno[j]) - ! map->reg_map[j] = gen_reg_rtx (GET_MODE (regno_reg_rtx[j])); - ! - /* The last copy needs the compare/branch insns at the end, - so reset copy_end here if the loop ends with a conditional - --- 995,1003 ---- - for (j = FIRST_PSEUDO_REGISTER; j < max_reg_before_loop; j++) - if (local_regno[j]) - ! { - ! map->reg_map[j] = gen_reg_rtx (GET_MODE (regno_reg_rtx[j])); - ! record_base_value (REGNO (map->reg_map[j]), - ! regno_reg_rtx[j]); - ! } - /* The last copy needs the compare/branch insns at the end, - so reset copy_end here if the loop ends with a conditional - *************** unroll_loop (loop_end, insn_count, loop_ - *** 1136,1140 **** - for (j = FIRST_PSEUDO_REGISTER; j < max_reg_before_loop; j++) - if (local_regno[j]) - ! map->reg_map[j] = gen_reg_rtx (GET_MODE (regno_reg_rtx[j])); - - /* If loop starts with a branch to the test, then fix it so that - --- 1139,1147 ---- - for (j = FIRST_PSEUDO_REGISTER; j < max_reg_before_loop; j++) - if (local_regno[j]) - ! { - ! map->reg_map[j] = gen_reg_rtx (GET_MODE (regno_reg_rtx[j])); - ! record_base_value (REGNO (map->reg_map[j]), - ! regno_reg_rtx[j]); - ! } - - /* If loop starts with a branch to the test, then fix it so that - *************** copy_loop_body (copy_start, copy_end, ma - *** 1631,1635 **** - incrementing the shared pseudo reg more than - once. */ - ! if (! tv->same_insn) - { - /* tv->dest_reg may actually be a (PLUS (REG) - --- 1638,1642 ---- - incrementing the shared pseudo reg more than - once. */ - ! if (! tv->same_insn && ! tv->shared) - { - /* tv->dest_reg may actually be a (PLUS (REG) - *************** copy_loop_body (copy_start, copy_end, ma - *** 1757,1760 **** - --- 1764,1768 ---- - giv_dest_reg = tem; - map->reg_map[regno] = tem; - + record_base_value (REGNO (tem), giv_src_reg); - } - else - *************** find_splittable_regs (unroll_type, loop_ - *** 2443,2447 **** - { - rtx tem = gen_reg_rtx (bl->biv->mode); - ! - emit_insn_before (gen_move_insn (tem, bl->biv->src_reg), - loop_start); - --- 2451,2456 ---- - { - rtx tem = gen_reg_rtx (bl->biv->mode); - ! - ! record_base_value (REGNO (tem), bl->biv->add_val); - emit_insn_before (gen_move_insn (tem, bl->biv->src_reg), - loop_start); - *************** find_splittable_regs (unroll_type, loop_ - *** 2500,2503 **** - --- 2509,2514 ---- - exits. */ - rtx tem = gen_reg_rtx (bl->biv->mode); - + record_base_value (REGNO (tem), bl->biv->add_val); - + - emit_insn_before (gen_move_insn (tem, bl->biv->src_reg), - loop_start); - *************** find_splittable_givs (bl, unroll_type, l - *** 2675,2678 **** - --- 2686,2690 ---- - rtx tem = gen_reg_rtx (bl->biv->mode); - - + record_base_value (REGNO (tem), bl->biv->add_val); - emit_insn_before (gen_move_insn (tem, bl->biv->src_reg), - loop_start); - *************** find_splittable_givs (bl, unroll_type, l - *** 2716,2719 **** - --- 2728,2732 ---- - { - rtx tem = gen_reg_rtx (v->mode); - + record_base_value (REGNO (tem), v->add_val); - emit_iv_add_mult (bl->initial_value, v->mult_val, - v->add_val, tem, loop_start); - *************** find_splittable_givs (bl, unroll_type, l - *** 2734,2747 **** - register for the split addr giv, just to be safe. */ - - ! /* ??? If there are multiple address givs which have been - ! combined with the same dest_reg giv, then we may only need - ! one new register for them. Pulling out constants below will - ! catch some of the common cases of this. Currently, I leave - ! the work of simplifying multiple address givs to the - ! following cse pass. */ - ! - ! /* As a special case, if we have multiple identical address givs - ! within a single instruction, then we do use a single pseudo - ! reg for both. This is necessary in case one is a match_dup - of the other. */ - - --- 2747,2753 ---- - register for the split addr giv, just to be safe. */ - - ! /* If we have multiple identical address givs within a - ! single instruction, then use a single pseudo reg for - ! both. This is necessary in case one is a match_dup - of the other. */ - - *************** find_splittable_givs (bl, unroll_type, l - *** 2756,2759 **** - --- 2762,2776 ---- - INSN_UID (v->insn)); - } - + /* If multiple address GIVs have been combined with the - + same dest_reg GIV, do not create a new register for - + each. */ - + else if (unroll_type != UNROLL_COMPLETELY - + && v->giv_type == DEST_ADDR - + && v->same && v->same->giv_type == DEST_ADDR - + && v->same->unrolled) - + { - + v->dest_reg = v->same->dest_reg; - + v->shared = 1; - + } - else if (unroll_type != UNROLL_COMPLETELY) - { - *************** find_splittable_givs (bl, unroll_type, l - *** 2761,2765 **** - register to hold the split value of the DEST_ADDR giv. - Emit insn to initialize its value before loop start. */ - ! tem = gen_reg_rtx (v->mode); - - /* If the address giv has a constant in its new_reg value, - --- 2778,2785 ---- - register to hold the split value of the DEST_ADDR giv. - Emit insn to initialize its value before loop start. */ - ! - ! rtx tem = gen_reg_rtx (v->mode); - ! record_base_value (REGNO (tem), v->add_val); - ! v->unrolled = 1; - - /* If the address giv has a constant in its new_reg value, - *************** find_splittable_givs (bl, unroll_type, l - *** 2772,2776 **** - v->dest_reg - = plus_constant (tem, INTVAL (XEXP (v->new_reg,1))); - ! - /* Only succeed if this will give valid addresses. - Try to validate both the first and the last - --- 2792,2796 ---- - v->dest_reg - = plus_constant (tem, INTVAL (XEXP (v->new_reg,1))); - ! - /* Only succeed if this will give valid addresses. - Try to validate both the first and the last - *************** final_biv_value (bl, loop_start, loop_en - *** 3061,3064 **** - --- 3081,3085 ---- - - tem = gen_reg_rtx (bl->biv->mode); - + record_base_value (REGNO (tem), bl->biv->add_val); - /* Make sure loop_end is not the last insn. */ - if (NEXT_INSN (loop_end) == 0) - *************** final_giv_value (v, loop_start, loop_end - *** 3154,3157 **** - --- 3175,3179 ---- - /* Put the final biv value in tem. */ - tem = gen_reg_rtx (bl->biv->mode); - + record_base_value (REGNO (tem), bl->biv->add_val); - emit_iv_add_mult (increment, GEN_INT (loop_n_iterations), - bl->initial_value, tem, insert_before); - diff -rcp2N gcc-2.7.2.2/version.c gcc-2.7.2.2.f.2/version.c - *** gcc-2.7.2.2/version.c Thu Feb 20 19:24:33 1997 - --- gcc-2.7.2.2.f.2/version.c Sun Feb 23 16:30:36 1997 - *************** - *** 1 **** - ! char *version_string = "2.7.2.2"; - --- 1 ---- - ! char *version_string = "2.7.2.2.f.2"; --- 0 ---- diff -rcp2N g77-0.5.20/f/gbe/2.7.2.3.diff g77-0.5.21/f/gbe/2.7.2.3.diff *** g77-0.5.20/f/gbe/2.7.2.3.diff Thu Jan 1 00:00:00 1970 --- g77-0.5.21/f/gbe/2.7.2.3.diff Tue Sep 9 06:11:36 1997 *************** *** 0 **** --- 1,13492 ---- + IMPORTANT: After applying this patch, you must rebuild the + Info documentation derived from the Texinfo files in the + gcc distribution, as this patch does not include patches + to any derived files (due to differences in the way gcc + version 2.7.2.2 is obtained by users). Use the following + command sequence after applying this patch: + + cd gcc-2.7.2.3; make -f Makefile.in gcc.info + + If that fails due to `makeinfo' not being installed, obtain + texinfo-3.11.tar.gz from a GNU distribution site, unpack, + build, and install it, and try the above command sequence + again. + + NOTE: You probably will have trouble with the `ChangeLog' + file in this patch. That's because gcc version 2.7.2.2 itself + had an incomplete patch file (gcc-2.7.2.2-2.7.2.3.diff.gz + omitted the patch to gcc/ChangeLog), which in turn "infected" + both forms of the 2.7.2.3 distribution (the .tar.gz and .diff.gz + file, neither of which has the proper gcc/ChangeLog file). + + The following patch's gcc/ChangeLog patchlet assumes a + "fixed" gcc-2.7.2.3/ChangeLog, and then further "fixes" it + to sort the pertinent entries in the usual chronological order. + + If you start with the gcc-2.7.2.2.tar.gz distribution, apply + the gcc-2.7.2.2-2.7.2.3.diff.gz patch, "fix up" the gcc/ChangeLog + file so the new material ends up "above" the single large + 2.7.2.2 release entry (dated "Tue Jan 29 02:47:13 1997"), then + you *should* be able to apply this patch file cleanly. + + In any case, don't worry; the contents of gcc/ChangeLog aren't + really important to non-developers of gcc. + + + diff -rcp2N gcc-2.7.2.3/ChangeLog gcc-2.7.2.3.f.1/ChangeLog + *** gcc-2.7.2.3/ChangeLog Sun Aug 31 09:41:00 1997 + --- gcc-2.7.2.3.f.1/ChangeLog Tue Sep 9 04:24:28 1997 + *************** + *** 1,6 **** + --- 1,36 ---- + + Wed Sep 3 12:26:33 1997 Jim Wilson + + + + * alias.c (true_dependence): Address with AND can alias scalars. + + (anti_dependence, output_dependence): Likewise. + + + + Wed Sep 3 10:36:51 1997 Jim Wilson + + + + * alias.c (true_dependence): Test x for BLKmode, in addition to mem. + + + + Sat Aug 30 16:42:50 1997 Craig Burley + + + + * reload.c (find_reloads): Fix 1997-07-28 fix so the + + loop to handle MATCH_DUPs is disabled when insn_code_number + + is <= 0, because in that case recog_dup_loc is not + + relevant. + + + + Tue Aug 26 01:52:17 1997 Craig Burley + + + + From Stan Cox + + * reg-stack.c (subst_stack_regs): Cope with computed goto + + (`GOTO I' in FORTRAN; `goto *lab;' in GNU C). + + + Thu Aug 22 23:47:38 1997 H.J. Lu (hjl@gnu.ai.mit.edu) + + * Version 2.7.2.3 released. + + + Fri Aug 22 21:31:54 1997 Jim Wilson + + + + * alias.c (true_dependence): Pass x_addr not x to varies. + + + + Sun Aug 17 03:31:44 1997 Craig Burley + + + + * Makefile.in: Comment out lines containing just formfeeds. + + + Wed Aug 13 08:28:18 1997 H.J. Lu (hjl@gnu.ai.mit.edu) + + *************** Wed Aug 13 08:28:18 1997 H.J. Lu (hjl@ + *** 26,33 **** + (FINALIZE_TRAMPOLINE, CLEAR_INSN_CACHE): New. + + ! Mon Mar 17 17:03:55 1997 J.T. Conklin + + ! * m68k.md (beq0_di, bne0_di, bge0_di, blt0_di): Use cmpw #0 + ! instead of tstl when testing address registers on the 68000. + + Fri Aug 8 08:15:55 1997 H.J. Lu (hjl@gnu.ai.mit.edu) + --- 56,81 ---- + (FINALIZE_TRAMPOLINE, CLEAR_INSN_CACHE): New. + + ! Sun Aug 10 22:23:10 1997 Richard Kenner + + ! * explow.c (probe_stack_range): Add USE for test_addr if -O0. + ! + ! Sun Aug 10 18:14:24 1997 Craig Burley + ! + ! Integrate C front end part of patch for better alias + ! handling from John Carr : + ! * c-decl.c (grokdeclarator): Check for RID_RESTRICT + ! flag; diagnose certain misuses; set DECL_RESTRICT as + ! appropriate. + ! * c-lex.c (init_lex): Set up RID_RESTRICT pointer. + ! Unset `restrict' as reserved word. + ! * c-lex.h: Replace RID_NOALIAS with RID_RESTRICT. + ! * c-parse.gperf: Add `restrict' and `__restrict' + ! keywords. + ! * tree.h: Add DECL_RESTRICT flag. + ! + ! Sun Aug 10 14:50:30 1997 Jim Wilson + ! + ! * sdbout.c (plain_type_1, case ARRAY_TYPE): Verify that TYPE_DOMAIN + ! has integer TYPE_{MAX,MIN}_VALUE before using them. + + Fri Aug 8 08:15:55 1997 H.J. Lu (hjl@gnu.ai.mit.edu) + *************** Fri Aug 8 08:15:55 1997 H.J. Lu (hjl@ + *** 38,41 **** + --- 86,143 ---- + * install1.texi: New. + + + Mon Aug 4 17:49:14 1997 Richard Kenner + + + + * combine.c (try_combine): If have PARALLEL of independent SETs + + and have cc0, ensure insn using CC0 come first. + + + + Sat Aug 2 08:03:04 1997 Richard Kenner + + + + * varasm.c (compare_constant_1, case STRING_CST): Compare TYPE_MODE. + + (record_constant_1, case STRING_CST): Record TYPE_MODE. + + + + Sat Aug 2 08:03:04 1997 Richard Kenner + + + + * tree.c (contains_this_placeholder_p): Delete. + + (contains_placeholder_p): Now contains code from above function. + + (contains_placeholder_p, case 'r'): Don't look at offset info. + + * expr.c (expand_expr, case PLACEHOLDER_EXPR): Find innermost + + matching and don't check contains_placeholder_p. + + + + Mon Jul 28 15:35:38 1997 Craig Burley + + + + * combine.c (num_sign_bit_copies): Speed up the 961126-1.c + + case of repeated (neg (neg (neg ...))) so c-torture runs + + in less time. + + + + * reload.c (find_reloads_toplev, find_reloads_address): + + These now return whether replacement by a constant, so + + caller can know to do other replacements. Currently if + + caller doesn't want that info and such replacement would + + happen, we crash so as to investigate the problem and + + learn more about it. All callers updated. + + (find_reloads): If pseudo replaced by constant, always + + update duplicates of it. + + + + Sun Jul 27 12:13:01 1997 Richard Kenner + + + + * expr.c (expand_expr, case SAVE_EXPR): Handle top-level SAVE_EXPR by + + moving into current function; abort if in odd context. + + * fold-const.c (fold_truthop, fold): Avoid making SAVE_EXPR + + if at top level. + + + + * expr.c (get_inner_unaligned_p): Deleted. + + (expand_assignment): Remove special-case of constant array. + + (expand_expr, case ARRAY_REF): Likewise, and clean up remaining code. + + + + * explow.c (probe_stack_range): Do probing with loop if more + + than a small number. + + + + Fri Jul 25 08:38:37 1997 Richard Kenner + + + + * calls.c: (expand_call): If -fstack-check and temp needed + + for arg is too large, use alloca. + + * expr.c (expand_expr, case MODIFY_EXPR): Don't preexpand calls + + if LHS is an indirect via a constant pointer. + + + Mon Jul 21 22:47:13 1997 H.J. Lu (hjl@gnu.ai.mit.edu) + + *************** Mon Jul 21 22:47:13 1997 H.J. Lu (hjl@ + *** 43,46 **** + --- 145,213 ---- + for Linux. + + + Mon Jul 21 00:00:24 1997 Craig Burley + + + + * fold-const.c (size_binop): Make sure overflows + + are flagged properly, so as to avoid silently generating + + bad code for, e.g., a too-large array. + + + + Sun Jul 20 06:10:26 1997 Richard Kenner + + + + * tree.c (contains_placeholder_p): Call contains_this_placeholder_p. + + (contains_this_placeholder_p): Renamed from contains_placeholder_p. + + Added new arg, PL. + + Rework to make more consistent, check more codes, and avoid + + undefined fields. + + * expr.c (expand_expr, case PLACEHOLDER_EXPR): Pick outermost + + object in placeholder_list of right type without a PLACEHOLDER_EXPR> + + + + Sat Jul 19 17:54:28 1997 Richard Kenner + + + + * alpha.h (STACK_CHECK_BUILTIN): New macro. + + + + Thu Jul 17 07:02:10 1997 Richard Kenner + + + + * expr.h (STACK_CHECK_*): Provide default values. + + (probe_stack_range): New declaration. + + * flags.h (flag_stack_check): Likewise. + + * explow.c (allocate_dynamic_stack_space): Call probe_stack_range. + + (emit_stack_probe, probe_stack_range): New functions. + + * function.c (expand_function_end): If function is non-leaf and stack + + checking is requested, emit needed probes. + + * reload1.c (reload): If checking stack, verify frame small enough. + + * stmt.c (expand_decl): If stack checking, use alloca for large vars. + + * toplev.c (flag_stack_check): New variable. + + (f_options): Add "stack-check". + + + + Sun Jul 13 22:23:14 1997 Craig Burley + + + + * stmt.c (expand_expr_stmt): Must generate code for + + statements within an expression (gcc's `({ ... )}') + + even if -fsyntax-only. + + + + Sun Jul 13 15:14:48 1997 Richard Kenner + + + + * m68k.md (tstdi, cmpdi): Disable. + + + + Tue Jul 1 23:27:43 1997 Richard Kenner + + + + * reorg.c (redundant_insn): If INSN or possible match has REG_UNUSED + + note, don't have match. + + + + Mon Jun 30 17:23:07 1997 Michael Meissner + + + + * gcc.c (process_command): If -save-temps and -pipe were specified + + together, don't do -pipe. + + + + Thu Jun 26 05:40:46 1997 Craig Burley + + + + * stor-layout.c (get_best_mode): Handle negative bitpos + + correctly, so caller doesn't get into infinite recursion + + trying to cope with a spurious VOIDmode. + + + + Tue Jun 24 19:46:31 1997 Craig Burley + + + + * varasm.c (assemble_variable): If low part of size + + doesn't fit in an int, variable is too large. + + + Tue Jun 24 11:24:56 1997 H.J. Lu (hjl@gnu.ai.mit.edu) + + *************** Mon Jun 23 22:48:00 1997 Jim Wilson + + ! * function.c (expand_function_end): Allow TRAMPOLINE_TEMPLATE + ! to be omitted on systems for which it is not cost effective. + ! * varasm.c (assemble_trampoline_template): No such function + ! if no TRAMPOLINE_TEMPLATE. + ! * m68k.h: Greatly simplify the run-time trampoline code: + ! (TRAMPOLINE_TEMPLATE, TRANSFER_FROM_TRAMPOLINE): Delete define. + ! (TRAMPOLINE_SIZE, INITIALIZE_TRAMPOLINE): Changed. + ! (TRAMPOLINE_ALIGN): No point aligning to cache line. + ! (FINISH_INIT_TRAMPOLINE): New define. + ! * m68k/next.h: Instead of redefining INITIALIZE_TRAMPOLINE, + ! make use of the new FINISH_INIT_TRAMPOLINE. + ! * m68k/{m68k.h,next.h} (FINISH_INIT_TRAMPOLINE): + ! Rename to FINALIZE_TRAMPOLINE. + + ! Mon Apr 15 08:49:20 1996 Tom May (ftom@netcom.com) + + ! * cse.c (invalidate_skipped_set): Ignore CLOBBER after calling + ! note_mem_written, not before. + + Tue Jan 29 02:47:13 1997 Richard Stallman + --- 236,433 ---- + to biv_count for reduced givs. + + ! Sat Jun 21 12:09:00 1997 Craig Burley + + ! * toplev.c (rest_of_compilation): Also temporarily set + ! flag_unroll_all_loops to 0 during first of two calls + ! to loop_optimize, and clean up code a bit to make it + ! easier to read. + + ! * expr.c (safe_from_p_1, safe_from_p): Fix these to use + ! TREE_SET_CODE instead of TREE_CODE. + + ! Thu Jun 19 19:30:47 1997 Craig Burley + ! + ! * config/alpha/alpha.c: Don't include on + ! GNU Linux machines. + ! + ! * config/alpha/elf.c: New file for ELF systems. + ! + ! * config/alpha/xm-alpha.h: Don't declare alloca() + ! if it's already a macro (probably defined in stdlib.h). + ! + ! * config/alpha/xm-linux.h (HAVE_STRERROR): #define + ! this, according to what various people suggest. + ! + ! * config.guess, configure: Make some (hopefully safe) + ! changes, based mostly on gcc-2.8.0-in-development, + ! in the hopes that these make some systems configure + ! "out of the box" more easily, especially Alpha systems. + ! + ! Mon Jun 9 04:26:53 1997 Craig Burley + ! + ! * expr.c (safe_from_p): Don't examine a given SAVE_EXPR + ! node more than once, to avoid combinatorial explosion + ! in complex expressions. Fortran case that triggered + ! this had a complicated *and* complex expression with + ! 293 unique nodes, resulting in 28 minutes of compile + ! time mostly spent in a single top-level safe_from_p() + ! call due to all the redundant SAVE_EXPR traversals. + ! This change reduced the time to around 2 seconds. + ! (safe_from_p_1): New helper function that does almost + ! exactly what the old safe_from_p() did. + ! + ! Fri May 30 11:40:10 1997 Richard Kenner + ! + ! * rs6000.md (movdi): Emit a CLOBBER before the two movsi insns + ! in constant case. + ! + ! Sun May 18 21:18:48 1997 Craig Burley + ! + ! * fold-const.c (fold): Clarify why TRUNC_DIV_EXPR + ! and FLOOR_DIV_EXPR aren't rewritten to EXACT_DIV_EXPR, + ! clean up related code. + ! + ! Sat May 17 15:15:23 1997 Richard Kenner + ! + ! * cse.c (cse_insn): Don't record a SRC that's a MEM and the same + ! as a REG_EQUIV note if DEST is set more than once. + ! + ! Sat May 3 13:53:00 1997 Craig Burley + ! + ! * config.sub: Change all `i[345]' to `i[3456]' to + ! support Pentium Pro (this change was already made + ! in configure for gcc-2.7.2.2). + ! + ! From Toon Moene : + ! * toplev.c (rest_of_compilation): Unroll loops + ! only the final time through loop optimization. + ! + ! Thu Apr 24 16:39:53 1997 Richard Kenner + ! + ! * stmt.c (pushcase_range): Check for null range first. + ! + ! Mon Apr 21 16:31:50 1997 Richard Kenner + ! + ! * cse.c (fold_rtx, case PLUS): When seeing if negative of constant + ! is around, make sure not dealing with largest negative. + ! + ! Sun Apr 20 10:46:24 1997 Richard Kenner + ! + ! * fold-const.c (operand_equal_p): Constants are not equal if there + ! has been an overflow. + ! + ! Sun Apr 20 10:45:35 1997 Richard Kenner + ! + ! * final.c (profile_function): Only call ASM_OUTPUT_REG_{PUSH,POP} + ! if defined. + ! + ! Wed Apr 16 22:26:16 1997 Craig Burley + ! + ! * alias.c, cse.c, loop.c, rtl.c, rtl.h, sched.c: + ! Make changes submitted by . + ! + ! Wed Apr 16 16:54:18 1997 Richard Kenner + ! + ! * function.c (find_temp_slot_from_address): Compare slots using + ! rtx_equal_p, not identity comparison. + ! * expr.c (store_expr): Check if TEMP and TARGET are the + ! same using rtx_equal_p. + ! + ! Tue Apr 15 18:03:58 1997 Richard Kenner + ! + ! * rs6000.c (rs6000_output_load_toc_table): New function. + ! (output_prolog): Delete code from here and call new function. + ! * rs6000.md (nonlocal_goto_receiver): New pattern. + ! + ! * expr.c (expand_assignment, store_field): Use copy_rtx when + ! need to copy rtx instead of change_address. + ! (expand_expr, case CONSTRUCTOR, COMPONENT_REF): Likewise. + ! + ! Sun Apr 13 19:32:53 1997 Craig Burley + ! + ! * fold-const.c (fold): If extra warnings enabled, + ! warn about integer division by zero. + ! + ! Sun Apr 13 08:15:31 1997 Bernd Schmidt + ! + ! * final.c (profile_function): Save the static chain register + ! around the call to the profiler function. + ! + ! Sat Apr 12 14:56:42 1997 Craig Burley + ! + ! * unroll.c (find_splittable_givs): Permit more cases + ! of mult_val/add_val to agree by using rtx_equal_p + ! to compare them instead of requiring them to be + ! integers with the same value. Also don't bother + ! checking if ADDRESS_COST not defined (they will be + ! equal in that case). + ! + ! Fri Apr 11 03:30:04 1997 Craig Burley + ! + ! * unroll.c (find_splittable_givs): Must create a new + ! register if the mult_val and add_val fields don't + ! agree. + ! + ! Fri Apr 4 23:00:55 1997 Craig Burley + ! + ! * fold-const.c (fold): Don't call multiple_of_p if + ! arg1 is constant zero, to avoid crashing; simplify + ! code accordingly. + ! + ! Mon Mar 24 22:33:40 1997 Dave Love + ! + ! * config/i386/i386.h (STACK_BOUNDARY): Define as BIGGEST_ALIGNMENT + ! so that -malign-double works for stack-allocated data. + ! + ! Wed Mar 19 12:24:11 1997 Jim Wilson + ! + ! * combine.c (move_deaths): Handle partial REG_DEAD note for + ! multi-reg hard register. + ! + ! Mon Mar 17 17:03:55 1997 J.T. Conklin + ! + ! * m68k.md (beq0_di, bne0_di, bge0_di, blt0_di): Use cmpw #0 + ! instead of tstl when testing address registers on the 68000. + ! + ! Sun Mar 16 19:53:13 1997 Richard Kenner + ! + ! * expr.c (expand_expr, case PLACEHOLDER_EXPR): Refine which + ! object is picked. + ! + ! Mon Mar 10 16:01:44 1997 Richard Kenner + ! + ! * emit-rtl.c (subreg_lowpart_p): Return 0 if SUBREG_REG is VOIDmode. + ! * combine.c (simplify_rtx, case SUBREG): Fix direction of test when + ! calling operand_subword; use inline code intead of subreg_lowpart_p. + ! + ! Wed Feb 26 13:09:33 1997 Michael Meissner + ! + ! * reload.c (debug_reload): Fix format string to print + ! reload_nocombine[r]. + ! + ! Sun Feb 23 15:26:53 1997 Craig Burley + ! + ! * fold-const.c (multiple_of_p): Clean up and improve. + ! (fold): Clean up invocation of multiple_of_p. + ! + ! Sun Feb 9 14:03:53 1997 Richard Kenner (kenner@vlsi1.ultra.nyu.edu) + ! + ! * function.c (assign_stack_temp): Clear MEM flags from reuse. + ! + ! Sat Feb 8 04:53:27 1997 Craig Burley + ! + ! From Fri, 07 Feb 1997 22:02:21 -0500: + ! * alias.c (init_alias_analysis): Reduce amount of time + ! needed to simplify the reg_base_value array in the + ! typical case (especially involving function inlining). + ! + ! Fri Feb 7 07:56:12 1997 Richard Kenner (kenner@vlsi1.ultra.nyu.edu) + ! + ! * function.c (instantiate_virtual_regs_1, case USE, CLOBBER): + ! Fix error in last change. + ! + ! Sat Feb 1 18:51:47 1997 Douglas B. Rupp (rupp@gnat.com) + ! + ! * gcc.c (process_command): Fix improper use of strncpy. + + Tue Jan 29 02:47:13 1997 Richard Stallman + *************** Tue Jan 29 02:47:13 1997 Richard Stallm + *** 109,112 **** + --- 450,532 ---- + [! LIBC_VERSION_1] (LIB_SPEC): New override definition. + + + Tue Jan 21 16:09:37 1997 Richard Kenner (kenner@vlsi1.ultra.nyu.edu) + + + + * function.c (mark_all_temps_used): Set KEEP as well. + + + + Fri Jan 10 17:22:17 1997 Craig Burley + + + + Minor improvements/fixes to better alias handling: + + * Makefile.in (alias.o): Fix typo in rule (was RLT_H). + + * cse.c, sched.c: Fix up some indenting. + + * toplev.c: Add -fargument-alias flag, so Fortran users + + can turn C-style aliasing on once g77 defaults to + + -fargument-noalias-global. + + + + Integrate patch for better alias handling from + + John Carr : + + * Makefile.in (OBJS, alias.o): New module and rule. + + * alias.c: New source module. + + * calls.c (expand_call): Recognize alias status of calls + + to malloc(). + + * combine.c (distribute_notes): New REG_NOALIAS note. + + * rtl.h (REG_NOALIAS): Ditto. + + Many other changes for new alias.c module. + + * cse.c: Many changes, and much code moved into alias.c. + + * flags.h (flag_alias_check, flag_argument_noalias): + + New flags. + + * toplev.c: New flags and related options. + + * local-alloc.c (validate_equiv_mem_from_store): + + Caller of true_dependence changed. + + * loop.c (NUM_STORES): Increase to 50 from 20. + + (prescan_loop): "const" functions don't alter unknown addresses. + + (invariant_p): Caller of true_dependence changed. + + (record_giv): Zero new unrolled and shared flags. + + (emit_iv_add_mult): Record base value for register. + + * sched.c: Many changes, mostly moving code to alias.c. + + (sched_note_set): SCHED_SORT macro def form, but not function, + + inexplicably changed. + + * unroll.c: Record base values for registers, etc. + + + + Fri Jan 3 04:01:00 1997 Craig Burley + + + + * loop.c (check_final_value): Handle insns with no luid's + + appropriately, instead of crashing on INSN_LUID macro + + invocations. + + + + Mon Dec 23 00:49:19 1996 Craig Burley + + + + * config/alpha/alpha.md: Fix pattern that matches if_then_else + + involving DF target, DF comparison, SF source. + + + + Fri Dec 20 15:42:52 1996 Craig Burley + + + + * fold-const.c (multiple_of_p): New function. + + (fold): Use new function to turn *_DIV_EXPR into EXACT_DIV_EXPR. + + + + Tue Nov 26 14:50:54 1996 Richard Kenner (kenner@vlsi1.ultra.nyu.edu) + + + + * expr.c (move_by_pieces): Abort only if length positive at end. + + + + Tue Oct 22 18:32:20 1996 Jim Wilson + + + + * unroll.c (unroll_loop): Always reject loops with unbalanced blocks. + + + + Tue Sep 24 19:37:00 1996 Jim Wilson + + + + * reload.c (push_secondary_reload): Do strip paradoxical SUBREG + + even if reload_class is CLASS_CANNOT_CHANGE_SIZE. Change reload_mode + + to mode in SECONDARY_MEMORY_NEEDED and get_secondary_mem calls. + + + + Mon Aug 12 07:48:54 1996 Richard Kenner (kenner@vlsi1.ultra.nyu.edu) + + + + * expr.c (expand_builtin, case BUILT_IN_SETJMP): Add test + + and call for nonlocal_goto_receiver pattern. + + * stmt.c (expand_end_bindings): Likewise. + + + + Mon Aug 5 16:53:36 1996 Doug Evans + + + + * stor-layout.c (layout_record): Correct overflow test for 0 sized + + fields. + + + Sat Jun 29 12:33:39 1996 Richard Kenner + + *************** Tue Jun 11 20:18:03 1996 Per Bothner + + + + * unroll.c (copy_loop_body): When update split DEST_ADDR giv, + + check to make sure it was split. + + (find_splittable_givs): Fix reversed test of verify_addresses result. + + + Fri May 10 18:35:00 1996 Richard Kenner (kenner@vlsi1.ultra.nyu.edu) + + *************** Wed Apr 17 17:53:23 1996 Michael Meissn + *** 136,139 **** + --- 566,597 ---- + bits. + + + Tue Apr 16 16:59:49 1996 Richard Henderson + + + + * function.c (expand_function_end): Allow TRAMPOLINE_TEMPLATE + + to be omitted on systems for which it is not cost effective. + + * varasm.c (assemble_trampoline_template): No such function + + if no TRAMPOLINE_TEMPLATE. + + * m68k.h: Greatly simplify the run-time trampoline code: + + (TRAMPOLINE_TEMPLATE, TRANSFER_FROM_TRAMPOLINE): Delete define. + + (TRAMPOLINE_SIZE, INITIALIZE_TRAMPOLINE): Changed. + + (TRAMPOLINE_ALIGN): No point aligning to cache line. + + (FINISH_INIT_TRAMPOLINE): New define. + + * m68k/next.h: Instead of redefining INITIALIZE_TRAMPOLINE, + + make use of the new FINISH_INIT_TRAMPOLINE. + + * m68k/{m68k.h,next.h} (FINISH_INIT_TRAMPOLINE): + + Rename to FINALIZE_TRAMPOLINE. + + + + Mon Apr 15 08:49:20 1996 Tom May (ftom@netcom.com) + + + + * cse.c (invalidate_skipped_set): Ignore CLOBBER after calling + + note_mem_written, not before. + + + + Sat Apr 13 07:47:09 1996 Richard Kenner (kenner@vlsi1.ultra.nyu.edu) + + + + * alpha.c (alpha_emit_set_const_1): Renamed from + + alpha_emit_set_const and static. + + Remove change of Nov 26; again use normal mechanism for SImode. + + (alpha_emit_set_const): New function. + + + Mon Apr 8 13:46:28 1996 Michael Meissner + + *************** Mon Feb 19 07:35:07 1996 Torbjorn Granl + *** 176,179 **** + --- 634,642 ---- + * rs6000.md (not:SI with assign and compare): Fix typo. + + + Tue Feb 13 17:43:46 1996 Jim Wilson + + + + * integrate.c (save_constants_in_decl_trees): New function. + + (save_for_inline_copying, save_for_inline_nocopy): Call it. + + + Wed Jan 24 18:00:12 1996 Brendan Kehoe + + *************** Tue Jan 16 06:01:28 1996 Thomas Graiche + *** 191,198 **** + --- 654,686 ---- + * i386/freebsd.h (ASM_WEAKEN_LABEL): Deleted; not supported. + + + Mon Jan 15 07:22:59 1996 Michel Delval (mfd@ccv.fr) + + + + * reload.c (find_equiv_reg): Apply single_set, not PATTERN, to WHERE. + + + Sun Jan 7 17:11:11 1996 David Edelsohn + + * collect2.c (scan_libraries): Correct Import File ID interpretation. + + + Sat Jan 6 03:27:49 1996 Hans-Peter Nilsson + + + + * expr.c (emit_move_insn_1): Don't emit lobber when moving + + by parts and source equals destination. + + + + Sat Jan 6 03:27:49 1996 Hans-Peter Nilsson + + + + * optabs.c (expand_fix): Don't copy TARGET to TO if same. + + + + Mon Jan 1 09:05:07 1996 Richard Kenner (kenner@vlsi1.ultra.nyu.edu) + + + + * local-alloc.c (reg_equiv_replacement): New variable. + + (memref_referenced_p, case REG): Check for reg_equiv_replacement. + + (update_equiv_regs): reg_equiv_replacement now file-scope. + + + + Fri Dec 22 17:29:42 1995 Richard Kenner (kenner@vlsi1.ultra.nyu.edu) + + + + * reload.c (find_valid_class): New function. + + (push_reload): Use it in cases where a SUBREG and its contents + + both need to be reloaded. + + + Thu Dec 28 22:24:53 1995 Michael Meissner + + *************** Mon Dec 18 18:40:34 1995 Jim Wilson + + + + * rs6000/rs6000.c (input_operand): Allow any integer constant, not + + just integers that fit in 1 instruction. + + Sun Nov 26 14:47:42 1995 Richard Kenner + diff -rcp2N gcc-2.7.2.3/Makefile.in gcc-2.7.2.3.f.1/Makefile.in + *** gcc-2.7.2.3/Makefile.in Sun Aug 31 09:39:41 1997 + --- gcc-2.7.2.3.f.1/Makefile.in Sun Aug 31 09:29:51 1997 + *************** all: all.indirect + *** 397,401 **** + ####cross overrides + ####build overrides + ! + # Now figure out from those variables how to compile and link. + + --- 397,401 ---- + ####cross overrides + ####build overrides + ! # + # Now figure out from those variables how to compile and link. + + *************** INCLUDES = -I. -I$(srcdir) -I$(srcdir)/c + *** 454,458 **** + # defined in this file into the environment. + .NOEXPORT: + ! + # Support for additional languages (other than c and objc). + # ??? objc can be supported this way too (leave for later). + --- 454,458 ---- + # defined in this file into the environment. + .NOEXPORT: + ! # + # Support for additional languages (other than c and objc). + # ??? objc can be supported this way too (leave for later). + *************** FLAGS_TO_PASS = \ + *** 491,495 **** + "bindir=$(bindir)" \ + "libsubdir=$(libsubdir)" + ! + # Lists of files for various purposes. + + --- 491,495 ---- + "bindir=$(bindir)" \ + "libsubdir=$(libsubdir)" + ! # + # Lists of files for various purposes. + + *************** OBJS = toplev.o version.o tree.o print-t + *** 519,523 **** + integrate.o jump.o cse.o loop.o unroll.o flow.o stupid.o combine.o \ + regclass.o local-alloc.o global.o reload.o reload1.o caller-save.o \ + ! insn-peep.o reorg.o sched.o final.o recog.o reg-stack.o \ + insn-opinit.o insn-recog.o insn-extract.o insn-output.o insn-emit.o \ + insn-attrtab.o $(out_object_file) getpwd.o convert.o $(EXTRA_OBJS) + --- 519,523 ---- + integrate.o jump.o cse.o loop.o unroll.o flow.o stupid.o combine.o \ + regclass.o local-alloc.o global.o reload.o reload1.o caller-save.o \ + ! insn-peep.o reorg.o alias.o sched.o final.o recog.o reg-stack.o \ + insn-opinit.o insn-recog.o insn-extract.o insn-output.o insn-emit.o \ + insn-attrtab.o $(out_object_file) getpwd.o convert.o $(EXTRA_OBJS) + *************** LIB2FUNCS = _muldi3 _divdi3 _moddi3 _udi + *** 570,574 **** + _fixxfdi _fixunsxfdi _floatdixf _fixunsxfsi \ + _fixtfdi _fixunstfdi _floatditf \ + ! __gcc_bcmp _varargs _eprintf _op_new _op_vnew _new_handler _op_delete \ + _op_vdel _bb _shtab _clear_cache _trampoline __main _exit _ctors _eh \ + _pure + --- 570,575 ---- + _fixxfdi _fixunsxfdi _floatdixf _fixunsxfsi \ + _fixtfdi _fixunstfdi _floatditf \ + ! __gcc_bcmp _varargs __dummy _eprintf \ + ! _op_new _op_vnew _new_handler _op_delete \ + _op_vdel _bb _shtab _clear_cache _trampoline __main _exit _ctors _eh \ + _pure + *************** RTL_H = rtl.h rtl.def machmode.h machmod + *** 585,589 **** + TREE_H = tree.h real.h tree.def machmode.h machmode.def + BYTECODE_H = bytecode.h bc-emit.h bc-optab.h + ! + # Language makefile fragments. + + --- 586,590 ---- + TREE_H = tree.h real.h tree.def machmode.h machmode.def + BYTECODE_H = bytecode.h bc-emit.h bc-optab.h + ! # + # Language makefile fragments. + + *************** BYTECODE_H = bytecode.h bc-emit.h bc-opt + *** 607,611 **** + + # End of language makefile fragments. + ! + # Avoid a lot of time thinking about remaking Makefile.in and *.def. + .SUFFIXES: .in .def + --- 608,612 ---- + + # End of language makefile fragments. + ! # + # Avoid a lot of time thinking about remaking Makefile.in and *.def. + .SUFFIXES: .in .def + *************** xlimits.h: glimits.h limitx.h limity.h + *** 730,734 **** + fi + mv tmp-xlimits.h xlimits.h + ! + # Build libgcc.a. + # This is done in two parts because some functions, in libgcc1.c, + --- 731,735 ---- + fi + mv tmp-xlimits.h xlimits.h + ! # + # Build libgcc.a. + # This is done in two parts because some functions, in libgcc1.c, + *************** stamp-crtS: stamp-crt crtstuff.c $(GCC_P + *** 1042,1046 **** + mv crtstuff$(objext) crtendS$(objext) + touch stamp-crtS + ! + # Compiling object files from source files. + + --- 1043,1047 ---- + mv crtstuff$(objext) crtendS$(objext) + touch stamp-crtS + ! # + # Compiling object files from source files. + + *************** expr.o : expr.c $(CONFIG_H) $(RTL_H) $(T + *** 1179,1183 **** + insn-flags.h insn-codes.h expr.h insn-config.h recog.h output.h \ + typeclass.h bytecode.h bc-opcode.h bc-typecd.h bc-typecd.def bc-optab.h \ + ! bc-emit.h modemap.def + calls.o : calls.c $(CONFIG_H) $(RTL_H) $(TREE_H) flags.h expr.h insn-codes.h \ + insn-flags.h + --- 1180,1184 ---- + insn-flags.h insn-codes.h expr.h insn-config.h recog.h output.h \ + typeclass.h bytecode.h bc-opcode.h bc-typecd.h bc-typecd.def bc-optab.h \ + ! bc-emit.h modemap.def hard-reg-set.h + calls.o : calls.c $(CONFIG_H) $(RTL_H) $(TREE_H) flags.h expr.h insn-codes.h \ + insn-flags.h + *************** reorg.o : reorg.c $(CONFIG_H) $(RTL_H) c + *** 1238,1241 **** + --- 1239,1243 ---- + basic-block.h regs.h insn-config.h insn-attr.h insn-flags.h recog.h \ + flags.h output.h + + alias.o : $(CONFIG_H) $(RTL_H) flags.h hard-reg-set.h regs.h + sched.o : sched.c $(CONFIG_H) $(RTL_H) basic-block.h regs.h hard-reg-set.h \ + flags.h insn-config.h insn-attr.h + *************** alloca.o: alloca.c + *** 1275,1279 **** + -c `echo $(srcdir)/alloca.c | sed 's,^\./,,'` + $(ALLOCA_FINISH) + ! + # Generate header and source files from the machine description, + # and compile them. + --- 1277,1281 ---- + -c `echo $(srcdir)/alloca.c | sed 's,^\./,,'` + $(ALLOCA_FINISH) + ! # + # Generate header and source files from the machine description, + # and compile them. + *************** stamp-output : $(md_file) genoutput $(sr + *** 1400,1404 **** + $(srcdir)/move-if-change tmp-output.c insn-output.c + touch stamp-output + ! + # Compile the programs that generate insn-* from the machine description. + # They are compiled with $(HOST_CC), and associated libraries, + --- 1402,1406 ---- + $(srcdir)/move-if-change tmp-output.c insn-output.c + touch stamp-output + ! # + # Compile the programs that generate insn-* from the machine description. + # They are compiled with $(HOST_CC), and associated libraries, + *************** genoutput : genoutput.o $(HOST_RTL) $(HO + *** 1493,1497 **** + genoutput.o : genoutput.c $(RTL_H) $(build_xm_file) + $(HOST_CC) -c $(HOST_CFLAGS) $(HOST_CPPFLAGS) $(INCLUDES) $(srcdir)/genoutput.c + ! + # Compile the libraries to be used by gen*. + # If we are not cross-building, gen* use the same .o's that cc1 will use, + --- 1495,1499 ---- + genoutput.o : genoutput.c $(RTL_H) $(build_xm_file) + $(HOST_CC) -c $(HOST_CFLAGS) $(HOST_CPPFLAGS) $(INCLUDES) $(srcdir)/genoutput.c + ! # + # Compile the libraries to be used by gen*. + # If we are not cross-building, gen* use the same .o's that cc1 will use, + *************** $(HOST_PREFIX_1)malloc.o: malloc.c + *** 1532,1536 **** + $(HOST_PREFIX_1): + touch $(HOST_PREFIX_1) + ! + # Remake bytecode files. + BI_OBJ=bi-parser.o bi-lexer.o bi-reverse.o + --- 1534,1538 ---- + $(HOST_PREFIX_1): + touch $(HOST_PREFIX_1) + ! # + # Remake bytecode files. + BI_OBJ=bi-parser.o bi-lexer.o bi-reverse.o + *************** bytecode.maintainer-clean: bytecode.clea + *** 1601,1605 **** + -rm -f bi-parser.c bi-parser.h + + ! + # Remake cpp and protoize. + + --- 1603,1607 ---- + -rm -f bi-parser.c bi-parser.h + + ! # + # Remake cpp and protoize. + + *************** test-protoize-simple: ./protoize ./unpro + *** 1724,1728 **** + diff $(srcdir)/protoize.c tmp-proto.c | cat + -rm -f tmp-proto.[cs] tmp-proto$(objext) + ! + # Build the include directory. The stamp files are stmp-* rather than + # stamp-* so that mostlyclean does not force the include directory to + --- 1726,1730 ---- + diff $(srcdir)/protoize.c tmp-proto.c | cat + -rm -f tmp-proto.[cs] tmp-proto$(objext) + ! # + # Build the include directory. The stamp files are stmp-* rather than + # stamp-* so that mostlyclean does not force the include directory to + *************** stmp-fixproto: fixhdr.ready fixproto stm + *** 1862,1866 **** + fi + touch stmp-fixproto + ! + # Remake the info files. + + --- 1864,1868 ---- + fi + touch stmp-fixproto + ! # + # Remake the info files. + + *************** $(srcdir)/INSTALL: install1.texi install + *** 1889,1893 **** + cd $(srcdir); $(MAKEINFO) -D INSTALLONLY --no-header \ + --no-split install1.texi -o INSTALL + ! + # Deletion of files made during compilation. + # There are four levels of this: + --- 1891,1895 ---- + cd $(srcdir); $(MAKEINFO) -D INSTALLONLY --no-header \ + --no-split install1.texi -o INSTALL + ! # + # Deletion of files made during compilation. + # There are four levels of this: + *************** maintainer-clean: distclean bytecode.mai + *** 2010,2014 **** + -rm -f cpp.info* cpp.??s cpp.*aux + -rm -f gcc.info* gcc.??s gcc.*aux + ! + # Entry points `install' and `uninstall'. + # Also use `install-collect2' to install collect2 when the config files don't. + --- 2012,2016 ---- + -rm -f cpp.info* cpp.??s cpp.*aux + -rm -f gcc.info* gcc.??s gcc.*aux + ! # + # Entry points `install' and `uninstall'. + # Also use `install-collect2' to install collect2 when the config files don't. + *************** uninstall: lang.uninstall + *** 2256,2260 **** + -rm -rf $(mandir)/protoize$(manext) + -rm -rf $(mandir)/unprotoize$(manext) + ! + # These exist for maintenance purposes. + + --- 2258,2262 ---- + -rm -rf $(mandir)/protoize$(manext) + -rm -rf $(mandir)/unprotoize$(manext) + ! # + # These exist for maintenance purposes. + + diff -rcp2N gcc-2.7.2.3/alias.c gcc-2.7.2.3.f.1/alias.c + *** gcc-2.7.2.3/alias.c Thu Jan 1 00:00:00 1970 + --- gcc-2.7.2.3.f.1/alias.c Tue Sep 9 04:23:32 1997 + *************** + *** 0 **** + --- 1,1004 ---- + + /* Alias analysis for GNU C, by John Carr (jfc@mit.edu). + + Derived in part from sched.c */ + + #include "config.h" + + #include "rtl.h" + + #include "expr.h" + + #include "regs.h" + + #include "hard-reg-set.h" + + #include "flags.h" + + + + static rtx canon_rtx PROTO((rtx)); + + static int rtx_equal_for_memref_p PROTO((rtx, rtx)); + + static rtx find_symbolic_term PROTO((rtx)); + + static int memrefs_conflict_p PROTO((int, rtx, int, rtx, + + HOST_WIDE_INT)); + + + + /* Set up all info needed to perform alias analysis on memory references. */ + + + + #define SIZE_FOR_MODE(X) (GET_MODE_SIZE (GET_MODE (X))) + + + + /* reg_base_value[N] gives an address to which register N is related. + + If all sets after the first add or subtract to the current value + + or otherwise modify it so it does not point to a different top level + + object, reg_base_value[N] is equal to the address part of the source + + of the first set. The value will be a SYMBOL_REF, a LABEL_REF, or + + (address (reg)) to indicate that the address is derived from an + + argument or fixed register. */ + + rtx *reg_base_value; + + unsigned int reg_base_value_size; /* size of reg_base_value array */ + + #define REG_BASE_VALUE(X) \ + + (REGNO (X) < reg_base_value_size ? reg_base_value[REGNO (X)] : 0) + + + + /* Vector indexed by N giving the initial (unchanging) value known + + for pseudo-register N. */ + + rtx *reg_known_value; + + + + /* Indicates number of valid entries in reg_known_value. */ + + static int reg_known_value_size; + + + + /* Vector recording for each reg_known_value whether it is due to a + + REG_EQUIV note. Future passes (viz., reload) may replace the + + pseudo with the equivalent expression and so we account for the + + dependences that would be introduced if that happens. */ + + /* ??? This is a problem only on the Convex. The REG_EQUIV notes created in + + assign_parms mention the arg pointer, and there are explicit insns in the + + RTL that modify the arg pointer. Thus we must ensure that such insns don't + + get scheduled across each other because that would invalidate the REG_EQUIV + + notes. One could argue that the REG_EQUIV notes are wrong, but solving + + the problem in the scheduler will likely give better code, so we do it + + here. */ + + char *reg_known_equiv_p; + + + + /* Inside SRC, the source of a SET, find a base address. */ + + + + /* When copying arguments into pseudo-registers, record the (ADDRESS) + + expression for the argument directly so that even if the argument + + register is changed later (e.g. for a function call) the original + + value is noted. */ + + static int copying_arguments; + + + + static rtx + + find_base_value (src) + + register rtx src; + + { + + switch (GET_CODE (src)) + + { + + case SYMBOL_REF: + + case LABEL_REF: + + return src; + + + + case REG: + + if (copying_arguments && REGNO (src) < FIRST_PSEUDO_REGISTER) + + return reg_base_value[REGNO (src)]; + + return src; + + + + case MEM: + + /* Check for an argument passed in memory. Only record in the + + copying-arguments block; it is too hard to track changes + + otherwise. */ + + if (copying_arguments + + && (XEXP (src, 0) == arg_pointer_rtx + + || (GET_CODE (XEXP (src, 0)) == PLUS + + && XEXP (XEXP (src, 0), 0) == arg_pointer_rtx))) + + return gen_rtx (ADDRESS, VOIDmode, src); + + return 0; + + + + case CONST: + + src = XEXP (src, 0); + + if (GET_CODE (src) != PLUS && GET_CODE (src) != MINUS) + + break; + + /* fall through */ + + case PLUS: + + case MINUS: + + /* Guess which operand to set the register equivalent to. */ + + /* If the first operand is a symbol or the second operand is + + an integer, the first operand is the base address. */ + + if (GET_CODE (XEXP (src, 0)) == SYMBOL_REF + + || GET_CODE (XEXP (src, 0)) == LABEL_REF + + || GET_CODE (XEXP (src, 1)) == CONST_INT) + + return XEXP (src, 0); + + /* If an operand is a register marked as a pointer, it is the base. */ + + if (GET_CODE (XEXP (src, 0)) == REG + + && REGNO_POINTER_FLAG (REGNO (XEXP (src, 0)))) + + src = XEXP (src, 0); + + else if (GET_CODE (XEXP (src, 1)) == REG + + && REGNO_POINTER_FLAG (REGNO (XEXP (src, 1)))) + + src = XEXP (src, 1); + + else + + return 0; + + if (copying_arguments && REGNO (src) < FIRST_PSEUDO_REGISTER) + + return reg_base_value[REGNO (src)]; + + return src; + + + + case AND: + + /* If the second operand is constant set the base + + address to the first operand. */ + + if (GET_CODE (XEXP (src, 1)) == CONST_INT + + && GET_CODE (XEXP (src, 0)) == REG) + + { + + src = XEXP (src, 0); + + if (copying_arguments && REGNO (src) < FIRST_PSEUDO_REGISTER) + + return reg_base_value[REGNO (src)]; + + return src; + + } + + return 0; + + + + case HIGH: + + return XEXP (src, 0); + + } + + + + return 0; + + } + + + + /* Called from init_alias_analysis indirectly through note_stores. */ + + + + /* while scanning insns to find base values, reg_seen[N] is nonzero if + + register N has been set in this function. */ + + static char *reg_seen; + + + + static + + void record_set (dest, set) + + rtx dest, set; + + { + + register int regno; + + rtx src; + + + + if (GET_CODE (dest) != REG) + + return; + + + + regno = REGNO (dest); + + + + if (set) + + { + + /* A CLOBBER wipes out any old value but does not prevent a previously + + unset register from acquiring a base address (i.e. reg_seen is not + + set). */ + + if (GET_CODE (set) == CLOBBER) + + { + + reg_base_value[regno] = 0; + + return; + + } + + src = SET_SRC (set); + + } + + else + + { + + static int unique_id; + + if (reg_seen[regno]) + + { + + reg_base_value[regno] = 0; + + return; + + } + + reg_seen[regno] = 1; + + reg_base_value[regno] = gen_rtx (ADDRESS, Pmode, + + GEN_INT (unique_id++)); + + return; + + } + + + + /* This is not the first set. If the new value is not related to the + + old value, forget the base value. Note that the following code is + + not detected: + + extern int x, y; int *p = &x; p += (&y-&x); + + ANSI C does not allow computing the difference of addresses + + of distinct top level objects. */ + + if (reg_base_value[regno]) + + switch (GET_CODE (src)) + + { + + case PLUS: + + case MINUS: + + if (XEXP (src, 0) != dest && XEXP (src, 1) != dest) + + reg_base_value[regno] = 0; + + break; + + case AND: + + if (XEXP (src, 0) != dest || GET_CODE (XEXP (src, 1)) != CONST_INT) + + reg_base_value[regno] = 0; + + break; + + case LO_SUM: + + if (XEXP (src, 0) != dest) + + reg_base_value[regno] = 0; + + break; + + default: + + reg_base_value[regno] = 0; + + break; + + } + + /* If this is the first set of a register, record the value. */ + + else if ((regno >= FIRST_PSEUDO_REGISTER || ! fixed_regs[regno]) + + && ! reg_seen[regno] && reg_base_value[regno] == 0) + + reg_base_value[regno] = find_base_value (src); + + + + reg_seen[regno] = 1; + + } + + + + /* Called from loop optimization when a new pseudo-register is created. */ + + void + + record_base_value (regno, val) + + int regno; + + rtx val; + + { + + if (!flag_alias_check || regno >= reg_base_value_size) + + return; + + if (GET_CODE (val) == REG) + + { + + if (REGNO (val) < reg_base_value_size) + + reg_base_value[regno] = reg_base_value[REGNO (val)]; + + return; + + } + + reg_base_value[regno] = find_base_value (val); + + } + + + + static rtx + + canon_rtx (x) + + rtx x; + + { + + /* Recursively look for equivalences. */ + + if (GET_CODE (x) == REG && REGNO (x) >= FIRST_PSEUDO_REGISTER + + && REGNO (x) < reg_known_value_size) + + return reg_known_value[REGNO (x)] == x + + ? x : canon_rtx (reg_known_value[REGNO (x)]); + + else if (GET_CODE (x) == PLUS) + + { + + rtx x0 = canon_rtx (XEXP (x, 0)); + + rtx x1 = canon_rtx (XEXP (x, 1)); + + + + if (x0 != XEXP (x, 0) || x1 != XEXP (x, 1)) + + { + + /* We can tolerate LO_SUMs being offset here; these + + rtl are used for nothing other than comparisons. */ + + if (GET_CODE (x0) == CONST_INT) + + return plus_constant_for_output (x1, INTVAL (x0)); + + else if (GET_CODE (x1) == CONST_INT) + + return plus_constant_for_output (x0, INTVAL (x1)); + + return gen_rtx (PLUS, GET_MODE (x), x0, x1); + + } + + } + + /* This gives us much better alias analysis when called from + + the loop optimizer. Note we want to leave the original + + MEM alone, but need to return the canonicalized MEM with + + all the flags with their original values. */ + + else if (GET_CODE (x) == MEM) + + { + + rtx addr = canon_rtx (XEXP (x, 0)); + + if (addr != XEXP (x, 0)) + + { + + rtx new = gen_rtx (MEM, GET_MODE (x), addr); + + MEM_VOLATILE_P (new) = MEM_VOLATILE_P (x); + + RTX_UNCHANGING_P (new) = RTX_UNCHANGING_P (x); + + MEM_IN_STRUCT_P (new) = MEM_IN_STRUCT_P (x); + + x = new; + + } + + } + + return x; + + } + + + + /* Return 1 if X and Y are identical-looking rtx's. + + + + We use the data in reg_known_value above to see if two registers with + + different numbers are, in fact, equivalent. */ + + + + static int + + rtx_equal_for_memref_p (x, y) + + rtx x, y; + + { + + register int i; + + register int j; + + register enum rtx_code code; + + register char *fmt; + + + + if (x == 0 && y == 0) + + return 1; + + if (x == 0 || y == 0) + + return 0; + + x = canon_rtx (x); + + y = canon_rtx (y); + + + + if (x == y) + + return 1; + + + + code = GET_CODE (x); + + /* Rtx's of different codes cannot be equal. */ + + if (code != GET_CODE (y)) + + return 0; + + + + /* (MULT:SI x y) and (MULT:HI x y) are NOT equivalent. + + (REG:SI x) and (REG:HI x) are NOT equivalent. */ + + + + if (GET_MODE (x) != GET_MODE (y)) + + return 0; + + + + /* REG, LABEL_REF, and SYMBOL_REF can be compared nonrecursively. */ + + + + if (code == REG) + + return REGNO (x) == REGNO (y); + + if (code == LABEL_REF) + + return XEXP (x, 0) == XEXP (y, 0); + + if (code == SYMBOL_REF) + + return XSTR (x, 0) == XSTR (y, 0); + + + + /* For commutative operations, the RTX match if the operand match in any + + order. Also handle the simple binary and unary cases without a loop. */ + + if (code == EQ || code == NE || GET_RTX_CLASS (code) == 'c') + + return ((rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)) + + && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1))) + + || (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 1)) + + && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 0)))); + + else if (GET_RTX_CLASS (code) == '<' || GET_RTX_CLASS (code) == '2') + + return (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)) + + && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1))); + + else if (GET_RTX_CLASS (code) == '1') + + return rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)); + + + + /* Compare the elements. If any pair of corresponding elements + + fail to match, return 0 for the whole things. */ + + + + fmt = GET_RTX_FORMAT (code); + + for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--) + + { + + switch (fmt[i]) + + { + + case 'w': + + if (XWINT (x, i) != XWINT (y, i)) + + return 0; + + break; + + + + case 'n': + + case 'i': + + if (XINT (x, i) != XINT (y, i)) + + return 0; + + break; + + + + case 'V': + + case 'E': + + /* Two vectors must have the same length. */ + + if (XVECLEN (x, i) != XVECLEN (y, i)) + + return 0; + + + + /* And the corresponding elements must match. */ + + for (j = 0; j < XVECLEN (x, i); j++) + + if (rtx_equal_for_memref_p (XVECEXP (x, i, j), XVECEXP (y, i, j)) == 0) + + return 0; + + break; + + + + case 'e': + + if (rtx_equal_for_memref_p (XEXP (x, i), XEXP (y, i)) == 0) + + return 0; + + break; + + + + case 'S': + + case 's': + + if (strcmp (XSTR (x, i), XSTR (y, i))) + + return 0; + + break; + + + + case 'u': + + /* These are just backpointers, so they don't matter. */ + + break; + + + + case '0': + + break; + + + + /* It is believed that rtx's at this level will never + + contain anything but integers and other rtx's, + + except for within LABEL_REFs and SYMBOL_REFs. */ + + default: + + abort (); + + } + + } + + return 1; + + } + + + + /* Given an rtx X, find a SYMBOL_REF or LABEL_REF within + + X and return it, or return 0 if none found. */ + + + + static rtx + + find_symbolic_term (x) + + rtx x; + + { + + register int i; + + register enum rtx_code code; + + register char *fmt; + + + + code = GET_CODE (x); + + if (code == SYMBOL_REF || code == LABEL_REF) + + return x; + + if (GET_RTX_CLASS (code) == 'o') + + return 0; + + + + fmt = GET_RTX_FORMAT (code); + + for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--) + + { + + rtx t; + + + + if (fmt[i] == 'e') + + { + + t = find_symbolic_term (XEXP (x, i)); + + if (t != 0) + + return t; + + } + + else if (fmt[i] == 'E') + + break; + + } + + return 0; + + } + + + + static rtx + + find_base_term (x) + + register rtx x; + + { + + switch (GET_CODE (x)) + + { + + case REG: + + return REG_BASE_VALUE (x); + + + + case HIGH: + + return find_base_term (XEXP (x, 0)); + + + + case CONST: + + x = XEXP (x, 0); + + if (GET_CODE (x) != PLUS && GET_CODE (x) != MINUS) + + return 0; + + /* fall through */ + + case LO_SUM: + + case PLUS: + + case MINUS: + + { + + rtx tmp = find_base_term (XEXP (x, 0)); + + if (tmp) + + return tmp; + + return find_base_term (XEXP (x, 1)); + + } + + + + case AND: + + if (GET_CODE (XEXP (x, 0)) == REG && GET_CODE (XEXP (x, 1)) == CONST_INT) + + return REG_BASE_VALUE (XEXP (x, 0)); + + return 0; + + + + case SYMBOL_REF: + + case LABEL_REF: + + return x; + + + + default: + + return 0; + + } + + } + + + + /* Return 0 if the addresses X and Y are known to point to different + + objects, 1 if they might be pointers to the same object. */ + + + + static int + + base_alias_check (x, y) + + rtx x, y; + + { + + rtx x_base = find_base_term (x); + + rtx y_base = find_base_term (y); + + + + /* If either base address is unknown or the base addresses are equal, + + nothing is known about aliasing. */ + + + + if (x_base == 0 || y_base == 0 || rtx_equal_p (x_base, y_base)) + + return 1; + + + + /* The base addresses of the read and write are different + + expressions. If they are both symbols there is no + + conflict. */ + + if (GET_CODE (x_base) != ADDRESS && GET_CODE (y_base) != ADDRESS) + + return 0; + + + + /* If one address is a stack reference there can be no alias: + + stack references using different base registers do not alias, + + a stack reference can not alias a parameter, and a stack reference + + can not alias a global. */ + + if ((GET_CODE (x_base) == ADDRESS && GET_MODE (x_base) == Pmode) + + || (GET_CODE (y_base) == ADDRESS && GET_MODE (y_base) == Pmode)) + + return 0; + + + + if (! flag_argument_noalias) + + return 1; + + + + if (flag_argument_noalias > 1) + + return 0; + + + + /* Weak noalias assertion (arguments are distinct, but may match globals). */ + + return ! (GET_MODE (x_base) == VOIDmode && GET_MODE (y_base) == VOIDmode); + + } + + + + /* Return nonzero if X and Y (memory addresses) could reference the + + same location in memory. C is an offset accumulator. When + + C is nonzero, we are testing aliases between X and Y + C. + + XSIZE is the size in bytes of the X reference, + + similarly YSIZE is the size in bytes for Y. + + + + If XSIZE or YSIZE is zero, we do not know the amount of memory being + + referenced (the reference was BLKmode), so make the most pessimistic + + assumptions. + + + + We recognize the following cases of non-conflicting memory: + + + + (1) addresses involving the frame pointer cannot conflict + + with addresses involving static variables. + + (2) static variables with different addresses cannot conflict. + + + + Nice to notice that varying addresses cannot conflict with fp if no + + local variables had their addresses taken, but that's too hard now. */ + + + + + + static int + + memrefs_conflict_p (xsize, x, ysize, y, c) + + register rtx x, y; + + int xsize, ysize; + + HOST_WIDE_INT c; + + { + + if (GET_CODE (x) == HIGH) + + x = XEXP (x, 0); + + else if (GET_CODE (x) == LO_SUM) + + x = XEXP (x, 1); + + else + + x = canon_rtx (x); + + if (GET_CODE (y) == HIGH) + + y = XEXP (y, 0); + + else if (GET_CODE (y) == LO_SUM) + + y = XEXP (y, 1); + + else + + y = canon_rtx (y); + + + + if (rtx_equal_for_memref_p (x, y)) + + { + + if (xsize == 0 || ysize == 0) + + return 1; + + if (c >= 0 && xsize > c) + + return 1; + + if (c < 0 && ysize+c > 0) + + return 1; + + return 0; + + } + + + + if (y == frame_pointer_rtx || y == hard_frame_pointer_rtx + + || y == stack_pointer_rtx) + + { + + rtx t = y; + + int tsize = ysize; + + y = x; ysize = xsize; + + x = t; xsize = tsize; + + } + + + + if (x == frame_pointer_rtx || x == hard_frame_pointer_rtx + + || x == stack_pointer_rtx) + + { + + rtx y1; + + + + if (CONSTANT_P (y)) + + return 0; + + + + if (GET_CODE (y) == PLUS + + && canon_rtx (XEXP (y, 0)) == x + + && (y1 = canon_rtx (XEXP (y, 1))) + + && GET_CODE (y1) == CONST_INT) + + { + + c += INTVAL (y1); + + return (xsize == 0 || ysize == 0 + + || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); + + } + + + + if (GET_CODE (y) == PLUS + + && (y1 = canon_rtx (XEXP (y, 0))) + + && CONSTANT_P (y1)) + + return 0; + + + + return 1; + + } + + + + if (GET_CODE (x) == PLUS) + + { + + /* The fact that X is canonicalized means that this + + PLUS rtx is canonicalized. */ + + rtx x0 = XEXP (x, 0); + + rtx x1 = XEXP (x, 1); + + + + if (GET_CODE (y) == PLUS) + + { + + /* The fact that Y is canonicalized means that this + + PLUS rtx is canonicalized. */ + + rtx y0 = XEXP (y, 0); + + rtx y1 = XEXP (y, 1); + + + + if (rtx_equal_for_memref_p (x1, y1)) + + return memrefs_conflict_p (xsize, x0, ysize, y0, c); + + if (rtx_equal_for_memref_p (x0, y0)) + + return memrefs_conflict_p (xsize, x1, ysize, y1, c); + + if (GET_CODE (x1) == CONST_INT) + + if (GET_CODE (y1) == CONST_INT) + + return memrefs_conflict_p (xsize, x0, ysize, y0, + + c - INTVAL (x1) + INTVAL (y1)); + + else + + return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1)); + + else if (GET_CODE (y1) == CONST_INT) + + return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1)); + + + + /* Handle case where we cannot understand iteration operators, + + but we notice that the base addresses are distinct objects. */ + + /* ??? Is this still necessary? */ + + x = find_symbolic_term (x); + + if (x == 0) + + return 1; + + y = find_symbolic_term (y); + + if (y == 0) + + return 1; + + return rtx_equal_for_memref_p (x, y); + + } + + else if (GET_CODE (x1) == CONST_INT) + + return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1)); + + } + + else if (GET_CODE (y) == PLUS) + + { + + /* The fact that Y is canonicalized means that this + + PLUS rtx is canonicalized. */ + + rtx y0 = XEXP (y, 0); + + rtx y1 = XEXP (y, 1); + + + + if (GET_CODE (y1) == CONST_INT) + + return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1)); + + else + + return 1; + + } + + + + if (GET_CODE (x) == GET_CODE (y)) + + switch (GET_CODE (x)) + + { + + case MULT: + + { + + /* Handle cases where we expect the second operands to be the + + same, and check only whether the first operand would conflict + + or not. */ + + rtx x0, y0; + + rtx x1 = canon_rtx (XEXP (x, 1)); + + rtx y1 = canon_rtx (XEXP (y, 1)); + + if (! rtx_equal_for_memref_p (x1, y1)) + + return 1; + + x0 = canon_rtx (XEXP (x, 0)); + + y0 = canon_rtx (XEXP (y, 0)); + + if (rtx_equal_for_memref_p (x0, y0)) + + return (xsize == 0 || ysize == 0 + + || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); + + + + /* Can't properly adjust our sizes. */ + + if (GET_CODE (x1) != CONST_INT) + + return 1; + + xsize /= INTVAL (x1); + + ysize /= INTVAL (x1); + + c /= INTVAL (x1); + + return memrefs_conflict_p (xsize, x0, ysize, y0, c); + + } + + } + + + + /* Treat an access through an AND (e.g. a subword access on an Alpha) + + as an access with indeterminate size. */ + + if (GET_CODE (x) == AND && GET_CODE (XEXP (x, 1)) == CONST_INT) + + return memrefs_conflict_p (0, XEXP (x, 0), ysize, y, c); + + if (GET_CODE (y) == AND && GET_CODE (XEXP (y, 1)) == CONST_INT) + + return memrefs_conflict_p (xsize, x, 0, XEXP (y, 0), c); + + + + if (CONSTANT_P (x)) + + { + + if (GET_CODE (x) == CONST_INT && GET_CODE (y) == CONST_INT) + + { + + c += (INTVAL (y) - INTVAL (x)); + + return (xsize == 0 || ysize == 0 + + || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); + + } + + + + if (GET_CODE (x) == CONST) + + { + + if (GET_CODE (y) == CONST) + + return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)), + + ysize, canon_rtx (XEXP (y, 0)), c); + + else + + return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)), + + ysize, y, c); + + } + + if (GET_CODE (y) == CONST) + + return memrefs_conflict_p (xsize, x, ysize, + + canon_rtx (XEXP (y, 0)), c); + + + + if (CONSTANT_P (y)) + + return (rtx_equal_for_memref_p (x, y) + + && (xsize == 0 || ysize == 0 + + || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0))); + + + + return 1; + + } + + return 1; + + } + + + + /* Functions to compute memory dependencies. + + + + Since we process the insns in execution order, we can build tables + + to keep track of what registers are fixed (and not aliased), what registers + + are varying in known ways, and what registers are varying in unknown + + ways. + + + + If both memory references are volatile, then there must always be a + + dependence between the two references, since their order can not be + + changed. A volatile and non-volatile reference can be interchanged + + though. + + + + A MEM_IN_STRUCT reference at a non-QImode non-AND varying address can never + + conflict with a non-MEM_IN_STRUCT reference at a fixed address. We must + + allow QImode aliasing because the ANSI C standard allows character + + pointers to alias anything. We are assuming that characters are + + always QImode here. We also must allow AND addresses, because they may + + generate accesses outside the object being referenced. This is used to + + generate aligned addresses from unaligned addresses, for instance, the + + alpha storeqi_unaligned pattern. */ + + + + /* Read dependence: X is read after read in MEM takes place. There can + + only be a dependence here if both reads are volatile. */ + + + + int + + read_dependence (mem, x) + + rtx mem; + + rtx x; + + { + + return MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem); + + } + + + + /* True dependence: X is read after store in MEM takes place. */ + + + + int + + true_dependence (mem, mem_mode, x, varies) + + rtx mem; + + enum machine_mode mem_mode; + + rtx x; + + int (*varies)(); + + { + + rtx x_addr, mem_addr; + + + + if (MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) + + return 1; + + + + x_addr = XEXP (x, 0); + + mem_addr = XEXP (mem, 0); + + + + if (flag_alias_check && ! base_alias_check (x_addr, mem_addr)) + + return 0; + + + + /* If X is an unchanging read, then it can't possibly conflict with any + + non-unchanging store. It may conflict with an unchanging write though, + + because there may be a single store to this address to initialize it. + + Just fall through to the code below to resolve the case where we have + + both an unchanging read and an unchanging write. This won't handle all + + cases optimally, but the possible performance loss should be + + negligible. */ + + if (RTX_UNCHANGING_P (x) && ! RTX_UNCHANGING_P (mem)) + + return 0; + + + + x_addr = canon_rtx (x_addr); + + mem_addr = canon_rtx (mem_addr); + + if (mem_mode == VOIDmode) + + mem_mode = GET_MODE (mem); + + + + if (! memrefs_conflict_p (mem_mode, mem_addr, SIZE_FOR_MODE (x), x_addr, 0)) + + return 0; + + + + /* If both references are struct references, or both are not, nothing + + is known about aliasing. + + + + If either reference is QImode or BLKmode, ANSI C permits aliasing. + + + + If both addresses are constant, or both are not, nothing is known + + about aliasing. */ + + if (MEM_IN_STRUCT_P (x) == MEM_IN_STRUCT_P (mem) + + || mem_mode == QImode || mem_mode == BLKmode + + || GET_MODE (x) == QImode || GET_MODE (x) == BLKmode + + || GET_CODE (x_addr) == AND || GET_CODE (mem_addr) == AND + + || varies (x_addr) == varies (mem_addr)) + + return 1; + + + + /* One memory reference is to a constant address, one is not. + + One is to a structure, the other is not. + + + + If either memory reference is a variable structure the other is a + + fixed scalar and there is no aliasing. */ + + if ((MEM_IN_STRUCT_P (mem) && varies (mem_addr)) + + || (MEM_IN_STRUCT_P (x) && varies (x_addr))) + + return 0; + + + + return 1; + + } + + + + /* Anti dependence: X is written after read in MEM takes place. */ + + + + int + + anti_dependence (mem, x) + + rtx mem; + + rtx x; + + { + + if (MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) + + return 1; + + + + if (flag_alias_check && ! base_alias_check (XEXP (x, 0), XEXP (mem, 0))) + + return 0; + + + + /* If MEM is an unchanging read, then it can't possibly conflict with + + the store to X, because there is at most one store to MEM, and it must + + have occurred somewhere before MEM. */ + + x = canon_rtx (x); + + mem = canon_rtx (mem); + + if (RTX_UNCHANGING_P (mem)) + + return 0; + + + + return (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0), + + SIZE_FOR_MODE (x), XEXP (x, 0), 0) + + && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem) + + && GET_MODE (mem) != QImode + + && GET_CODE (XEXP (mem, 0)) != AND + + && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x)) + + && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x) + + && GET_MODE (x) != QImode + + && GET_CODE (XEXP (x, 0)) != AND + + && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem))); + + } + + + + /* Output dependence: X is written after store in MEM takes place. */ + + + + int + + output_dependence (mem, x) + + register rtx mem; + + register rtx x; + + { + + if (MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) + + return 1; + + + + if (flag_alias_check && !base_alias_check (XEXP (x, 0), XEXP (mem, 0))) + + return 0; + + + + x = canon_rtx (x); + + mem = canon_rtx (mem); + + return (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0), + + SIZE_FOR_MODE (x), XEXP (x, 0), 0) + + && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem) + + && GET_MODE (mem) != QImode + + && GET_CODE (XEXP (mem, 0)) != AND + + && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x)) + + && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x) + + && GET_MODE (x) != QImode + + && GET_CODE (XEXP (x, 0)) != AND + + && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem))); + + } + + + + void + + init_alias_analysis () + + { + + int maxreg = max_reg_num (); + + int changed; + + register int i; + + register rtx insn; + + rtx note; + + rtx set; + + + + reg_known_value_size = maxreg; + + + + reg_known_value + + = (rtx *) oballoc ((maxreg - FIRST_PSEUDO_REGISTER) * sizeof (rtx)) + + - FIRST_PSEUDO_REGISTER; + + reg_known_equiv_p = + + oballoc (maxreg - FIRST_PSEUDO_REGISTER) - FIRST_PSEUDO_REGISTER; + + bzero ((char *) (reg_known_value + FIRST_PSEUDO_REGISTER), + + (maxreg-FIRST_PSEUDO_REGISTER) * sizeof (rtx)); + + bzero (reg_known_equiv_p + FIRST_PSEUDO_REGISTER, + + (maxreg - FIRST_PSEUDO_REGISTER) * sizeof (char)); + + + + if (flag_alias_check) + + { + + /* Overallocate reg_base_value to allow some growth during loop + + optimization. Loop unrolling can create a large number of + + registers. */ + + reg_base_value_size = maxreg * 2; + + reg_base_value = (rtx *)oballoc (reg_base_value_size * sizeof (rtx)); + + reg_seen = (char *)alloca (reg_base_value_size); + + bzero (reg_base_value, reg_base_value_size * sizeof (rtx)); + + bzero (reg_seen, reg_base_value_size); + + + + /* Mark all hard registers which may contain an address. + + The stack, frame and argument pointers may contain an address. + + An argument register which can hold a Pmode value may contain + + an address even if it is not in BASE_REGS. + + + + The address expression is VOIDmode for an argument and + + Pmode for other registers. */ + + #ifndef OUTGOING_REGNO + + #define OUTGOING_REGNO(N) N + + #endif + + for (i = 0; i < FIRST_PSEUDO_REGISTER; i++) + + /* Check whether this register can hold an incoming pointer + + argument. FUNCTION_ARG_REGNO_P tests outgoing register + + numbers, so translate if necessary due to register windows. */ + + if (FUNCTION_ARG_REGNO_P (OUTGOING_REGNO (i)) && HARD_REGNO_MODE_OK (i, Pmode)) + + reg_base_value[i] = gen_rtx (ADDRESS, VOIDmode, + + gen_rtx (REG, Pmode, i)); + + + + reg_base_value[STACK_POINTER_REGNUM] + + = gen_rtx (ADDRESS, Pmode, stack_pointer_rtx); + + reg_base_value[ARG_POINTER_REGNUM] + + = gen_rtx (ADDRESS, Pmode, arg_pointer_rtx); + + reg_base_value[FRAME_POINTER_REGNUM] + + = gen_rtx (ADDRESS, Pmode, frame_pointer_rtx); + + reg_base_value[HARD_FRAME_POINTER_REGNUM] + + = gen_rtx (ADDRESS, Pmode, hard_frame_pointer_rtx); + + } + + + + copying_arguments = 1; + + /* Fill in the entries with known constant values. */ + + for (insn = get_insns (); insn; insn = NEXT_INSN (insn)) + + { + + if (flag_alias_check && GET_RTX_CLASS (GET_CODE (insn)) == 'i') + + { + + /* If this insn has a noalias note, process it, Otherwise, + + scan for sets. A simple set will have no side effects + + which could change the base value of any other register. */ + + rtx noalias_note; + + if (GET_CODE (PATTERN (insn)) == SET + + && (noalias_note = find_reg_note (insn, REG_NOALIAS, NULL_RTX))) + + record_set (SET_DEST (PATTERN (insn)), 0); + + else + + note_stores (PATTERN (insn), record_set); + + } + + else if (GET_CODE (insn) == NOTE + + && NOTE_LINE_NUMBER (insn) == NOTE_INSN_FUNCTION_BEG) + + copying_arguments = 0; + + + + if ((set = single_set (insn)) != 0 + + && GET_CODE (SET_DEST (set)) == REG + + && REGNO (SET_DEST (set)) >= FIRST_PSEUDO_REGISTER + + && (((note = find_reg_note (insn, REG_EQUAL, 0)) != 0 + + && reg_n_sets[REGNO (SET_DEST (set))] == 1) + + || (note = find_reg_note (insn, REG_EQUIV, NULL_RTX)) != 0) + + && GET_CODE (XEXP (note, 0)) != EXPR_LIST) + + { + + int regno = REGNO (SET_DEST (set)); + + reg_known_value[regno] = XEXP (note, 0); + + reg_known_equiv_p[regno] = REG_NOTE_KIND (note) == REG_EQUIV; + + } + + } + + + + /* Fill in the remaining entries. */ + + for (i = FIRST_PSEUDO_REGISTER; i < maxreg; i++) + + if (reg_known_value[i] == 0) + + reg_known_value[i] = regno_reg_rtx[i]; + + + + if (! flag_alias_check) + + return; + + + + /* Simplify the reg_base_value array so that no register refers to + + another register, except to special registers indirectly through + + ADDRESS expressions. + + + + In theory this loop can take as long as O(registers^2), but unless + + there are very long dependency chains it will run in close to linear + + time. */ + + do + + { + + changed = 0; + + for (i = FIRST_PSEUDO_REGISTER; i < reg_base_value_size; i++) + + { + + rtx base = reg_base_value[i]; + + if (base && GET_CODE (base) == REG) + + { + + int base_regno = REGNO (base); + + if (base_regno == i) /* register set from itself */ + + reg_base_value[i] = 0; + + else + + reg_base_value[i] = reg_base_value[base_regno]; + + changed = 1; + + } + + } + + } + + while (changed); + + + + reg_seen = 0; + + } + + + + void + + end_alias_analysis () + + { + + reg_known_value = 0; + + reg_base_value = 0; + + reg_base_value_size = 0; + + } + diff -rcp2N gcc-2.7.2.3/c-decl.c gcc-2.7.2.3.f.1/c-decl.c + *** gcc-2.7.2.3/c-decl.c Fri Oct 27 09:44:43 1995 + --- gcc-2.7.2.3.f.1/c-decl.c Sun Aug 10 22:46:24 1997 + *************** init_decl_processing () + *** 3207,3210 **** + --- 3207,3223 ---- + builtin_function ("__builtin_cosl", ldouble_ftype_ldouble, + BUILT_IN_COS, "cosl"); + + builtin_function ("__builtin_setjmp", + + build_function_type (integer_type_node, + + tree_cons (NULL_TREE, + + ptr_type_node, endlink)), + + BUILT_IN_SETJMP, NULL_PTR); + + builtin_function ("__builtin_longjmp", + + build_function_type + + (void_type_node, + + tree_cons (NULL, ptr_type_node, + + tree_cons (NULL_TREE, + + integer_type_node, + + endlink))), + + BUILT_IN_LONGJMP, NULL_PTR); + + /* In an ANSI C program, it is okay to supply built-in meanings + *************** grokdeclarator (declarator, declspecs, d + *** 4049,4052 **** + --- 4062,4066 ---- + int volatilep; + int inlinep; + + int restrictp; + int explicit_int = 0; + int explicit_char = 0; + *************** grokdeclarator (declarator, declspecs, d + *** 4342,4349 **** + --- 4356,4366 ---- + volatilep = !! (specbits & 1 << (int) RID_VOLATILE) + TYPE_VOLATILE (type); + inlinep = !! (specbits & (1 << (int) RID_INLINE)); + + restrictp = !! (specbits & (1 << (int) RID_RESTRICT)); + if (constp > 1) + pedwarn ("duplicate `const'"); + if (volatilep > 1) + pedwarn ("duplicate `volatile'"); + + if (restrictp) + + error ("`restrict' used in non-parameter or non-pointer type declaration"); + if (! flag_gen_aux_info && (TYPE_READONLY (type) || TYPE_VOLATILE (type))) + type = TYPE_MAIN_VARIANT (type); + *************** grokdeclarator (declarator, declspecs, d + *** 4693,4696 **** + --- 4710,4715 ---- + else if (TREE_VALUE (typemodlist) == ridpointers[(int) RID_VOLATILE]) + volatilep++; + + else if (TREE_VALUE (typemodlist) == ridpointers[(int) RID_RESTRICT]) + + restrictp++; + else if (!erred) + { + *************** grokdeclarator (declarator, declspecs, d + *** 4703,4706 **** + --- 4722,4727 ---- + if (volatilep > 1) + pedwarn ("duplicate `volatile'"); + + if (restrictp > 1) + + pedwarn ("duplicate `restrict'"); + } + + *************** grokdeclarator (declarator, declspecs, d + *** 4844,4847 **** + --- 4865,4875 ---- + } + + + if (restrictp) + + { + + if (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE) + + error ("`restrict' applied to non-pointer"); + + DECL_RESTRICT (decl) = 1; + + } + + + DECL_ARG_TYPE_AS_WRITTEN (decl) = type_as_written; + } + *************** start_struct (code, name) + *** 5365,5368 **** + --- 5393,5397 ---- + pushtag (name, ref); + C_TYPE_BEING_DEFINED (ref) = 1; + + TYPE_PACKED (ref) = flag_pack_struct; + return ref; + } + *************** start_enum (name) + *** 5806,5809 **** + --- 5835,5841 ---- + enum_overflow = 0; + + + if (flag_short_enums) + + TYPE_PACKED (enumtype) = 1; + + + return enumtype; + } + *************** finish_enum (enumtype, values, attribute + *** 5862,5867 **** + precision = MAX (lowprec, highprec); + + ! if (flag_short_enums || TYPE_PACKED (enumtype) + ! || precision > TYPE_PRECISION (integer_type_node)) + /* Use the width of the narrowest normal C type which is wide enough. */ + TYPE_PRECISION (enumtype) = TYPE_PRECISION (type_for_size (precision, 1)); + --- 5894,5898 ---- + precision = MAX (lowprec, highprec); + + ! if (TYPE_PACKED (enumtype) || precision > TYPE_PRECISION (integer_type_node)) + /* Use the width of the narrowest normal C type which is wide enough. */ + TYPE_PRECISION (enumtype) = TYPE_PRECISION (type_for_size (precision, 1)); + diff -rcp2N gcc-2.7.2.3/c-gperf.h gcc-2.7.2.3.f.1/c-gperf.h + *** gcc-2.7.2.3/c-gperf.h Fri Mar 4 19:15:53 1994 + --- gcc-2.7.2.3.f.1/c-gperf.h Mon Aug 11 06:58:47 1997 + *************** + *** 1,15 **** + /* C code produced by gperf version 2.5 (GNU C++ version) */ + ! /* Command-line: gperf -p -j1 -i 1 -g -o -t -G -N is_reserved_word -k1,3,$ c-parse.gperf */ + struct resword { char *name; short token; enum rid rid; }; + + ! #define TOTAL_KEYWORDS 79 + #define MIN_WORD_LENGTH 2 + #define MAX_WORD_LENGTH 20 + ! #define MIN_HASH_VALUE 10 + ! #define MAX_HASH_VALUE 144 + ! /* maximum key range = 135, duplicates = 0 */ + + #ifdef __GNUC__ + ! __inline + #endif + static unsigned int + --- 1,16 ---- + /* C code produced by gperf version 2.5 (GNU C++ version) */ + ! /* Command-line: gperf -p -j1 -i 1 -g -o -t -G -N is_reserved_word -k1,3,$ ../g77-new/c-parse.gperf */ + ! /* Command-line: gperf -p -j1 -i 1 -g -o -t -N is_reserved_word -k1,3,$ c-parse.gperf */ + struct resword { char *name; short token; enum rid rid; }; + + ! #define TOTAL_KEYWORDS 81 + #define MIN_WORD_LENGTH 2 + #define MAX_WORD_LENGTH 20 + ! #define MIN_HASH_VALUE 11 + ! #define MAX_HASH_VALUE 157 + ! /* maximum key range = 147, duplicates = 0 */ + + #ifdef __GNUC__ + ! inline + #endif + static unsigned int + *************** hash (str, len) + *** 20,36 **** + static unsigned char asso_values[] = + { + ! 145, 145, 145, 145, 145, 145, 145, 145, 145, 145, + ! 145, 145, 145, 145, 145, 145, 145, 145, 145, 145, + ! 145, 145, 145, 145, 145, 145, 145, 145, 145, 145, + ! 145, 145, 145, 145, 145, 145, 145, 145, 145, 145, + ! 145, 145, 145, 145, 145, 145, 145, 145, 145, 145, + ! 145, 145, 145, 145, 145, 145, 145, 145, 145, 145, + ! 145, 145, 145, 145, 25, 145, 145, 145, 145, 145, + ! 145, 145, 145, 145, 145, 145, 145, 145, 145, 145, + ! 145, 145, 145, 145, 145, 145, 145, 145, 145, 145, + ! 145, 145, 145, 145, 145, 1, 145, 46, 8, 15, + ! 61, 6, 36, 48, 3, 5, 145, 18, 63, 25, + ! 29, 76, 1, 145, 13, 2, 1, 51, 37, 9, + ! 9, 1, 3, 145, 145, 145, 145, 145, + }; + register int hval = len; + --- 21,37 ---- + static unsigned char asso_values[] = + { + ! 158, 158, 158, 158, 158, 158, 158, 158, 158, 158, + ! 158, 158, 158, 158, 158, 158, 158, 158, 158, 158, + ! 158, 158, 158, 158, 158, 158, 158, 158, 158, 158, + ! 158, 158, 158, 158, 158, 158, 158, 158, 158, 158, + ! 158, 158, 158, 158, 158, 158, 158, 158, 158, 158, + ! 158, 158, 158, 158, 158, 158, 158, 158, 158, 158, + ! 158, 158, 158, 158, 2, 158, 158, 158, 158, 158, + ! 158, 158, 158, 158, 158, 158, 158, 158, 158, 158, + ! 158, 158, 158, 158, 158, 158, 158, 158, 158, 158, + ! 158, 158, 158, 158, 158, 1, 158, 18, 1, 58, + ! 56, 6, 44, 64, 13, 45, 158, 4, 26, 68, + ! 2, 74, 1, 158, 2, 13, 1, 33, 48, 5, + ! 5, 3, 12, 158, 158, 158, 158, 158, + }; + register int hval = len; + *************** hash (str, len) + *** 44,47 **** + --- 45,49 ---- + case 1: + hval += asso_values[str[0]]; + + break; + } + return hval + asso_values[str[len - 1]]; + *************** hash (str, len) + *** 50,166 **** + static struct resword wordlist[] = + { + ! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, + ! {"",}, + ! {"int", TYPESPEC, RID_INT}, + ! {"",}, {"",}, + ! {"__typeof__", TYPEOF, NORID}, + ! {"__signed__", TYPESPEC, RID_SIGNED}, + ! {"__imag__", IMAGPART, NORID}, + ! {"switch", SWITCH, NORID}, + ! {"__inline__", SCSPEC, RID_INLINE}, + ! {"else", ELSE, NORID}, + ! {"__iterator__", SCSPEC, RID_ITERATOR}, + ! {"__inline", SCSPEC, RID_INLINE}, + ! {"__extension__", EXTENSION, NORID}, + ! {"struct", STRUCT, NORID}, + ! {"__real__", REALPART, NORID}, + ! {"__const", TYPE_QUAL, RID_CONST}, + ! {"while", WHILE, NORID}, + ! {"__const__", TYPE_QUAL, RID_CONST}, + ! {"case", CASE, NORID}, + ! {"__complex__", TYPESPEC, RID_COMPLEX}, + ! {"__iterator", SCSPEC, RID_ITERATOR}, + ! {"bycopy", TYPE_QUAL, RID_BYCOPY}, + ! {"",}, {"",}, {"",}, + ! {"__complex", TYPESPEC, RID_COMPLEX}, + ! {"",}, + ! {"in", TYPE_QUAL, RID_IN}, + ! {"break", BREAK, NORID}, + ! {"@defs", DEFS, NORID}, + ! {"",}, {"",}, {"",}, + ! {"extern", SCSPEC, RID_EXTERN}, + ! {"if", IF, NORID}, + ! {"typeof", TYPEOF, NORID}, + ! {"typedef", SCSPEC, RID_TYPEDEF}, + ! {"__typeof", TYPEOF, NORID}, + ! {"sizeof", SIZEOF, NORID}, + ! {"",}, + ! {"return", RETURN, NORID}, + ! {"const", TYPE_QUAL, RID_CONST}, + ! {"__volatile__", TYPE_QUAL, RID_VOLATILE}, + ! {"@private", PRIVATE, NORID}, + ! {"@selector", SELECTOR, NORID}, + ! {"__volatile", TYPE_QUAL, RID_VOLATILE}, + ! {"__asm__", ASM_KEYWORD, NORID}, + ! {"",}, {"",}, + ! {"continue", CONTINUE, NORID}, + ! {"__alignof__", ALIGNOF, NORID}, + ! {"__imag", IMAGPART, NORID}, + ! {"__attribute__", ATTRIBUTE, NORID}, + ! {"",}, {"",}, + ! {"__attribute", ATTRIBUTE, NORID}, + ! {"for", FOR, NORID}, + ! {"",}, + ! {"@encode", ENCODE, NORID}, + ! {"id", OBJECTNAME, RID_ID}, + ! {"static", SCSPEC, RID_STATIC}, + ! {"@interface", INTERFACE, NORID}, + ! {"",}, + ! {"__signed", TYPESPEC, RID_SIGNED}, + ! {"",}, + ! {"__label__", LABEL, NORID}, + ! {"",}, {"",}, + ! {"__asm", ASM_KEYWORD, NORID}, + ! {"char", TYPESPEC, RID_CHAR}, + ! {"",}, + ! {"inline", SCSPEC, RID_INLINE}, + ! {"out", TYPE_QUAL, RID_OUT}, + ! {"register", SCSPEC, RID_REGISTER}, + ! {"__real", REALPART, NORID}, + ! {"short", TYPESPEC, RID_SHORT}, + ! {"",}, + ! {"enum", ENUM, NORID}, + ! {"inout", TYPE_QUAL, RID_INOUT}, + ! {"",}, + ! {"oneway", TYPE_QUAL, RID_ONEWAY}, + ! {"union", UNION, NORID}, + ! {"",}, + ! {"__alignof", ALIGNOF, NORID}, + ! {"",}, + ! {"@implementation", IMPLEMENTATION, NORID}, + ! {"",}, + ! {"@class", CLASS, NORID}, + ! {"",}, + ! {"@public", PUBLIC, NORID}, + ! {"asm", ASM_KEYWORD, NORID}, + ! {"",}, {"",}, {"",}, {"",}, {"",}, + ! {"default", DEFAULT, NORID}, + ! {"",}, + ! {"void", TYPESPEC, RID_VOID}, + ! {"",}, + ! {"@protected", PROTECTED, NORID}, + ! {"@protocol", PROTOCOL, NORID}, + ! {"",}, {"",}, {"",}, + ! {"volatile", TYPE_QUAL, RID_VOLATILE}, + ! {"",}, {"",}, + ! {"signed", TYPESPEC, RID_SIGNED}, + ! {"float", TYPESPEC, RID_FLOAT}, + ! {"@end", END, NORID}, + ! {"",}, {"",}, + ! {"unsigned", TYPESPEC, RID_UNSIGNED}, + ! {"@compatibility_alias", ALIAS, NORID}, + ! {"double", TYPESPEC, RID_DOUBLE}, + ! {"",}, {"",}, + ! {"auto", SCSPEC, RID_AUTO}, + ! {"",}, + ! {"goto", GOTO, NORID}, + ! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, + ! {"do", DO, NORID}, + ! {"",}, {"",}, {"",}, {"",}, + ! {"long", TYPESPEC, RID_LONG}, + }; + + #ifdef __GNUC__ + ! __inline + #endif + struct resword * + --- 52,167 ---- + static struct resword wordlist[] = + { + ! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, + ! {"",}, {"",}, + ! {"return", RETURN, NORID}, + ! {"__real__", REALPART, NORID}, + ! {"__typeof__", TYPEOF, NORID}, + ! {"__restrict", TYPE_QUAL, RID_RESTRICT}, + ! {"extern", SCSPEC, RID_EXTERN}, + ! {"break", BREAK, NORID}, + ! {"@encode", ENCODE, NORID}, + ! {"@private", PRIVATE, NORID}, + ! {"@selector", SELECTOR, NORID}, + ! {"@interface", INTERFACE, NORID}, + ! {"__extension__", EXTENSION, NORID}, + ! {"struct", STRUCT, NORID}, + ! {"",}, + ! {"restrict", TYPE_QUAL, RID_RESTRICT}, + ! {"__signed__", TYPESPEC, RID_SIGNED}, + ! {"@defs", DEFS, NORID}, + ! {"__asm__", ASM_KEYWORD, NORID}, + ! {"",}, + ! {"else", ELSE, NORID}, + ! {"",}, + ! {"__alignof__", ALIGNOF, NORID}, + ! {"",}, + ! {"__attribute__", ATTRIBUTE, NORID}, + ! {"",}, + ! {"__real", REALPART, NORID}, + ! {"__attribute", ATTRIBUTE, NORID}, + ! {"__label__", LABEL, NORID}, + ! {"",}, + ! {"@protocol", PROTOCOL, NORID}, + ! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, + ! {"@class", CLASS, NORID}, + ! {"",}, + ! {"in", TYPE_QUAL, RID_IN}, + ! {"int", TYPESPEC, RID_INT}, + ! {"for", FOR, NORID}, + ! {"typeof", TYPEOF, NORID}, + ! {"typedef", SCSPEC, RID_TYPEDEF}, + ! {"__typeof", TYPEOF, NORID}, + ! {"__imag__", IMAGPART, NORID}, + ! {"",}, + ! {"__inline__", SCSPEC, RID_INLINE}, + ! {"__iterator", SCSPEC, RID_ITERATOR}, + ! {"__iterator__", SCSPEC, RID_ITERATOR}, + ! {"__inline", SCSPEC, RID_INLINE}, + ! {"while", WHILE, NORID}, + ! {"__volatile__", TYPE_QUAL, RID_VOLATILE}, + ! {"",}, + ! {"@end", END, NORID}, + ! {"__volatile", TYPE_QUAL, RID_VOLATILE}, + ! {"const", TYPE_QUAL, RID_CONST}, + ! {"__const", TYPE_QUAL, RID_CONST}, + ! {"bycopy", TYPE_QUAL, RID_BYCOPY}, + ! {"__const__", TYPE_QUAL, RID_CONST}, + ! {"@protected", PROTECTED, NORID}, + ! {"__complex__", TYPESPEC, RID_COMPLEX}, + ! {"__alignof", ALIGNOF, NORID}, + ! {"__complex", TYPESPEC, RID_COMPLEX}, + ! {"continue", CONTINUE, NORID}, + ! {"sizeof", SIZEOF, NORID}, + ! {"register", SCSPEC, RID_REGISTER}, + ! {"switch", SWITCH, NORID}, + ! {"__signed", TYPESPEC, RID_SIGNED}, + ! {"out", TYPE_QUAL, RID_OUT}, + ! {"",}, + ! {"case", CASE, NORID}, + ! {"char", TYPESPEC, RID_CHAR}, + ! {"inline", SCSPEC, RID_INLINE}, + ! {"",}, + ! {"union", UNION, NORID}, + ! {"",}, + ! {"@implementation", IMPLEMENTATION, NORID}, + ! {"volatile", TYPE_QUAL, RID_VOLATILE}, + ! {"oneway", TYPE_QUAL, RID_ONEWAY}, + ! {"",}, + ! {"if", IF, NORID}, + ! {"__asm", ASM_KEYWORD, NORID}, + ! {"short", TYPESPEC, RID_SHORT}, + ! {"",}, + ! {"static", SCSPEC, RID_STATIC}, + ! {"long", TYPESPEC, RID_LONG}, + ! {"auto", SCSPEC, RID_AUTO}, + ! {"",}, {"",}, + ! {"@public", PUBLIC, NORID}, + ! {"double", TYPESPEC, RID_DOUBLE}, + ! {"",}, + ! {"id", OBJECTNAME, RID_ID}, + ! {"",}, {"",}, {"",}, {"",}, + ! {"default", DEFAULT, NORID}, + ! {"@compatibility_alias", ALIAS, NORID}, + ! {"unsigned", TYPESPEC, RID_UNSIGNED}, + ! {"enum", ENUM, NORID}, + ! {"",}, {"",}, {"",}, {"",}, + ! {"__imag", IMAGPART, NORID}, + ! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, + ! {"float", TYPESPEC, RID_FLOAT}, + ! {"inout", TYPE_QUAL, RID_INOUT}, + ! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, + ! {"do", DO, NORID}, + ! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, + ! {"signed", TYPESPEC, RID_SIGNED}, + ! {"",}, {"",}, {"",}, + ! {"goto", GOTO, NORID}, + ! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, + ! {"void", TYPESPEC, RID_VOID}, + ! {"",}, {"",}, {"",}, + ! {"asm", ASM_KEYWORD, NORID}, + }; + + #ifdef __GNUC__ + ! inline + #endif + struct resword * + diff -rcp2N gcc-2.7.2.3/c-lex.c gcc-2.7.2.3.f.1/c-lex.c + *** gcc-2.7.2.3/c-lex.c Thu Jun 15 11:11:39 1995 + --- gcc-2.7.2.3.f.1/c-lex.c Sun Aug 10 22:46:49 1997 + *************** init_lex () + *** 173,176 **** + --- 173,177 ---- + ridpointers[(int) RID_CONST] = get_identifier ("const"); + ridpointers[(int) RID_VOLATILE] = get_identifier ("volatile"); + + ridpointers[(int) RID_RESTRICT] = get_identifier ("restrict"); + ridpointers[(int) RID_AUTO] = get_identifier ("auto"); + ridpointers[(int) RID_STATIC] = get_identifier ("static"); + *************** init_lex () + *** 206,209 **** + --- 207,211 ---- + UNSET_RESERVED_WORD ("iterator"); + UNSET_RESERVED_WORD ("complex"); + + UNSET_RESERVED_WORD ("restrict"); + } + if (flag_no_asm) + *************** init_lex () + *** 214,217 **** + --- 216,220 ---- + UNSET_RESERVED_WORD ("iterator"); + UNSET_RESERVED_WORD ("complex"); + + UNSET_RESERVED_WORD ("restrict"); + } + } + *************** yylex () + *** 1433,1437 **** + /* Create a node with determined type and value. */ + if (imag) + ! yylval.ttype = build_complex (convert (type, integer_zero_node), + build_real (type, value)); + else + --- 1436,1441 ---- + /* Create a node with determined type and value. */ + if (imag) + ! yylval.ttype = build_complex (NULL_TREE, + ! convert (type, integer_zero_node), + build_real (type, value)); + else + *************** yylex () + *** 1624,1629 **** + <= TYPE_PRECISION (integer_type_node)) + yylval.ttype + ! = build_complex (integer_zero_node, + ! convert (integer_type_node, yylval.ttype)); + else + error ("complex integer constant is too wide for `complex int'"); + --- 1628,1634 ---- + <= TYPE_PRECISION (integer_type_node)) + yylval.ttype + ! = build_complex (NULL_TREE, integer_zero_node, + ! convert (integer_type_node, + ! yylval.ttype)); + else + error ("complex integer constant is too wide for `complex int'"); + diff -rcp2N gcc-2.7.2.3/c-lex.h gcc-2.7.2.3.f.1/c-lex.h + *** gcc-2.7.2.3/c-lex.h Thu Jun 15 11:12:22 1995 + --- gcc-2.7.2.3.f.1/c-lex.h Sun Aug 10 22:10:55 1997 + *************** enum rid + *** 43,47 **** + RID_VOLATILE, + RID_INLINE, + ! RID_NOALIAS, + RID_ITERATOR, + RID_COMPLEX, + --- 43,47 ---- + RID_VOLATILE, + RID_INLINE, + ! RID_RESTRICT, + RID_ITERATOR, + RID_COMPLEX, + diff -rcp2N gcc-2.7.2.3/c-parse.gperf gcc-2.7.2.3.f.1/c-parse.gperf + *** gcc-2.7.2.3/c-parse.gperf Fri Apr 9 23:00:44 1993 + --- gcc-2.7.2.3.f.1/c-parse.gperf Sun Aug 10 22:10:55 1997 + *************** __label__, LABEL, NORID + *** 36,39 **** + --- 36,40 ---- + __real, REALPART, NORID + __real__, REALPART, NORID + + __restrict, TYPE_QUAL, RID_RESTRICT + __signed, TYPESPEC, RID_SIGNED + __signed__, TYPESPEC, RID_SIGNED + *************** oneway, TYPE_QUAL, RID_ONEWAY + *** 69,72 **** + --- 70,74 ---- + out, TYPE_QUAL, RID_OUT + register, SCSPEC, RID_REGISTER + + restrict, TYPE_QUAL, RID_RESTRICT + return, RETURN, NORID + short, TYPESPEC, RID_SHORT + diff -rcp2N gcc-2.7.2.3/c-typeck.c gcc-2.7.2.3.f.1/c-typeck.c + *** gcc-2.7.2.3/c-typeck.c Sat Jun 29 16:27:15 1996 + --- gcc-2.7.2.3.f.1/c-typeck.c Sun Aug 10 22:46:29 1997 + *************** pointer_int_sum (resultcode, ptrop, into + *** 2681,2686 **** + so the multiply won't overflow spuriously. */ + + ! if (TYPE_PRECISION (TREE_TYPE (intop)) != POINTER_SIZE) + ! intop = convert (type_for_size (POINTER_SIZE, 0), intop); + + /* Replace the integer argument with a suitable product by the object size. + --- 2681,2688 ---- + so the multiply won't overflow spuriously. */ + + ! if (TYPE_PRECISION (TREE_TYPE (intop)) != TYPE_PRECISION (sizetype) + ! || TREE_UNSIGNED (TREE_TYPE (intop)) != TREE_UNSIGNED (sizetype)) + ! intop = convert (type_for_size (TYPE_PRECISION (sizetype), + ! TREE_UNSIGNED (sizetype)), intop); + + /* Replace the integer argument with a suitable product by the object size. + diff -rcp2N gcc-2.7.2.3/calls.c gcc-2.7.2.3.f.1/calls.c + *** gcc-2.7.2.3/calls.c Fri Oct 27 01:53:43 1995 + --- gcc-2.7.2.3.f.1/calls.c Fri Aug 29 07:52:07 1997 + *************** expand_call (exp, target, ignore) + *** 564,567 **** + --- 564,569 ---- + /* Nonzero if it is plausible that this is a call to alloca. */ + int may_be_alloca; + + /* Nonzero if this is a call to malloc or a related function. */ + + int is_malloc; + /* Nonzero if this is a call to setjmp or a related function. */ + int returns_twice; + *************** expand_call (exp, target, ignore) + *** 741,745 **** + if (stack_arg_under_construction || i >= 0) + { + ! rtx insn = NEXT_INSN (before_call), seq; + + /* Look for a call in the inline function code. + --- 743,749 ---- + if (stack_arg_under_construction || i >= 0) + { + ! rtx first_insn + ! = before_call ? NEXT_INSN (before_call) : get_insns (); + ! rtx insn, seq; + + /* Look for a call in the inline function code. + *************** expand_call (exp, target, ignore) + *** 749,753 **** + + if (OUTGOING_ARGS_SIZE (DECL_SAVED_INSNS (fndecl)) == 0) + ! for (; insn; insn = NEXT_INSN (insn)) + if (GET_CODE (insn) == CALL_INSN) + break; + --- 753,757 ---- + + if (OUTGOING_ARGS_SIZE (DECL_SAVED_INSNS (fndecl)) == 0) + ! for (insn = first_insn; insn; insn = NEXT_INSN (insn)) + if (GET_CODE (insn) == CALL_INSN) + break; + *************** expand_call (exp, target, ignore) + *** 781,785 **** + seq = get_insns (); + end_sequence (); + ! emit_insns_before (seq, NEXT_INSN (before_call)); + emit_stack_restore (SAVE_BLOCK, old_stack_level, NULL_RTX); + } + --- 785,789 ---- + seq = get_insns (); + end_sequence (); + ! emit_insns_before (seq, first_insn); + emit_stack_restore (SAVE_BLOCK, old_stack_level, NULL_RTX); + } + *************** expand_call (exp, target, ignore) + *** 852,855 **** + --- 856,860 ---- + returns_twice = 0; + is_longjmp = 0; + + is_malloc = 0; + + if (name != 0 && IDENTIFIER_LENGTH (DECL_NAME (fndecl)) <= 15) + *************** expand_call (exp, target, ignore) + *** 891,894 **** + --- 896,903 ---- + && ! strcmp (tname, "longjmp")) + is_longjmp = 1; + + /* Only recognize malloc when alias analysis is enabled. */ + + else if (tname[0] == 'm' && flag_alias_check + + && ! strcmp(tname, "malloc")) + + is_malloc = 1; + } + + *************** expand_call (exp, target, ignore) + *** 1060,1064 **** + + if (TYPE_SIZE (type) == 0 + ! || TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST) + { + /* This is a variable-sized object. Make space on the stack + --- 1069,1077 ---- + + if (TYPE_SIZE (type) == 0 + ! || TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST + ! || (flag_stack_check && ! STACK_CHECK_BUILTIN + ! && (TREE_INT_CST_HIGH (TYPE_SIZE (type)) != 0 + ! || (TREE_INT_CST_LOW (TYPE_SIZE (type)) + ! > STACK_CHECK_MAX_VAR_SIZE * BITS_PER_UNIT)))) + { + /* This is a variable-sized object. Make space on the stack + *************** expand_call (exp, target, ignore) + *** 1087,1090 **** + --- 1100,1104 ---- + + store_expr (args[i].tree_value, copy, 0); + + is_const = 0; + + args[i].tree_value = build1 (ADDR_EXPR, + *************** expand_call (exp, target, ignore) + *** 1363,1367 **** + /* Now we are about to start emitting insns that can be deleted + if a libcall is deleted. */ + ! if (is_const) + start_sequence (); + + --- 1377,1381 ---- + /* Now we are about to start emitting insns that can be deleted + if a libcall is deleted. */ + ! if (is_const || is_malloc) + start_sequence (); + + *************** expand_call (exp, target, ignore) + *** 1951,1954 **** + --- 1965,1982 ---- + end_sequence (); + emit_insns (insns); + + } + + else if (is_malloc) + + { + + rtx temp = gen_reg_rtx (GET_MODE (valreg)); + + rtx last, insns; + + + + emit_move_insn (temp, valreg); + + last = get_last_insn (); + + REG_NOTES (last) = + + gen_rtx (EXPR_LIST, REG_NOALIAS, temp, REG_NOTES (last)); + + insns = get_insns (); + + end_sequence (); + + emit_insns (insns); + + valreg = temp; + } + + diff -rcp2N gcc-2.7.2.3/cccp.c gcc-2.7.2.3.f.1/cccp.c + *** gcc-2.7.2.3/cccp.c Thu Oct 26 22:07:26 1995 + --- gcc-2.7.2.3.f.1/cccp.c Sun Aug 10 22:45:53 1997 + *************** initialize_builtins (inp, outp) + *** 9626,9629 **** + --- 9626,9630 ---- + so that it is present only when truly compiling with GNU C. */ + /* install ((U_CHAR *) "__GNUC__", -1, T_CONST, "2", -1); */ + + install ((U_CHAR *) "__HAVE_BUILTIN_SETJMP__", -1, T_CONST, "1", -1); + + if (debug_output) + diff -rcp2N gcc-2.7.2.3/combine.c gcc-2.7.2.3.f.1/combine.c + *** gcc-2.7.2.3/combine.c Sun Nov 26 19:32:07 1995 + --- gcc-2.7.2.3.f.1/combine.c Fri Aug 29 07:52:16 1997 + *************** try_combine (i3, i2, i1) + *** 2011,2016 **** + XVECEXP (newpat, 0, 1))) + { + ! newi2pat = XVECEXP (newpat, 0, 1); + ! newpat = XVECEXP (newpat, 0, 0); + + i2_code_number + --- 2011,2029 ---- + XVECEXP (newpat, 0, 1))) + { + ! /* Normally, it doesn't matter which of the two is done first, + ! but it does if one references cc0. In that case, it has to + ! be first. */ + ! #ifdef HAVE_cc0 + ! if (reg_referenced_p (cc0_rtx, XVECEXP (newpat, 0, 0))) + ! { + ! newi2pat = XVECEXP (newpat, 0, 0); + ! newpat = XVECEXP (newpat, 0, 1); + ! } + ! else + ! #endif + ! { + ! newi2pat = XVECEXP (newpat, 0, 1); + ! newpat = XVECEXP (newpat, 0, 0); + ! } + + i2_code_number + *************** simplify_rtx (x, op0_mode, last, in_dest + *** 3278,3282 **** + if (CONSTANT_P (SUBREG_REG (x)) && op0_mode != VOIDmode + && GET_MODE_SIZE (mode) == UNITS_PER_WORD + ! && GET_MODE_SIZE (op0_mode) < UNITS_PER_WORD + && GET_MODE_CLASS (mode) == MODE_INT) + { + --- 3291,3295 ---- + if (CONSTANT_P (SUBREG_REG (x)) && op0_mode != VOIDmode + && GET_MODE_SIZE (mode) == UNITS_PER_WORD + ! && GET_MODE_SIZE (op0_mode) > UNITS_PER_WORD + && GET_MODE_CLASS (mode) == MODE_INT) + { + *************** simplify_rtx (x, op0_mode, last, in_dest + *** 3290,3295 **** + take the low bits. On a little-endian machine, that's + always valid. On a big-endian machine, it's valid + ! only if the constant's mode fits in one word. */ + ! if (CONSTANT_P (SUBREG_REG (x)) && subreg_lowpart_p (x) + && GET_MODE_SIZE (mode) < GET_MODE_SIZE (op0_mode) + && (! WORDS_BIG_ENDIAN + --- 3303,3316 ---- + take the low bits. On a little-endian machine, that's + always valid. On a big-endian machine, it's valid + ! only if the constant's mode fits in one word. Note that we + ! cannot use subreg_lowpart_p since we SUBREG_REG may be VOIDmode. */ + ! if (CONSTANT_P (SUBREG_REG (x)) + ! && ((GET_MODE_SIZE (op0_mode) <= UNITS_PER_WORD + ! || ! WORDS_BIG_ENDIAN) + ! ? SUBREG_WORD (x) == 0 + ! : (SUBREG_WORD (x) + ! == ((GET_MODE_SIZE (op0_mode) + ! - MAX (GET_MODE_SIZE (mode), UNITS_PER_WORD)) + ! / UNITS_PER_WORD))) + && GET_MODE_SIZE (mode) < GET_MODE_SIZE (op0_mode) + && (! WORDS_BIG_ENDIAN + *************** num_sign_bit_copies (x, mode) + *** 7326,7329 **** + --- 7347,7356 ---- + + case NEG: + + while (GET_MODE (XEXP (x, 0)) == GET_MODE (x) + + && GET_CODE (XEXP (x, 0)) == NEG + + && GET_MODE (XEXP (XEXP (x, 0), 0)) == GET_MODE (x) + + && GET_CODE (XEXP (XEXP (x, 0), 0)) == NEG) + + x = XEXP (XEXP (x, 0), 0); /* Speed up 961126-1.c */ + + + /* In general, this subtracts one sign bit copy. But if the value + is known to be positive, the number of sign bit copies is the + *************** move_deaths (x, from_cuid, to_insn, pnot + *** 10421,10425 **** + if (note != 0 && regno < FIRST_PSEUDO_REGISTER + && (GET_MODE_SIZE (GET_MODE (XEXP (note, 0))) + ! != GET_MODE_SIZE (GET_MODE (x)))) + { + int deadregno = REGNO (XEXP (note, 0)); + --- 10448,10452 ---- + if (note != 0 && regno < FIRST_PSEUDO_REGISTER + && (GET_MODE_SIZE (GET_MODE (XEXP (note, 0))) + ! > GET_MODE_SIZE (GET_MODE (x)))) + { + int deadregno = REGNO (XEXP (note, 0)); + *************** move_deaths (x, from_cuid, to_insn, pnot + *** 10437,10452 **** + REG_NOTES (where_dead)); + } + ! /* If we didn't find any note, and we have a multi-reg hard + register, then to be safe we must check for REG_DEAD notes + for each register other than the first. They could have + their own REG_DEAD notes lying around. */ + ! else if (note == 0 && regno < FIRST_PSEUDO_REGISTER + && HARD_REGNO_NREGS (regno, GET_MODE (x)) > 1) + { + int ourend = regno + HARD_REGNO_NREGS (regno, GET_MODE (x)); + ! int i; + rtx oldnotes = 0; + + ! for (i = regno + 1; i < ourend; i++) + move_deaths (gen_rtx (REG, reg_raw_mode[i], i), + from_cuid, to_insn, &oldnotes); + --- 10464,10489 ---- + REG_NOTES (where_dead)); + } + ! /* If we didn't find any note, or if we found a REG_DEAD note that + ! covers only part of the given reg, and we have a multi-reg hard + register, then to be safe we must check for REG_DEAD notes + for each register other than the first. They could have + their own REG_DEAD notes lying around. */ + ! else if ((note == 0 + ! || (note != 0 + ! && (GET_MODE_SIZE (GET_MODE (XEXP (note, 0))) + ! < GET_MODE_SIZE (GET_MODE (x))))) + ! && regno < FIRST_PSEUDO_REGISTER + && HARD_REGNO_NREGS (regno, GET_MODE (x)) > 1) + { + int ourend = regno + HARD_REGNO_NREGS (regno, GET_MODE (x)); + ! int i, offset; + rtx oldnotes = 0; + + ! if (note) + ! offset = HARD_REGNO_NREGS (regno, GET_MODE (XEXP (note, 0))); + ! else + ! offset = 1; + ! + ! for (i = regno + offset; i < ourend; i++) + move_deaths (gen_rtx (REG, reg_raw_mode[i], i), + from_cuid, to_insn, &oldnotes); + *************** distribute_notes (notes, from_insn, i3, + *** 10648,10651 **** + --- 10685,10689 ---- + case REG_EQUIV: + case REG_NONNEG: + + case REG_NOALIAS: + /* These notes say something about results of an insn. We can + only support them if they used to be on I3 in which case they + diff -rcp2N gcc-2.7.2.3/config/alpha/alpha.c gcc-2.7.2.3.f.1/config/alpha/alpha.c + *** gcc-2.7.2.3/config/alpha/alpha.c Sat Jun 29 16:26:53 1996 + --- gcc-2.7.2.3.f.1/config/alpha/alpha.c Fri Aug 29 07:51:37 1997 + *************** extern int rtx_equal_function_value_matt + *** 64,67 **** + --- 64,69 ---- + /* Declarations of static functions. */ + static void alpha_set_memflags_1 PROTO((rtx, int, int, int)); + + static rtx alpha_emit_set_const_1 PROTO((rtx, enum machine_mode, + + HOST_WIDE_INT, int)); + static void add_long_const PROTO((FILE *, HOST_WIDE_INT, int, int, int)); + + *************** alpha_emit_set_const (target, mode, c, n + *** 670,673 **** + --- 672,695 ---- + int n; + { + + rtx pat; + + int i; + + + + /* Try 1 insn, then 2, then up to N. */ + + for (i = 1; i <= n; i++) + + if ((pat = alpha_emit_set_const_1 (target, mode, c, i)) != 0) + + return pat; + + + + return 0; + + } + + + + /* Internal routine for the above to check for N or below insns. */ + + + + static rtx + + alpha_emit_set_const_1 (target, mode, c, n) + + rtx target; + + enum machine_mode mode; + + HOST_WIDE_INT c; + + int n; + + { + HOST_WIDE_INT new = c; + int i, bits; + *************** alpha_emit_set_const (target, mode, c, n + *** 714,723 **** + if (c == low || (low == 0 && extra == 0)) + return copy_to_suggested_reg (GEN_INT (c), target, mode); + ! else if (n >= 2 + (extra != 0) + ! /* We can't do this when SImode if HIGH required adjustment. + ! This is because the code relies on an implicit overflow + ! which is invisible to the RTL. We can thus get incorrect + ! code if the two ldah instructions are combined. */ + ! && ! (mode == SImode && extra != 0)) + { + temp = copy_to_suggested_reg (GEN_INT (low), subtarget, mode); + --- 736,740 ---- + if (c == low || (low == 0 && extra == 0)) + return copy_to_suggested_reg (GEN_INT (c), target, mode); + ! else if (n >= 2 + (extra != 0)) + { + temp = copy_to_suggested_reg (GEN_INT (low), subtarget, mode); + *************** direct_return () + *** 1239,1243 **** + cross-compiler. Otherwise, use the versions in /usr/include/stamp.h. */ + + ! #if !defined(CROSS_COMPILE) && !defined(_WIN32) + #include + #endif + --- 1256,1260 ---- + cross-compiler. Otherwise, use the versions in /usr/include/stamp.h. */ + + ! #if !defined(CROSS_COMPILE) && !defined(_WIN32) && !defined(__linux__) + #include + #endif + *************** output_prolog (file, size) + *** 1370,1373 **** + --- 1387,1395 ---- + + alpha_function_needs_gp = 0; + + #ifdef __linux__ + + if(profile_flag) { + + alpha_function_needs_gp = 1; + + } + + #endif + for (insn = get_insns (); insn; insn = NEXT_INSN (insn)) + if ((GET_CODE (insn) == CALL_INSN) + diff -rcp2N gcc-2.7.2.3/config/alpha/alpha.h gcc-2.7.2.3.f.1/config/alpha/alpha.h + *** gcc-2.7.2.3/config/alpha/alpha.h Sat Jun 29 16:27:31 1996 + --- gcc-2.7.2.3.f.1/config/alpha/alpha.h Fri Aug 29 07:52:06 1997 + *************** extern int target_flags; + *** 112,116 **** + --- 112,118 ---- + {"", TARGET_DEFAULT | TARGET_CPU_DEFAULT} } + + + #ifndef TARGET_DEFAULT + #define TARGET_DEFAULT 3 + + #endif + + #ifndef TARGET_CPU_DEFAULT + *************** extern int target_flags; + *** 253,256 **** + --- 255,261 ---- + #define BIGGEST_ALIGNMENT 64 + + + /* For atomic access to objects, must have at least 32-bit alignment. */ + + #define MINIMUM_ATOMIC_ALIGNMENT 32 + + + /* Make strings word-aligned so strcpy from constants will be faster. */ + #define CONSTANT_ALIGNMENT(EXP, ALIGN) \ + *************** enum reg_class { NO_REGS, GENERAL_REGS, + *** 664,667 **** + --- 669,675 ---- + On Alpha, don't define this because there are no push insns. */ + /* #define PUSH_ROUNDING(BYTES) */ + + + + /* Define this to be nonzero if stack checking is built into the ABI. */ + + #define STACK_CHECK_BUILTIN 1 + + /* Define this if the maximum size of all the outgoing args is to be + diff -rcp2N gcc-2.7.2.3/config/alpha/alpha.md gcc-2.7.2.3.f.1/config/alpha/alpha.md + *** gcc-2.7.2.3/config/alpha/alpha.md Fri Oct 27 10:49:59 1995 + --- gcc-2.7.2.3.f.1/config/alpha/alpha.md Fri Jul 11 00:08:48 1997 + *************** + *** 1746,1752 **** + (if_then_else:DF + (match_operator 3 "signed_comparison_operator" + ! [(match_operand:DF 1 "reg_or_fp0_operand" "fG,fG") + (match_operand:DF 2 "fp0_operand" "G,G")]) + ! (float_extend:DF (match_operand:SF 4 "reg_or_fp0_operand" "fG,0")) + (match_operand:DF 5 "reg_or_fp0_operand" "0,fG")))] + "TARGET_FP" + --- 1746,1752 ---- + (if_then_else:DF + (match_operator 3 "signed_comparison_operator" + ! [(match_operand:DF 4 "reg_or_fp0_operand" "fG,fG") + (match_operand:DF 2 "fp0_operand" "G,G")]) + ! (float_extend:DF (match_operand:SF 1 "reg_or_fp0_operand" "fG,0")) + (match_operand:DF 5 "reg_or_fp0_operand" "0,fG")))] + "TARGET_FP" + diff -rcp2N gcc-2.7.2.3/config/alpha/elf.h gcc-2.7.2.3.f.1/config/alpha/elf.h + *** gcc-2.7.2.3/config/alpha/elf.h Thu Jan 1 00:00:00 1970 + --- gcc-2.7.2.3.f.1/config/alpha/elf.h Fri Jul 11 00:08:49 1997 + *************** + *** 0 **** + --- 1,522 ---- + + /* Definitions of target machine for GNU compiler, for DEC Alpha w/ELF. + + Copyright (C) 1996 Free Software Foundation, Inc. + + Contributed by Richard Henderson (rth@tamu.edu). + + + + This file is part of GNU CC. + + + + GNU CC 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 CC 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 CC; see the file COPYING. If not, write to + + the Free Software Foundation, 59 Temple Place - Suite 330, + + Boston, MA 02111-1307, USA. */ + + + + /* This is used on Alpha platforms that use the ELF format. + + Currently only Linux uses this. */ + + + + #include "alpha/linux.h" + + + + #undef TARGET_VERSION + + #define TARGET_VERSION fprintf (stderr, " (Alpha Linux/ELF)"); + + + + #undef OBJECT_FORMAT_COFF + + #undef EXTENDED_COFF + + #define OBJECT_FORMAT_ELF + + + + #define SDB_DEBUGGING_INFO + + + + #undef ASM_FINAL_SPEC + + + + #undef CPP_PREDEFINES + + #define CPP_PREDEFINES "\ + + -D__alpha -D__alpha__ -D__linux__ -D__linux -D_LONGLONG -Dlinux -Dunix \ + + -Asystem(linux) -Acpu(alpha) -Amachine(alpha) -D__ELF__" + + + + #undef LINK_SPEC + + #define LINK_SPEC "-m elf64alpha -G 8 %{O*:-O3} %{!O*:-O1} \ + + %{shared:-shared} \ + + %{!shared: \ + + %{!static: \ + + %{rdynamic:-export-dynamic} \ + + %{!dynamic-linker:-dynamic-linker /lib/ld.so.1}} \ + + %{static:-static}}" + + + + /* Output at beginning of assembler file. */ + + + + #undef ASM_FILE_START + + #define ASM_FILE_START(FILE) \ + + { \ + + alpha_write_verstamp (FILE); \ + + output_file_directive (FILE, main_input_filename); \ + + fprintf (FILE, "\t.version\t\"01.01\"\n"); \ + + fprintf (FILE, "\t.set noat\n"); \ + + } + + + + #define ASM_OUTPUT_SOURCE_LINE(STREAM, LINE) \ + + alpha_output_lineno (STREAM, LINE) + + extern void alpha_output_lineno (); + + + + extern void output_file_directive (); + + + + /* Attach a special .ident directive to the end of the file to identify + + the version of GCC which compiled this code. The format of the + + .ident string is patterned after the ones produced by native svr4 + + C compilers. */ + + + + #define IDENT_ASM_OP ".ident" + + + + #ifdef IDENTIFY_WITH_IDENT + + #define ASM_IDENTIFY_GCC(FILE) /* nothing */ + + #define ASM_IDENTIFY_LANGUAGE(FILE) \ + + fprintf(FILE, "\t%s \"GCC (%s) %s\"\n", IDENT_ASM_OP, \ + + lang_identify(), version_string) + + #else + + #define ASM_FILE_END(FILE) \ + + do { \ + + fprintf ((FILE), "\t%s\t\"GCC: (GNU) %s\"\n", \ + + IDENT_ASM_OP, version_string); \ + + } while (0) + + #endif + + + + /* Allow #sccs in preprocessor. */ + + + + #define SCCS_DIRECTIVE + + + + /* Output #ident as a .ident. */ + + + + #define ASM_OUTPUT_IDENT(FILE, NAME) \ + + fprintf (FILE, "\t%s\t\"%s\"\n", IDENT_ASM_OP, NAME); + + + + /* This is how to allocate empty space in some section. The .zero + + pseudo-op is used for this on most svr4 assemblers. */ + + + + #define SKIP_ASM_OP ".zero" + + + + #undef ASM_OUTPUT_SKIP + + #define ASM_OUTPUT_SKIP(FILE,SIZE) \ + + fprintf (FILE, "\t%s\t%u\n", SKIP_ASM_OP, (SIZE)) + + + + /* Output the label which precedes a jumptable. Note that for all svr4 + + systems where we actually generate jumptables (which is to say every + + svr4 target except i386, where we use casesi instead) we put the jump- + + tables into the .rodata section and since other stuff could have been + + put into the .rodata section prior to any given jumptable, we have to + + make sure that the location counter for the .rodata section gets pro- + + perly re-aligned prior to the actual beginning of the jump table. */ + + + + #define ALIGN_ASM_OP ".align" + + + + #ifndef ASM_OUTPUT_BEFORE_CASE_LABEL + + #define ASM_OUTPUT_BEFORE_CASE_LABEL(FILE,PREFIX,NUM,TABLE) \ + + ASM_OUTPUT_ALIGN ((FILE), 2); + + #endif + + + + #undef ASM_OUTPUT_CASE_LABEL + + #define ASM_OUTPUT_CASE_LABEL(FILE,PREFIX,NUM,JUMPTABLE) \ + + do { \ + + ASM_OUTPUT_BEFORE_CASE_LABEL (FILE, PREFIX, NUM, JUMPTABLE) \ + + ASM_OUTPUT_INTERNAL_LABEL (FILE, PREFIX, NUM); \ + + } while (0) + + + + /* The standard SVR4 assembler seems to require that certain builtin + + library routines (e.g. .udiv) be explicitly declared as .globl + + in each assembly file where they are referenced. */ + + + + #define ASM_OUTPUT_EXTERNAL_LIBCALL(FILE, FUN) \ + + ASM_GLOBALIZE_LABEL (FILE, XSTR (FUN, 0)) + + + + /* This says how to output assembler code to declare an + + uninitialized external linkage data object. Under SVR4, + + the linker seems to want the alignment of data objects + + to depend on their types. We do exactly that here. */ + + + + #define COMMON_ASM_OP ".comm" + + + + #undef ASM_OUTPUT_ALIGNED_COMMON + + #define ASM_OUTPUT_ALIGNED_COMMON(FILE, NAME, SIZE, ALIGN) \ + + do { \ + + fprintf ((FILE), "\t%s\t", COMMON_ASM_OP); \ + + assemble_name ((FILE), (NAME)); \ + + fprintf ((FILE), ",%u,%u\n", (SIZE), (ALIGN) / BITS_PER_UNIT); \ + + } while (0) + + + + /* This says how to output assembler code to declare an + + uninitialized internal linkage data object. Under SVR4, + + the linker seems to want the alignment of data objects + + to depend on their types. We do exactly that here. */ + + + + #define LOCAL_ASM_OP ".local" + + + + #undef ASM_OUTPUT_ALIGNED_LOCAL + + #define ASM_OUTPUT_ALIGNED_LOCAL(FILE, NAME, SIZE, ALIGN) \ + + do { \ + + fprintf ((FILE), "\t%s\t", LOCAL_ASM_OP); \ + + assemble_name ((FILE), (NAME)); \ + + fprintf ((FILE), "\n"); \ + + ASM_OUTPUT_ALIGNED_COMMON (FILE, NAME, SIZE, ALIGN); \ + + } while (0) + + + + /* This is the pseudo-op used to generate a 64-bit word of data with a + + specific value in some section. */ + + + + #define INT_ASM_OP ".quad" + + + + /* This is the pseudo-op used to generate a contiguous sequence of byte + + values from a double-quoted string WITHOUT HAVING A TERMINATING NUL + + AUTOMATICALLY APPENDED. This is the same for most svr4 assemblers. */ + + + + #undef ASCII_DATA_ASM_OP + + #define ASCII_DATA_ASM_OP ".ascii" + + + + /* Support const sections and the ctors and dtors sections for g++. + + Note that there appears to be two different ways to support const + + sections at the moment. You can either #define the symbol + + READONLY_DATA_SECTION (giving it some code which switches to the + + readonly data section) or else you can #define the symbols + + EXTRA_SECTIONS, EXTRA_SECTION_FUNCTIONS, SELECT_SECTION, and + + SELECT_RTX_SECTION. We do both here just to be on the safe side. */ + + + + #define USE_CONST_SECTION 1 + + + + #define CONST_SECTION_ASM_OP ".section\t.rodata" + + + + /* Define the pseudo-ops used to switch to the .ctors and .dtors sections. + + + + Note that we want to give these sections the SHF_WRITE attribute + + because these sections will actually contain data (i.e. tables of + + addresses of functions in the current root executable or shared library + + file) and, in the case of a shared library, the relocatable addresses + + will have to be properly resolved/relocated (and then written into) by + + the dynamic linker when it actually attaches the given shared library + + to the executing process. (Note that on SVR4, you may wish to use the + + `-z text' option to the ELF linker, when building a shared library, as + + an additional check that you are doing everything right. But if you do + + use the `-z text' option when building a shared library, you will get + + errors unless the .ctors and .dtors sections are marked as writable + + via the SHF_WRITE attribute.) */ + + + + #define CTORS_SECTION_ASM_OP ".section\t.ctors,\"aw\"" + + #define DTORS_SECTION_ASM_OP ".section\t.dtors,\"aw\"" + + + + /* On svr4, we *do* have support for the .init and .fini sections, and we + + can put stuff in there to be executed before and after `main'. We let + + crtstuff.c and other files know this by defining the following symbols. + + The definitions say how to change sections to the .init and .fini + + sections. This is the same for all known svr4 assemblers. */ + + + + #define INIT_SECTION_ASM_OP ".section\t.init" + + #define FINI_SECTION_ASM_OP ".section\t.fini" + + + + /* Support non-common, uninitialized data in the .bss section. */ + + + + #define BSS_SECTION_ASM_OP ".section\t.bss" + + + + /* A default list of other sections which we might be "in" at any given + + time. For targets that use additional sections (e.g. .tdesc) you + + should override this definition in the target-specific file which + + includes this file. */ + + + + #undef EXTRA_SECTIONS + + #define EXTRA_SECTIONS in_const, in_ctors, in_dtors, in_bss + + + + /* A default list of extra section function definitions. For targets + + that use additional sections (e.g. .tdesc) you should override this + + definition in the target-specific file which includes this file. */ + + + + #undef EXTRA_SECTION_FUNCTIONS + + #define EXTRA_SECTION_FUNCTIONS \ + + CONST_SECTION_FUNCTION \ + + CTORS_SECTION_FUNCTION \ + + DTORS_SECTION_FUNCTION \ + + BSS_SECTION_FUNCTION + + + + #undef READONLY_DATA_SECTION + + #define READONLY_DATA_SECTION() const_section () + + + + extern void text_section (); + + + + #define CONST_SECTION_FUNCTION \ + + void \ + + const_section () \ + + { \ + + if (!USE_CONST_SECTION) \ + + text_section(); \ + + else if (in_section != in_const) \ + + { \ + + fprintf (asm_out_file, "%s\n", CONST_SECTION_ASM_OP); \ + + in_section = in_const; \ + + } \ + + } + + + + #define CTORS_SECTION_FUNCTION \ + + void \ + + ctors_section () \ + + { \ + + if (in_section != in_ctors) \ + + { \ + + fprintf (asm_out_file, "%s\n", CTORS_SECTION_ASM_OP); \ + + in_section = in_ctors; \ + + } \ + + } + + + + #define DTORS_SECTION_FUNCTION \ + + void \ + + dtors_section () \ + + { \ + + if (in_section != in_dtors) \ + + { \ + + fprintf (asm_out_file, "%s\n", DTORS_SECTION_ASM_OP); \ + + in_section = in_dtors; \ + + } \ + + } + + + + #define BSS_SECTION_FUNCTION \ + + void \ + + bss_section () \ + + { \ + + if (in_section != in_bss) \ + + { \ + + fprintf (asm_out_file, "%s\n", BSS_SECTION_ASM_OP); \ + + in_section = in_bss; \ + + } \ + + } + + + + + + /* Switch into a generic section. + + This is currently only used to support section attributes. + + + + We make the section read-only and executable for a function decl, + + read-only for a const data decl, and writable for a non-const data decl. */ + + #define ASM_OUTPUT_SECTION_NAME(FILE, DECL, NAME) \ + + fprintf (FILE, ".section\t%s,\"%s\",@progbits\n", NAME, \ + + (DECL) && TREE_CODE (DECL) == FUNCTION_DECL ? "ax" : \ + + (DECL) && TREE_READONLY (DECL) ? "a" : "aw") + + + + + + /* A C statement (sans semicolon) to output an element in the table of + + global constructors. */ + + #define ASM_OUTPUT_CONSTRUCTOR(FILE,NAME) \ + + do { \ + + ctors_section (); \ + + fprintf (FILE, "\t%s\t ", INT_ASM_OP); \ + + assemble_name (FILE, NAME); \ + + fprintf (FILE, "\n"); \ + + } while (0) + + + + /* A C statement (sans semicolon) to output an element in the table of + + global destructors. */ + + #define ASM_OUTPUT_DESTRUCTOR(FILE,NAME) \ + + do { \ + + dtors_section (); \ + + fprintf (FILE, "\t%s\t ", INT_ASM_OP); \ + + assemble_name (FILE, NAME); \ + + fprintf (FILE, "\n"); \ + + } while (0) + + + + /* A C statement or statements to switch to the appropriate + + section for output of DECL. DECL is either a `VAR_DECL' node + + or a constant of some sort. RELOC indicates whether forming + + the initial value of DECL requires link-time relocations. */ + + + + #define SELECT_SECTION(DECL,RELOC) \ + + { \ + + if (TREE_CODE (DECL) == STRING_CST) \ + + { \ + + if (! flag_writable_strings) \ + + const_section (); \ + + else \ + + data_section (); \ + + } \ + + else if (TREE_CODE (DECL) == VAR_DECL) \ + + { \ + + if ((flag_pic && RELOC) \ + + || !TREE_READONLY (DECL) || TREE_SIDE_EFFECTS (DECL) \ + + || !DECL_INITIAL (DECL) \ + + || (DECL_INITIAL (DECL) != error_mark_node \ + + && !TREE_CONSTANT (DECL_INITIAL (DECL)))) \ + + { \ + + if (DECL_COMMON (DECL) \ + + && !DECL_INITIAL (DECL)) \ + + /* || DECL_INITIAL (DECL) == error_mark_node)) */ \ + + bss_section(); \ + + else \ + + data_section (); \ + + } \ + + else \ + + const_section (); \ + + } \ + + else \ + + const_section (); \ + + } + + + + /* A C statement or statements to switch to the appropriate + + section for output of RTX in mode MODE. RTX is some kind + + of constant in RTL. The argument MODE is redundant except + + in the case of a `const_int' rtx. Currently, these always + + go into the const section. */ + + + + #undef SELECT_RTX_SECTION + + #define SELECT_RTX_SECTION(MODE,RTX) const_section() + + + + /* Define the strings used for the special svr4 .type and .size directives. + + These strings generally do not vary from one system running svr4 to + + another, but if a given system (e.g. m88k running svr) needs to use + + different pseudo-op names for these, they may be overridden in the + + file which includes this one. */ + + + + #define TYPE_ASM_OP ".type" + + #define SIZE_ASM_OP ".size" + + + + /* This is how we tell the assembler that a symbol is weak. */ + + + + #define ASM_WEAKEN_LABEL(FILE,NAME) \ + + do { fputs ("\t.weak\t", FILE); assemble_name (FILE, NAME); \ + + fputc ('\n', FILE); } while (0) + + + + /* This is how we tell the assembler that two symbols have the same value. */ + + + + #define ASM_OUTPUT_DEF(FILE,NAME1,NAME2) \ + + do { assemble_name(FILE, NAME1); \ + + fputs(" = ", FILE); \ + + assemble_name(FILE, NAME2); \ + + fputc('\n', FILE); } while (0) + + + + /* The following macro defines the format used to output the second + + operand of the .type assembler directive. Different svr4 assemblers + + expect various different forms for this operand. The one given here + + is just a default. You may need to override it in your machine- + + specific tm.h file (depending upon the particulars of your assembler). */ + + + + #define TYPE_OPERAND_FMT "@%s" + + + + /* Write the extra assembler code needed to declare a function's result. + + Most svr4 assemblers don't require any special declaration of the + + result value, but there are exceptions. */ + + + + #ifndef ASM_DECLARE_RESULT + + #define ASM_DECLARE_RESULT(FILE, RESULT) + + #endif + + + + /* These macros generate the special .type and .size directives which + + are used to set the corresponding fields of the linker symbol table + + entries in an ELF object file under SVR4. These macros also output + + the starting labels for the relevant functions/objects. */ + + + + /* Write the extra assembler code needed to declare an object properly. */ + + + + #define ASM_DECLARE_OBJECT_NAME(FILE, NAME, DECL) \ + + do { \ + + fprintf (FILE, "\t%s\t ", TYPE_ASM_OP); \ + + assemble_name (FILE, NAME); \ + + putc (',', FILE); \ + + fprintf (FILE, TYPE_OPERAND_FMT, "object"); \ + + putc ('\n', FILE); \ + + size_directive_output = 0; \ + + if (!flag_inhibit_size_directive && DECL_SIZE (DECL)) \ + + { \ + + size_directive_output = 1; \ + + fprintf (FILE, "\t%s\t ", SIZE_ASM_OP); \ + + assemble_name (FILE, NAME); \ + + fprintf (FILE, ",%d\n", int_size_in_bytes (TREE_TYPE (DECL))); \ + + } \ + + ASM_OUTPUT_LABEL(FILE, NAME); \ + + } while (0) + + + + /* Output the size directive for a decl in rest_of_decl_compilation + + in the case where we did not do so before the initializer. + + Once we find the error_mark_node, we know that the value of + + size_directive_output was set + + by ASM_DECLARE_OBJECT_NAME when it was run for the same decl. */ + + + + #define ASM_FINISH_DECLARE_OBJECT(FILE, DECL, TOP_LEVEL, AT_END) \ + + do { \ + + char *name = XSTR (XEXP (DECL_RTL (DECL), 0), 0); \ + + if (!flag_inhibit_size_directive && DECL_SIZE (DECL) \ + + && ! AT_END && TOP_LEVEL \ + + && DECL_INITIAL (DECL) == error_mark_node \ + + && !size_directive_output) \ + + { \ + + size_directive_output = 1; \ + + fprintf (FILE, "\t%s\t ", SIZE_ASM_OP); \ + + assemble_name (FILE, name); \ + + fprintf (FILE, ",%d\n", int_size_in_bytes (TREE_TYPE (DECL))); \ + + } \ + + } while (0) + + + + /* A table of bytes codes used by the ASM_OUTPUT_ASCII and + + ASM_OUTPUT_LIMITED_STRING macros. Each byte in the table + + corresponds to a particular byte value [0..255]. For any + + given byte value, if the value in the corresponding table + + position is zero, the given character can be output directly. + + If the table value is 1, the byte must be output as a \ooo + + octal escape. If the tables value is anything else, then the + + byte value should be output as a \ followed by the value + + in the table. Note that we can use standard UN*X escape + + sequences for many control characters, but we don't use + + \a to represent BEL because some svr4 assemblers (e.g. on + + the i386) don't know about that. Also, we don't use \v + + since some versions of gas, such as 2.2 did not accept it. */ + + + + #define ESCAPES \ + + "\1\1\1\1\1\1\1\1btn\1fr\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\ + + \0\0\"\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\ + + \0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\\\0\0\0\ + + \0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\1\ + + \1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\ + + \1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\ + + \1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\ + + \1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1" + + + + /* Some svr4 assemblers have a limit on the number of characters which + + can appear in the operand of a .string directive. If your assembler + + has such a limitation, you should define STRING_LIMIT to reflect that + + limit. Note that at least some svr4 assemblers have a limit on the + + actual number of bytes in the double-quoted string, and that they + + count each character in an escape sequence as one byte. Thus, an + + escape sequence like \377 would count as four bytes. + + + + If your target assembler doesn't support the .string directive, you + + should define this to zero. + + */ + + + + #define STRING_LIMIT ((unsigned) 256) + + + + #define STRING_ASM_OP ".string" + + + + /* + + * We always use gas here, so we don't worry about ECOFF assembler problems. + + */ + + #undef TARGET_GAS + + #define TARGET_GAS (1) + + + + #undef PREFERRED_DEBUGGING_TYPE + + #define PREFERRED_DEBUGGING_TYPE DBX_DEBUG + + + + /* Provide a STARTFILE_SPEC appropriate for Linux. Here we add + + the Linux magical crtbegin.o file (see crtstuff.c) which + + provides part of the support for getting C++ file-scope static + + object constructed before entering `main'. */ + + + + #undef STARTFILE_SPEC + + #define STARTFILE_SPEC \ + + "%{!shared: \ + + %{pg:gcrt1.o%s} %{!pg:%{p:gcrt1.o%s} %{!p:crt1.o%s}}}\ + + crti.o%s crtbegin.o%s" + + + + /* Provide a ENDFILE_SPEC appropriate for Linux. Here we tack on + + the Linux magical crtend.o file (see crtstuff.c) which + + provides part of the support for getting C++ file-scope static + + object constructed before entering `main', followed by a normal + + Linux "finalizer" file, `crtn.o'. */ + + + + #undef ENDFILE_SPEC + + #define ENDFILE_SPEC \ + + "crtend.o%s crtn.o%s" + diff -rcp2N gcc-2.7.2.3/config/alpha/linux.h gcc-2.7.2.3.f.1/config/alpha/linux.h + *** gcc-2.7.2.3/config/alpha/linux.h Thu Jan 1 00:00:00 1970 + --- gcc-2.7.2.3.f.1/config/alpha/linux.h Fri Jul 11 00:08:49 1997 + *************** + *** 0 **** + --- 1,72 ---- + + /* Definitions of target machine for GNU compiler, for Alpha Linux, + + using ECOFF. + + Copyright (C) 1995 Free Software Foundation, Inc. + + Contributed by Bob Manson. + + Derived from work contributed by Cygnus Support, + + (c) 1993 Free Software Foundation. + + + + This file is part of GNU CC. + + + + GNU CC 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 CC 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 CC; see the file COPYING. If not, write to + + the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ + + + + #define TARGET_DEFAULT (3 | MASK_GAS) + + + + #include "alpha/alpha.h" + + + + #undef TARGET_VERSION + + #define TARGET_VERSION fprintf (stderr, " (Linux/Alpha)"); + + + + #undef CPP_PREDEFINES + + #define CPP_PREDEFINES "\ + + -D__alpha -D__alpha__ -D__linux__ -D__linux -D_LONGLONG -Dlinux -Dunix \ + + -Asystem(linux) -Acpu(alpha) -Amachine(alpha)" + + + + /* We don't actually need any of these; the MD_ vars are ignored + + anyway for cross-compilers, and the other specs won't get picked up + + 'coz the user is supposed to do ld -r (hmm, perhaps that should be + + the default). In any case, setting them thus will catch some + + common user errors. */ + + + + #undef MD_EXEC_PREFIX + + #undef MD_STARTFILE_PREFIX + + + + #undef LIB_SPEC + + #define LIB_SPEC "%{pg:-lgmon} %{pg:-lc_p} %{!pg:-lc}" + + + + #undef LINK_SPEC + + #define LINK_SPEC \ + + "-G 8 %{O*:-O3} %{!O*:-O1}" + + + + #undef ASM_SPEC + + #define ASM_SPEC "-nocpp" + + + + /* Can't do stabs */ + + #undef SDB_DEBUGGING_INFO + + + + /* Prefer dbx. */ + + #undef PREFERRED_DEBUGGING_TYPE + + #define PREFERRED_DEBUGGING_TYPE DBX_DEBUG + + + + #undef FUNCTION_PROFILER + + + + #define FUNCTION_PROFILER(FILE, LABELNO) \ + + do { \ + + fputs ("\tlda $27,_mcount\n", (FILE)); \ + + fputs ("\tjsr $26,($27),_mcount\n", (FILE)); \ + + fputs ("\tldgp $29,0($26)\n", (FILE)); \ + + } while (0); + + + + /* Generate calls to memcpy, etc., not bcopy, etc. */ + + #define TARGET_MEM_FUNCTIONS + diff -rcp2N gcc-2.7.2.3/config/alpha/t-linux gcc-2.7.2.3.f.1/config/alpha/t-linux + *** gcc-2.7.2.3/config/alpha/t-linux Thu Jan 1 00:00:00 1970 + --- gcc-2.7.2.3.f.1/config/alpha/t-linux Fri Jul 11 00:08:49 1997 + *************** + *** 0 **** + --- 1,3 ---- + + # Our header files are supposed to be correct, nein? + + FIXINCLUDES = + + STMP_FIXPROTO = + diff -rcp2N gcc-2.7.2.3/config/alpha/x-linux gcc-2.7.2.3.f.1/config/alpha/x-linux + *** gcc-2.7.2.3/config/alpha/x-linux Thu Jan 1 00:00:00 1970 + --- gcc-2.7.2.3.f.1/config/alpha/x-linux Fri Jul 11 00:08:49 1997 + *************** + *** 0 **** + --- 1 ---- + + CLIB=-lbfd -liberty + diff -rcp2N gcc-2.7.2.3/config/alpha/xm-alpha.h gcc-2.7.2.3.f.1/config/alpha/xm-alpha.h + *** gcc-2.7.2.3/config/alpha/xm-alpha.h Thu Aug 31 21:52:27 1995 + --- gcc-2.7.2.3.f.1/config/alpha/xm-alpha.h Fri Jul 11 00:08:49 1997 + *************** Boston, MA 02111-1307, USA. */ + *** 46,51 **** + --- 46,53 ---- + #include + #else + + #ifndef alloca + extern void *alloca (); + #endif + + #endif + + /* The host compiler has problems with enum bitfields since it makes + *************** extern void *malloc (), *realloc (), *ca + *** 68,72 **** + --- 70,76 ---- + /* OSF/1 has vprintf. */ + + + #ifndef linux /* 1996/02/22 mauro@craftwork.com -- unreliable with Linux */ + #define HAVE_VPRINTF + + #endif + + /* OSF/1 has putenv. */ + diff -rcp2N gcc-2.7.2.3/config/alpha/xm-linux.h gcc-2.7.2.3.f.1/config/alpha/xm-linux.h + *** gcc-2.7.2.3/config/alpha/xm-linux.h Thu Jan 1 00:00:00 1970 + --- gcc-2.7.2.3.f.1/config/alpha/xm-linux.h Fri Jul 11 00:08:49 1997 + *************** + *** 0 **** + --- 1,10 ---- + + #ifndef _XM_LINUX_H + + #define _XM_LINUX_H + + + + #include "xm-alpha.h" + + + + #define HAVE_STRERROR + + + + #define DONT_DECLARE_SYS_SIGLIST + + #define USE_BFD + + #endif + diff -rcp2N gcc-2.7.2.3/config/i386/i386.c gcc-2.7.2.3.f.1/config/i386/i386.c + *** gcc-2.7.2.3/config/i386/i386.c Sun Oct 22 11:13:21 1995 + --- gcc-2.7.2.3.f.1/config/i386/i386.c Sun Aug 10 22:46:09 1997 + *************** standard_80387_constant_p (x) + *** 1290,1294 **** + set_float_handler (handler); + REAL_VALUE_FROM_CONST_DOUBLE (d, x); + ! is0 = REAL_VALUES_EQUAL (d, dconst0); + is1 = REAL_VALUES_EQUAL (d, dconst1); + set_float_handler (NULL_PTR); + --- 1290,1294 ---- + set_float_handler (handler); + REAL_VALUE_FROM_CONST_DOUBLE (d, x); + ! is0 = REAL_VALUES_EQUAL (d, dconst0) && !REAL_VALUE_MINUS_ZERO (d); + is1 = REAL_VALUES_EQUAL (d, dconst1); + set_float_handler (NULL_PTR); + diff -rcp2N gcc-2.7.2.3/config/i386/i386.h gcc-2.7.2.3.f.1/config/i386/i386.h + *** gcc-2.7.2.3/config/i386/i386.h Fri Sep 22 22:42:57 1995 + --- gcc-2.7.2.3.f.1/config/i386/i386.h Sun Aug 24 10:33:50 1997 + *************** extern int target_flags; + *** 245,249 **** + + /* Boundary (in *bits*) on which stack pointer should be aligned. */ + ! #define STACK_BOUNDARY 32 + + /* Allocation boundary (in *bits*) for the code of a function. + --- 245,249 ---- + + /* Boundary (in *bits*) on which stack pointer should be aligned. */ + ! #define STACK_BOUNDARY BIGGEST_ALIGNMENT + + /* Allocation boundary (in *bits*) for the code of a function. + diff -rcp2N gcc-2.7.2.3/config/m68k/m68k.md gcc-2.7.2.3.f.1/config/m68k/m68k.md + *** gcc-2.7.2.3/config/m68k/m68k.md Sun Aug 31 09:39:43 1997 + --- gcc-2.7.2.3.f.1/config/m68k/m68k.md Sun Aug 31 09:21:09 1997 + *************** + *** 288,292 **** + (match_operand:DI 0 "nonimmediate_operand" "d")) + (clobber (match_dup 1))])] + ! "" + "operands[1] = gen_reg_rtx (DImode);") + + --- 288,292 ---- + (match_operand:DI 0 "nonimmediate_operand" "d")) + (clobber (match_dup 1))])] + ! "0" + "operands[1] = gen_reg_rtx (DImode);") + + *************** + *** 411,415 **** + (match_operand:DI 1 "general_operand" ""))) + (clobber (match_dup 2))])] + ! "" + "operands[2] = gen_reg_rtx (DImode);") + + --- 411,415 ---- + (match_operand:DI 1 "general_operand" ""))) + (clobber (match_dup 2))])] + ! "0" + "operands[2] = gen_reg_rtx (DImode);") + + diff -rcp2N gcc-2.7.2.3/config/mips/mips.c gcc-2.7.2.3.f.1/config/mips/mips.c + *** gcc-2.7.2.3/config/mips/mips.c Sat Jun 29 16:26:44 1996 + --- gcc-2.7.2.3.f.1/config/mips/mips.c Sun Aug 10 22:45:43 1997 + *************** expand_block_move (operands) + *** 2360,2365 **** + + else if (constp && bytes <= 2*MAX_MOVE_BYTES) + ! emit_insn (gen_movstrsi_internal (gen_rtx (MEM, BLKmode, dest_reg), + ! gen_rtx (MEM, BLKmode, src_reg), + bytes_rtx, align_rtx)); + + --- 2360,2367 ---- + + else if (constp && bytes <= 2*MAX_MOVE_BYTES) + ! emit_insn (gen_movstrsi_internal (change_address (operands[0], + ! BLKmode, dest_reg), + ! change_address (orig_src, BLKmode, + ! src_reg), + bytes_rtx, align_rtx)); + + diff -rcp2N gcc-2.7.2.3/config/mips/mips.h gcc-2.7.2.3.f.1/config/mips/mips.h + *** gcc-2.7.2.3/config/mips/mips.h Thu Nov 9 16:23:09 1995 + --- gcc-2.7.2.3.f.1/config/mips/mips.h Sun Aug 10 22:46:44 1997 + *************** typedef struct mips_args { + *** 2160,2170 **** + } \ + \ + ! /* Flush the instruction cache. */ \ + ! /* ??? Are the modes right? Maybe they should depend on -mint64/-mlong64? */\ + /* ??? Should check the return value for errors. */ \ + ! emit_library_call (gen_rtx (SYMBOL_REF, Pmode, "cacheflush"), \ + 0, VOIDmode, 3, addr, Pmode, \ + GEN_INT (TRAMPOLINE_SIZE), SImode, \ + ! GEN_INT (1), SImode); \ + } + + --- 2160,2170 ---- + } \ + \ + ! /* Flush both caches. We need to flush the data cache in case \ + ! the system has a write-back cache. */ \ + /* ??? Should check the return value for errors. */ \ + ! emit_library_call (gen_rtx (SYMBOL_REF, Pmode, "_flush_cache"), \ + 0, VOIDmode, 3, addr, Pmode, \ + GEN_INT (TRAMPOLINE_SIZE), SImode, \ + ! GEN_INT (3), TYPE_MODE (integer_type_node)); \ + } + + *************** typedef struct mips_args { + *** 2388,2392 **** + ((GET_CODE (X) != CONST_DOUBLE \ + || mips_const_double_ok (X, GET_MODE (X))) \ + ! && ! (GET_CODE (X) == CONST && ABI_64BIT)) + + /* A C compound statement that attempts to replace X with a valid + --- 2388,2393 ---- + ((GET_CODE (X) != CONST_DOUBLE \ + || mips_const_double_ok (X, GET_MODE (X))) \ + ! && ! (GET_CODE (X) == CONST \ + ! && (ABI_64BIT || GET_CODE (XEXP (X, 0)) == MINUS))) + + /* A C compound statement that attempts to replace X with a valid + diff -rcp2N gcc-2.7.2.3/config/mips/sni-gas.h gcc-2.7.2.3.f.1/config/mips/sni-gas.h + *** gcc-2.7.2.3/config/mips/sni-gas.h Thu Jan 1 00:00:00 1970 + --- gcc-2.7.2.3.f.1/config/mips/sni-gas.h Sun Aug 10 22:46:33 1997 + *************** + *** 0 **** + --- 1,43 ---- + + #include "mips/sni-svr4.h" + + + + /* Enable debugging. */ + + #define DBX_DEBUGGING_INFO + + #define SDB_DEBUGGING_INFO + + #define MIPS_DEBUGGING_INFO + + + + #define DWARF_DEBUGGING_INFO + + #undef PREFERRED_DEBUGGING_TYPE + + #define PREFERRED_DEBUGGING_TYPE DWARF_DEBUG + + + + /* We need to use .esize and .etype instead of .size and .type to + + avoid conflicting with ELF directives. These are only recognized + + by gas, anyhow, not the native assembler. */ + + #undef PUT_SDB_SIZE + + #define PUT_SDB_SIZE(a) \ + + do { \ + + extern FILE *asm_out_text_file; \ + + fprintf (asm_out_text_file, "\t.esize\t%d;", (a)); \ + + } while (0) + + + + #undef PUT_SDB_TYPE + + #define PUT_SDB_TYPE(a) \ + + do { \ + + extern FILE *asm_out_text_file; \ + + fprintf (asm_out_text_file, "\t.etype\t0x%x;", (a)); \ + + } while (0) + + + + + + /* This is how to equate one symbol to another symbol. The syntax used is + + `SYM1=SYM2'. Note that this is different from the way equates are done + + with most svr4 assemblers, where the syntax is `.set SYM1,SYM2'. */ + + + + #define ASM_OUTPUT_DEF(FILE,LABEL1,LABEL2) \ + + do { fprintf ((FILE), "\t"); \ + + assemble_name (FILE, LABEL1); \ + + fprintf (FILE, " = "); \ + + assemble_name (FILE, LABEL2); \ + + fprintf (FILE, "\n"); \ + + } while (0) + + + + + + + diff -rcp2N gcc-2.7.2.3/config/mips/sni-svr4.h gcc-2.7.2.3.f.1/config/mips/sni-svr4.h + *** gcc-2.7.2.3/config/mips/sni-svr4.h Thu Jan 1 00:00:00 1970 + --- gcc-2.7.2.3.f.1/config/mips/sni-svr4.h Sun Aug 10 22:46:33 1997 + *************** + *** 0 **** + --- 1,103 ---- + + /* Definitions of target machine for GNU compiler. SNI SINIX version. + + Copyright (C) 1996 Free Software Foundation, Inc. + + Contributed by Marco Walther (Marco.Walther@mch.sni.de). + + + + This file is part of GNU CC. + + + + GNU CC 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 CC 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 CC; see the file COPYING. If not, write to + + the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ + + + + #define MIPS_SVR4 + + + + #define CPP_PREDEFINES "\ + + -Dmips -Dunix -Dhost_mips -DMIPSEB -DR3000 -DSYSTYPE_SVR4 \ + + -D_mips -D_unix -D_host_mips -D_MIPSEB -D_R3000 -D_SYSTYPE_SVR4 \ + + -Asystem(unix) -Asystem(svr4) -Acpu(mips) -Amachine(mips)" + + + + #define CPP_SPEC "\ + + %{.cc: -D__LANGUAGE_C_PLUS_PLUS -D_LANGUAGE_C_PLUS_PLUS} \ + + %{.cxx: -D__LANGUAGE_C_PLUS_PLUS -D_LANGUAGE_C_PLUS_PLUS} \ + + %{.C: -D__LANGUAGE_C_PLUS_PLUS -D_LANGUAGE_C_PLUS_PLUS} \ + + %{.m: -D__LANGUAGE_OBJECTIVE_C -D_LANGUAGE_OBJECTIVE_C} \ + + %{.S: -D__LANGUAGE_ASSEMBLY -D_LANGUAGE_ASSEMBLY %{!ansi:-DLANGUAGE_ASSEMBLY}} \ + + %{.s: -D__LANGUAGE_ASSEMBLY -D_LANGUAGE_ASSEMBLY %{!ansi:-DLANGUAGE_ASSEMBLY}} \ + + %{!.S:%{!.s: -D__LANGUAGE_C -D_LANGUAGE_C %{!ansi:-DLANGUAGE_C}}} \ + + -D__SIZE_TYPE__=unsigned\\ int -D__PTRDIFF_TYPE__=int" + + + + #define LINK_SPEC "\ + + %{G*} \ + + %{!mgas: \ + + %{dy} %{dn}}" + + + + #define LIB_SPEC "\ + + %{p:-lprof1} \ + + %{!p:%{pg:-lprof1} \ + + %{!pg:-L/usr/ccs/lib/ -lc /usr/ccs/lib/crtn.o%s}}" + + + + #define STARTFILE_SPEC "\ + + %{pg:gcrt0.o%s} \ + + %{!pg:%{p:mcrt0.o%s} \ + + %{!p:/usr/ccs/lib/crt1.o /usr/ccs/lib/crti.o /usr/ccs/lib/values-Xt.o%s}}" + + + + /* Mips System V.4 doesn't have a getpagesize() function needed by the + + trampoline code, so use the POSIX sysconf function to get it. + + This is only done when compiling the trampoline code. */ + + + + #ifdef L_trampoline + + #include + + + + #define getpagesize() sysconf(_SC_PAGE_SIZE) + + #endif /* L_trampoline */ + + + + /* Use atexit for static constructors/destructors, instead of defining + + our own exit function. */ + + #define HAVE_ATEXIT + + + + /* Generate calls to memcpy, etc., not bcopy, etc. */ + + #define TARGET_MEM_FUNCTIONS + + + + #define OBJECT_FORMAT_ELF + + + + #define TARGET_DEFAULT MASK_ABICALLS + + #define ABICALLS_ASM_OP ".option pic2" + + + + #define MACHINE_TYPE "SNI running SINIX 5.42" + + + + #define MIPS_DEFAULT_GVALUE 0 + + + + #define NM_FLAGS "-p" + + + + /* wir haben ein Problem, wenn in einem Assembler-File keine .text-section + + erzeugt wird. Dann landen diese Pseudo-Labels in irgendeiner anderen + + section, z.B. .reginfo. Das macht den ld sehr ungluecklich. */ + + + + #define ASM_IDENTIFY_GCC(mw_stream) \ + + fprintf(mw_stream, "\t.ident \"gcc2_compiled.\"\n"); + + + + #define ASM_IDENTIFY_LANGUAGE(STREAM) + + + + #define ASM_LONG ".word\t" + + #define ASM_GLOBAL ".rdata\n\t\t.globl\t" + + + + #include "mips/mips.h" + + + + /* We do not want to run mips-tfile! */ + + #undef ASM_FINAL_SPEC + + + + #undef OBJECT_FORMAT_COFF + + + + /* We don't support debugging info for now. */ + + #undef DBX_DEBUGGING_INFO + + #undef SDB_DEBUGGING_INFO + + #undef MIPS_DEBUGGING_INFO + diff -rcp2N gcc-2.7.2.3/config/mips/x-sni-svr4 gcc-2.7.2.3.f.1/config/mips/x-sni-svr4 + *** gcc-2.7.2.3/config/mips/x-sni-svr4 Thu Jan 1 00:00:00 1970 + --- gcc-2.7.2.3.f.1/config/mips/x-sni-svr4 Sun Aug 10 22:46:33 1997 + *************** + *** 0 **** + --- 1,18 ---- + + # Define CC and OLDCC as the same, so that the tests: + + # if [ x"$(OLDCC)" = x"$(CC)" ] ... + + # + + # will succeed (if OLDCC != CC, it is assumed that GCC is + + # being used in secondary stage builds). + + # -Olimit is so the user can use -O2. Down with fixed + + # size tables! + + + + CC = $(OLDCC) + + OPT = + + OLDCC = cc -Olimit 3000 $(OPT) + + + + X_CFLAGS = -DNO_SYS_SIGLIST + + + + # Show we need to use the C version of ALLOCA + + # The SVR3 configurations have it, but the SVR4 configurations don't. + + # For now, just try using it for all SVR* configurations. + + ALLOCA = alloca.o + diff -rcp2N gcc-2.7.2.3/config/msdos/configur.bat gcc-2.7.2.3.f.1/config/msdos/configur.bat + *** gcc-2.7.2.3/config/msdos/configur.bat Mon Aug 28 09:55:47 1995 + --- gcc-2.7.2.3.f.1/config/msdos/configur.bat Sun Aug 10 23:08:05 1997 + *************** sed -f config/msdos/top.sed Makefile.in + *** 18,21 **** + --- 18,27 ---- + set LANG= + + + if not exist ada\make-lang.in goto no_ada + + sed -f config/msdos/top.sed ada\make-lang.in >> Makefile + + sed -f config/msdos/top.sed ada\makefile.in > ada\Makefile + + set LANG=%LANG% ada.& + + :no_ada + + + if not exist cp\make-lang.in goto no_cp + sed -f config/msdos/top.sed cp\make-lang.in >> Makefile + diff -rcp2N gcc-2.7.2.3/config/pa/pa.c gcc-2.7.2.3.f.1/config/pa/pa.c + *** gcc-2.7.2.3/config/pa/pa.c Sun Oct 22 11:45:20 1995 + --- gcc-2.7.2.3.f.1/config/pa/pa.c Sun Aug 10 22:45:44 1997 + *************** output_move_double (operands) + *** 1344,1369 **** + do them in the other order. + + ! RMS says "This happens only for registers; + ! such overlap can't happen in memory unless the user explicitly + ! sets it up, and that is an undefined circumstance." + ! + ! but it happens on the HP-PA when loading parameter registers, + ! so I am going to define that circumstance, and make it work + ! as expected. */ + + ! if (optype0 == REGOP && (optype1 == MEMOP || optype1 == OFFSOP) + ! && reg_overlap_mentioned_p (operands[0], XEXP (operands[1], 0))) + { + - /* XXX THIS PROBABLY DOESN'T WORK. */ + /* Do the late half first. */ + if (addreg1) + output_asm_insn ("ldo 4(%0),%0", &addreg1); + output_asm_insn (singlemove_string (latehalf), latehalf); + if (addreg1) + output_asm_insn ("ldo -4(%0),%0", &addreg1); + - /* Then clobber. */ + return singlemove_string (operands); + } + + if (optype0 == REGOP && optype1 == REGOP + && REGNO (operands[0]) == REGNO (operands[1]) + 1) + --- 1344,1377 ---- + do them in the other order. + + ! This can happen in two cases: + + ! mem -> register where the first half of the destination register + ! is the same register used in the memory's address. Reload + ! can create such insns. + ! + ! mem in this case will be either register indirect or register + ! indirect plus a valid offset. + ! + ! register -> register move where REGNO(dst) == REGNO(src + 1) + ! someone (Tim/Tege?) claimed this can happen for parameter loads. + ! + ! Handle mem -> register case first. */ + ! if (optype0 == REGOP + ! && (optype1 == MEMOP || optype1 == OFFSOP) + ! && refers_to_regno_p (REGNO (operands[0]), REGNO (operands[0]) + 1, + ! operands[1], 0)) + { + /* Do the late half first. */ + if (addreg1) + output_asm_insn ("ldo 4(%0),%0", &addreg1); + output_asm_insn (singlemove_string (latehalf), latehalf); + + + + /* Then clobber. */ + if (addreg1) + output_asm_insn ("ldo -4(%0),%0", &addreg1); + return singlemove_string (operands); + } + + + /* Now handle register -> register case. */ + if (optype0 == REGOP && optype1 == REGOP + && REGNO (operands[0]) == REGNO (operands[1]) + 1) + diff -rcp2N gcc-2.7.2.3/config/pa/pa.md gcc-2.7.2.3.f.1/config/pa/pa.md + *** gcc-2.7.2.3/config/pa/pa.md Mon Aug 14 13:00:49 1995 + --- gcc-2.7.2.3.f.1/config/pa/pa.md Sun Aug 10 22:45:45 1997 + *************** + *** 1828,1832 **** + (define_insn "" + [(set (match_operand:DF 0 "reg_or_nonsymb_mem_operand" + ! "=f,*r,Q,?o,?Q,f,*&r,*&r") + (match_operand:DF 1 "reg_or_0_or_nonsymb_mem_operand" + "fG,*rG,f,*r,*r,Q,o,Q"))] + --- 1828,1832 ---- + (define_insn "" + [(set (match_operand:DF 0 "reg_or_nonsymb_mem_operand" + ! "=f,*r,Q,?o,?Q,f,*r,*r") + (match_operand:DF 1 "reg_or_0_or_nonsymb_mem_operand" + "fG,*rG,f,*r,*r,Q,o,Q"))] + *************** + *** 1846,1850 **** + (define_insn "" + [(set (match_operand:DF 0 "reg_or_nonsymb_mem_operand" + ! "=r,?o,?Q,&r,&r") + (match_operand:DF 1 "reg_or_0_or_nonsymb_mem_operand" + "rG,r,r,o,Q"))] + --- 1846,1850 ---- + (define_insn "" + [(set (match_operand:DF 0 "reg_or_nonsymb_mem_operand" + ! "=r,?o,?Q,r,r") + (match_operand:DF 1 "reg_or_0_or_nonsymb_mem_operand" + "rG,r,r,o,Q"))] + *************** + *** 2019,2023 **** + (define_insn "" + [(set (match_operand:DI 0 "reg_or_nonsymb_mem_operand" + ! "=r,o,Q,&r,&r,&r,f,f,*T") + (match_operand:DI 1 "general_operand" + "rM,r,r,o,Q,i,fM,*T,f"))] + --- 2019,2023 ---- + (define_insn "" + [(set (match_operand:DI 0 "reg_or_nonsymb_mem_operand" + ! "=r,o,Q,r,r,r,f,f,*T") + (match_operand:DI 1 "general_operand" + "rM,r,r,o,Q,i,fM,*T,f"))] + *************** + *** 2037,2041 **** + (define_insn "" + [(set (match_operand:DI 0 "reg_or_nonsymb_mem_operand" + ! "=r,o,Q,&r,&r,&r") + (match_operand:DI 1 "general_operand" + "rM,r,r,o,Q,i"))] + --- 2037,2041 ---- + (define_insn "" + [(set (match_operand:DI 0 "reg_or_nonsymb_mem_operand" + ! "=r,o,Q,r,r,r") + (match_operand:DI 1 "general_operand" + "rM,r,r,o,Q,i"))] + diff -rcp2N gcc-2.7.2.3/config/rs6000/rs6000.c gcc-2.7.2.3.f.1/config/rs6000/rs6000.c + *** gcc-2.7.2.3/config/rs6000/rs6000.c Sat Jun 29 16:26:26 1996 + --- gcc-2.7.2.3.f.1/config/rs6000/rs6000.c Fri Aug 29 07:51:51 1997 + *************** input_operand (op, mode) + *** 724,730 **** + return 1; + + ! /* For HImode and QImode, any constant is valid. */ + ! if ((mode == HImode || mode == QImode) + ! && GET_CODE (op) == CONST_INT) + return 1; + + --- 724,729 ---- + return 1; + + ! /* For integer modes, any constant is ok. */ + ! if (GET_CODE (op) == CONST_INT) + return 1; + + *************** svr4_traceback (file, name, decl) + *** 2611,2614 **** + --- 2610,2682 ---- + #endif /* USING_SVR4_H */ + + + /* Write out an instruction to load the TOC_TABLE address into register 30. + + This is only needed when TARGET_TOC, TARGET_MINIMAL_TOC, and there is + + a constant pool. */ + + + + void + + rs6000_output_load_toc_table (file) + + FILE *file; + + { + + char buf[256]; + + + + #ifdef USING_SVR4_H + + if (TARGET_RELOCATABLE) + + { + + ASM_GENERATE_INTERNAL_LABEL (buf, "LCF", rs6000_pic_labelno); + + fprintf (file, "\tbl "); + + assemble_name (file, buf); + + fprintf (file, "\n"); + + + + ASM_OUTPUT_INTERNAL_LABEL (file, "LCF", rs6000_pic_labelno); + + fprintf (file, "\tmflr %s\n", reg_names[30]); + + + + if (TARGET_POWERPC64) + + fprintf (file, "\tld"); + + else if (TARGET_NEW_MNEMONICS) + + fprintf (file, "\tlwz"); + + else + + fprintf (file, "\tl"); + + + + fprintf (file, " %s,(", reg_names[0]); + + ASM_GENERATE_INTERNAL_LABEL (buf, "LCL", rs6000_pic_labelno); + + assemble_name (file, buf); + + fprintf (file, "-"); + + ASM_GENERATE_INTERNAL_LABEL (buf, "LCF", rs6000_pic_labelno); + + assemble_name (file, buf); + + fprintf (file, ")(%s)\n", reg_names[30]); + + asm_fprintf (file, "\t{cax|add} %s,%s,%s\n", + + reg_names[30], reg_names[0], reg_names[30]); + + rs6000_pic_labelno++; + + } + + else if (!TARGET_64BIT) + + { + + ASM_GENERATE_INTERNAL_LABEL (buf, "LCTOC", 1); + + asm_fprintf (file, "\t{cau|addis} %s,%s,", reg_names[30], reg_names[0]); + + assemble_name (file, buf); + + asm_fprintf (file, "@ha\n"); + + if (TARGET_NEW_MNEMONICS) + + { + + asm_fprintf (file, "\taddi %s,%s,", reg_names[30], reg_names[30]); + + assemble_name (file, buf); + + asm_fprintf (file, "@l\n"); + + } + + else + + { + + asm_fprintf (file, "\tcal %s,", reg_names[30]); + + assemble_name (file, buf); + + asm_fprintf (file, "@l(%s)\n", reg_names[30]); + + } + + } + + else + + abort (); + + + + #else /* !USING_SVR4_H */ + + ASM_GENERATE_INTERNAL_LABEL (buf, "LCTOC", 0); + + asm_fprintf (file, "\t{l|lwz} %s,", reg_names[30]); + + assemble_name (file, buf); + + asm_fprintf (file, "(%s)\n", reg_names[2]); + + #endif /* USING_SVR4_H */ + + } + + + /* Write function prologue. */ + void + *************** output_prolog (file, size) + *** 2770,2834 **** + TOC_TABLE address into register 30. */ + if (TARGET_TOC && TARGET_MINIMAL_TOC && get_pool_size () != 0) + ! { + ! char buf[256]; + ! + ! #ifdef USING_SVR4_H + ! if (TARGET_RELOCATABLE) + ! { + ! ASM_GENERATE_INTERNAL_LABEL (buf, "LCF", rs6000_pic_labelno); + ! fprintf (file, "\tbl "); + ! assemble_name (file, buf); + ! fprintf (file, "\n"); + ! + ! ASM_OUTPUT_INTERNAL_LABEL (file, "LCF", rs6000_pic_labelno); + ! fprintf (file, "\tmflr %s\n", reg_names[30]); + ! + ! if (TARGET_POWERPC64) + ! fprintf (file, "\tld"); + ! else if (TARGET_NEW_MNEMONICS) + ! fprintf (file, "\tlwz"); + ! else + ! fprintf (file, "\tl"); + ! + ! fprintf (file, " %s,(", reg_names[0]); + ! ASM_GENERATE_INTERNAL_LABEL (buf, "LCL", rs6000_pic_labelno); + ! assemble_name (file, buf); + ! fprintf (file, "-"); + ! ASM_GENERATE_INTERNAL_LABEL (buf, "LCF", rs6000_pic_labelno); + ! assemble_name (file, buf); + ! fprintf (file, ")(%s)\n", reg_names[30]); + ! asm_fprintf (file, "\t{cax|add} %s,%s,%s\n", + ! reg_names[30], reg_names[0], reg_names[30]); + ! rs6000_pic_labelno++; + ! } + ! else if (!TARGET_64BIT) + ! { + ! ASM_GENERATE_INTERNAL_LABEL (buf, "LCTOC", 1); + ! asm_fprintf (file, "\t{cau|addis} %s,%s,", reg_names[30], reg_names[0]); + ! assemble_name (file, buf); + ! asm_fprintf (file, "@ha\n"); + ! if (TARGET_NEW_MNEMONICS) + ! { + ! asm_fprintf (file, "\taddi %s,%s,", reg_names[30], reg_names[30]); + ! assemble_name (file, buf); + ! asm_fprintf (file, "@l\n"); + ! } + ! else + ! { + ! asm_fprintf (file, "\tcal %s,", reg_names[30]); + ! assemble_name (file, buf); + ! asm_fprintf (file, "@l(%s)\n", reg_names[30]); + ! } + ! } + ! else + ! abort (); + ! + ! #else /* !USING_SVR4_H */ + ! ASM_GENERATE_INTERNAL_LABEL (buf, "LCTOC", 0); + ! asm_fprintf (file, "\t{l|lwz} %s,", reg_names[30]); + ! assemble_name (file, buf); + ! asm_fprintf (file, "(%s)\n", reg_names[2]); + ! #endif /* USING_SVR4_H */ + ! } + } + + --- 2838,2842 ---- + TOC_TABLE address into register 30. */ + if (TARGET_TOC && TARGET_MINIMAL_TOC && get_pool_size () != 0) + ! rs6000_output_load_toc_table (file); + } + + diff -rcp2N gcc-2.7.2.3/config/rs6000/rs6000.md gcc-2.7.2.3.f.1/config/rs6000/rs6000.md + *** gcc-2.7.2.3/config/rs6000/rs6000.md Sat Jun 29 16:27:24 1996 + --- gcc-2.7.2.3.f.1/config/rs6000/rs6000.md Fri Aug 29 07:52:00 1997 + *************** + *** 4420,4423 **** + --- 4420,4424 ---- + } + + + emit_insn (gen_rtx (CLOBBER, VOIDmode, operands[0])); + emit_move_insn (gen_rtx (SUBREG, SImode, operands[0], WORDS_BIG_ENDIAN), + GEN_INT (low)); + *************** + *** 5409,5412 **** + --- 5410,5425 ---- + DONE; + }") + + + + ;; If we have -mmiminal-toc, we need to reload r30 after a nonlocal goto. + + + + (define_insn "nonlocal_goto_receiver" + + [(unspec_volatile [(const_int 0)] 1)] + + "TARGET_TOC && TARGET_MINIMAL_TOC && get_pool_size () != 0" + + "* + + { + + rs6000_output_load_toc_table (asm_out_file); + + return \"\"; + + }" + + [(set_attr "type" "load")]) + + ;; A function pointer is a pointer to a data area whose first word contains + diff -rcp2N gcc-2.7.2.3/config/sparc/sol2.h gcc-2.7.2.3.f.1/config/sparc/sol2.h + *** gcc-2.7.2.3/config/sparc/sol2.h Sat Aug 19 21:36:45 1995 + --- gcc-2.7.2.3.f.1/config/sparc/sol2.h Sun Aug 10 22:45:53 1997 + *************** do { \ + *** 166,168 **** + /* Define for support of TFmode long double and REAL_ARITHMETIC. + Sparc ABI says that long double is 4 words. */ + ! #define LONG_DOUBLE_TYPE_SIZE 128 + --- 166,168 ---- + /* Define for support of TFmode long double and REAL_ARITHMETIC. + Sparc ABI says that long double is 4 words. */ + ! #define LONG_DOUBLE_TYPE_SIZE 64 + diff -rcp2N gcc-2.7.2.3/config/sparc/sparc.c gcc-2.7.2.3.f.1/config/sparc/sparc.c + *** gcc-2.7.2.3/config/sparc/sparc.c Tue Sep 12 22:32:24 1995 + --- gcc-2.7.2.3.f.1/config/sparc/sparc.c Sun Aug 10 22:46:03 1997 + *************** Boston, MA 02111-1307, USA. */ + *** 40,46 **** + /* 1 if the caller has placed an "unimp" insn immediately after the call. + This is used in v8 code when calling a function that returns a structure. + ! v9 doesn't have this. */ + + ! #define SKIP_CALLERS_UNIMP_P (!TARGET_V9 && current_function_returns_struct) + + /* Global variables for machine-dependent things. */ + --- 40,51 ---- + /* 1 if the caller has placed an "unimp" insn immediately after the call. + This is used in v8 code when calling a function that returns a structure. + ! v9 doesn't have this. Be careful to have this test be the same as that + ! used on the call. */ + + ! #define SKIP_CALLERS_UNIMP_P \ + ! (!TARGET_V9 && current_function_returns_struct \ + ! && ! integer_zerop (DECL_SIZE (DECL_RESULT (current_function_decl))) \ + ! && (TREE_CODE (DECL_SIZE (DECL_RESULT (current_function_decl))) \ + ! == INTEGER_CST)) + + /* Global variables for machine-dependent things. */ + diff -rcp2N gcc-2.7.2.3/config/sparc/sparc.h gcc-2.7.2.3.f.1/config/sparc/sparc.h + *** gcc-2.7.2.3/config/sparc/sparc.h Sat Jun 29 16:25:54 1996 + --- gcc-2.7.2.3.f.1/config/sparc/sparc.h Sun Aug 10 22:46:13 1997 + *************** extern int leaf_function; + *** 1526,1533 **** + + /* Output assembler code to FILE to increment profiler label # LABELNO + ! for profiling a function entry. */ + + #define FUNCTION_PROFILER(FILE, LABELNO) \ + do { \ + fputs ("\tsethi %hi(", (FILE)); \ + ASM_OUTPUT_INTERNAL_LABELREF (FILE, "LP", LABELNO); \ + --- 1526,1540 ---- + + /* Output assembler code to FILE to increment profiler label # LABELNO + ! for profiling a function entry. + ! + ! 32 bit sparc uses %g2 as the STATIC_CHAIN_REGNUM which gets clobbered + ! during profiling so we need to save/restore it around the call to mcount. + ! We're guaranteed that a save has just been done, and we use the space + ! allocated for intreg/fpreg value passing. */ + + #define FUNCTION_PROFILER(FILE, LABELNO) \ + do { \ + + if (! TARGET_V9) \ + + fputs ("\tst %g2,[%fp-4]\n", FILE); \ + fputs ("\tsethi %hi(", (FILE)); \ + ASM_OUTPUT_INTERNAL_LABELREF (FILE, "LP", LABELNO); \ + *************** extern int leaf_function; + *** 1539,1542 **** + --- 1546,1551 ---- + ASM_OUTPUT_INTERNAL_LABELREF (FILE, "LP", LABELNO); \ + fputs ("),%o0,%o0\n", (FILE)); \ + + if (! TARGET_V9) \ + + fputs ("\tld [%fp-4],%g2\n", FILE); \ + } while (0) + + diff -rcp2N gcc-2.7.2.3/config/sparc/sparc.md gcc-2.7.2.3.f.1/config/sparc/sparc.md + *** gcc-2.7.2.3/config/sparc/sparc.md Tue Sep 12 22:57:35 1995 + --- gcc-2.7.2.3.f.1/config/sparc/sparc.md Sun Aug 10 22:46:27 1997 + *************** + *** 4799,4803 **** + abort (); + + ! if (GET_CODE (XEXP (operands[0], 0)) == LABEL_REF) + { + /* This is really a PIC sequence. We want to represent + --- 4799,4803 ---- + abort (); + + ! if (GET_CODE (XEXP (operands[0], 0)) == LABEL_REF) + { + /* This is really a PIC sequence. We want to represent + *************** + *** 4809,4824 **** + + if (! TARGET_V9 && INTVAL (operands[3]) != 0) + ! emit_jump_insn (gen_rtx (PARALLEL, VOIDmode, gen_rtvec (3, + ! gen_rtx (SET, VOIDmode, pc_rtx, + ! XEXP (operands[0], 0)), + ! operands[3], + ! gen_rtx (CLOBBER, VOIDmode, + ! gen_rtx (REG, Pmode, 15))))); + else + ! emit_jump_insn (gen_rtx (PARALLEL, VOIDmode, gen_rtvec (2, + ! gen_rtx (SET, VOIDmode, pc_rtx, + ! XEXP (operands[0], 0)), + ! gen_rtx (CLOBBER, VOIDmode, + ! gen_rtx (REG, Pmode, 15))))); + goto finish_call; + } + --- 4809,4828 ---- + + if (! TARGET_V9 && INTVAL (operands[3]) != 0) + ! emit_jump_insn + ! (gen_rtx (PARALLEL, VOIDmode, + ! gen_rtvec (3, + ! gen_rtx (SET, VOIDmode, pc_rtx, + ! XEXP (operands[0], 0)), + ! GEN_INT (INTVAL (operands[3]) & 0xfff), + ! gen_rtx (CLOBBER, VOIDmode, + ! gen_rtx (REG, Pmode, 15))))); + else + ! emit_jump_insn + ! (gen_rtx (PARALLEL, VOIDmode, + ! gen_rtvec (2, + ! gen_rtx (SET, VOIDmode, pc_rtx, + ! XEXP (operands[0], 0)), + ! gen_rtx (CLOBBER, VOIDmode, + ! gen_rtx (REG, Pmode, 15))))); + goto finish_call; + } + *************** + *** 4839,4852 **** + + if (! TARGET_V9 && INTVAL (operands[3]) != 0) + ! emit_call_insn (gen_rtx (PARALLEL, VOIDmode, gen_rtvec (3, + ! gen_rtx (CALL, VOIDmode, fn_rtx, nregs_rtx), + ! operands[3], + ! gen_rtx (CLOBBER, VOIDmode, + ! gen_rtx (REG, Pmode, 15))))); + else + ! emit_call_insn (gen_rtx (PARALLEL, VOIDmode, gen_rtvec (2, + ! gen_rtx (CALL, VOIDmode, fn_rtx, nregs_rtx), + ! gen_rtx (CLOBBER, VOIDmode, + ! gen_rtx (REG, Pmode, 15))))); + + finish_call: + --- 4843,4858 ---- + + if (! TARGET_V9 && INTVAL (operands[3]) != 0) + ! emit_call_insn + ! (gen_rtx (PARALLEL, VOIDmode, + ! gen_rtvec (3, gen_rtx (CALL, VOIDmode, fn_rtx, nregs_rtx), + ! GEN_INT (INTVAL (operands[3]) & 0xfff), + ! gen_rtx (CLOBBER, VOIDmode, + ! gen_rtx (REG, Pmode, 15))))); + else + ! emit_call_insn + ! (gen_rtx (PARALLEL, VOIDmode, + ! gen_rtvec (2, gen_rtx (CALL, VOIDmode, fn_rtx, nregs_rtx), + ! gen_rtx (CLOBBER, VOIDmode, + ! gen_rtx (REG, Pmode, 15))))); + + finish_call: + *************** + *** 4911,4915 **** + (clobber (reg:SI 15))] + ;;- Do not use operand 1 for most machines. + ! "! TARGET_V9 && GET_CODE (operands[2]) == CONST_INT && INTVAL (operands[2]) > 0" + "call %a0,%1\;nop\;unimp %2" + [(set_attr "type" "call_no_delay_slot")]) + --- 4917,4921 ---- + (clobber (reg:SI 15))] + ;;- Do not use operand 1 for most machines. + ! "! TARGET_V9 && GET_CODE (operands[2]) == CONST_INT && INTVAL (operands[2]) >= 0" + "call %a0,%1\;nop\;unimp %2" + [(set_attr "type" "call_no_delay_slot")]) + *************** + *** 4923,4927 **** + (clobber (reg:SI 15))] + ;;- Do not use operand 1 for most machines. + ! "! TARGET_V9 && GET_CODE (operands[2]) == CONST_INT && INTVAL (operands[2]) > 0" + "call %a0,%1\;nop\;unimp %2" + [(set_attr "type" "call_no_delay_slot")]) + --- 4929,4933 ---- + (clobber (reg:SI 15))] + ;;- Do not use operand 1 for most machines. + ! "! TARGET_V9 && GET_CODE (operands[2]) == CONST_INT && INTVAL (operands[2]) >= 0" + "call %a0,%1\;nop\;unimp %2" + [(set_attr "type" "call_no_delay_slot")]) + *************** + *** 5178,5184 **** + emit_insn (gen_rtx (USE, VOIDmode, stack_pointer_rtx)); + emit_insn (gen_rtx (USE, VOIDmode, static_chain_rtx)); + - emit_insn (gen_rtx (USE, VOIDmode, gen_rtx (REG, Pmode, 8))); + /* Return, restoring reg window and jumping to goto handler. */ + emit_insn (gen_goto_handler_and_restore ()); + DONE; + }") + --- 5184,5190 ---- + emit_insn (gen_rtx (USE, VOIDmode, stack_pointer_rtx)); + emit_insn (gen_rtx (USE, VOIDmode, static_chain_rtx)); + /* Return, restoring reg window and jumping to goto handler. */ + emit_insn (gen_goto_handler_and_restore ()); + + emit_barrier (); + DONE; + }") + *************** + *** 5192,5200 **** + + (define_insn "goto_handler_and_restore" + ! [(unspec_volatile [(const_int 0)] 2)] + "" + "jmp %%o0+0\;restore" + [(set_attr "type" "misc") + (set_attr "length" "2")]) + + ;; Special pattern for the FLUSH instruction. + --- 5198,5237 ---- + + (define_insn "goto_handler_and_restore" + ! [(unspec_volatile [(const_int 0)] 2) + ! (use (reg:SI 8))] + "" + "jmp %%o0+0\;restore" + [(set_attr "type" "misc") + (set_attr "length" "2")]) + + + + ;; Pattern for use after a setjmp to store FP and the return register + + ;; into the stack area. + + + + (define_expand "setjmp" + + [(const_int 0)] + + "" + + " + + { + + if (TARGET_V9) + + emit_insn (gen_setjmp_64 ()); + + else + + emit_insn (gen_setjmp_32 ()); + + + + DONE; + + }") + + + + (define_expand "setjmp_32" + + [(set (mem:SI (plus:SI (reg:SI 14) (const_int 56))) (match_dup 0)) + + (set (mem:SI (plus:SI (reg:SI 14) (const_int 60))) (reg:SI 31))] + + "" + + " + + { operands[0] = frame_pointer_rtx; }") + + + + (define_expand "setjmp_64" + + [(set (mem:DI (plus:DI (reg:DI 14) (const_int 112))) (match_dup 0)) + + (set (mem:DI (plus:DI (reg:DI 14) (const_int 120))) (reg:DI 31))] + + "" + + " + + { operands[0] = frame_pointer_rtx; }") + + ;; Special pattern for the FLUSH instruction. + diff -rcp2N gcc-2.7.2.3/config/x-linux gcc-2.7.2.3.f.1/config/x-linux + *** gcc-2.7.2.3/config/x-linux Tue Mar 28 12:43:37 1995 + --- gcc-2.7.2.3.f.1/config/x-linux Fri Jul 11 00:08:49 1997 + *************** BOOT_CFLAGS = -O $(CFLAGS) -Iinclude + *** 13,14 **** + --- 13,17 ---- + # Don't run fixproto + STMP_FIXPROTO = + + + + # Don't install "assert.h" in gcc. We use the one in glibc. + + INSTALL_ASSERT_H = + diff -rcp2N gcc-2.7.2.3/config/x-linux-aout gcc-2.7.2.3.f.1/config/x-linux-aout + *** gcc-2.7.2.3/config/x-linux-aout Thu Jan 1 00:00:00 1970 + --- gcc-2.7.2.3.f.1/config/x-linux-aout Fri Jul 11 00:08:49 1997 + *************** + *** 0 **** + --- 1,14 ---- + + # It is defined in config/xm-linux.h. + + # X_CFLAGS = -DPOSIX + + + + # The following is needed when compiling stages 2 and 3 because gcc's + + # limits.h must be picked up before /usr/include/limits.h. This is because + + # each does an #include_next of the other if the other hasn't been included. + + # /usr/include/limits.h loses if it gets found first because /usr/include is + + # at the end of the search order. When a new version of gcc is released, + + # gcc's limits.h hasn't been installed yet and hence isn't found. + + + + BOOT_CFLAGS = -O $(CFLAGS) -Iinclude + + + + # Don't run fixproto + + STMP_FIXPROTO = + diff -rcp2N gcc-2.7.2.3/config.guess gcc-2.7.2.3.f.1/config.guess + *** gcc-2.7.2.3/config.guess Sun Aug 31 09:39:43 1997 + --- gcc-2.7.2.3.f.1/config.guess Sun Aug 31 09:21:10 1997 + *************** trap 'rm -f dummy.c dummy.o dummy; exit + *** 52,63 **** + + case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + - alpha:OSF1:V*:*) + - # After 1.2, OSF1 uses "V1.3" for uname -r. + - echo alpha-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^V//'` + - exit 0 ;; + alpha:OSF1:*:*) + # 1.2 uses "1.2" for uname -r. + ! echo alpha-dec-osf${UNAME_RELEASE} + ! exit 0 ;; + 21064:Windows_NT:50:3) + echo alpha-dec-winnt3.5 + --- 52,62 ---- + + case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + alpha:OSF1:*:*) + + # A Vn.n version is a released version. + + # A Tn.n version is a released field test version. + + # A Xn.n version is an unreleased experimental baselevel. + # 1.2 uses "1.2" for uname -r. + ! echo alpha-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VTX]//'` + ! exit 0 ;; + 21064:Windows_NT:50:3) + echo alpha-dec-winnt3.5 + *************** case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ + *** 154,161 **** + echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` + exit 0 ;; + ! ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. + echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id + exit 0 ;; # Note that: echo "'`uname -s`'" gives 'AIX ' + ! i[34]86:AIX:*:*) + echo i386-ibm-aix + exit 0 ;; + --- 153,160 ---- + echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` + exit 0 ;; + ! ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. + echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id + exit 0 ;; # Note that: echo "'`uname -s`'" gives 'AIX ' + ! i?86:AIX:*:*) + echo i386-ibm-aix + exit 0 ;; + *************** EOF + *** 220,224 **** + 9000/31? ) HP_ARCH=m68000 ;; + 9000/[34]?? ) HP_ARCH=m68k ;; + ! 9000/7?? | 9000/8?[79] ) HP_ARCH=hppa1.1 ;; + 9000/8?? ) HP_ARCH=hppa1.0 ;; + esac + --- 219,223 ---- + 9000/31? ) HP_ARCH=m68000 ;; + 9000/[34]?? ) HP_ARCH=m68k ;; + ! 9000/7?? | 9000/8?[1679] ) HP_ARCH=hppa1.1 ;; + 9000/8?? ) HP_ARCH=hppa1.0 ;; + esac + *************** EOF + *** 304,308 **** + echo m68k-hp-netbsd${UNAME_RELEASE} + exit 0 ;; + ! i[34]86:BSD/386:*:* | *:BSD/OS:*:*) + echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} + exit 0 ;; + --- 303,307 ---- + echo m68k-hp-netbsd${UNAME_RELEASE} + exit 0 ;; + ! i?86:BSD/386:*:* | *:BSD/OS:*:*) + echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} + exit 0 ;; + *************** EOF + *** 314,318 **** + exit 0 ;; + *:GNU:*:*) + ! echo `echo ${UNAME_MACHINE}|sed -e 's,/.*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` + exit 0 ;; + *:Linux:*:*) + --- 313,317 ---- + exit 0 ;; + *:GNU:*:*) + ! echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` + exit 0 ;; + *:Linux:*:*) + *************** EOF + *** 320,330 **** + # first see if it will tell us. + ld_help_string=`ld --help 2>&1` + ! # if echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: elf_i[345]86"; then + # echo "${UNAME_MACHINE}-unknown-linux" ; exit 0 + ! if echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: i[345]86linux"; then + echo "${UNAME_MACHINE}-unknown-linuxaout" ; exit 0 + ! elif echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: i[345]86coff"; then + echo "${UNAME_MACHINE}-unknown-linuxcoff" ; exit 0 + elif test "${UNAME_MACHINE}" = "alpha" ; then + echo alpha-unknown-linux ; exit 0 + else + --- 319,333 ---- + # first see if it will tell us. + ld_help_string=`ld --help 2>&1` + ! # if echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: elf_i?86"; then + # echo "${UNAME_MACHINE}-unknown-linux" ; exit 0 + ! if echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: i?86linux"; then + echo "${UNAME_MACHINE}-unknown-linuxaout" ; exit 0 + ! elif echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: i?86coff"; then + echo "${UNAME_MACHINE}-unknown-linuxcoff" ; exit 0 + elif test "${UNAME_MACHINE}" = "alpha" ; then + + as_version_string=`as --version 2>&1` + + if echo $as_version_string | grep >/dev/null 2>&1 " version 2.6 "; then + + echo alpha-unknown-linuxoldas ; exit 0 + + fi + echo alpha-unknown-linux ; exit 0 + else + *************** EOF + *** 362,369 **** + # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. earlier versions + # are messed up and put the nodename in both sysname and nodename. + ! i[34]86:DYNIX/ptx:4*:*) + echo i386-sequent-sysv4 + exit 0 ;; + ! i[34]86:*:4.*:* | i[34]86:SYSTEM_V:4.*:*) + if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then + echo ${UNAME_MACHINE}-univel-sysv${UNAME_RELEASE} + --- 365,372 ---- + # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. earlier versions + # are messed up and put the nodename in both sysname and nodename. + ! i?86:DYNIX/ptx:4*:*) + echo i386-sequent-sysv4 + exit 0 ;; + ! i?86:*:4.*:* | i?86:SYSTEM_V:4.*:*) + if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then + echo ${UNAME_MACHINE}-univel-sysv${UNAME_RELEASE} + *************** EOF + *** 372,376 **** + fi + exit 0 ;; + ! i[34]86:*:3.2:*) + if test -f /usr/options/cb.name; then + UNAME_REL=`sed -n 's/.*Version //p' /dev/null) && UNAME_MACHINE=i486 + + (/bin/uname -X|egrep '^Machine.*Pentium' >/dev/null) \ + + && UNAME_MACHINE=i586 + echo ${UNAME_MACHINE}-unknown-sco$UNAME_REL + else + *************** EOF + *** 401,405 **** + echo m68010-convergent-sysv + exit 0 ;; + ! M680[234]0:*:R3V[567]*:*) + test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;; + 3[34]??:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0) + --- 406,410 ---- + echo m68010-convergent-sysv + exit 0 ;; + ! M68*:*:R3V[567]*:*) + test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;; + 3[34]??:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0) + *************** EOF + *** 409,413 **** + uname -p 2>/dev/null | grep 86 >/dev/null \ + && echo i486-ncr-sysv4 && exit 0 ;; + ! m680[234]0:LynxOS:2.[23]*:*) + echo m68k-lynx-lynxos${UNAME_RELEASE} + exit 0 ;; + --- 414,418 ---- + uname -p 2>/dev/null | grep 86 >/dev/null \ + && echo i486-ncr-sysv4 && exit 0 ;; + ! m68*:LynxOS:2.*:*) + echo m68k-lynx-lynxos${UNAME_RELEASE} + exit 0 ;; + *************** EOF + *** 415,425 **** + echo m68k-atari-sysv4 + exit 0 ;; + ! i[34]86:LynxOS:2.[23]*:*) + echo i386-lynx-lynxos${UNAME_RELEASE} + exit 0 ;; + ! TSUNAMI:LynxOS:2.[23]*:*) + echo sparc-lynx-lynxos${UNAME_RELEASE} + exit 0 ;; + ! rs6000:LynxOS:2.[23]*:*) + echo rs6000-lynx-lynxos${UNAME_RELEASE} + exit 0 ;; + --- 420,430 ---- + echo m68k-atari-sysv4 + exit 0 ;; + ! i?86:LynxOS:2.*:*) + echo i386-lynx-lynxos${UNAME_RELEASE} + exit 0 ;; + ! TSUNAMI:LynxOS:2.*:*) + echo sparc-lynx-lynxos${UNAME_RELEASE} + exit 0 ;; + ! rs6000:LynxOS:2.*:* | PowerPC:LynxOS:2.*:*) + echo rs6000-lynx-lynxos${UNAME_RELEASE} + exit 0 ;; + *************** main () + *** 478,482 **** + int version; + version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; + ! printf ("%s-next-nextstep%s\n", __ARCHITECTURE__, version==2 ? "2" : "3"); + exit (0); + #endif + --- 483,487 ---- + int version; + version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; + ! printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); + exit (0); + #endif + diff -rcp2N gcc-2.7.2.3/configure gcc-2.7.2.3.f.1/configure + *** gcc-2.7.2.3/configure Sun Aug 31 09:39:44 1997 + --- gcc-2.7.2.3.f.1/configure Sun Aug 31 09:35:10 1997 + *************** exec_prefix='$(prefix)' + *** 82,85 **** + --- 82,86 ---- + # The default g++ include directory is $(libdir)/g++-include. + gxx_include_dir='$(libdir)/g++-include' + + #gxx_include_dir='$(exec_prefix)/include/g++' + + # Default --program-transform-name to nothing. + *************** for machine in $canon_build $canon_host + *** 548,551 **** + --- 549,578 ---- + use_collect2=yes + ;; + + alpha-*-linux*oldas*) + + tm_file=alpha/linux.h + + tmake_file=alpha/t-linux + + xmake_file=alpha/x-linux + + fixincludes=Makefile.in + + xm_file=alpha/xm-linux.h + + gas=yes gnu_ld=yes + + ;; + + alpha-*-linux*ecoff*) + + tm_file=alpha/linux.h + + tmake_file=alpha/t-linux + + xmake_file=alpha/x-linux + + fixincludes=Makefile.in + + xm_file=alpha/xm-linux.h + + extra_parts="crtbegin.o crtbeginS.o crtend.o crtendS.o" + + gas=yes gnu_ld=yes + + ;; + + alpha-*-linux*) + + tm_file=alpha/elf.h + + tmake_file=alpha/t-linux + + xmake_file=alpha/x-linux + + fixincludes=Makefile.in + + xm_file=alpha/xm-linux.h + + extra_parts="crtbegin.o crtbeginS.o crtend.o crtendS.o" + + gas=yes gnu_ld=yes + + ;; + alpha-dec-osf[23456789]*) + tm_file=alpha/osf2.h + *************** for machine in $canon_build $canon_host + *** 982,986 **** + cpu_type=i386 # with a.out format using pre BFD linkers + xm_file=i386/xm-linux.h + ! xmake_file=x-linux + tm_file=i386/linux-oldld.h + fixincludes=Makefile.in # The headers are ok already. + --- 1009,1013 ---- + cpu_type=i386 # with a.out format using pre BFD linkers + xm_file=i386/xm-linux.h + ! xmake_file=x-linux-aout + tm_file=i386/linux-oldld.h + fixincludes=Makefile.in # The headers are ok already. + *************** for machine in $canon_build $canon_host + *** 991,995 **** + cpu_type=i386 # with a.out format + xm_file=i386/xm-linux.h + ! xmake_file=x-linux + tm_file=i386/linux-aout.h + fixincludes=Makefile.in # The headers are ok already. + --- 1018,1022 ---- + cpu_type=i386 # with a.out format + xm_file=i386/xm-linux.h + ! xmake_file=x-linux-aout + tm_file=i386/linux-aout.h + fixincludes=Makefile.in # The headers are ok already. + *************** for machine in $canon_build $canon_host + *** 1663,1666 **** + --- 1690,1714 ---- + use_collect2=yes + ;; + + mips-sni-sysv4) + + if [ x$gas = xyes ] + + then + + if [ x$stabs = xyes ] + + then + + tm_file=mips/iris5gdb.h + + else + + tm_file=mips/sni-gas.h + + fi + + else + + tm_file=mips/sni-svr4.h + + fi + + xm_file=mips/xm-sysv.h + + xmake_file=mips/x-sni-svr4 + + tmake_file=mips/t-mips-gas + + if [ x$gnu_ld != xyes ] + + then + + use_collect2=yes + + fi + + broken_install=yes + + ;; + mips-sgi-irix5*) # SGI System V.4., IRIX 5 + if [ x$gas = xyes ] + *************** MAYBE_TARGET_DEFAULT = -DTARGET_CPU_DEFA + *** 2995,2999 **** + rm Makefile.sed + echo 's| ||' > Makefile.sed + ! echo "s|^target=.*$|target=${target}|" >> Makefile.sed + echo "s|^xmake_file=.*$|xmake_file=${dep_host_xmake_file}|" >> Makefile.sed + echo "s|^tmake_file=.*$|tmake_file=${dep_tmake_file}|" >> Makefile.sed + --- 3043,3047 ---- + rm Makefile.sed + echo 's| ||' > Makefile.sed + ! echo "s|^target=.*$|target=${canon_target}|" >> Makefile.sed + echo "s|^xmake_file=.*$|xmake_file=${dep_host_xmake_file}|" >> Makefile.sed + echo "s|^tmake_file=.*$|tmake_file=${dep_tmake_file}|" >> Makefile.sed + diff -rcp2N gcc-2.7.2.3/cse.c gcc-2.7.2.3.f.1/cse.c + *** gcc-2.7.2.3/cse.c Sun Aug 31 09:39:46 1997 + --- gcc-2.7.2.3.f.1/cse.c Sun Aug 31 09:21:14 1997 + *************** static struct table_elt *last_jump_equiv + *** 520,544 **** + static int constant_pool_entries_cost; + + - /* Bits describing what kind of values in memory must be invalidated + - for a particular instruction. If all three bits are zero, + - no memory refs need to be invalidated. Each bit is more powerful + - than the preceding ones, and if a bit is set then the preceding + - bits are also set. + - + - Here is how the bits are set: + - Pushing onto the stack invalidates only the stack pointer, + - writing at a fixed address invalidates only variable addresses, + - writing in a structure element at variable address + - invalidates all but scalar variables, + - and writing in anything else at variable address invalidates everything. */ + - + - struct write_data + - { + - int sp : 1; /* Invalidate stack pointer. */ + - int var : 1; /* Invalidate variable addresses. */ + - int nonscalar : 1; /* Invalidate all but scalar variables. */ + - int all : 1; /* Invalidate all memory refs. */ + - }; + - + /* Define maximum length of a branch path. */ + + --- 520,523 ---- + *************** static void merge_equiv_classes PROTO((s + *** 626,632 **** + struct table_elt *)); + static void invalidate PROTO((rtx, enum machine_mode)); + static void remove_invalid_refs PROTO((int)); + static void rehash_using_reg PROTO((rtx)); + ! static void invalidate_memory PROTO((struct write_data *)); + static void invalidate_for_call PROTO((void)); + static rtx use_related_value PROTO((rtx, struct table_elt *)); + --- 605,612 ---- + struct table_elt *)); + static void invalidate PROTO((rtx, enum machine_mode)); + + static int cse_rtx_varies_p PROTO((rtx)); + static void remove_invalid_refs PROTO((int)); + static void rehash_using_reg PROTO((rtx)); + ! static void invalidate_memory PROTO((void)); + static void invalidate_for_call PROTO((void)); + static rtx use_related_value PROTO((rtx, struct table_elt *)); + *************** static void set_nonvarying_address_compo + *** 638,644 **** + HOST_WIDE_INT *)); + static int refers_to_p PROTO((rtx, rtx)); + - static int refers_to_mem_p PROTO((rtx, rtx, HOST_WIDE_INT, + - HOST_WIDE_INT)); + - static int cse_rtx_addr_varies_p PROTO((rtx)); + static rtx canon_reg PROTO((rtx, rtx)); + static void find_best_addr PROTO((rtx, rtx *)); + --- 618,621 ---- + *************** static void record_jump_cond PROTO((enum + *** 656,661 **** + rtx, rtx, int)); + static void cse_insn PROTO((rtx, int)); + ! static void note_mem_written PROTO((rtx, struct write_data *)); + ! static void invalidate_from_clobbers PROTO((struct write_data *, rtx)); + static rtx cse_process_notes PROTO((rtx, rtx)); + static void cse_around_loop PROTO((rtx)); + --- 633,638 ---- + rtx, rtx, int)); + static void cse_insn PROTO((rtx, int)); + ! static int note_mem_written PROTO((rtx)); + ! static void invalidate_from_clobbers PROTO((rtx)); + static rtx cse_process_notes PROTO((rtx, rtx)); + static void cse_around_loop PROTO((rtx)); + *************** invalidate (x, full_mode) + *** 1512,1517 **** + register int i; + register struct table_elt *p; + - rtx base; + - HOST_WIDE_INT start, end; + + /* If X is a register, dependencies on its contents + --- 1489,1492 ---- + *************** invalidate (x, full_mode) + *** 1605,1611 **** + full_mode = GET_MODE (x); + + - set_nonvarying_address_components (XEXP (x, 0), GET_MODE_SIZE (full_mode), + - &base, &start, &end); + - + for (i = 0; i < NBUCKETS; i++) + { + --- 1580,1583 ---- + *************** invalidate (x, full_mode) + *** 1614,1618 **** + { + next = p->next_same_hash; + ! if (refers_to_mem_p (p->exp, base, start, end)) + remove_from_table (p, i); + } + --- 1586,1594 ---- + { + next = p->next_same_hash; + ! /* Invalidate ASM_OPERANDS which reference memory (this is easier + ! than checking all the aliases). */ + ! if (p->in_memory + ! && (GET_CODE (p->exp) != MEM + ! || true_dependence (x, full_mode, p->exp, cse_rtx_varies_p))) + remove_from_table (p, i); + } + *************** rehash_using_reg (x) + *** 1695,1722 **** + } + + - /* Remove from the hash table all expressions that reference memory, + - or some of them as specified by *WRITES. */ + - + - static void + - invalidate_memory (writes) + - struct write_data *writes; + - { + - register int i; + - register struct table_elt *p, *next; + - int all = writes->all; + - int nonscalar = writes->nonscalar; + - + - for (i = 0; i < NBUCKETS; i++) + - for (p = table[i]; p; p = next) + - { + - next = p->next_same_hash; + - if (p->in_memory + - && (all + - || (nonscalar && p->in_struct) + - || cse_rtx_addr_varies_p (p->exp))) + - remove_from_table (p, i); + - } + - } + - + /* Remove from the hash table any expression that is a call-clobbered + register. Also update their TICK values. */ + --- 1671,1674 ---- + *************** invalidate_for_call () + *** 1756,1759 **** + --- 1708,1717 ---- + next = p->next_same_hash; + + + if (p->in_memory) + + { + + remove_from_table (p, hash); + + continue; + + } + + + if (GET_CODE (p->exp) != REG + || REGNO (p->exp) >= FIRST_PSEUDO_REGISTER) + *************** canon_hash (x, mode) + *** 1946,1950 **** + return 0; + } + ! if (! RTX_UNCHANGING_P (x)) + { + hash_arg_in_memory = 1; + --- 1904,1908 ---- + return 0; + } + ! if (! RTX_UNCHANGING_P (x) || FIXED_BASE_PLUS_P (XEXP (x, 0))) + { + hash_arg_in_memory = 1; + *************** set_nonvarying_address_components (addr, + *** 2395,2477 **** + } + + ! /* Return 1 iff any subexpression of X refers to memory + ! at an address of BASE plus some offset + ! such that any of the bytes' offsets fall between START (inclusive) + ! and END (exclusive). + ! + ! The value is undefined if X is a varying address (as determined by + ! cse_rtx_addr_varies_p). This function is not used in such cases. + ! + ! When used in the cse pass, `qty_const' is nonzero, and it is used + ! to treat an address that is a register with a known constant value + ! as if it were that constant value. + ! In the loop pass, `qty_const' is zero, so this is not done. */ + ! + ! static int + ! refers_to_mem_p (x, base, start, end) + ! rtx x, base; + ! HOST_WIDE_INT start, end; + ! { + ! register HOST_WIDE_INT i; + ! register enum rtx_code code; + ! register char *fmt; + ! + ! repeat: + ! if (x == 0) + ! return 0; + ! + ! code = GET_CODE (x); + ! if (code == MEM) + ! { + ! register rtx addr = XEXP (x, 0); /* Get the address. */ + ! rtx mybase; + ! HOST_WIDE_INT mystart, myend; + ! + ! set_nonvarying_address_components (addr, GET_MODE_SIZE (GET_MODE (x)), + ! &mybase, &mystart, &myend); + ! + ! + ! /* refers_to_mem_p is never called with varying addresses. + ! If the base addresses are not equal, there is no chance + ! of the memory addresses conflicting. */ + ! if (! rtx_equal_p (mybase, base)) + ! return 0; + ! + ! return myend > start && mystart < end; + ! } + ! + ! /* X does not match, so try its subexpressions. */ + ! + ! fmt = GET_RTX_FORMAT (code); + ! for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--) + ! if (fmt[i] == 'e') + ! { + ! if (i == 0) + ! { + ! x = XEXP (x, 0); + ! goto repeat; + ! } + ! else + ! if (refers_to_mem_p (XEXP (x, i), base, start, end)) + ! return 1; + ! } + ! else if (fmt[i] == 'E') + ! { + ! int j; + ! for (j = 0; j < XVECLEN (x, i); j++) + ! if (refers_to_mem_p (XVECEXP (x, i, j), base, start, end)) + ! return 1; + ! } + ! + ! return 0; + ! } + ! + ! /* Nonzero if X refers to memory at a varying address; + except that a register which has at the moment a known constant value + isn't considered variable. */ + + static int + ! cse_rtx_addr_varies_p (x) + ! rtx x; + { + /* We need not check for X and the equivalence class being of the same + --- 2353,2363 ---- + } + + ! /* Nonzero if X, a memory address, refers to a varying address; + except that a register which has at the moment a known constant value + isn't considered variable. */ + + static int + ! cse_rtx_varies_p (x) + ! register rtx x; + { + /* We need not check for X and the equivalence class being of the same + *************** cse_rtx_addr_varies_p (x) + *** 2479,2497 **** + doesn't vary in any mode. */ + + ! if (GET_CODE (x) == MEM + ! && GET_CODE (XEXP (x, 0)) == REG + ! && REGNO_QTY_VALID_P (REGNO (XEXP (x, 0))) + ! && GET_MODE (XEXP (x, 0)) == qty_mode[reg_qty[REGNO (XEXP (x, 0))]] + ! && qty_const[reg_qty[REGNO (XEXP (x, 0))]] != 0) + return 0; + + ! if (GET_CODE (x) == MEM + ! && GET_CODE (XEXP (x, 0)) == PLUS + ! && GET_CODE (XEXP (XEXP (x, 0), 1)) == CONST_INT + ! && GET_CODE (XEXP (XEXP (x, 0), 0)) == REG + ! && REGNO_QTY_VALID_P (REGNO (XEXP (XEXP (x, 0), 0))) + ! && (GET_MODE (XEXP (XEXP (x, 0), 0)) + ! == qty_mode[reg_qty[REGNO (XEXP (XEXP (x, 0), 0))]]) + ! && qty_const[reg_qty[REGNO (XEXP (XEXP (x, 0), 0))]]) + return 0; + + --- 2365,2381 ---- + doesn't vary in any mode. */ + + ! if (GET_CODE (x) == REG + ! && REGNO_QTY_VALID_P (REGNO (x)) + ! && GET_MODE (x) == qty_mode[reg_qty[REGNO (x)]] + ! && qty_const[reg_qty[REGNO (x)]] != 0) + return 0; + + ! if (GET_CODE (x) == PLUS + ! && GET_CODE (XEXP (x, 1)) == CONST_INT + ! && GET_CODE (XEXP (x, 0)) == REG + ! && REGNO_QTY_VALID_P (REGNO (XEXP (x, 0))) + ! && (GET_MODE (XEXP (x, 0)) + ! == qty_mode[reg_qty[REGNO (XEXP (x, 0))]]) + ! && qty_const[reg_qty[REGNO (XEXP (x, 0))]]) + return 0; + + *************** cse_rtx_addr_varies_p (x) + *** 2501,2519 **** + load fp minus a constant into a register, then a MEM which is the + sum of the two `constant' registers. */ + ! if (GET_CODE (x) == MEM + ! && GET_CODE (XEXP (x, 0)) == PLUS + ! && GET_CODE (XEXP (XEXP (x, 0), 0)) == REG + ! && GET_CODE (XEXP (XEXP (x, 0), 1)) == REG + ! && REGNO_QTY_VALID_P (REGNO (XEXP (XEXP (x, 0), 0))) + ! && (GET_MODE (XEXP (XEXP (x, 0), 0)) + ! == qty_mode[reg_qty[REGNO (XEXP (XEXP (x, 0), 0))]]) + ! && qty_const[reg_qty[REGNO (XEXP (XEXP (x, 0), 0))]] + ! && REGNO_QTY_VALID_P (REGNO (XEXP (XEXP (x, 0), 1))) + ! && (GET_MODE (XEXP (XEXP (x, 0), 1)) + ! == qty_mode[reg_qty[REGNO (XEXP (XEXP (x, 0), 1))]]) + ! && qty_const[reg_qty[REGNO (XEXP (XEXP (x, 0), 1))]]) + return 0; + + ! return rtx_addr_varies_p (x); + } + + --- 2385,2402 ---- + load fp minus a constant into a register, then a MEM which is the + sum of the two `constant' registers. */ + ! if (GET_CODE (x) == PLUS + ! && GET_CODE (XEXP (x, 0)) == REG + ! && GET_CODE (XEXP (x, 1)) == REG + ! && REGNO_QTY_VALID_P (REGNO (XEXP (x, 0))) + ! && (GET_MODE (XEXP (x, 0)) + ! == qty_mode[reg_qty[REGNO (XEXP (x, 0))]]) + ! && qty_const[reg_qty[REGNO (XEXP (x, 0))]] + ! && REGNO_QTY_VALID_P (REGNO (XEXP (x, 1))) + ! && (GET_MODE (XEXP (x, 1)) + ! == qty_mode[reg_qty[REGNO (XEXP (x, 1))]]) + ! && qty_const[reg_qty[REGNO (XEXP (x, 1))]]) + return 0; + + ! return rtx_varies_p (x); + } + + *************** fold_rtx (x, insn) + *** 5542,5550 **** + CONST_INT, see if we can find a register equivalent to the + positive constant. Make a MINUS if so. Don't do this for + ! a negative constant since we might then alternate between + chosing positive and negative constants. Having the positive + ! constant previously-used is the more common case. */ + ! if (const_arg1 && GET_CODE (const_arg1) == CONST_INT + ! && INTVAL (const_arg1) < 0 && GET_CODE (folded_arg1) == REG) + { + rtx new_const = GEN_INT (- INTVAL (const_arg1)); + --- 5425,5439 ---- + CONST_INT, see if we can find a register equivalent to the + positive constant. Make a MINUS if so. Don't do this for + ! a non-negative constant since we might then alternate between + chosing positive and negative constants. Having the positive + ! constant previously-used is the more common case. Be sure + ! the resulting constant is non-negative; if const_arg1 were + ! the smallest negative number this would overflow: depending + ! on the mode, this would either just be the same value (and + ! hence not save anything) or be incorrect. */ + ! if (const_arg1 != 0 && GET_CODE (const_arg1) == CONST_INT + ! && INTVAL (const_arg1) < 0 + ! && - INTVAL (const_arg1) >= 0 + ! && GET_CODE (folded_arg1) == REG) + { + rtx new_const = GEN_INT (- INTVAL (const_arg1)); + *************** cse_insn (insn, in_libcall_block) + *** 6105,6110 **** + rtx this_insn_cc0 = 0; + enum machine_mode this_insn_cc0_mode; + - struct write_data writes_memory; + - static struct write_data init = {0, 0, 0, 0}; + + rtx src_eqv = 0; + --- 5994,5997 ---- + *************** cse_insn (insn, in_libcall_block) + *** 6118,6122 **** + + this_insn = insn; + - writes_memory = init; + + /* Find all the SETs and CLOBBERs in this instruction. + --- 6005,6008 ---- + *************** cse_insn (insn, in_libcall_block) + *** 6220,6232 **** + else if (GET_CODE (y) == CLOBBER) + { + ! /* If we clobber memory, take note of that, + ! and canon the address. + This does nothing when a register is clobbered + because we have already invalidated the reg. */ + if (GET_CODE (XEXP (y, 0)) == MEM) + ! { + ! canon_reg (XEXP (y, 0), NULL_RTX); + ! note_mem_written (XEXP (y, 0), &writes_memory); + ! } + } + else if (GET_CODE (y) == USE + --- 6106,6114 ---- + else if (GET_CODE (y) == CLOBBER) + { + ! /* If we clobber memory, canon the address. + This does nothing when a register is clobbered + because we have already invalidated the reg. */ + if (GET_CODE (XEXP (y, 0)) == MEM) + ! canon_reg (XEXP (y, 0), NULL_RTX); + } + else if (GET_CODE (y) == USE + *************** cse_insn (insn, in_libcall_block) + *** 6247,6254 **** + { + if (GET_CODE (XEXP (x, 0)) == MEM) + ! { + ! canon_reg (XEXP (x, 0), NULL_RTX); + ! note_mem_written (XEXP (x, 0), &writes_memory); + ! } + } + + --- 6129,6133 ---- + { + if (GET_CODE (XEXP (x, 0)) == MEM) + ! canon_reg (XEXP (x, 0), NULL_RTX); + } + + *************** cse_insn (insn, in_libcall_block) + *** 6430,6433 **** + --- 6309,6327 ---- + sets[i].src_in_struct = hash_arg_in_struct; + + + /* If SRC is a MEM, there is a REG_EQUIV note for SRC, and DEST is + + a pseudo that is set more than once, do not record SRC. Using + + SRC as a replacement for anything else will be incorrect in that + + situation. Note that this usually occurs only for stack slots, + + in which case all the RTL would be refering to SRC, so we don't + + lose any optimization opportunities by not having SRC in the + + hash table. */ + + + + if (GET_CODE (src) == MEM + + && find_reg_note (insn, REG_EQUIV, src) != 0 + + && GET_CODE (dest) == REG + + && REGNO (dest) >= FIRST_PSEUDO_REGISTER + + && reg_n_sets[REGNO (dest)] != 1) + + sets[i].src_volatile = 1; + + + #if 0 + /* It is no longer clear why we used to do this, but it doesn't + *************** cse_insn (insn, in_libcall_block) + *** 6674,6678 **** + } + #endif /* LOAD_EXTEND_OP */ + ! + if (src == src_folded) + src_folded = 0; + --- 6568,6572 ---- + } + #endif /* LOAD_EXTEND_OP */ + ! + if (src == src_folded) + src_folded = 0; + *************** cse_insn (insn, in_libcall_block) + *** 6860,6864 **** + || (GET_CODE (src_folded) != MEM + && ! src_folded_force_flag)) + ! && GET_MODE_CLASS (mode) != MODE_CC) + { + src_folded_force_flag = 1; + --- 6754,6759 ---- + || (GET_CODE (src_folded) != MEM + && ! src_folded_force_flag)) + ! && GET_MODE_CLASS (mode) != MODE_CC + ! && mode != VOIDmode) + { + src_folded_force_flag = 1; + *************** cse_insn (insn, in_libcall_block) + *** 6983,6993 **** + if (GET_CODE (dest) == MEM) + { + dest = fold_rtx (dest, insn); + - + - /* Decide whether we invalidate everything in memory, + - or just things at non-fixed places. + - Writing a large aggregate must invalidate everything + - because we don't know how long it is. */ + - note_mem_written (dest, &writes_memory); + } + + --- 6878,6890 ---- + if (GET_CODE (dest) == MEM) + { + + #ifdef PUSH_ROUNDING + + /* Stack pushes invalidate the stack pointer. */ + + rtx addr = XEXP (dest, 0); + + if ((GET_CODE (addr) == PRE_DEC || GET_CODE (addr) == PRE_INC + + || GET_CODE (addr) == POST_DEC || GET_CODE (addr) == POST_INC) + + && XEXP (addr, 0) == stack_pointer_rtx) + + invalidate (stack_pointer_rtx, Pmode); + + #endif + dest = fold_rtx (dest, insn); + } + + *************** cse_insn (insn, in_libcall_block) + *** 7234,7238 **** + sets[i].src_elt = src_eqv_elt; + + ! invalidate_from_clobbers (&writes_memory, x); + + /* Some registers are invalidated by subroutine calls. Memory is + --- 7131,7135 ---- + sets[i].src_elt = src_eqv_elt; + + ! invalidate_from_clobbers (x); + + /* Some registers are invalidated by subroutine calls. Memory is + *************** cse_insn (insn, in_libcall_block) + *** 7241,7248 **** + if (GET_CODE (insn) == CALL_INSN) + { + - static struct write_data everything = {0, 1, 1, 1}; + - + if (! CONST_CALL_P (insn)) + ! invalidate_memory (&everything); + invalidate_for_call (); + } + --- 7138,7143 ---- + if (GET_CODE (insn) == CALL_INSN) + { + if (! CONST_CALL_P (insn)) + ! invalidate_memory (); + invalidate_for_call (); + } + *************** cse_insn (insn, in_libcall_block) + *** 7265,7270 **** + we have just done an invalidate_memory that covers even those. */ + if (GET_CODE (dest) == REG || GET_CODE (dest) == SUBREG + ! || (GET_CODE (dest) == MEM && ! writes_memory.all + ! && ! cse_rtx_addr_varies_p (dest))) + invalidate (dest, VOIDmode); + else if (GET_CODE (dest) == STRICT_LOW_PART + --- 7160,7164 ---- + we have just done an invalidate_memory that covers even those. */ + if (GET_CODE (dest) == REG || GET_CODE (dest) == SUBREG + ! || GET_CODE (dest) == MEM) + invalidate (dest, VOIDmode); + else if (GET_CODE (dest) == STRICT_LOW_PART + *************** cse_insn (insn, in_libcall_block) + *** 7359,7363 **** + sets[i].dest_hash, GET_MODE (dest)); + elt->in_memory = (GET_CODE (sets[i].inner_dest) == MEM + ! && ! RTX_UNCHANGING_P (sets[i].inner_dest)); + + if (elt->in_memory) + --- 7253,7259 ---- + sets[i].dest_hash, GET_MODE (dest)); + elt->in_memory = (GET_CODE (sets[i].inner_dest) == MEM + ! && (! RTX_UNCHANGING_P (sets[i].inner_dest) + ! || FIXED_BASE_PLUS_P (XEXP (sets[i].inner_dest, + ! 0)))); + + if (elt->in_memory) + *************** cse_insn (insn, in_libcall_block) + *** 7532,7580 **** + } + + - /* Store 1 in *WRITES_PTR for those categories of memory ref + - that must be invalidated when the expression WRITTEN is stored in. + - If WRITTEN is null, say everything must be invalidated. */ + - + static void + ! note_mem_written (written, writes_ptr) + ! rtx written; + ! struct write_data *writes_ptr; + ! { + ! static struct write_data everything = {0, 1, 1, 1}; + ! + ! if (written == 0) + ! *writes_ptr = everything; + ! else if (GET_CODE (written) == MEM) + ! { + ! /* Pushing or popping the stack invalidates just the stack pointer. */ + ! rtx addr = XEXP (written, 0); + ! if ((GET_CODE (addr) == PRE_DEC || GET_CODE (addr) == PRE_INC + ! || GET_CODE (addr) == POST_DEC || GET_CODE (addr) == POST_INC) + ! && GET_CODE (XEXP (addr, 0)) == REG + ! && REGNO (XEXP (addr, 0)) == STACK_POINTER_REGNUM) + ! { + ! writes_ptr->sp = 1; + ! return; + ! } + ! else if (GET_MODE (written) == BLKmode) + ! *writes_ptr = everything; + ! /* (mem (scratch)) means clobber everything. */ + ! else if (GET_CODE (addr) == SCRATCH) + ! *writes_ptr = everything; + ! else if (cse_rtx_addr_varies_p (written)) + ! { + ! /* A varying address that is a sum indicates an array element, + ! and that's just as good as a structure element + ! in implying that we need not invalidate scalar variables. + ! However, we must allow QImode aliasing of scalars, because the + ! ANSI C standard allows character pointers to alias anything. */ + ! if (! ((MEM_IN_STRUCT_P (written) + ! || GET_CODE (XEXP (written, 0)) == PLUS) + ! && GET_MODE (written) != QImode)) + ! writes_ptr->all = 1; + ! writes_ptr->nonscalar = 1; + ! } + ! writes_ptr->var = 1; + } + } + + --- 7428,7471 ---- + } + + static void + ! invalidate_memory () + ! { + ! register int i; + ! register struct table_elt *p, *next; + ! + ! for (i = 0; i < NBUCKETS; i++) + ! for (p = table[i]; p; p = next) + ! { + ! next = p->next_same_hash; + ! if (p->in_memory) + ! remove_from_table (p, i); + ! } + ! } + ! + ! static int + ! note_mem_written (mem) + ! register rtx mem; + ! { + ! if (mem == 0 || GET_CODE(mem) != MEM ) + ! return 0; + ! else + ! { + ! register rtx addr = XEXP (mem, 0); + ! /* Pushing or popping the stack invalidates just the stack pointer. */ + ! if ((GET_CODE (addr) == PRE_DEC || GET_CODE (addr) == PRE_INC + ! || GET_CODE (addr) == POST_DEC || GET_CODE (addr) == POST_INC) + ! && GET_CODE (XEXP (addr, 0)) == REG + ! && REGNO (XEXP (addr, 0)) == STACK_POINTER_REGNUM) + ! { + ! if (reg_tick[STACK_POINTER_REGNUM] >= 0) + ! reg_tick[STACK_POINTER_REGNUM]++; + ! + ! /* This should be *very* rare. */ + ! if (TEST_HARD_REG_BIT (hard_regs_in_table, STACK_POINTER_REGNUM)) + ! invalidate (stack_pointer_rtx, VOIDmode); + ! return 1; + } + + return 0; + + } + } + + *************** note_mem_written (written, writes_ptr) + *** 7584,7612 **** + alias with something that is SET or CLOBBERed. + + - W points to the writes_memory for this insn, a struct write_data + - saying which kinds of memory references must be invalidated. + X is the pattern of the insn. */ + + static void + ! invalidate_from_clobbers (w, x) + ! struct write_data *w; + rtx x; + { + - /* If W->var is not set, W specifies no action. + - If W->all is set, this step gets all memory refs + - so they can be ignored in the rest of this function. */ + - if (w->var) + - invalidate_memory (w); + - + - if (w->sp) + - { + - if (reg_tick[STACK_POINTER_REGNUM] >= 0) + - reg_tick[STACK_POINTER_REGNUM]++; + - + - /* This should be *very* rare. */ + - if (TEST_HARD_REG_BIT (hard_regs_in_table, STACK_POINTER_REGNUM)) + - invalidate (stack_pointer_rtx, VOIDmode); + - } + - + if (GET_CODE (x) == CLOBBER) + { + --- 7475,7484 ---- + alias with something that is SET or CLOBBERed. + + X is the pattern of the insn. */ + + static void + ! invalidate_from_clobbers (x) + rtx x; + { + if (GET_CODE (x) == CLOBBER) + { + *************** invalidate_from_clobbers (w, x) + *** 7615,7619 **** + { + if (GET_CODE (ref) == REG || GET_CODE (ref) == SUBREG + ! || (GET_CODE (ref) == MEM && ! w->all)) + invalidate (ref, VOIDmode); + else if (GET_CODE (ref) == STRICT_LOW_PART + --- 7487,7491 ---- + { + if (GET_CODE (ref) == REG || GET_CODE (ref) == SUBREG + ! || GET_CODE (ref) == MEM) + invalidate (ref, VOIDmode); + else if (GET_CODE (ref) == STRICT_LOW_PART + *************** invalidate_from_clobbers (w, x) + *** 7631,7643 **** + { + rtx ref = XEXP (y, 0); + ! if (ref) + ! { + ! if (GET_CODE (ref) == REG || GET_CODE (ref) == SUBREG + ! || (GET_CODE (ref) == MEM && !w->all)) + ! invalidate (ref, VOIDmode); + ! else if (GET_CODE (ref) == STRICT_LOW_PART + ! || GET_CODE (ref) == ZERO_EXTRACT) + ! invalidate (XEXP (ref, 0), GET_MODE (ref)); + ! } + } + } + --- 7503,7512 ---- + { + rtx ref = XEXP (y, 0); + ! if (GET_CODE (ref) == REG || GET_CODE (ref) == SUBREG + ! || GET_CODE (ref) == MEM) + ! invalidate (ref, VOIDmode); + ! else if (GET_CODE (ref) == STRICT_LOW_PART + ! || GET_CODE (ref) == ZERO_EXTRACT) + ! invalidate (XEXP (ref, 0), GET_MODE (ref)); + } + } + *************** cse_around_loop (loop_start) + *** 7800,7807 **** + } + + - /* Variable used for communications between the next two routines. */ + - + - static struct write_data skipped_writes_memory; + - + /* Process one SET of an insn that was skipped. We ignore CLOBBERs + since they are done elsewhere. This function is called via note_stores. */ + --- 7669,7672 ---- + *************** invalidate_skipped_set (dest, set) + *** 7812,7823 **** + rtx dest; + { + ! if (GET_CODE (dest) == MEM) + ! note_mem_written (dest, &skipped_writes_memory); + ! + ! /* There are times when an address can appear varying and be a PLUS + ! during this scan when it would be a fixed address were we to know + ! the proper equivalences. So promote "nonscalar" to be "all". */ + ! if (skipped_writes_memory.nonscalar) + ! skipped_writes_memory.all = 1; + + if (GET_CODE (set) == CLOBBER + --- 7677,7695 ---- + rtx dest; + { + ! enum rtx_code code = GET_CODE (dest); + ! + ! if (code == MEM + ! && ! note_mem_written (dest) /* If this is not a stack push ... */ + ! /* There are times when an address can appear varying and be a PLUS + ! during this scan when it would be a fixed address were we to know + ! the proper equivalences. So invalidate all memory if there is + ! a BLKmode or nonscalar memory reference or a reference to a + ! variable address. */ + ! && (MEM_IN_STRUCT_P (dest) || GET_MODE (dest) == BLKmode + ! || cse_rtx_varies_p (XEXP (dest, 0)))) + ! { + ! invalidate_memory (); + ! return; + ! } + + if (GET_CODE (set) == CLOBBER + *************** invalidate_skipped_set (dest, set) + *** 7828,7837 **** + return; + + ! if (GET_CODE (dest) == REG || GET_CODE (dest) == SUBREG + ! || (! skipped_writes_memory.all && ! cse_rtx_addr_varies_p (dest))) + ! invalidate (dest, VOIDmode); + ! else if (GET_CODE (dest) == STRICT_LOW_PART + ! || GET_CODE (dest) == ZERO_EXTRACT) + invalidate (XEXP (dest, 0), GET_MODE (dest)); + } + + --- 7700,7707 ---- + return; + + ! if (code == STRICT_LOW_PART || code == ZERO_EXTRACT) + invalidate (XEXP (dest, 0), GET_MODE (dest)); + + else if (code == REG || code == SUBREG || code == MEM) + + invalidate (dest, VOIDmode); + } + + *************** invalidate_skipped_block (start) + *** 7845,7850 **** + { + rtx insn; + - static struct write_data init = {0, 0, 0, 0}; + - static struct write_data everything = {0, 1, 1, 1}; + + for (insn = start; insn && GET_CODE (insn) != CODE_LABEL; + --- 7715,7718 ---- + *************** invalidate_skipped_block (start) + *** 7854,7867 **** + continue; + + - skipped_writes_memory = init; + - + if (GET_CODE (insn) == CALL_INSN) + { + invalidate_for_call (); + - skipped_writes_memory = everything; + } + + note_stores (PATTERN (insn), invalidate_skipped_set); + - invalidate_from_clobbers (&skipped_writes_memory, PATTERN (insn)); + } + } + --- 7722,7733 ---- + continue; + + if (GET_CODE (insn) == CALL_INSN) + { + + if (! CONST_CALL_P (insn)) + + invalidate_memory (); + invalidate_for_call (); + } + + note_stores (PATTERN (insn), invalidate_skipped_set); + } + } + *************** cse_set_around_loop (x, insn, loop_start + *** 7913,7920 **** + { + struct table_elt *src_elt; + - static struct write_data init = {0, 0, 0, 0}; + - struct write_data writes_memory; + - + - writes_memory = init; + + /* If this is a SET, see if we can replace SET_SRC, but ignore SETs that + --- 7779,7782 ---- + *************** cse_set_around_loop (x, insn, loop_start + *** 7976,7991 **** + + /* Now invalidate anything modified by X. */ + ! note_mem_written (SET_DEST (x), &writes_memory); + ! + ! if (writes_memory.var) + ! invalidate_memory (&writes_memory); + ! + ! /* See comment on similar code in cse_insn for explanation of these tests. */ + if (GET_CODE (SET_DEST (x)) == REG || GET_CODE (SET_DEST (x)) == SUBREG + ! || (GET_CODE (SET_DEST (x)) == MEM && ! writes_memory.all + ! && ! cse_rtx_addr_varies_p (SET_DEST (x)))) + invalidate (SET_DEST (x), VOIDmode); + else if (GET_CODE (SET_DEST (x)) == STRICT_LOW_PART + ! || GET_CODE (SET_DEST (x)) == ZERO_EXTRACT) + invalidate (XEXP (SET_DEST (x), 0), GET_MODE (SET_DEST (x))); + } + --- 7838,7849 ---- + + /* Now invalidate anything modified by X. */ + ! note_mem_written (SET_DEST (x)); + ! + ! /* See comment on similar code in cse_insn for explanation of these tests. */ + if (GET_CODE (SET_DEST (x)) == REG || GET_CODE (SET_DEST (x)) == SUBREG + ! || GET_CODE (SET_DEST (x)) == MEM) + invalidate (SET_DEST (x), VOIDmode); + else if (GET_CODE (SET_DEST (x)) == STRICT_LOW_PART + ! || GET_CODE (SET_DEST (x)) == ZERO_EXTRACT) + invalidate (XEXP (SET_DEST (x), 0), GET_MODE (SET_DEST (x))); + } + *************** cse_main (f, nregs, after_loop, file) + *** 8234,8237 **** + --- 8092,8096 ---- + + init_recog (); + + init_alias_analysis (); + + max_reg = nregs; + *************** cse_basic_block (from, to, next_branch, + *** 8405,8408 **** + --- 8264,8268 ---- + int to_usage = 0; + int in_libcall_block = 0; + + int num_insns = 0; + + /* Each of these arrays is undefined before max_reg, so only allocate + *************** cse_basic_block (from, to, next_branch, + *** 8437,8440 **** + --- 8297,8320 ---- + { + register enum rtx_code code; + + int i; + + struct table_elt *p, *next; + + + + /* If we have processed 1,000 insns, flush the hash table to avoid + + extreme quadratic behavior. */ + + if (num_insns++ > 1000) + + { + + for (i = 0; i < NBUCKETS; i++) + + for (p = table[i]; p; p = next) + + { + + next = p->next_same_hash; + + + + if (GET_CODE (p->exp) == REG) + + invalidate (p->exp, p->mode); + + else + + remove_from_table (p, i); + + } + + + + num_insns = 0; + + } + + /* See if this is a branch that is part of the path. If so, and it is + diff -rcp2N gcc-2.7.2.3/dwarfout.c gcc-2.7.2.3.f.1/dwarfout.c + *** gcc-2.7.2.3/dwarfout.c Fri Oct 27 01:40:07 1995 + --- gcc-2.7.2.3.f.1/dwarfout.c Sun Aug 10 22:47:19 1997 + *************** output_bound_representation (bound, dim_ + *** 1629,1705 **** + { + + ! case ERROR_MARK: + ! return; + + /* All fixed-bounds are represented by INTEGER_CST nodes. */ + + ! case INTEGER_CST: + ! ASM_OUTPUT_DWARF_DATA4 (asm_out_file, + ! (unsigned) TREE_INT_CST_LOW (bound)); + ! break; + ! + ! /* Dynamic bounds may be represented by NOP_EXPR nodes containing + ! SAVE_EXPR nodes. */ + ! + ! case NOP_EXPR: + ! bound = TREE_OPERAND (bound, 0); + ! /* ... fall thru... */ + ! + ! case SAVE_EXPR: + ! { + ! char begin_label[MAX_ARTIFICIAL_LABEL_BYTES]; + ! char end_label[MAX_ARTIFICIAL_LABEL_BYTES]; + ! + ! sprintf (begin_label, BOUND_BEGIN_LABEL_FMT, + ! current_dienum, dim_num, u_or_l); + + ! sprintf (end_label, BOUND_END_LABEL_FMT, + ! current_dienum, dim_num, u_or_l); + + ! ASM_OUTPUT_DWARF_DELTA2 (asm_out_file, end_label, begin_label); + ! ASM_OUTPUT_LABEL (asm_out_file, begin_label); + + ! /* If we are working on a bound for a dynamic dimension in C, + ! the dynamic dimension in question had better have a static + ! (zero) lower bound and a dynamic *upper* bound. */ + + ! if (u_or_l != 'u') + ! abort (); + + ! /* If optimization is turned on, the SAVE_EXPRs that describe + ! how to access the upper bound values are essentially bogus. + ! They only describe (at best) how to get at these values at + ! the points in the generated code right after they have just + ! been computed. Worse yet, in the typical case, the upper + ! bound values will not even *be* computed in the optimized + ! code, so these SAVE_EXPRs are entirely bogus. + ! + ! In order to compensate for this fact, we check here to see + ! if optimization is enabled, and if so, we effectively create + ! an empty location description for the (unknown and unknowable) + ! upper bound. + ! + ! This should not cause too much trouble for existing (stupid?) + ! debuggers because they have to deal with empty upper bounds + ! location descriptions anyway in order to be able to deal with + ! incomplete array types. + ! + ! Of course an intelligent debugger (GDB?) should be able to + ! comprehend that a missing upper bound specification in a + ! array type used for a storage class `auto' local array variable + ! indicates that the upper bound is both unknown (at compile- + ! time) and unknowable (at run-time) due to optimization. + ! */ + ! + ! if (! optimize) + ! output_loc_descriptor + ! (eliminate_regs (SAVE_EXPR_RTL (bound), 0, NULL_RTX)); + + ! ASM_OUTPUT_LABEL (asm_out_file, end_label); + ! } + ! break; + + - default: + - abort (); + } + } + --- 1629,1699 ---- + { + + ! case ERROR_MARK: + ! return; + + /* All fixed-bounds are represented by INTEGER_CST nodes. */ + + ! case INTEGER_CST: + ! ASM_OUTPUT_DWARF_DATA4 (asm_out_file, + ! (unsigned) TREE_INT_CST_LOW (bound)); + ! break; + + ! default: + + ! /* Dynamic bounds may be represented by NOP_EXPR nodes containing + ! SAVE_EXPR nodes, in which case we can do something, or as + ! an expression, which we cannot represent. */ + ! { + ! char begin_label[MAX_ARTIFICIAL_LABEL_BYTES]; + ! char end_label[MAX_ARTIFICIAL_LABEL_BYTES]; + + ! sprintf (begin_label, BOUND_BEGIN_LABEL_FMT, + ! current_dienum, dim_num, u_or_l); + + ! sprintf (end_label, BOUND_END_LABEL_FMT, + ! current_dienum, dim_num, u_or_l); + + ! ASM_OUTPUT_DWARF_DELTA2 (asm_out_file, end_label, begin_label); + ! ASM_OUTPUT_LABEL (asm_out_file, begin_label); + ! + ! /* If optimization is turned on, the SAVE_EXPRs that describe + ! how to access the upper bound values are essentially bogus. + ! They only describe (at best) how to get at these values at + ! the points in the generated code right after they have just + ! been computed. Worse yet, in the typical case, the upper + ! bound values will not even *be* computed in the optimized + ! code, so these SAVE_EXPRs are entirely bogus. + ! + ! In order to compensate for this fact, we check here to see + ! if optimization is enabled, and if so, we effectively create + ! an empty location description for the (unknown and unknowable) + ! upper bound. + ! + ! This should not cause too much trouble for existing (stupid?) + ! debuggers because they have to deal with empty upper bounds + ! location descriptions anyway in order to be able to deal with + ! incomplete array types. + ! + ! Of course an intelligent debugger (GDB?) should be able to + ! comprehend that a missing upper bound specification in a + ! array type used for a storage class `auto' local array variable + ! indicates that the upper bound is both unknown (at compile- + ! time) and unknowable (at run-time) due to optimization. */ + ! + ! if (! optimize) + ! { + ! while (TREE_CODE (bound) == NOP_EXPR + ! || TREE_CODE (bound) == CONVERT_EXPR) + ! bound = TREE_OPERAND (bound, 0); + ! + ! if (TREE_CODE (bound) == SAVE_EXPR) + ! output_loc_descriptor + ! (eliminate_regs (SAVE_EXPR_RTL (bound), 0, NULL_RTX)); + ! } + + ! ASM_OUTPUT_LABEL (asm_out_file, end_label); + ! } + ! break; + + } + } + *************** type_attribute (type, decl_const, decl_v + *** 2857,2861 **** + register int root_type_modified; + + ! if (TREE_CODE (type) == ERROR_MARK) + return; + + --- 2851,2855 ---- + register int root_type_modified; + + ! if (code == ERROR_MARK) + return; + + *************** type_attribute (type, decl_const, decl_v + *** 2864,2869 **** + type `void', so this only applies to function return types. */ + + ! if (TREE_CODE (type) == VOID_TYPE) + return; + + root_type_modified = (code == POINTER_TYPE || code == REFERENCE_TYPE + --- 2858,2869 ---- + type `void', so this only applies to function return types. */ + + ! if (code == VOID_TYPE) + return; + + + + /* If this is a subtype, find the underlying type. Eventually, + + this should write out the appropriate subtype info. */ + + while ((code == INTEGER_TYPE || code == REAL_TYPE) + + && TREE_TYPE (type) != 0) + + type = TREE_TYPE (type), code = TREE_CODE (type); + + root_type_modified = (code == POINTER_TYPE || code == REFERENCE_TYPE + diff -rcp2N gcc-2.7.2.3/emit-rtl.c gcc-2.7.2.3.f.1/emit-rtl.c + *** gcc-2.7.2.3/emit-rtl.c Thu Sep 14 20:09:30 1995 + --- gcc-2.7.2.3.f.1/emit-rtl.c Fri Aug 29 07:51:46 1997 + *************** max_label_num () + *** 545,548 **** + --- 545,565 ---- + } + + + /* Identify REG (which may be a CONCAT) as a user register. */ + + + + void + + mark_user_reg (reg) + + rtx reg; + + { + + if (GET_CODE (reg) == CONCAT) + + { + + REG_USERVAR_P (XEXP (reg, 0)) = 1; + + REG_USERVAR_P (XEXP (reg, 1)) = 1; + + } + + else if (GET_CODE (reg) == REG) + + REG_USERVAR_P (reg) = 1; + + else + + abort (); + + } + + + /* Return first label number used in this function (if any were used). */ + + *************** subreg_lowpart_p (x) + *** 975,978 **** + --- 992,997 ---- + if (GET_CODE (x) != SUBREG) + return 1; + + else if (GET_MODE (SUBREG_REG (x)) == VOIDmode) + + return 0; + + if (WORDS_BIG_ENDIAN + *************** change_address (memref, mode, addr) + *** 1315,1318 **** + --- 1334,1340 ---- + addr = memory_address (mode, addr); + + + if (rtx_equal_p (addr, XEXP (memref, 0)) && mode == GET_MODE (memref)) + + return memref; + + + new = gen_rtx (MEM, mode, addr); + MEM_VOLATILE_P (new) = MEM_VOLATILE_P (memref); + diff -rcp2N gcc-2.7.2.3/explow.c gcc-2.7.2.3.f.1/explow.c + *** gcc-2.7.2.3/explow.c Thu Jun 15 11:30:10 1995 + --- gcc-2.7.2.3.f.1/explow.c Fri Aug 29 07:52:03 1997 + *************** Boston, MA 02111-1307, USA. */ + *** 32,36 **** + + static rtx break_out_memory_refs PROTO((rtx)); + ! + /* Return an rtx for the sum of X and the integer C. + + --- 32,36 ---- + + static rtx break_out_memory_refs PROTO((rtx)); + ! static void emit_stack_probe PROTO((rtx)); + /* Return an rtx for the sum of X and the integer C. + + *************** convert_memory_address (to_mode, x) + *** 305,310 **** + --- 305,313 ---- + rtx x; + { + + enum machine_mode from_mode = to_mode == ptr_mode ? Pmode : ptr_mode; + rtx temp; + + + /* Here we handle some special cases. If none of them apply, fall through + + to the default case. */ + switch (GET_CODE (x)) + { + *************** convert_memory_address (to_mode, x) + *** 321,339 **** + return temp; + + - case PLUS: + - case MULT: + - return gen_rtx (GET_CODE (x), to_mode, + - convert_memory_address (to_mode, XEXP (x, 0)), + - convert_memory_address (to_mode, XEXP (x, 1))); + - + case CONST: + return gen_rtx (CONST, to_mode, + convert_memory_address (to_mode, XEXP (x, 0))); + + ! default: + ! return convert_modes (to_mode, + ! to_mode == ptr_mode ? Pmode : ptr_mode, + ! x, POINTERS_EXTEND_UNSIGNED); + } + } + #endif + --- 324,348 ---- + return temp; + + case CONST: + return gen_rtx (CONST, to_mode, + convert_memory_address (to_mode, XEXP (x, 0))); + + ! case PLUS: + ! case MULT: + ! /* For addition the second operand is a small constant, we can safely + ! permute the converstion and addition operation. We can always safely + ! permute them if we are making the address narrower. In addition, + ! always permute the operations if this is a constant. */ + ! if (GET_MODE_SIZE (to_mode) < GET_MODE_SIZE (from_mode) + ! || (GET_CODE (x) == PLUS && GET_CODE (XEXP (x, 1)) == CONST_INT + ! && (INTVAL (XEXP (x, 1)) + 20000 < 40000 + ! || CONSTANT_P (XEXP (x, 0))))) + ! return gen_rtx (GET_CODE (x), to_mode, + ! convert_memory_address (to_mode, XEXP (x, 0)), + ! convert_memory_address (to_mode, XEXP (x, 1))); + } + + + + return convert_modes (to_mode, from_mode, + + x, POINTERS_EXTEND_UNSIGNED); + } + #endif + *************** allocate_dynamic_stack_space (size, targ + *** 1066,1069 **** + --- 1075,1083 ---- + do_pending_stack_adjust (); + + + /* If needed, check that we have the required amount of stack. Take into + + account what has already been checked. */ + + if (flag_stack_check && ! STACK_CHECK_BUILTIN) + + probe_stack_range (STACK_CHECK_MAX_FRAME_SIZE + STACK_CHECK_PROTECT, size); + + + /* Don't use a TARGET that isn't a pseudo. */ + if (target == 0 || GET_CODE (target) != REG + *************** allocate_dynamic_stack_space (size, targ + *** 1133,1136 **** + --- 1147,1281 ---- + + return target; + + } + + + + /* Emit one stack probe at ADDRESS, an address within the stack. */ + + + + static void + + emit_stack_probe (address) + + rtx address; + + { + + rtx memref = gen_rtx (MEM, word_mode, address); + + + + MEM_VOLATILE_P (memref) = 1; + + + + if (STACK_CHECK_PROBE_LOAD) + + emit_move_insn (gen_reg_rtx (word_mode), memref); + + else + + emit_move_insn (memref, const0_rtx); + + } + + + + /* Probe a range of stack addresses from FIRST to FIRST+SIZE, inclusive. + + FIRST is a constant and size is a Pmode RTX. These are offsets from the + + current stack pointer. STACK_GROWS_DOWNWARD says whether to add or + + subtract from the stack. If SIZE is constant, this is done + + with a fixed number of probes. Otherwise, we must make a loop. */ + + + + #ifdef STACK_GROWS_DOWNWARD + + #define STACK_GROW_OP MINUS + + #else + + #define STACK_GROW_OP PLUS + + #endif + + + + void + + probe_stack_range (first, size) + + HOST_WIDE_INT first; + + rtx size; + + { + + /* First see if we have an insn to check the stack. Use it if so. */ + + #ifdef HAVE_check_stack + + if (HAVE_check_stack) + + { + + rtx last_addr = force_operand (gen_rtx (STACK_GROW_OP, Pmode, + + stack_pointer_rtx, + + plus_constant (size, first)), + + NULL_RTX); + + + + if (insn_operand_predicate[(int) CODE_FOR_check_stack][0] + + && ! ((*insn_operand_predicate[(int) CODE_FOR_check_stack][0]) + + (last_address, Pmode))) + + last_address = copy_to_mode_reg (Pmode, last_address); + + + + emit_insn (gen_check_stack (last_address)); + + return; + + } + + #endif + + + + /* If we have to generate explicit probes, see if we have a constant + + small number of them to generate. If so, that's the easy case. */ + + if (GET_CODE (size) == CONST_INT && INTVAL (size) < 10) + + { + + HOST_WIDE_INT offset; + + + + /* Start probing at FIRST + N * STACK_CHECK_PROBE_INTERVAL + + for values of N from 1 until it exceeds LAST. If only one + + probe is needed, this will not generate any code. Then probe + + at LAST. */ + + for (offset = first + STACK_CHECK_PROBE_INTERVAL; + + offset < INTVAL (size); + + offset = offset + STACK_CHECK_PROBE_INTERVAL) + + emit_stack_probe (gen_rtx (STACK_GROW_OP, Pmode, + + stack_pointer_rtx, GEN_INT (offset))); + + + + emit_stack_probe (gen_rtx (STACK_GROW_OP, Pmode, stack_pointer_rtx, + + plus_constant (size, first))); + + } + + + + /* In the variable case, do the same as above, but in a loop. We emit loop + + notes so that loop optimization can be done. */ + + else + + { + + rtx test_addr + + = force_operand (gen_rtx (STACK_GROW_OP, Pmode, stack_pointer_rtx, + + GEN_INT (first + + + STACK_CHECK_PROBE_INTERVAL)), + + NULL_RTX); + + rtx last_addr + + = force_operand (gen_rtx (STACK_GROW_OP, Pmode, stack_pointer_rtx, + + plus_constant (size, first)), + + NULL_RTX); + + rtx incr = GEN_INT (STACK_CHECK_PROBE_INTERVAL); + + rtx loop_lab = gen_label_rtx (); + + rtx test_lab = gen_label_rtx (); + + rtx end_lab = gen_label_rtx (); + + rtx temp; + + + + if (GET_CODE (test_addr) != REG + + || REGNO (test_addr) < FIRST_PSEUDO_REGISTER) + + test_addr = force_reg (Pmode, test_addr); + + + + emit_note (NULL_PTR, NOTE_INSN_LOOP_BEG); + + emit_jump (test_lab); + + + + emit_label (loop_lab); + + emit_stack_probe (test_addr); + + + + emit_note (NULL_PTR, NOTE_INSN_LOOP_CONT); + + + + #ifdef STACK_GROWS_DOWNWARD + + #define CMP_OPCODE GTU + + temp = expand_binop (Pmode, sub_optab, test_addr, incr, test_addr, + + 1, OPTAB_WIDEN); + + #else + + #define CMP_OPCODE LTU + + temp = expand_binop (Pmode, add_optab, test_addr, incr, test_addr, + + 1, OPTAB_WIDEN); + + #endif + + + + if (temp != test_addr) + + abort (); + + + + emit_label (test_lab); + + emit_cmp_insn (test_addr, last_addr, CMP_OPCODE, NULL_RTX, Pmode, 1, 0); + + emit_jump_insn ((*bcc_gen_fctn[(int) CMP_OPCODE]) (loop_lab)); + + emit_jump (end_lab); + + emit_note (NULL_PTR, NOTE_INSN_LOOP_END); + + emit_label (end_lab); + + + + /* If will be doing stupid optimization, show test_addr is still live. */ + + if (obey_regdecls) + + emit_insn (gen_rtx (USE, VOIDmode, test_addr)); + + + + emit_stack_probe (last_addr); + + } + } + + diff -rcp2N gcc-2.7.2.3/expmed.c gcc-2.7.2.3.f.1/expmed.c + *** gcc-2.7.2.3/expmed.c Thu Jul 13 23:25:37 1995 + --- gcc-2.7.2.3.f.1/expmed.c Sun Aug 10 22:46:23 1997 + *************** store_bit_field (str_rtx, bitsize, bitnu + *** 399,402 **** + --- 399,403 ---- + #ifdef HAVE_insv + if (HAVE_insv + + && GET_MODE (value) != BLKmode + && !(bitsize == 1 && GET_CODE (value) == CONST_INT) + /* Ensure insv's size is wide enough for this field. */ + *************** store_split_bit_field (op0, bitsize, bit + *** 777,781 **** + done in extract_bit_field, so that the two calls to + extract_fixed_bit_field will have comparable arguments. */ + ! if (GET_CODE (value) != MEM) + total_bits = BITS_PER_WORD; + else + --- 778,782 ---- + done in extract_bit_field, so that the two calls to + extract_fixed_bit_field will have comparable arguments. */ + ! if (GET_CODE (value) != MEM || GET_MODE (value) == BLKmode) + total_bits = BITS_PER_WORD; + else + *************** store_split_bit_field (op0, bitsize, bit + *** 790,797 **** + /* The args are chosen so that the last part includes the + lsb. Give extract_bit_field the value it needs (with + ! endianness compensation) to fetch the piece we want. */ + ! part = extract_fixed_bit_field (word_mode, value, 0, thissize, + ! total_bits - bitsize + bitsdone, + ! NULL_RTX, 1, align); + } + else + --- 791,807 ---- + /* The args are chosen so that the last part includes the + lsb. Give extract_bit_field the value it needs (with + ! endianness compensation) to fetch the piece we want. + ! + ! ??? We have no idea what the alignment of VALUE is, so + ! we have to use a guess. */ + ! part + ! = extract_fixed_bit_field + ! (word_mode, value, 0, thissize, + ! total_bits - bitsize + bitsdone, NULL_RTX, 1, + ! GET_MODE (value) == VOIDmode + ! ? UNITS_PER_WORD + ! : (GET_MODE (value) == BLKmode + ! ? 1 + ! : GET_MODE_ALIGNMENT (GET_MODE (value)) / BITS_PER_UNIT)); + } + else + *************** store_split_bit_field (op0, bitsize, bit + *** 803,808 **** + & (((HOST_WIDE_INT) 1 << thissize) - 1)); + else + ! part = extract_fixed_bit_field (word_mode, value, 0, thissize, + ! bitsdone, NULL_RTX, 1, align); + } + + --- 813,824 ---- + & (((HOST_WIDE_INT) 1 << thissize) - 1)); + else + ! part + ! = extract_fixed_bit_field + ! (word_mode, value, 0, thissize, bitsdone, NULL_RTX, 1, + ! GET_MODE (value) == VOIDmode + ! ? UNITS_PER_WORD + ! : (GET_MODE (value) == BLKmode + ! ? 1 + ! : GET_MODE_ALIGNMENT (GET_MODE (value)) / BITS_PER_UNIT)); + } + + *************** extract_bit_field (str_rtx, bitsize, bit + *** 876,882 **** + rtx spec_target_subreg = 0; + + - if (GET_CODE (str_rtx) == MEM && ! MEM_IN_STRUCT_P (str_rtx)) + - abort (); + - + /* Discount the part of the structure before the desired byte. + We need to know how many bytes are safe to reference after it. */ + --- 892,895 ---- + *************** expand_divmod (rem_flag, code, mode, op0 + *** 3189,3193 **** + Notice that we compute also the final remainder value here, + and return the result right away. */ + ! if (target == 0) + target = gen_reg_rtx (compute_mode); + + --- 3202,3206 ---- + Notice that we compute also the final remainder value here, + and return the result right away. */ + ! if (target == 0 || GET_MODE (target) != compute_mode) + target = gen_reg_rtx (compute_mode); + + *************** expand_divmod (rem_flag, code, mode, op0 + *** 3316,3320 **** + remainder. Notice that we compute also the final remainder + value here, and return the result right away. */ + ! if (target == 0) + target = gen_reg_rtx (compute_mode); + + --- 3329,3333 ---- + remainder. Notice that we compute also the final remainder + value here, and return the result right away. */ + ! if (target == 0 || GET_MODE (target) != compute_mode) + target = gen_reg_rtx (compute_mode); + + *************** expand_divmod (rem_flag, code, mode, op0 + *** 3418,3422 **** + remainder. Notice that we compute also the final remainder + value here, and return the result right away. */ + ! if (target == 0) + target = gen_reg_rtx (compute_mode); + if (rem_flag) + --- 3431,3435 ---- + remainder. Notice that we compute also the final remainder + value here, and return the result right away. */ + ! if (target == 0 || GET_MODE (target) != compute_mode) + target = gen_reg_rtx (compute_mode); + if (rem_flag) + *************** expand_divmod (rem_flag, code, mode, op0 + *** 3602,3605 **** + --- 3615,3621 ---- + if (quotient == 0) + { + + if (target && GET_MODE (target) != compute_mode) + + target = 0; + + + if (rem_flag) + { + *************** expand_divmod (rem_flag, code, mode, op0 + *** 3653,3656 **** + --- 3669,3675 ---- + if (rem_flag) + { + + if (target && GET_MODE (target) != compute_mode) + + target = 0; + + + if (quotient == 0) + /* No divide instruction either. Use library for remainder. */ + diff -rcp2N gcc-2.7.2.3/expr.c gcc-2.7.2.3.f.1/expr.c + *** gcc-2.7.2.3/expr.c Sat Jun 29 16:26:15 1996 + --- gcc-2.7.2.3.f.1/expr.c Fri Aug 29 08:01:24 1997 + *************** Boston, MA 02111-1307, USA. */ + *** 27,30 **** + --- 27,31 ---- + #include "flags.h" + #include "regs.h" + + #include "hard-reg-set.h" + #include "function.h" + #include "insn-flags.h" + *************** extern int stack_depth; + *** 139,143 **** + extern int max_stack_depth; + extern struct obstack permanent_obstack; + ! + + static rtx enqueue_insn PROTO((rtx, rtx)); + --- 140,144 ---- + extern int max_stack_depth; + extern struct obstack permanent_obstack; + ! extern rtx arg_pointer_save_area; + + static rtx enqueue_insn PROTO((rtx, rtx)); + *************** static void store_constructor PROTO((tre + *** 151,155 **** + static rtx store_field PROTO((rtx, int, int, enum machine_mode, tree, + enum machine_mode, int, int, int)); + - static int get_inner_unaligned_p PROTO((tree)); + static tree save_noncopied_parts PROTO((tree, tree)); + static tree init_noncopied_parts PROTO((tree, tree)); + --- 152,155 ---- + *************** move_by_pieces (to, from, len, align) + *** 1494,1498 **** + + /* The code above should have handled everything. */ + ! if (data.len != 0) + abort (); + } + --- 1494,1498 ---- + + /* The code above should have handled everything. */ + ! if (data.len > 0) + abort (); + } + *************** emit_move_insn_1 (x, y) + *** 1989,1993 **** + + /* Show the output dies here. */ + ! emit_insn (gen_rtx (CLOBBER, VOIDmode, x)); + + for (i = 0; + --- 1989,1994 ---- + + /* Show the output dies here. */ + ! if (x != y) + ! emit_insn (gen_rtx (CLOBBER, VOIDmode, x)); + + for (i = 0; + *************** expand_assignment (to, from, want_value, + *** 2481,2490 **** + problem. */ + + ! if (TREE_CODE (to) == COMPONENT_REF + ! || TREE_CODE (to) == BIT_FIELD_REF + ! || (TREE_CODE (to) == ARRAY_REF + ! && ((TREE_CODE (TREE_OPERAND (to, 1)) == INTEGER_CST + ! && TREE_CODE (TYPE_SIZE (TREE_TYPE (to))) == INTEGER_CST) + ! || (SLOW_UNALIGNED_ACCESS && get_inner_unaligned_p (to))))) + { + enum machine_mode mode1; + --- 2482,2487 ---- + problem. */ + + ! if (TREE_CODE (to) == COMPONENT_REF || TREE_CODE (to) == BIT_FIELD_REF + ! || TREE_CODE (to) == ARRAY_REF) + { + enum machine_mode mode1; + *************** expand_assignment (to, from, want_value, + *** 2498,2503 **** + + push_temp_slots (); + ! tem = get_inner_reference (to, &bitsize, &bitpos, &offset, + ! &mode1, &unsignedp, &volatilep); + + /* If we are going to use store_bit_field and extract_bit_field, + --- 2495,2500 ---- + + push_temp_slots (); + ! tem = get_inner_reference (to, &bitsize, &bitpos, &offset, &mode1, + ! &unsignedp, &volatilep, &alignment); + + /* If we are going to use store_bit_field and extract_bit_field, + *************** expand_assignment (to, from, want_value, + *** 2507,2511 **** + tem = stabilize_reference (tem); + + - alignment = TYPE_ALIGN (TREE_TYPE (tem)) / BITS_PER_UNIT; + to_rtx = expand_expr (tem, NULL_RTX, VOIDmode, 0); + if (offset != 0) + --- 2504,2507 ---- + *************** expand_assignment (to, from, want_value, + *** 2518,2529 **** + gen_rtx (PLUS, ptr_mode, XEXP (to_rtx, 0), + force_reg (ptr_mode, offset_rtx))); + - /* If we have a variable offset, the known alignment + - is only that of the innermost structure containing the field. + - (Actually, we could sometimes do better by using the + - align of an element of the innermost array, but no need.) */ + - if (TREE_CODE (to) == COMPONENT_REF + - || TREE_CODE (to) == BIT_FIELD_REF) + - alignment + - = TYPE_ALIGN (TREE_TYPE (TREE_OPERAND (to, 0))) / BITS_PER_UNIT; + } + if (volatilep) + --- 2514,2517 ---- + *************** expand_assignment (to, from, want_value, + *** 2535,2539 **** + We must make a new MEM before setting the volatile bit. */ + if (offset == 0) + ! to_rtx = change_address (to_rtx, VOIDmode, XEXP (to_rtx, 0)); + MEM_VOLATILE_P (to_rtx) = 1; + } + --- 2523,2527 ---- + We must make a new MEM before setting the volatile bit. */ + if (offset == 0) + ! to_rtx = copy_rtx (to_rtx); + MEM_VOLATILE_P (to_rtx) = 1; + } + *************** store_expr (exp, target, want_value) + *** 2775,2780 **** + which will often result in some optimizations. Do the conversion + in two steps: first change the signedness, if needed, then + ! the extend. */ + ! if (! want_value) + { + if (TREE_UNSIGNED (TREE_TYPE (exp)) + --- 2763,2771 ---- + which will often result in some optimizations. Do the conversion + in two steps: first change the signedness, if needed, then + ! the extend. But don't do this if the type of EXP is a subtype + ! of something else since then the conversion might involve + ! more than just converting modes. */ + ! if (! want_value && INTEGRAL_TYPE_P (TREE_TYPE (exp)) + ! && TREE_TYPE (TREE_TYPE (exp)) == 0) + { + if (TREE_UNSIGNED (TREE_TYPE (exp)) + *************** store_expr (exp, target, want_value) + *** 2843,2847 **** + Convert the value to TARGET's type first if nec. */ + + ! if (temp != target && TREE_CODE (exp) != ERROR_MARK) + { + target = protect_from_queue (target, 1); + --- 2834,2838 ---- + Convert the value to TARGET's type first if nec. */ + + ! if (! rtx_equal_p (temp, target) && TREE_CODE (exp) != ERROR_MARK) + { + target = protect_from_queue (target, 1); + *************** store_constructor (exp, target) + *** 3071,3074 **** + --- 3062,3073 ---- + } + + + if (TREE_READONLY (field)) + + { + + if (GET_CODE (to_rtx) == MEM) + + to_rtx = copy_rtx (to_rtx); + + + + RTX_UNCHANGING_P (to_rtx) = 1; + + } + + + store_field (to_rtx, bitsize, bitpos, mode, TREE_VALUE (elt), + /* The alignment of TARGET is + *************** store_field (target, bitsize, bitpos, mo + *** 3414,3417 **** + --- 3413,3428 ---- + rtx temp = expand_expr (exp, NULL_RTX, VOIDmode, 0); + + + /* If BITSIZE is narrower than the size of the type of EXP + + we will be narrowing TEMP. Normally, what's wanted are the + + low-order bits. However, if EXP's type is a record and this is + + big-endian machine, we want the upper BITSIZE bits. */ + + if (BYTES_BIG_ENDIAN && GET_MODE_CLASS (GET_MODE (temp)) == MODE_INT + + && bitsize < GET_MODE_BITSIZE (GET_MODE (temp)) + + && TREE_CODE (TREE_TYPE (exp)) == RECORD_TYPE) + + temp = expand_shift (RSHIFT_EXPR, GET_MODE (temp), temp, + + size_int (GET_MODE_BITSIZE (GET_MODE (temp)) + + - bitsize), + + temp, 1); + + + /* Unless MODE is VOIDmode or BLKmode, convert TEMP to + MODE. */ + *************** store_field (target, bitsize, bitpos, mo + *** 3420,3423 **** + --- 3431,3455 ---- + temp = convert_modes (mode, TYPE_MODE (TREE_TYPE (exp)), temp, 1); + + + /* If the modes of TARGET and TEMP are both BLKmode, both + + must be in memory and BITPOS must be aligned on a byte + + boundary. If so, we simply do a block copy. */ + + if (GET_MODE (target) == BLKmode && GET_MODE (temp) == BLKmode) + + { + + if (GET_CODE (target) != MEM || GET_CODE (temp) != MEM + + || bitpos % BITS_PER_UNIT != 0) + + abort (); + + + + target = change_address (target, VOIDmode, + + plus_constant (XEXP (target, 0), + + bitpos / BITS_PER_UNIT)); + + + + emit_block_move (target, temp, + + GEN_INT ((bitsize + BITS_PER_UNIT - 1) + + / BITS_PER_UNIT), + + 1); + + + + return value_mode == VOIDmode ? const0_rtx : target; + + } + + + /* Store the value in the bitfield. */ + store_bit_field (target, bitsize, bitpos, mode, temp, align, total_size); + *************** store_field (target, bitsize, bitpos, mo + *** 3466,3471 **** + /* Now build a reference to just the desired component. */ + + ! to_rtx = change_address (target, mode, + ! plus_constant (addr, (bitpos / BITS_PER_UNIT))); + MEM_IN_STRUCT_P (to_rtx) = 1; + + --- 3498,3505 ---- + /* Now build a reference to just the desired component. */ + + ! to_rtx + ! = copy_rtx (change_address (target, mode, + ! plus_constant (addr, + ! (bitpos / BITS_PER_UNIT)))); + MEM_IN_STRUCT_P (to_rtx) = 1; + + *************** store_field (target, bitsize, bitpos, mo + *** 3474,3508 **** + } + + - /* Return true if any object containing the innermost array is an unaligned + - packed structure field. */ + - + - static int + - get_inner_unaligned_p (exp) + - tree exp; + - { + - int needed_alignment = TYPE_ALIGN (TREE_TYPE (exp)); + - + - while (1) + - { + - if (TREE_CODE (exp) == COMPONENT_REF || TREE_CODE (exp) == BIT_FIELD_REF) + - { + - if (TYPE_ALIGN (TREE_TYPE (TREE_OPERAND (exp, 0))) + - < needed_alignment) + - return 1; + - } + - else if (TREE_CODE (exp) != ARRAY_REF + - && TREE_CODE (exp) != NON_LVALUE_EXPR + - && ! ((TREE_CODE (exp) == NOP_EXPR + - || TREE_CODE (exp) == CONVERT_EXPR) + - && (TYPE_MODE (TREE_TYPE (exp)) + - == TYPE_MODE (TREE_TYPE (TREE_OPERAND (exp, 0)))))) + - break; + - + - exp = TREE_OPERAND (exp, 0); + - } + - + - return 0; + - } + - + /* Given an expression EXP that may be a COMPONENT_REF, a BIT_FIELD_REF, + or an ARRAY_REF, look for nested COMPONENT_REFs, BIT_FIELD_REFs, or + --- 3508,3511 ---- + *************** get_inner_unaligned_p (exp) + *** 3515,3518 **** + --- 3518,3524 ---- + This offset is in addition to the bit position. + If the position is not variable, we store 0 in *POFFSET. + + We set *PALIGNMENT to the alignment in bytes of the address that will be + + computed. This is the alignment of the thing we return if *POFFSET + + is zero, but can be more less strictly aligned if *POFFSET is nonzero. + + If any of the extraction expressions is volatile, + *************** get_inner_unaligned_p (exp) + *** 3525,3533 **** + If the field describes a variable-sized object, *PMODE is set to + VOIDmode and *PBITSIZE is set to -1. An access cannot be made in + ! this case, but the address of the object can be found. */ + + tree + get_inner_reference (exp, pbitsize, pbitpos, poffset, pmode, + ! punsignedp, pvolatilep) + tree exp; + int *pbitsize; + --- 3531,3539 ---- + If the field describes a variable-sized object, *PMODE is set to + VOIDmode and *PBITSIZE is set to -1. An access cannot be made in + ! this case, but the address of the object can be found. */ + + tree + get_inner_reference (exp, pbitsize, pbitpos, poffset, pmode, + ! punsignedp, pvolatilep, palignment) + tree exp; + int *pbitsize; + *************** get_inner_reference (exp, pbitsize, pbit + *** 3537,3540 **** + --- 3543,3547 ---- + int *punsignedp; + int *pvolatilep; + + int *palignment; + { + tree orig_exp = exp; + *************** get_inner_reference (exp, pbitsize, pbit + *** 3542,3545 **** + --- 3549,3553 ---- + enum machine_mode mode = VOIDmode; + tree offset = integer_zero_node; + + int alignment = BIGGEST_ALIGNMENT; + + if (TREE_CODE (exp) == COMPONENT_REF) + *************** get_inner_reference (exp, pbitsize, pbit + *** 3599,3607 **** + + *pbitpos += TREE_INT_CST_LOW (constant); + ! + ! if (var) + ! offset = size_binop (PLUS_EXPR, offset, + ! size_binop (EXACT_DIV_EXPR, var, + ! size_int (BITS_PER_UNIT))); + } + + --- 3607,3613 ---- + + *pbitpos += TREE_INT_CST_LOW (constant); + ! offset = size_binop (PLUS_EXPR, offset, + ! size_binop (EXACT_DIV_EXPR, var, + ! size_int (BITS_PER_UNIT))); + } + + *************** get_inner_reference (exp, pbitsize, pbit + *** 3629,3633 **** + + index = fold (build (MULT_EXPR, index_type, index, + ! TYPE_SIZE (TREE_TYPE (exp)))); + + if (TREE_CODE (index) == INTEGER_CST + --- 3635,3640 ---- + + index = fold (build (MULT_EXPR, index_type, index, + ! convert (index_type, + ! TYPE_SIZE (TREE_TYPE (exp))))); + + if (TREE_CODE (index) == INTEGER_CST + *************** get_inner_reference (exp, pbitsize, pbit + *** 3652,3666 **** + if (TREE_THIS_VOLATILE (exp)) + *pvolatilep = 1; + exp = TREE_OPERAND (exp, 0); + } + + ! /* If this was a bit-field, see if there is a mode that allows direct + ! access in case EXP is in memory. */ + ! if (mode == VOIDmode && *pbitsize != 0 && *pbitpos % *pbitsize == 0) + ! { + ! mode = mode_for_size (*pbitsize, MODE_INT, 0); + ! if (mode == BLKmode) + ! mode = VOIDmode; + ! } + + if (integer_zerop (offset)) + --- 3659,3675 ---- + if (TREE_THIS_VOLATILE (exp)) + *pvolatilep = 1; + + + + /* If the offset is non-constant already, then we can't assume any + + alignment more than the alignment here. */ + + if (! integer_zerop (offset)) + + alignment = MIN (alignment, TYPE_ALIGN (TREE_TYPE (exp))); + + + exp = TREE_OPERAND (exp, 0); + } + + ! if (TREE_CODE_CLASS (TREE_CODE (exp)) == 'd') + ! alignment = MIN (alignment, DECL_ALIGN (exp)); + ! else if (TREE_TYPE (exp) != 0) + ! alignment = MIN (alignment, TYPE_ALIGN (TREE_TYPE (exp))); + + if (integer_zerop (offset)) + *************** get_inner_reference (exp, pbitsize, pbit + *** 3672,3675 **** + --- 3681,3685 ---- + *pmode = mode; + *poffset = offset; + + *palignment = alignment / BITS_PER_UNIT; + return exp; + } + *************** init_noncopied_parts (lhs, list) + *** 3812,3820 **** + } + + ! /* Subroutine of expand_expr: return nonzero iff there is no way that + EXP can reference X, which is being modified. */ + + static int + ! safe_from_p (x, exp) + rtx x; + tree exp; + --- 3822,3834 ---- + } + + ! static int safe_from_p_count; + ! static int safe_from_p_size; + ! static tree *safe_from_p_rewritten; + ! + ! /* Subroutine of safe_from_p: return nonzero iff there is no way that + EXP can reference X, which is being modified. */ + + static int + ! safe_from_p_1 (x, exp) + rtx x; + tree exp; + *************** safe_from_p (x, exp) + *** 3822,3825 **** + --- 3836,3840 ---- + rtx exp_rtl = 0; + int i, nops; + + int is_save_expr = 0; + + if (x == 0 + *************** safe_from_p (x, exp) + *** 3860,3878 **** + + case 'x': + ! if (TREE_CODE (exp) == TREE_LIST) + ! return ((TREE_VALUE (exp) == 0 + ! || safe_from_p (x, TREE_VALUE (exp))) + ! && (TREE_CHAIN (exp) == 0 + ! || safe_from_p (x, TREE_CHAIN (exp)))); + ! else + ! return 0; + + case '1': + ! return safe_from_p (x, TREE_OPERAND (exp, 0)); + + case '2': + case '<': + ! return (safe_from_p (x, TREE_OPERAND (exp, 0)) + ! && safe_from_p (x, TREE_OPERAND (exp, 1))); + + case 'e': + --- 3875,3900 ---- + + case 'x': + ! switch (TREE_CODE (exp)) + ! { + ! case TREE_LIST: + ! return ((TREE_VALUE (exp) == 0 + ! || safe_from_p_1 (x, TREE_VALUE (exp))) + ! && (TREE_CHAIN (exp) == 0 + ! || safe_from_p_1 (x, TREE_CHAIN (exp)))); + ! + ! case ERROR_MARK: + ! return 1; + ! + ! default: + ! return 0; + ! } + + case '1': + ! return safe_from_p_1 (x, TREE_OPERAND (exp, 0)); + + case '2': + case '<': + ! return (safe_from_p_1 (x, TREE_OPERAND (exp, 0)) + ! && safe_from_p_1 (x, TREE_OPERAND (exp, 1))); + + case 'e': + *************** safe_from_p (x, exp) + *** 3887,3891 **** + case ADDR_EXPR: + return (staticp (TREE_OPERAND (exp, 0)) + ! || safe_from_p (x, TREE_OPERAND (exp, 0))); + + case INDIRECT_REF: + --- 3909,3913 ---- + case ADDR_EXPR: + return (staticp (TREE_OPERAND (exp, 0)) + ! || safe_from_p_1 (x, TREE_OPERAND (exp, 0))); + + case INDIRECT_REF: + *************** safe_from_p (x, exp) + *** 3922,3928 **** + + case CLEANUP_POINT_EXPR: + ! return safe_from_p (x, TREE_OPERAND (exp, 0)); + + case SAVE_EXPR: + exp_rtl = SAVE_EXPR_RTL (exp); + break; + --- 3944,3951 ---- + + case CLEANUP_POINT_EXPR: + ! return safe_from_p_1 (x, TREE_OPERAND (exp, 0)); + + case SAVE_EXPR: + + is_save_expr = 1; + exp_rtl = SAVE_EXPR_RTL (exp); + break; + *************** safe_from_p (x, exp) + *** 3931,3935 **** + /* The only operand we look at is operand 1. The rest aren't + part of the expression. */ + ! return safe_from_p (x, TREE_OPERAND (exp, 1)); + + case METHOD_CALL_EXPR: + --- 3954,3958 ---- + /* The only operand we look at is operand 1. The rest aren't + part of the expression. */ + ! return safe_from_p_1 (x, TREE_OPERAND (exp, 1)); + + case METHOD_CALL_EXPR: + *************** safe_from_p (x, exp) + *** 3945,3949 **** + for (i = 0; i < nops; i++) + if (TREE_OPERAND (exp, i) != 0 + ! && ! safe_from_p (x, TREE_OPERAND (exp, i))) + return 0; + } + --- 3968,3972 ---- + for (i = 0; i < nops; i++) + if (TREE_OPERAND (exp, i) != 0 + ! && ! safe_from_p_1 (x, TREE_OPERAND (exp, i))) + return 0; + } + *************** safe_from_p (x, exp) + *** 3969,3975 **** + --- 3992,4054 ---- + + /* If we reach here, it is safe. */ + + if (is_save_expr) + + { + + /* This SAVE_EXPR might appear many times in the top-level + + safe_from_p() expression, and if it has a complex + + subexpression, examining it multiple times could result + + in a combinatorial explosion. E.g. on an Alpha Cabriolet + + running at least 200MHz, a Fortran test case compiled with + + optimization took about 28 minutes to compile -- even though + + it was only a few lines long, and the complicated line causing + + so much time to be spent in the earlier version of safe_from_p() + + had only 293 or so unique nodes. + + + + So, turn this SAVE_EXPR into an ERROR_MARK for now, but remember + + where it is so we can turn it back in the top-level safe_from_p() + + when we're done. */ + + + + if (safe_from_p_count > safe_from_p_size) + + return 0; /* For now, don't bother re-sizing the array. */ + + safe_from_p_rewritten[safe_from_p_count++] = exp; + + TREE_SET_CODE (exp, ERROR_MARK); + + } + + + return 1; + } + + + /* Subroutine of expand_expr: return nonzero iff there is no way that + + EXP can reference X, which is being modified. */ + + + + static int + + safe_from_p (x, exp) + + rtx x; + + tree exp; + + { + + int rtn; + + int i; + + tree trees[128]; + + + + safe_from_p_count = 0; + + safe_from_p_size = sizeof (trees) / sizeof (trees[0]); + + safe_from_p_rewritten = &trees[0]; + + + + rtn = safe_from_p_1 (x, exp); + + + + #if 0 + + if (safe_from_p_count != 0) + + fprintf (stderr, "%s:%d: safe_from_p_count = %d\n", + + input_filename, lineno, safe_from_p_count); + + #endif + + + + for (i = 0; i < safe_from_p_count; ++i) + + { + + if (TREE_CODE (trees [i]) != ERROR_MARK) + + abort (); + + TREE_SET_CODE (trees[i], SAVE_EXPR); + + } + + + + return rtn; + + } + + + /* Subroutine of expand_expr: return nonzero iff EXP is an + expression whose type is statically determinable. */ + *************** expand_expr (exp, target, tmode, modifie + *** 4300,4303 **** + --- 4379,4387 ---- + context = decl_function_context (exp); + + + /* If this SAVE_EXPR was at global context, assume we are an + + initialization function and move it into our context. */ + + if (context == 0) + + SAVE_EXPR_CONTEXT (exp) = current_function_decl; + + + /* We treat inline_function_decl as an alias for the current function + because that is the inline function whose vars, types, etc. + *************** expand_expr (exp, target, tmode, modifie + *** 4310,4313 **** + --- 4394,4401 ---- + if (context) + { + + /* The following call just exists to abort if the context is + + not of a containing function. */ + + find_function_data (context); + + + temp = SAVE_EXPR_RTL (exp); + if (temp && GET_CODE (temp) == REG) + *************** expand_expr (exp, target, tmode, modifie + *** 4381,4400 **** + if (placeholder_list) + { + ! tree object; + tree old_list = placeholder_list; + + ! for (object = TREE_PURPOSE (placeholder_list); + ! (TYPE_MAIN_VARIANT (TREE_TYPE (object)) + ! != TYPE_MAIN_VARIANT (type)) + ! && (TREE_CODE_CLASS (TREE_CODE (object)) == 'r' + ! || TREE_CODE_CLASS (TREE_CODE (object)) == '1' + ! || TREE_CODE_CLASS (TREE_CODE (object)) == '2' + ! || TREE_CODE_CLASS (TREE_CODE (object)) == 'e'); + ! object = TREE_OPERAND (object, 0)) + ! ; + ! + ! if (object != 0 + ! && (TYPE_MAIN_VARIANT (TREE_TYPE (object)) + ! == TYPE_MAIN_VARIANT (type))) + { + /* Expand this object skipping the list entries before + --- 4469,4501 ---- + if (placeholder_list) + { + ! tree need_type = TYPE_MAIN_VARIANT (type); + ! tree object = 0; + tree old_list = placeholder_list; + + tree elt; + + + + /* See if the object is the type that we want. */ + + if ((TYPE_MAIN_VARIANT (TREE_TYPE (TREE_PURPOSE (placeholder_list))) + + == need_type)) + + object = TREE_PURPOSE (placeholder_list); + + + + /* Find the innermost reference that is of the type we want. */ + + for (elt = TREE_PURPOSE (placeholder_list); + + elt != 0 + + && (TREE_CODE_CLASS (TREE_CODE (elt)) == 'r' + + || TREE_CODE_CLASS (TREE_CODE (elt)) == '1' + + || TREE_CODE_CLASS (TREE_CODE (elt)) == '2' + + || TREE_CODE_CLASS (TREE_CODE (elt)) == 'e'); + + elt = ((TREE_CODE (elt) == COMPOUND_EXPR + + || TREE_CODE (elt) == COND_EXPR) + + ? TREE_OPERAND (elt, 1) : TREE_OPERAND (elt, 0))) + + if (TREE_CODE_CLASS (TREE_CODE (elt)) == 'r' + + && (TYPE_MAIN_VARIANT (TREE_TYPE (TREE_OPERAND (elt, 0))) + + == need_type)) + + { + + object = TREE_OPERAND (elt, 0); + + break; + + } + + ! if (object != 0) + { + /* Expand this object skipping the list entries before + *************** expand_expr (exp, target, tmode, modifie + *** 4534,4537 **** + --- 4635,4647 ---- + } + } + + + + if (TREE_READONLY (exp)) + + { + + if (GET_CODE (target) == MEM) + + target = copy_rtx (target); + + + + RTX_UNCHANGING_P (target) = 1; + + } + + + store_constructor (exp, target); + return target; + *************** expand_expr (exp, target, tmode, modifie + *** 4543,4567 **** + tree exp2; + + ! /* A SAVE_EXPR as the address in an INDIRECT_EXPR is generated + ! for *PTR += ANYTHING where PTR is put inside the SAVE_EXPR. + ! This code has the same general effect as simply doing + ! expand_expr on the save expr, except that the expression PTR + ! is computed for use as a memory address. This means different + ! code, suitable for indexing, may be generated. */ + ! if (TREE_CODE (exp1) == SAVE_EXPR + ! && SAVE_EXPR_RTL (exp1) == 0 + ! && TYPE_MODE (TREE_TYPE (exp1)) == ptr_mode) + ! { + ! temp = expand_expr (TREE_OPERAND (exp1, 0), NULL_RTX, + ! VOIDmode, EXPAND_SUM); + ! op0 = memory_address (mode, temp); + ! op0 = copy_all_regs (op0); + ! SAVE_EXPR_RTL (exp1) = op0; + ! } + ! else + ! { + ! op0 = expand_expr (exp1, NULL_RTX, VOIDmode, EXPAND_SUM); + ! op0 = memory_address (mode, op0); + ! } + + temp = gen_rtx (MEM, mode, op0); + --- 4653,4658 ---- + tree exp2; + + ! op0 = expand_expr (exp1, NULL_RTX, VOIDmode, EXPAND_SUM); + ! op0 = memory_address (mode, op0); + + temp = gen_rtx (MEM, mode, op0); + *************** expand_expr (exp, target, tmode, modifie + *** 4597,4605 **** + tree index = TREE_OPERAND (exp, 1); + tree index_type = TREE_TYPE (index); + ! int i; + ! + ! if (TREE_CODE (low_bound) != INTEGER_CST + ! && contains_placeholder_p (low_bound)) + ! low_bound = build (WITH_RECORD_EXPR, sizetype, low_bound, exp); + + /* Optimize the special-case of a zero lower bound. + --- 4688,4692 ---- + tree index = TREE_OPERAND (exp, 1); + tree index_type = TREE_TYPE (index); + ! HOST_WIDE_INT i; + + /* Optimize the special-case of a zero lower bound. + *************** expand_expr (exp, target, tmode, modifie + *** 4618,4684 **** + convert (sizetype, low_bound))); + + - if ((TREE_CODE (index) != INTEGER_CST + - || TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST) + - && (! SLOW_UNALIGNED_ACCESS || ! get_inner_unaligned_p (exp))) + - { + - /* Nonconstant array index or nonconstant element size, and + - not an array in an unaligned (packed) structure field. + - Generate the tree for *(&array+index) and expand that, + - except do it in a language-independent way + - and don't complain about non-lvalue arrays. + - `mark_addressable' should already have been called + - for any array for which this case will be reached. */ + - + - /* Don't forget the const or volatile flag from the array + - element. */ + - tree variant_type = build_type_variant (type, + - TREE_READONLY (exp), + - TREE_THIS_VOLATILE (exp)); + - tree array_adr = build1 (ADDR_EXPR, + - build_pointer_type (variant_type), array); + - tree elt; + - tree size = size_in_bytes (type); + - + - /* Convert the integer argument to a type the same size as sizetype + - so the multiply won't overflow spuriously. */ + - if (TYPE_PRECISION (index_type) != TYPE_PRECISION (sizetype)) + - index = convert (type_for_size (TYPE_PRECISION (sizetype), 0), + - index); + - + - if (TREE_CODE (size) != INTEGER_CST + - && contains_placeholder_p (size)) + - size = build (WITH_RECORD_EXPR, sizetype, size, exp); + - + - /* Don't think the address has side effects + - just because the array does. + - (In some cases the address might have side effects, + - and we fail to record that fact here. However, it should not + - matter, since expand_expr should not care.) */ + - TREE_SIDE_EFFECTS (array_adr) = 0; + - + - elt + - = build1 + - (INDIRECT_REF, type, + - fold (build (PLUS_EXPR, + - TYPE_POINTER_TO (variant_type), + - array_adr, + - fold + - (build1 + - (NOP_EXPR, + - TYPE_POINTER_TO (variant_type), + - fold (build (MULT_EXPR, TREE_TYPE (index), + - index, + - convert (TREE_TYPE (index), + - size))))))));; + - + - /* Volatility, etc., of new expression is same as old + - expression. */ + - TREE_SIDE_EFFECTS (elt) = TREE_SIDE_EFFECTS (exp); + - TREE_THIS_VOLATILE (elt) = TREE_THIS_VOLATILE (exp); + - TREE_READONLY (elt) = TREE_READONLY (exp); + - + - return expand_expr (elt, target, tmode, modifier); + - } + - + /* Fold an expression like: "foo"[2]. + This is not done in fold so it won't happen inside &. + --- 4705,4708 ---- + *************** expand_expr (exp, target, tmode, modifie + *** 4720,4725 **** + && TREE_CODE (DECL_INITIAL (array)) != ERROR_MARK) + { + ! if (TREE_CODE (index) == INTEGER_CST + ! && TREE_INT_CST_HIGH (index) == 0) + { + tree init = DECL_INITIAL (array); + --- 4744,4748 ---- + && TREE_CODE (DECL_INITIAL (array)) != ERROR_MARK) + { + ! if (TREE_CODE (index) == INTEGER_CST) + { + tree init = DECL_INITIAL (array); + *************** expand_expr (exp, target, tmode, modifie + *** 4738,4748 **** + } + else if (TREE_CODE (init) == STRING_CST + ! && i < TREE_STRING_LENGTH (init)) + ! return GEN_INT (TREE_STRING_POINTER (init)[i]); + } + } + } + + ! /* Treat array-ref with constant index as a component-ref. */ + + case COMPONENT_REF: + --- 4761,4775 ---- + } + else if (TREE_CODE (init) == STRING_CST + ! && TREE_INT_CST_HIGH (index) == 0 + ! && (TREE_INT_CST_LOW (index) + ! < TREE_STRING_LENGTH (init))) + ! return (GEN_INT + ! (TREE_STRING_POINTER + ! (init)[TREE_INT_CST_LOW (index)])); + } + } + } + + ! /* ... fall through ... */ + + case COMPONENT_REF: + *************** expand_expr (exp, target, tmode, modifie + *** 4770,4776 **** + tree offset; + int volatilep = 0; + - tree tem = get_inner_reference (exp, &bitsize, &bitpos, &offset, + - &mode1, &unsignedp, &volatilep); + int alignment; + + /* If we got back the original object, something is wrong. Perhaps + --- 4797,4804 ---- + tree offset; + int volatilep = 0; + int alignment; + + tree tem = get_inner_reference (exp, &bitsize, &bitpos, &offset, + + &mode1, &unsignedp, &volatilep, + + &alignment); + + /* If we got back the original object, something is wrong. Perhaps + *************** expand_expr (exp, target, tmode, modifie + *** 4793,4797 **** + != INTEGER_CST) + ? target : NULL_RTX), + ! VOIDmode, EXPAND_SUM); + + /* If this is a constant, put it into a register if it is a + --- 4821,4826 ---- + != INTEGER_CST) + ? target : NULL_RTX), + ! VOIDmode, + ! modifier == EXPAND_INITIALIZER ? modifier : 0); + + /* If this is a constant, put it into a register if it is a + *************** expand_expr (exp, target, tmode, modifie + *** 4806,4810 **** + } + + - alignment = TYPE_ALIGN (TREE_TYPE (tem)) / BITS_PER_UNIT; + if (offset != 0) + { + --- 4835,4838 ---- + *************** expand_expr (exp, target, tmode, modifie + *** 4816,4827 **** + gen_rtx (PLUS, ptr_mode, XEXP (op0, 0), + force_reg (ptr_mode, offset_rtx))); + - /* If we have a variable offset, the known alignment + - is only that of the innermost structure containing the field. + - (Actually, we could sometimes do better by using the + - size of an element of the innermost array, but no need.) */ + - if (TREE_CODE (exp) == COMPONENT_REF + - || TREE_CODE (exp) == BIT_FIELD_REF) + - alignment = (TYPE_ALIGN (TREE_TYPE (TREE_OPERAND (exp, 0))) + - / BITS_PER_UNIT); + } + + --- 4844,4847 ---- + *************** expand_expr (exp, target, tmode, modifie + *** 4844,4848 **** + && modifier != EXPAND_SUM + && modifier != EXPAND_INITIALIZER + ! && ((mode1 != BLKmode && ! direct_load[(int) mode1]) + /* If the field isn't aligned enough to fetch as a memref, + fetch it as a bit field. */ + --- 4864,4870 ---- + && modifier != EXPAND_SUM + && modifier != EXPAND_INITIALIZER + ! && ((mode1 != BLKmode && ! direct_load[(int) mode1] + ! && GET_MODE_CLASS (mode) != MODE_COMPLEX_INT + ! && GET_MODE_CLASS (mode) != MODE_COMPLEX_FLOAT) + /* If the field isn't aligned enough to fetch as a memref, + fetch it as a bit field. */ + *************** expand_expr (exp, target, tmode, modifie + *** 4857,4861 **** + + if (ext_mode == BLKmode) + ! abort (); + + op0 = extract_bit_field (validize_mem (op0), bitsize, bitpos, + --- 4879,4907 ---- + + if (ext_mode == BLKmode) + ! { + ! /* In this case, BITPOS must start at a byte boundary and + ! TARGET, if specified, must be a MEM. */ + ! if (GET_CODE (op0) != MEM + ! || (target != 0 && GET_CODE (target) != MEM) + ! || bitpos % BITS_PER_UNIT != 0) + ! abort (); + ! + ! op0 = change_address (op0, VOIDmode, + ! plus_constant (XEXP (op0, 0), + ! bitpos / BITS_PER_UNIT)); + ! if (target == 0) + ! { + ! target + ! = assign_stack_temp (mode, int_size_in_bytes (type), 0); + ! MEM_IN_STRUCT_P (target) = AGGREGATE_TYPE_P (type); + ! } + ! + ! emit_block_move (target, op0, + ! GEN_INT ((bitsize + BITS_PER_UNIT - 1) + ! / BITS_PER_UNIT), + ! 1); + ! + ! return target; + ! } + + op0 = extract_bit_field (validize_mem (op0), bitsize, bitpos, + *************** expand_expr (exp, target, tmode, modifie + *** 4863,4866 **** + --- 4909,4924 ---- + alignment, + int_size_in_bytes (TREE_TYPE (tem))); + + + + /* If the result is a record type and BITSIZE is narrower than + + the mode of OP0, an integral mode, and this is a big endian + + machine, we must put the field into the high-order bits. */ + + if (TREE_CODE (type) == RECORD_TYPE && BYTES_BIG_ENDIAN + + && GET_MODE_CLASS (GET_MODE (op0)) == MODE_INT + + && bitsize < GET_MODE_BITSIZE (GET_MODE (op0))) + + op0 = expand_shift (LSHIFT_EXPR, GET_MODE (op0), op0, + + size_int (GET_MODE_BITSIZE (GET_MODE (op0)) + + - bitsize), + + op0, 1); + + + if (mode == BLKmode) + { + *************** expand_expr (exp, target, tmode, modifie + *** 4877,4880 **** + --- 4935,4943 ---- + } + + + /* If the result is BLKmode, use that to access the object + + now as well. */ + + if (mode == BLKmode) + + mode1 = BLKmode; + + + /* Get a reference to just this component. */ + if (modifier == EXPAND_CONST_ADDRESS + *************** expand_expr (exp, target, tmode, modifie + *** 4883,4895 **** + (bitpos / BITS_PER_UNIT))); + else + ! op0 = change_address (op0, mode1, + ! plus_constant (XEXP (op0, 0), + ! (bitpos / BITS_PER_UNIT))); + MEM_IN_STRUCT_P (op0) = 1; + MEM_VOLATILE_P (op0) |= volatilep; + ! if (mode == mode1 || mode1 == BLKmode || mode1 == tmode) + return op0; + ! if (target == 0) + target = gen_reg_rtx (tmode != VOIDmode ? tmode : mode); + convert_move (target, op0, unsignedp); + return target; + --- 4946,4964 ---- + (bitpos / BITS_PER_UNIT))); + else + ! op0 + ! = copy_rtx + ! (change_address (op0, mode1, + ! plus_constant (XEXP (op0, 0), + ! (bitpos / BITS_PER_UNIT)))); + ! + MEM_IN_STRUCT_P (op0) = 1; + MEM_VOLATILE_P (op0) |= volatilep; + ! if (mode == mode1 || mode1 == BLKmode || mode1 == tmode + ! || modifier == EXPAND_CONST_ADDRESS + ! || modifier == EXPAND_INITIALIZER) + return op0; + ! else if (target == 0) + target = gen_reg_rtx (tmode != VOIDmode ? tmode : mode); + + + convert_move (target, op0, unsignedp); + return target; + *************** expand_expr (exp, target, tmode, modifie + *** 6199,6203 **** + if (TREE_CODE (lhs) != VAR_DECL + && TREE_CODE (lhs) != RESULT_DECL + ! && TREE_CODE (lhs) != PARM_DECL) + preexpand_calls (exp); + + --- 6268,6274 ---- + if (TREE_CODE (lhs) != VAR_DECL + && TREE_CODE (lhs) != RESULT_DECL + ! && TREE_CODE (lhs) != PARM_DECL + ! && ! (TREE_CODE (lhs) == INDIRECT_REF + ! && TYPE_READONLY (TREE_TYPE (TREE_OPERAND (lhs, 0))))) + preexpand_calls (exp); + + *************** expand_builtin (exp, target, subtarget, + *** 7986,7989 **** + --- 8057,8295 ---- + #endif + + + /* __builtin_setjmp is passed a pointer to an array of five words + + (not all will be used on all machines). It operates similarly to + + the C library function of the same name, but is more efficient. + + Much of the code below (and for longjmp) is copied from the handling + + of non-local gotos. + + + + NOTE: This is intended for use by GNAT and will only work in + + the method used by it. This code will likely NOT survive to + + the GCC 2.8.0 release. */ + + case BUILT_IN_SETJMP: + + if (arglist == 0 + + || TREE_CODE (TREE_TYPE (TREE_VALUE (arglist))) != POINTER_TYPE) + + break; + + + + { + + rtx buf_addr = expand_expr (TREE_VALUE (arglist), subtarget, + + VOIDmode, 0); + + rtx lab1 = gen_label_rtx (), lab2 = gen_label_rtx (); + + enum machine_mode sa_mode = Pmode; + + rtx stack_save; + + int old_inhibit_defer_pop = inhibit_defer_pop; + + int return_pops = RETURN_POPS_ARGS (get_identifier ("__dummy"), + + get_identifier ("__dummy"), 0); + + rtx next_arg_reg; + + CUMULATIVE_ARGS args_so_far; + + int current_call_is_indirect = 1; + + int i; + + + + #ifdef POINTERS_EXTEND_UNSIGNED + + buf_addr = convert_memory_address (Pmode, buf_addr); + + #endif + + + + buf_addr = force_reg (Pmode, buf_addr); + + + + if (target == 0 || GET_CODE (target) != REG + + || REGNO (target) < FIRST_PSEUDO_REGISTER) + + target = gen_reg_rtx (value_mode); + + + + emit_queue (); + + + + CONST_CALL_P (emit_note (NULL_PTR, NOTE_INSN_SETJMP)) = 1; + + current_function_calls_setjmp = 1; + + + + /* We store the frame pointer and the address of lab1 in the buffer + + and use the rest of it for the stack save area, which is + + machine-dependent. */ + + emit_move_insn (gen_rtx (MEM, Pmode, buf_addr), + + virtual_stack_vars_rtx); + + emit_move_insn + + (validize_mem (gen_rtx (MEM, Pmode, + + plus_constant (buf_addr, + + GET_MODE_SIZE (Pmode)))), + + gen_rtx (LABEL_REF, Pmode, lab1)); + + + + #ifdef HAVE_save_stack_nonlocal + + if (HAVE_save_stack_nonlocal) + + sa_mode = insn_operand_mode[(int) CODE_FOR_save_stack_nonlocal][0]; + + #endif + + + + current_function_has_nonlocal_goto = 1; + + + + stack_save = gen_rtx (MEM, sa_mode, + + plus_constant (buf_addr, + + 2 * GET_MODE_SIZE (Pmode))); + + emit_stack_save (SAVE_NONLOCAL, &stack_save, NULL_RTX); + + + + #ifdef HAVE_setjmp + + if (HAVE_setjmp) + + emit_insn (gen_setjmp ()); + + #endif + + + + /* Set TARGET to zero and branch around the other case. */ + + emit_move_insn (target, const0_rtx); + + emit_jump_insn (gen_jump (lab2)); + + emit_barrier (); + + emit_label (lab1); + + + + /* Note that setjmp clobbers FP when we get here, so we have to + + make sure it's marked as used by this function. */ + + emit_insn (gen_rtx (USE, VOIDmode, hard_frame_pointer_rtx)); + + + + /* Mark the static chain as clobbered here so life information + + doesn't get messed up for it. */ + + emit_insn (gen_rtx (CLOBBER, VOIDmode, static_chain_rtx)); + + + + /* Now put in the code to restore the frame pointer, and argument + + pointer, if needed. The code below is from expand_end_bindings + + in stmt.c; see detailed documentation there. */ + + #ifdef HAVE_nonlocal_goto + + if (! HAVE_nonlocal_goto) + + #endif + + emit_move_insn (virtual_stack_vars_rtx, hard_frame_pointer_rtx); + + + + #if ARG_POINTER_REGNUM != HARD_FRAME_POINTER_REGNUM + + if (fixed_regs[ARG_POINTER_REGNUM]) + + { + + #ifdef ELIMINABLE_REGS + + static struct elims {int from, to;} elim_regs[] = ELIMINABLE_REGS; + + + + for (i = 0; i < sizeof elim_regs / sizeof elim_regs[0]; i++) + + if (elim_regs[i].from == ARG_POINTER_REGNUM + + && elim_regs[i].to == HARD_FRAME_POINTER_REGNUM) + + break; + + + + if (i == sizeof elim_regs / sizeof elim_regs [0]) + + #endif + + { + + /* Now restore our arg pointer from the address at which it + + was saved in our stack frame. + + If there hasn't be space allocated for it yet, make + + some now. */ + + if (arg_pointer_save_area == 0) + + arg_pointer_save_area + + = assign_stack_local (Pmode, GET_MODE_SIZE (Pmode), 0); + + emit_move_insn (virtual_incoming_args_rtx, + + copy_to_reg (arg_pointer_save_area)); + + } + + } + + #endif + + + + #ifdef HAVE_nonlocal_goto_receiver + + if (HAVE_nonlocal_goto_receiver) + + emit_insn (gen_nonlocal_goto_receiver ()); + + #endif + + /* The static chain pointer contains the address of dummy function. + + We need to call it here to handle some PIC cases of restoring + + a global pointer. Then return 1. */ + + op0 = copy_to_mode_reg (Pmode, static_chain_rtx); + + + + /* We can't actually call emit_library_call here, so do everything + + it does, which isn't much for a libfunc with no args. */ + + op0 = memory_address (FUNCTION_MODE, op0); + + + + INIT_CUMULATIVE_ARGS (args_so_far, NULL_TREE, + + gen_rtx (SYMBOL_REF, Pmode, "__dummy")); + + next_arg_reg = FUNCTION_ARG (args_so_far, VOIDmode, void_type_node, 1); + + + + #ifndef ACCUMULATE_OUTGOING_ARGS + + #ifdef HAVE_call_pop + + if (HAVE_call_pop) + + emit_call_insn (gen_call_pop (gen_rtx (MEM, FUNCTION_MODE, op0), + + const0_rtx, next_arg_reg, + + GEN_INT (return_pops))); + + else + + #endif + + #endif + + + + #ifdef HAVE_call + + if (HAVE_call) + + emit_call_insn (gen_call (gen_rtx (MEM, FUNCTION_MODE, op0), + + const0_rtx, next_arg_reg, const0_rtx)); + + else + + #endif + + abort (); + + + + emit_move_insn (target, const1_rtx); + + emit_label (lab2); + + return target; + + } + + + + /* __builtin_longjmp is passed a pointer to an array of five words + + and a value, which is a dummy. It's similar to the C library longjmp + + function but works with __builtin_setjmp above. */ + + case BUILT_IN_LONGJMP: + + if (arglist == 0 || TREE_CHAIN (arglist) == 0 + + || TREE_CODE (TREE_TYPE (TREE_VALUE (arglist))) != POINTER_TYPE) + + break; + + + + { + + tree dummy_id = get_identifier ("__dummy"); + + tree dummy_type = build_function_type (void_type_node, NULL_TREE); + + tree dummy_decl = build_decl (FUNCTION_DECL, dummy_id, dummy_type); + + #ifdef POINTERS_EXTEND_UNSIGNED + + rtx buf_addr + + = force_reg (Pmode, + + convert_memory_address + + (Pmode, + + expand_expr (TREE_VALUE (arglist), + + NULL_RTX, VOIDmode, 0))); + + #else + + rtx buf_addr + + = force_reg (Pmode, expand_expr (TREE_VALUE (arglist), + + NULL_RTX, + + VOIDmode, 0)); + + #endif + + rtx fp = gen_rtx (MEM, Pmode, buf_addr); + + rtx lab = gen_rtx (MEM, Pmode, + + plus_constant (buf_addr, GET_MODE_SIZE (Pmode))); + + enum machine_mode sa_mode + + #ifdef HAVE_save_stack_nonlocal + + = (HAVE_save_stack_nonlocal + + ? insn_operand_mode[(int) CODE_FOR_save_stack_nonlocal][0] + + : Pmode); + + #else + + = Pmode; + + #endif + + rtx stack = gen_rtx (MEM, sa_mode, + + plus_constant (buf_addr, + + 2 * GET_MODE_SIZE (Pmode))); + + + + DECL_EXTERNAL (dummy_decl) = 1; + + TREE_PUBLIC (dummy_decl) = 1; + + make_decl_rtl (dummy_decl, NULL_PTR, 1); + + + + /* Expand the second expression just for side-effects. */ + + expand_expr (TREE_VALUE (TREE_CHAIN (arglist)), + + const0_rtx, VOIDmode, 0); + + + + assemble_external (dummy_decl); + + + + /* Pick up FP, label, and SP from the block and jump. This code is + + from expand_goto in stmt.c; see there for detailed comments. */ + + #if HAVE_nonlocal_goto + + if (HAVE_nonlocal_goto) + + emit_insn (gen_nonlocal_goto (fp, lab, stack, + + XEXP (DECL_RTL (dummy_decl), 0))); + + else + + #endif + + { + + lab = copy_to_reg (lab); + + emit_move_insn (hard_frame_pointer_rtx, fp); + + emit_stack_restore (SAVE_NONLOCAL, stack, NULL_RTX); + + + + /* Put in the static chain register the address of the dummy + + function. */ + + emit_move_insn (static_chain_rtx, XEXP (DECL_RTL (dummy_decl), 0)); + + emit_insn (gen_rtx (USE, VOIDmode, hard_frame_pointer_rtx)); + + emit_insn (gen_rtx (USE, VOIDmode, stack_pointer_rtx)); + + emit_insn (gen_rtx (USE, VOIDmode, static_chain_rtx)); + + emit_indirect_jump (lab); + + } + + + + return const0_rtx; + + } + + + default: /* just do library call, if unknown builtin */ + error ("built-in function `%s' not currently supported", + *************** preexpand_calls (exp) + *** 8688,8701 **** + case CALL_EXPR: + /* Do nothing if already expanded. */ + ! if (CALL_EXPR_RTL (exp) != 0) + return; + + ! /* Do nothing to built-in functions. */ + ! if (TREE_CODE (TREE_OPERAND (exp, 0)) != ADDR_EXPR + ! || TREE_CODE (TREE_OPERAND (TREE_OPERAND (exp, 0), 0)) != FUNCTION_DECL + ! || ! DECL_BUILT_IN (TREE_OPERAND (TREE_OPERAND (exp, 0), 0)) + ! /* Do nothing if the call returns a variable-sized object. */ + ! || TREE_CODE (TYPE_SIZE (TREE_TYPE(exp))) != INTEGER_CST) + ! CALL_EXPR_RTL (exp) = expand_call (exp, NULL_RTX, 0); + return; + + --- 8994,9008 ---- + case CALL_EXPR: + /* Do nothing if already expanded. */ + ! if (CALL_EXPR_RTL (exp) != 0 + ! /* Do nothing if the call returns a variable-sized object. */ + ! || TREE_CODE (TYPE_SIZE (TREE_TYPE(exp))) != INTEGER_CST + ! /* Do nothing to built-in functions. */ + ! || (TREE_CODE (TREE_OPERAND (exp, 0)) == ADDR_EXPR + ! && (TREE_CODE (TREE_OPERAND (TREE_OPERAND (exp, 0), 0)) + ! == FUNCTION_DECL) + ! && DECL_BUILT_IN (TREE_OPERAND (TREE_OPERAND (exp, 0), 0)))) + return; + + ! CALL_EXPR_RTL (exp) = expand_call (exp, NULL_RTX, 0); + return; + + *************** do_jump (exp, if_false_label, if_true_la + *** 9087,9090 **** + --- 9394,9398 ---- + push_temp_slots (); + expand_expr (TREE_OPERAND (exp, 0), const0_rtx, VOIDmode, 0); + + preserve_temp_slots (NULL_RTX); + free_temp_slots (); + pop_temp_slots (); + *************** do_jump (exp, if_false_label, if_true_la + *** 9103,9111 **** + tree offset; + int volatilep = 0; + + /* Get description of this reference. We don't actually care + about the underlying object here. */ + get_inner_reference (exp, &bitsize, &bitpos, &offset, + ! &mode, &unsignedp, &volatilep); + + type = type_for_size (bitsize, unsignedp); + --- 9411,9421 ---- + tree offset; + int volatilep = 0; + + int alignment; + + /* Get description of this reference. We don't actually care + about the underlying object here. */ + get_inner_reference (exp, &bitsize, &bitpos, &offset, + ! &mode, &unsignedp, &volatilep, + ! &alignment); + + type = type_for_size (bitsize, unsignedp); + diff -rcp2N gcc-2.7.2.3/expr.h gcc-2.7.2.3.f.1/expr.h + *** gcc-2.7.2.3/expr.h Fri Oct 27 10:16:56 1995 + --- gcc-2.7.2.3.f.1/expr.h Fri Aug 29 07:52:02 1997 + *************** enum direction {none, upward, downward}; + *** 229,232 **** + --- 229,272 ---- + #define RETURN_IN_MEMORY(TYPE) (TYPE_MODE (TYPE) == BLKmode) + #endif + + + + /* Provide default values for the macros controlling stack checking. */ + + + + #ifndef STACK_CHECK_BUILTIN + + #define STACK_CHECK_BUILTIN 0 + + #endif + + + + /* The default interval is one page. */ + + #ifndef STACK_CHECK_PROBE_INTERVAL + + #define STACK_CHECK_PROBE_INTERVAL 4096 + + #endif + + + + /* The default is to do a store into the stack. */ + + #ifndef STACK_CHECK_PROBE_LOAD + + #define STACK_CHECK_PROBE_LOAD 0 + + #endif + + + + /* This value is arbitrary, but should be sufficient for most machines. */ + + #ifndef STACK_CHECK_PROTECT + + #define STACK_CHECK_PROTECT (75 * UNITS_PER_WORD) + + #endif + + + + /* Make the maximum frame size be the largest we can and still only need + + one probe per function. */ + + #ifndef STACK_CHECK_MAX_FRAME_SIZE + + #define STACK_CHECK_MAX_FRAME_SIZE \ + + (STACK_CHECK_PROBE_INTERVAL - UNITS_PER_WORD) + + #endif + + + + /* This is arbitrary, but should be large enough everywhere. */ + + #ifndef STACK_CHECK_FIXED_FRAME_SIZE + + #define STACK_CHECK_FIXED_FRAME_SIZE (4 * UNITS_PER_WORD) + + #endif + + + + /* Provide a reasonable default for the maximum size of an object to + + allocate in the fixed frame. We may need to be able to make this + + controllable by the user at some point. */ + + #ifndef STACK_CHECK_MAX_VAR_SIZE + + #define STACK_CHECK_MAX_VAR_SIZE (STACK_CHECK_MAX_FRAME_SIZE / 100) + + #endif + + /* Optabs are tables saying how to generate insn bodies + *************** extern void emit_stack_restore PROTO((en + *** 828,831 **** + --- 868,878 ---- + says how many bytes. */ + extern rtx allocate_dynamic_stack_space PROTO((rtx, rtx, int)); + + + + /* Probe a range of stack addresses from FIRST to FIRST+SIZE, inclusive. + + FIRST is a constant and size is a Pmode RTX. These are offsets from the + + current stack pointer. STACK_GROWS_DOWNWARD says whether to add or + + subtract from the stack. If SIZE is constant, this is done + + with a fixed number of probes. Otherwise, we must make a loop. */ + + extern void probe_stack_range PROTO((HOST_WIDE_INT, rtx)); + + /* Emit code to copy function value to a new temp reg and return that reg. */ + diff -rcp2N gcc-2.7.2.3/final.c gcc-2.7.2.3.f.1/final.c + *** gcc-2.7.2.3/final.c Sun Nov 26 18:50:00 1995 + --- gcc-2.7.2.3.f.1/final.c Fri Jul 11 00:11:16 1997 + *************** profile_function (file) + *** 983,991 **** + text_section (); + + ! #ifdef STRUCT_VALUE_INCOMING_REGNUM + if (sval) + ASM_OUTPUT_REG_PUSH (file, STRUCT_VALUE_INCOMING_REGNUM); + #else + ! #ifdef STRUCT_VALUE_REGNUM + if (sval) + ASM_OUTPUT_REG_PUSH (file, STRUCT_VALUE_REGNUM); + --- 983,991 ---- + text_section (); + + ! #if defined(STRUCT_VALUE_INCOMING_REGNUM) && defined(ASM_OUTPUT_REG_PUSH) + if (sval) + ASM_OUTPUT_REG_PUSH (file, STRUCT_VALUE_INCOMING_REGNUM); + #else + ! #if defined(STRUCT_VALUE_REGNUM) && defined(ASM_OUTPUT_REG_PUSH) + if (sval) + ASM_OUTPUT_REG_PUSH (file, STRUCT_VALUE_REGNUM); + *************** profile_function (file) + *** 993,1027 **** + #endif + + ! #if 0 + ! #ifdef STATIC_CHAIN_INCOMING_REGNUM + if (cxt) + ASM_OUTPUT_REG_PUSH (file, STATIC_CHAIN_INCOMING_REGNUM); + #else + ! #ifdef STATIC_CHAIN_REGNUM + if (cxt) + ASM_OUTPUT_REG_PUSH (file, STATIC_CHAIN_REGNUM); + #endif + #endif + - #endif /* 0 */ + + FUNCTION_PROFILER (file, profile_label_no); + + ! #if 0 + ! #ifdef STATIC_CHAIN_INCOMING_REGNUM + if (cxt) + ASM_OUTPUT_REG_POP (file, STATIC_CHAIN_INCOMING_REGNUM); + #else + ! #ifdef STATIC_CHAIN_REGNUM + if (cxt) + ASM_OUTPUT_REG_POP (file, STATIC_CHAIN_REGNUM); + #endif + #endif + - #endif /* 0 */ + + ! #ifdef STRUCT_VALUE_INCOMING_REGNUM + if (sval) + ASM_OUTPUT_REG_POP (file, STRUCT_VALUE_INCOMING_REGNUM); + #else + ! #ifdef STRUCT_VALUE_REGNUM + if (sval) + ASM_OUTPUT_REG_POP (file, STRUCT_VALUE_REGNUM); + --- 993,1023 ---- + #endif + + ! #if defined(STATIC_CHAIN_INCOMING_REGNUM) && defined(ASM_OUTPUT_REG_PUSH) + if (cxt) + ASM_OUTPUT_REG_PUSH (file, STATIC_CHAIN_INCOMING_REGNUM); + #else + ! #if defined(STATIC_CHAIN_REGNUM) && defined(ASM_OUTPUT_REG_PUSH) + if (cxt) + ASM_OUTPUT_REG_PUSH (file, STATIC_CHAIN_REGNUM); + #endif + #endif + + FUNCTION_PROFILER (file, profile_label_no); + + ! #if defined(STATIC_CHAIN_INCOMING_REGNUM) && defined(ASM_OUTPUT_REG_PUSH) + if (cxt) + ASM_OUTPUT_REG_POP (file, STATIC_CHAIN_INCOMING_REGNUM); + #else + ! #if defined(STATIC_CHAIN_REGNUM) && defined(ASM_OUTPUT_REG_PUSH) + if (cxt) + ASM_OUTPUT_REG_POP (file, STATIC_CHAIN_REGNUM); + #endif + #endif + + ! #if defined(STRUCT_VALUE_INCOMING_REGNUM) && defined(ASM_OUTPUT_REG_PUSH) + if (sval) + ASM_OUTPUT_REG_POP (file, STRUCT_VALUE_INCOMING_REGNUM); + #else + ! #if defined(STRUCT_VALUE_REGNUM) && defined(ASM_OUTPUT_REG_PUSH) + if (sval) + ASM_OUTPUT_REG_POP (file, STRUCT_VALUE_REGNUM); + diff -rcp2N gcc-2.7.2.3/flags.h gcc-2.7.2.3.f.1/flags.h + *** gcc-2.7.2.3/flags.h Thu Jun 15 11:34:11 1995 + --- gcc-2.7.2.3.f.1/flags.h Fri Aug 29 08:40:01 1997 + *************** extern int flag_unroll_loops; + *** 204,207 **** + --- 204,221 ---- + extern int flag_unroll_all_loops; + + + /* Nonzero forces all invariant computations in loops to be moved + + outside the loop. */ + + + + extern int flag_move_all_movables; + + + + /* Nonzero forces all general induction variables in loops to be + + strength reduced. */ + + + + extern int flag_reduce_all_givs; + + + + /* Nonzero gets another run of loop_optimize performed. */ + + + + extern int flag_rerun_loop_opt; + + + /* Nonzero for -fcse-follow-jumps: + have cse follow jumps to do a more extensive job. */ + *************** extern int flag_gnu_linker; + *** 339,342 **** + --- 353,373 ---- + /* Tag all structures with __attribute__(packed) */ + extern int flag_pack_struct; + + + + /* Emit code to check for stack overflow; also may cause large objects + + to be allocated dynamically. */ + + extern int flag_stack_check; + + + + /* 1 if alias checking is enabled: symbols do not alias each other + + and parameters do not alias the current stack frame. */ + + extern int flag_alias_check; + + + + /* This flag is only tested if alias checking is enabled. + + 0 if pointer arguments may alias each other. True in C. + + 1 if pointer arguments may not alias each other but may alias + + global variables. + + 2 if pointer arguments may not alias each other and may not + + alias global variables. True in Fortran. + + The value is ignored if flag_alias_check is 0. */ + + extern int flag_argument_noalias; + + /* Other basic status info about current function. */ + diff -rcp2N gcc-2.7.2.3/flow.c gcc-2.7.2.3.f.1/flow.c + *** gcc-2.7.2.3/flow.c Mon Aug 28 10:23:34 1995 + --- gcc-2.7.2.3.f.1/flow.c Wed Aug 27 11:46:36 1997 + *************** static HARD_REG_SET elim_reg_set; + *** 288,292 **** + /* Forward declarations */ + static void find_basic_blocks PROTO((rtx, rtx)); + ! static int uses_reg_or_mem PROTO((rtx)); + static void mark_label_ref PROTO((rtx, rtx, int)); + static void life_analysis PROTO((rtx, int)); + --- 288,292 ---- + /* Forward declarations */ + static void find_basic_blocks PROTO((rtx, rtx)); + ! static int jmp_uses_reg_or_mem PROTO((rtx)); + static void mark_label_ref PROTO((rtx, rtx, int)); + static void life_analysis PROTO((rtx, int)); + *************** find_basic_blocks (f, nonlocal_label_lis + *** 554,563 **** + if (GET_CODE (XVECEXP (pat, 0, i)) == SET + && SET_DEST (XVECEXP (pat, 0, i)) == pc_rtx + ! && uses_reg_or_mem (SET_SRC (XVECEXP (pat, 0, i)))) + computed_jump = 1; + } + else if (GET_CODE (pat) == SET + && SET_DEST (pat) == pc_rtx + ! && uses_reg_or_mem (SET_SRC (pat))) + computed_jump = 1; + + --- 554,563 ---- + if (GET_CODE (XVECEXP (pat, 0, i)) == SET + && SET_DEST (XVECEXP (pat, 0, i)) == pc_rtx + ! && jmp_uses_reg_or_mem (SET_SRC (XVECEXP (pat, 0, i)))) + computed_jump = 1; + } + else if (GET_CODE (pat) == SET + && SET_DEST (pat) == pc_rtx + ! && jmp_uses_reg_or_mem (SET_SRC (pat))) + computed_jump = 1; + + *************** find_basic_blocks (f, nonlocal_label_lis + *** 760,767 **** + /* Subroutines of find_basic_blocks. */ + + ! /* Return 1 if X contain a REG or MEM that is not in the constant pool. */ + + static int + ! uses_reg_or_mem (x) + rtx x; + { + --- 760,768 ---- + /* Subroutines of find_basic_blocks. */ + + ! /* Return 1 if X, the SRC_SRC of SET of (pc) contain a REG or MEM that is + ! not in the constant pool and not in the condition of an IF_THEN_ELSE. */ + + static int + ! jmp_uses_reg_or_mem (x) + rtx x; + { + *************** uses_reg_or_mem (x) + *** 770,778 **** + char *fmt; + + ! if (code == REG + ! || (code == MEM + ! && ! (GET_CODE (XEXP (x, 0)) == SYMBOL_REF + ! && CONSTANT_POOL_ADDRESS_P (XEXP (x, 0))))) + ! return 1; + + fmt = GET_RTX_FORMAT (code); + --- 771,796 ---- + char *fmt; + + ! switch (code) + ! { + ! case CONST: + ! case LABEL_REF: + ! case PC: + ! return 0; + ! + ! case REG: + ! return 1; + ! + ! case MEM: + ! return ! (GET_CODE (XEXP (x, 0)) == SYMBOL_REF + ! && CONSTANT_POOL_ADDRESS_P (XEXP (x, 0))); + ! + ! case IF_THEN_ELSE: + ! return (jmp_uses_reg_or_mem (XEXP (x, 1)) + ! || jmp_uses_reg_or_mem (XEXP (x, 2))); + ! + ! case PLUS: case MINUS: case MULT: + ! return (jmp_uses_reg_or_mem (XEXP (x, 0)) + ! || jmp_uses_reg_or_mem (XEXP (x, 1))); + ! } + + fmt = GET_RTX_FORMAT (code); + *************** uses_reg_or_mem (x) + *** 780,789 **** + { + if (fmt[i] == 'e' + ! && uses_reg_or_mem (XEXP (x, i))) + return 1; + + if (fmt[i] == 'E') + for (j = 0; j < XVECLEN (x, i); j++) + ! if (uses_reg_or_mem (XVECEXP (x, i, j))) + return 1; + } + --- 798,807 ---- + { + if (fmt[i] == 'e' + ! && jmp_uses_reg_or_mem (XEXP (x, i))) + return 1; + + if (fmt[i] == 'E') + for (j = 0; j < XVECLEN (x, i); j++) + ! if (jmp_uses_reg_or_mem (XVECEXP (x, i, j))) + return 1; + } + *************** propagate_block (old, first, last, final + *** 1605,1614 **** + + /* Each call clobbers all call-clobbered regs that are not + ! global. Note that the function-value reg is a + call-clobbered reg, and mark_set_regs has already had + a chance to handle it. */ + + for (i = 0; i < FIRST_PSEUDO_REGISTER; i++) + ! if (call_used_regs[i] && ! global_regs[i]) + dead[i / REGSET_ELT_BITS] + |= ((REGSET_ELT_TYPE) 1 << (i % REGSET_ELT_BITS)); + --- 1623,1633 ---- + + /* Each call clobbers all call-clobbered regs that are not + ! global or fixed. Note that the function-value reg is a + call-clobbered reg, and mark_set_regs has already had + a chance to handle it. */ + + for (i = 0; i < FIRST_PSEUDO_REGISTER; i++) + ! if (call_used_regs[i] && ! global_regs[i] + ! && ! fixed_regs[i]) + dead[i / REGSET_ELT_BITS] + |= ((REGSET_ELT_TYPE) 1 << (i % REGSET_ELT_BITS)); + diff -rcp2N gcc-2.7.2.3/fold-const.c gcc-2.7.2.3.f.1/fold-const.c + *** gcc-2.7.2.3/fold-const.c Fri Sep 15 22:26:12 1995 + --- gcc-2.7.2.3.f.1/fold-const.c Fri Aug 29 07:52:10 1997 + *************** static tree unextend PROTO((tree, int, i + *** 80,83 **** + --- 80,84 ---- + static tree fold_truthop PROTO((enum tree_code, tree, tree, tree)); + static tree strip_compound_expr PROTO((tree, tree)); + + static int multiple_of_p PROTO((tree, tree, tree)); + + #ifndef BRANCH_COST + *************** const_binop (code, arg1, arg2, notrunc) + *** 1077,1080 **** + --- 1078,1083 ---- + if (int2h == 0 && int2l > 0 + && TREE_TYPE (arg1) == sizetype + + && ! TREE_CONSTANT_OVERFLOW (arg1) + + && ! TREE_CONSTANT_OVERFLOW (arg2) + && int1h == 0 && int1l >= 0) + { + *************** const_binop (code, arg1, arg2, notrunc) + *** 1230,1233 **** + --- 1233,1237 ---- + if (TREE_CODE (arg1) == COMPLEX_CST) + { + + register tree type = TREE_TYPE (arg1); + register tree r1 = TREE_REALPART (arg1); + register tree i1 = TREE_IMAGPART (arg1); + *************** const_binop (code, arg1, arg2, notrunc) + *** 1239,1253 **** + { + case PLUS_EXPR: + ! t = build_complex (const_binop (PLUS_EXPR, r1, r2, notrunc), + const_binop (PLUS_EXPR, i1, i2, notrunc)); + break; + + case MINUS_EXPR: + ! t = build_complex (const_binop (MINUS_EXPR, r1, r2, notrunc), + const_binop (MINUS_EXPR, i1, i2, notrunc)); + break; + + case MULT_EXPR: + ! t = build_complex (const_binop (MINUS_EXPR, + const_binop (MULT_EXPR, + r1, r2, notrunc), + --- 1243,1260 ---- + { + case PLUS_EXPR: + ! t = build_complex (type, + ! const_binop (PLUS_EXPR, r1, r2, notrunc), + const_binop (PLUS_EXPR, i1, i2, notrunc)); + break; + + case MINUS_EXPR: + ! t = build_complex (type, + ! const_binop (MINUS_EXPR, r1, r2, notrunc), + const_binop (MINUS_EXPR, i1, i2, notrunc)); + break; + + case MULT_EXPR: + ! t = build_complex (type, + ! const_binop (MINUS_EXPR, + const_binop (MULT_EXPR, + r1, r2, notrunc), + *************** const_binop (code, arg1, arg2, notrunc) + *** 1271,1293 **** + notrunc); + + ! t = build_complex + ! (const_binop (INTEGRAL_TYPE_P (TREE_TYPE (r1)) + ! ? TRUNC_DIV_EXPR : RDIV_EXPR, + ! const_binop (PLUS_EXPR, + ! const_binop (MULT_EXPR, r1, r2, + ! notrunc), + ! const_binop (MULT_EXPR, i1, i2, + ! notrunc), + ! notrunc), + ! magsquared, notrunc), + ! const_binop (INTEGRAL_TYPE_P (TREE_TYPE (r1)) + ! ? TRUNC_DIV_EXPR : RDIV_EXPR, + ! const_binop (MINUS_EXPR, + ! const_binop (MULT_EXPR, i1, r2, + ! notrunc), + ! const_binop (MULT_EXPR, r1, i2, + ! notrunc), + ! notrunc), + ! magsquared, notrunc)); + } + break; + --- 1278,1302 ---- + notrunc); + + ! t = build_complex (type, + ! const_binop + ! (INTEGRAL_TYPE_P (TREE_TYPE (r1)) + ! ? TRUNC_DIV_EXPR : RDIV_EXPR, + ! const_binop (PLUS_EXPR, + ! const_binop (MULT_EXPR, r1, r2, + ! notrunc), + ! const_binop (MULT_EXPR, i1, i2, + ! notrunc), + ! notrunc), + ! magsquared, notrunc), + ! const_binop + ! (INTEGRAL_TYPE_P (TREE_TYPE (r1)) + ! ? TRUNC_DIV_EXPR : RDIV_EXPR, + ! const_binop (MINUS_EXPR, + ! const_binop (MULT_EXPR, i1, r2, + ! notrunc), + ! const_binop (MULT_EXPR, r1, i2, + ! notrunc), + ! notrunc), + ! magsquared, notrunc)); + } + break; + *************** const_binop (code, arg1, arg2, notrunc) + *** 1296,1300 **** + abort (); + } + - TREE_TYPE (t) = TREE_TYPE (arg1); + return t; + } + --- 1305,1308 ---- + *************** size_binop (code, arg0, arg1) + *** 1346,1363 **** + { + /* And some specific cases even faster than that. */ + ! if (code == PLUS_EXPR + ! && TREE_INT_CST_LOW (arg0) == 0 + ! && TREE_INT_CST_HIGH (arg0) == 0) + return arg1; + ! if (code == MINUS_EXPR + ! && TREE_INT_CST_LOW (arg1) == 0 + ! && TREE_INT_CST_HIGH (arg1) == 0) + return arg0; + ! if (code == MULT_EXPR + ! && TREE_INT_CST_LOW (arg0) == 1 + ! && TREE_INT_CST_HIGH (arg0) == 0) + return arg1; + /* Handle general case of two integer constants. */ + ! return const_binop (code, arg0, arg1, 0); + } + + --- 1354,1367 ---- + { + /* And some specific cases even faster than that. */ + ! if (code == PLUS_EXPR && integer_zerop (arg0)) + return arg1; + ! else if ((code == MINUS_EXPR || code == PLUS_EXPR) + ! && integer_zerop (arg1)) + return arg0; + ! else if (code == MULT_EXPR && integer_onep (arg0)) + return arg1; + + + /* Handle general case of two integer constants. */ + ! return const_binop (code, arg0, arg1, 1); + } + + *************** fold_convert (t, arg1) + *** 1482,1486 **** + { + if (REAL_VALUE_ISNAN (TREE_REAL_CST (arg1))) + ! return arg1; + else if (setjmp (float_error)) + { + --- 1486,1494 ---- + { + if (REAL_VALUE_ISNAN (TREE_REAL_CST (arg1))) + ! { + ! t = arg1; + ! TREE_TYPE (arg1) = type; + ! return t; + ! } + else if (setjmp (float_error)) + { + *************** operand_equal_p (arg0, arg1, only_const) + *** 1644,1687 **** + STRIP_NOPS (arg1); + + ! /* If ARG0 and ARG1 are the same SAVE_EXPR, they are necessarily equal. + ! We don't care about side effects in that case because the SAVE_EXPR + ! takes care of that for us. */ + ! if (TREE_CODE (arg0) == SAVE_EXPR && arg0 == arg1) + ! return ! only_const; + ! + ! if (TREE_SIDE_EFFECTS (arg0) || TREE_SIDE_EFFECTS (arg1)) + return 0; + + ! if (TREE_CODE (arg0) == TREE_CODE (arg1) + ! && TREE_CODE (arg0) == ADDR_EXPR + ! && TREE_OPERAND (arg0, 0) == TREE_OPERAND (arg1, 0)) + ! return 1; + ! + ! if (TREE_CODE (arg0) == TREE_CODE (arg1) + ! && TREE_CODE (arg0) == INTEGER_CST + ! && TREE_INT_CST_LOW (arg0) == TREE_INT_CST_LOW (arg1) + ! && TREE_INT_CST_HIGH (arg0) == TREE_INT_CST_HIGH (arg1)) + return 1; + + ! /* Detect when real constants are equal. */ + ! if (TREE_CODE (arg0) == TREE_CODE (arg1) + ! && TREE_CODE (arg0) == REAL_CST) + ! return !bcmp ((char *) &TREE_REAL_CST (arg0), + ! (char *) &TREE_REAL_CST (arg1), + ! sizeof (REAL_VALUE_TYPE)); + + if (only_const) + return 0; + + - if (arg0 == arg1) + - return 1; + - + - if (TREE_CODE (arg0) != TREE_CODE (arg1)) + - return 0; + - /* This is needed for conversions and for COMPONENT_REF. + - Might as well play it safe and always test this. */ + - if (TYPE_MODE (TREE_TYPE (arg0)) != TYPE_MODE (TREE_TYPE (arg1))) + - return 0; + - + switch (TREE_CODE_CLASS (TREE_CODE (arg0))) + { + --- 1652,1710 ---- + STRIP_NOPS (arg1); + + ! if (TREE_CODE (arg0) != TREE_CODE (arg1) + ! /* This is needed for conversions and for COMPONENT_REF. + ! Might as well play it safe and always test this. */ + ! || TYPE_MODE (TREE_TYPE (arg0)) != TYPE_MODE (TREE_TYPE (arg1))) + return 0; + + ! /* If ARG0 and ARG1 are the same SAVE_EXPR, they are necessarily equal. + ! We don't care about side effects in that case because the SAVE_EXPR + ! takes care of that for us. In all other cases, two expressions are + ! equal if they have no side effects. If we have two identical + ! expressions with side effects that should be treated the same due + ! to the only side effects being identical SAVE_EXPR's, that will + ! be detected in the recursive calls below. */ + ! if (arg0 == arg1 && ! only_const + ! && (TREE_CODE (arg0) == SAVE_EXPR + ! || (! TREE_SIDE_EFFECTS (arg0) && ! TREE_SIDE_EFFECTS (arg1)))) + return 1; + + ! /* Next handle constant cases, those for which we can return 1 even + ! if ONLY_CONST is set. */ + ! if (TREE_CONSTANT (arg0) && TREE_CONSTANT (arg1)) + ! switch (TREE_CODE (arg0)) + ! { + ! case INTEGER_CST: + ! return (! TREE_CONSTANT_OVERFLOW (arg0) + ! && ! TREE_CONSTANT_OVERFLOW (arg1) + ! && TREE_INT_CST_LOW (arg0) == TREE_INT_CST_LOW (arg1) + ! && TREE_INT_CST_HIGH (arg0) == TREE_INT_CST_HIGH (arg1)); + ! + ! case REAL_CST: + ! return (! TREE_CONSTANT_OVERFLOW (arg0) + ! && ! TREE_CONSTANT_OVERFLOW (arg1) + ! && REAL_VALUES_EQUAL (TREE_REAL_CST (arg0), + ! TREE_REAL_CST (arg1))); + ! + ! case COMPLEX_CST: + ! return (operand_equal_p (TREE_REALPART (arg0), TREE_REALPART (arg1), + ! only_const) + ! && operand_equal_p (TREE_IMAGPART (arg0), TREE_IMAGPART (arg1), + ! only_const)); + ! + ! case STRING_CST: + ! return (TREE_STRING_LENGTH (arg0) == TREE_STRING_LENGTH (arg1) + ! && ! strncmp (TREE_STRING_POINTER (arg0), + ! TREE_STRING_POINTER (arg1), + ! TREE_STRING_LENGTH (arg0))); + ! + ! case ADDR_EXPR: + ! return operand_equal_p (TREE_OPERAND (arg0, 0), TREE_OPERAND (arg1, 0), + ! 0); + ! } + + if (only_const) + return 0; + + switch (TREE_CODE_CLASS (TREE_CODE (arg0))) + { + *************** operand_equal_p (arg0, arg1, only_const) + *** 1698,1705 **** + case '<': + case '2': + ! return (operand_equal_p (TREE_OPERAND (arg0, 0), + ! TREE_OPERAND (arg1, 0), 0) + && operand_equal_p (TREE_OPERAND (arg0, 1), + ! TREE_OPERAND (arg1, 1), 0)); + + case 'r': + --- 1721,1740 ---- + case '<': + case '2': + ! if (operand_equal_p (TREE_OPERAND (arg0, 0), TREE_OPERAND (arg1, 0), 0) + ! && operand_equal_p (TREE_OPERAND (arg0, 1), TREE_OPERAND (arg1, 1), + ! 0)) + ! return 1; + ! + ! /* For commutative ops, allow the other order. */ + ! return ((TREE_CODE (arg0) == PLUS_EXPR || TREE_CODE (arg0) == MULT_EXPR + ! || TREE_CODE (arg0) == MIN_EXPR || TREE_CODE (arg0) == MAX_EXPR + ! || TREE_CODE (arg0) == BIT_IOR_EXPR + ! || TREE_CODE (arg0) == BIT_XOR_EXPR + ! || TREE_CODE (arg0) == BIT_AND_EXPR + ! || TREE_CODE (arg0) == NE_EXPR || TREE_CODE (arg0) == EQ_EXPR) + ! && operand_equal_p (TREE_OPERAND (arg0, 0), + ! TREE_OPERAND (arg1, 1), 0) + && operand_equal_p (TREE_OPERAND (arg0, 1), + ! TREE_OPERAND (arg1, 0), 0)); + + case 'r': + *************** optimize_bit_field_compare (code, compar + *** 2212,2215 **** + --- 2247,2251 ---- + int lunsignedp, runsignedp; + int lvolatilep = 0, rvolatilep = 0; + + int alignment; + tree linner, rinner; + tree mask; + *************** optimize_bit_field_compare (code, compar + *** 2220,2224 **** + extraction at all and so can do nothing. */ + linner = get_inner_reference (lhs, &lbitsize, &lbitpos, &offset, &lmode, + ! &lunsignedp, &lvolatilep); + if (linner == lhs || lbitsize == GET_MODE_BITSIZE (lmode) || lbitsize < 0 + || offset != 0) + --- 2256,2260 ---- + extraction at all and so can do nothing. */ + linner = get_inner_reference (lhs, &lbitsize, &lbitpos, &offset, &lmode, + ! &lunsignedp, &lvolatilep, &alignment); + if (linner == lhs || lbitsize == GET_MODE_BITSIZE (lmode) || lbitsize < 0 + || offset != 0) + *************** optimize_bit_field_compare (code, compar + *** 2229,2234 **** + /* If this is not a constant, we can only do something if bit positions, + sizes, and signedness are the same. */ + ! rinner = get_inner_reference (rhs, &rbitsize, &rbitpos, &offset, + ! &rmode, &runsignedp, &rvolatilep); + + if (rinner == rhs || lbitpos != rbitpos || lbitsize != rbitsize + --- 2265,2270 ---- + /* If this is not a constant, we can only do something if bit positions, + sizes, and signedness are the same. */ + ! rinner = get_inner_reference (rhs, &rbitsize, &rbitpos, &offset, &rmode, + ! &runsignedp, &rvolatilep, &alignment); + + if (rinner == rhs || lbitpos != rbitpos || lbitsize != rbitsize + *************** decode_field_reference (exp, pbitsize, p + *** 2403,2406 **** + --- 2439,2443 ---- + tree unsigned_type; + int precision; + + int alignment; + + /* All the optimizations using this function assume integer fields. + *************** decode_field_reference (exp, pbitsize, p + *** 2423,2427 **** + + inner = get_inner_reference (exp, pbitsize, pbitpos, &offset, pmode, + ! punsignedp, pvolatilep); + if ((inner == exp && and_mask == 0) + || *pbitsize < 0 || offset != 0) + --- 2460,2464 ---- + + inner = get_inner_reference (exp, pbitsize, pbitpos, &offset, pmode, + ! punsignedp, pvolatilep, &alignment); + if ((inner == exp && and_mask == 0) + || *pbitsize < 0 || offset != 0) + *************** fold_truthop (code, truth_type, lhs, rhs + *** 2767,2770 **** + --- 2804,2810 ---- + { + /* Avoid evaluating the variable part twice. */ + + if (current_function_decl == 0) + + return 0; + + + ll_arg = save_expr (ll_arg); + lhs = build (lcode, TREE_TYPE (lhs), ll_arg, lr_arg); + *************** strip_compound_expr (t, s) + *** 3065,3068 **** + --- 3105,3208 ---- + } + + + /* Determine if first argument is a multiple of second argument. + + Return 0 if it is not, or is not easily determined to so be. + + + + An example of the sort of thing we care about (at this point -- + + this routine could surely be made more general, and expanded + + to do what the *_DIV_EXPR's fold() cases do now) is discovering + + that + + + + SAVE_EXPR (I) * SAVE_EXPR (J * 8) + + + + is a multiple of + + + + SAVE_EXPR (J * 8) + + + + when we know that the two `SAVE_EXPR (J * 8)' nodes are the + + same node (which means they will have the same value at run + + time, even though we don't know when they'll be assigned). + + + + This code also handles discovering that + + + + SAVE_EXPR (I) * SAVE_EXPR (J * 8) + + + + is a multiple of + + + + 8 + + + + (of course) so we don't have to worry about dealing with a + + possible remainder. + + + + Note that we _look_ inside a SAVE_EXPR only to determine + + how it was calculated; it is not safe for fold() to do much + + of anything else with the internals of a SAVE_EXPR, since + + fold() cannot know when it will be evaluated at run time. + + For example, the latter example above _cannot_ be implemented + + as + + + + SAVE_EXPR (I) * J + + + + or any variant thereof, since the value of J at evaluation time + + of the original SAVE_EXPR is not necessarily the same at the time + + the new expression is evaluated. The only optimization of this + + sort that would be valid is changing + + + + SAVE_EXPR (I) * SAVE_EXPR (SAVE_EXPR (J) * 8) + + divided by + + 8 + + + + to + + + + SAVE_EXPR (I) * SAVE_EXPR (J) + + + + (where the same SAVE_EXPR (J) is used in the original and the + + transformed version). */ + + + + static int + + multiple_of_p (type, top, bottom) + + tree type; + + tree top; + + tree bottom; + + { + + if (operand_equal_p (top, bottom, 0)) + + return 1; + + + + if (TREE_CODE (type) != INTEGER_TYPE) + + return 0; + + + + switch (TREE_CODE (top)) + + { + + case MULT_EXPR: + + return (multiple_of_p (type, TREE_OPERAND (top, 0), bottom) + + || multiple_of_p (type, TREE_OPERAND (top, 1), bottom)); + + + + case PLUS_EXPR: + + case MINUS_EXPR: + + return (multiple_of_p (type, TREE_OPERAND (top, 0), bottom) + + && multiple_of_p (type, TREE_OPERAND (top, 1), bottom)); + + + + case NOP_EXPR: + + /* Punt if conversion from non-integral or wider integral type. */ + + if ((TREE_CODE (TREE_TYPE (TREE_OPERAND (top, 0))) != INTEGER_TYPE) + + || (TYPE_PRECISION (type) + + < TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (top, 0))))) + + return 0; + + /* Fall through. */ + + case SAVE_EXPR: + + return multiple_of_p (type, TREE_OPERAND (top, 0), bottom); + + + + case INTEGER_CST: + + if ((TREE_CODE (bottom) != INTEGER_CST) + + || (tree_int_cst_sgn (top) < 0) + + || (tree_int_cst_sgn (bottom) < 0)) + + return 0; + + return integer_zerop (const_binop (TRUNC_MOD_EXPR, + + top, bottom, 0)); + + + + default: + + return 0; + + } + + } + + + /* Perform constant folding and related simplification of EXPR. + The related simplifications include x*1 => x, x*0 => 0, etc., + *************** fold (expr) + *** 3091,3096 **** + int wins = 1; + + ! /* Don't try to process an RTL_EXPR since its operands aren't trees. */ + ! if (code == RTL_EXPR) + return t; + + --- 3231,3237 ---- + int wins = 1; + + ! /* Don't try to process an RTL_EXPR since its operands aren't trees. + ! Likewise for a SAVE_EXPR that's already been evaluated. */ + ! if (code == RTL_EXPR || (code == SAVE_EXPR && SAVE_EXPR_RTL (t)) != 0) + return t; + + *************** fold (expr) + *** 3280,3285 **** + fold (build (code, type, + arg0, TREE_OPERAND (arg1, 1)))); + ! else if (TREE_CODE (arg1) == COND_EXPR + ! || TREE_CODE_CLASS (TREE_CODE (arg1)) == '<') + { + tree test, true_value, false_value; + --- 3421,3427 ---- + fold (build (code, type, + arg0, TREE_OPERAND (arg1, 1)))); + ! else if ((TREE_CODE (arg1) == COND_EXPR + ! || TREE_CODE_CLASS (TREE_CODE (arg1)) == '<') + ! && (! TREE_SIDE_EFFECTS (arg0) || current_function_decl != 0)) + { + tree test, true_value, false_value; + *************** fold (expr) + *** 3319,3323 **** + return fold (build (COND_EXPR, type, test, lhs, rhs)); + + ! arg0 = save_expr (arg0); + } + + --- 3461,3466 ---- + return fold (build (COND_EXPR, type, test, lhs, rhs)); + + ! if (current_function_decl != 0) + ! arg0 = save_expr (arg0); + } + + *************** fold (expr) + *** 3336,3341 **** + return build (COMPOUND_EXPR, type, TREE_OPERAND (arg0, 0), + fold (build (code, type, TREE_OPERAND (arg0, 1), arg1))); + ! else if (TREE_CODE (arg0) == COND_EXPR + ! || TREE_CODE_CLASS (TREE_CODE (arg0)) == '<') + { + tree test, true_value, false_value; + --- 3479,3485 ---- + return build (COMPOUND_EXPR, type, TREE_OPERAND (arg0, 0), + fold (build (code, type, TREE_OPERAND (arg0, 1), arg1))); + ! else if ((TREE_CODE (arg0) == COND_EXPR + ! || TREE_CODE_CLASS (TREE_CODE (arg0)) == '<') + ! && (! TREE_SIDE_EFFECTS (arg1) || current_function_decl != 0)) + { + tree test, true_value, false_value; + *************** fold (expr) + *** 3367,3371 **** + return fold (build (COND_EXPR, type, test, lhs, rhs)); + + ! arg1 = save_expr (arg1); + } + + --- 3511,3516 ---- + return fold (build (COND_EXPR, type, test, lhs, rhs)); + + ! if (current_function_decl != 0) + ! arg1 = save_expr (arg1); + } + + *************** fold (expr) + *** 3611,3615 **** + TREE_OPERAND (arg0, 1)))); + else if (TREE_CODE (arg0) == COMPLEX_CST) + ! return build_complex (TREE_OPERAND (arg0, 0), + fold (build1 (NEGATE_EXPR, + TREE_TYPE (TREE_TYPE (arg0)), + --- 3756,3760 ---- + TREE_OPERAND (arg0, 1)))); + else if (TREE_CODE (arg0) == COMPLEX_CST) + ! return build_complex (type, TREE_OPERAND (arg0, 0), + fold (build1 (NEGATE_EXPR, + TREE_TYPE (TREE_TYPE (arg0)), + *************** fold (expr) + *** 3889,3893 **** + return non_lvalue (convert (type, arg0)); + /* x*2 is x+x */ + ! if (! wins && real_twop (arg1)) + { + tree arg = save_expr (arg0); + --- 4034,4038 ---- + return non_lvalue (convert (type, arg0)); + /* x*2 is x+x */ + ! if (! wins && real_twop (arg1) && current_function_decl != 0) + { + tree arg = save_expr (arg0); + *************** fold (expr) + *** 4014,4018 **** + return non_lvalue (convert (type, arg0)); + if (integer_zerop (arg1)) + ! return t; + + /* If we have ((a / C1) / C2) where both division are the same type, try + --- 4159,4179 ---- + return non_lvalue (convert (type, arg0)); + if (integer_zerop (arg1)) + ! { + ! if (extra_warnings) + ! warning ("integer division by zero"); + ! return t; + ! } + ! + ! /* If arg0 is a multiple of arg1, then rewrite to the fastest div + ! operation, EXACT_DIV_EXPR. Otherwise, handle folding of + ! general divide. Note that only CEIL_DIV_EXPR is rewritten now, + ! only because the others seem to be faster in some cases, e.g. the + ! nonoptimized TRUNC_DIV_EXPR or FLOOR_DIV_EXPR on DEC Alpha. This + ! is probably just due to more work being done on it in expmed.c than + ! on EXACT_DIV_EXPR, and could presumably be fixed, since + ! EXACT_DIV_EXPR should _never_ be slower than *_DIV_EXPR. */ + ! if ((code == CEIL_DIV_EXPR) + ! && multiple_of_p (type, arg0, arg1)) + ! return fold (build (EXACT_DIV_EXPR, type, arg0, arg1)); + + /* If we have ((a / C1) / C2) where both division are the same type, try + *************** fold (expr) + *** 4049,4053 **** + tree xarg0 = arg0; + + ! if (TREE_CODE (xarg0) == SAVE_EXPR) + have_save_expr = 1, xarg0 = TREE_OPERAND (xarg0, 0); + + --- 4210,4214 ---- + tree xarg0 = arg0; + + ! if (TREE_CODE (xarg0) == SAVE_EXPR && SAVE_EXPR_RTL (xarg0) == 0) + have_save_expr = 1, xarg0 = TREE_OPERAND (xarg0, 0); + + *************** fold (expr) + *** 4067,4071 **** + } + + ! if (TREE_CODE (xarg0) == SAVE_EXPR) + have_save_expr = 1, xarg0 = TREE_OPERAND (xarg0, 0); + + --- 4228,4232 ---- + } + + ! if (TREE_CODE (xarg0) == SAVE_EXPR && SAVE_EXPR_RTL (xarg0) == 0) + have_save_expr = 1, xarg0 = TREE_OPERAND (xarg0, 0); + + *************** fold (expr) + *** 5050,5054 **** + case COMPLEX_EXPR: + if (wins) + ! return build_complex (arg0, arg1); + return t; + + --- 5211,5215 ---- + case COMPLEX_EXPR: + if (wins) + ! return build_complex (type, arg0, arg1); + return t; + + diff -rcp2N gcc-2.7.2.3/function.c gcc-2.7.2.3.f.1/function.c + *** gcc-2.7.2.3/function.c Sun Aug 31 09:39:47 1997 + --- gcc-2.7.2.3.f.1/function.c Sun Aug 31 09:21:15 1997 + *************** assign_stack_temp (mode, size, keep) + *** 917,920 **** + --- 917,925 ---- + p->keep = keep; + } + + + + /* We may be reusing an old slot, so clear any MEM flags that may have been + + set from before. */ + + RTX_UNCHANGING_P (p->slot) = 0; + + MEM_IN_STRUCT_P (p->slot) = 0; + return p->slot; + } + *************** find_temp_slot_from_address (x) + *** 994,999 **** + if (! p->in_use) + continue; + ! else if (XEXP (p->slot, 0) == x + ! || p->address == x) + return p; + + --- 999,1004 ---- + if (! p->in_use) + continue; + ! else if (rtx_equal_p (XEXP (p->slot, 0), x) + ! || rtx_equal_p (p->address, x)) + return p; + + *************** free_temps_for_rtl_expr (t) + *** 1184,1187 **** + --- 1189,1207 ---- + } + + + /* Mark all temporaries ever allocated in this functon as not suitable + + for reuse until the current level is exited. */ + + + + void + + mark_all_temps_used () + + { + + struct temp_slot *p; + + + + for (p = temp_slots; p; p = p->next) + + { + + p->in_use = p->keep = 1; + + p->level = MIN (p->level, temp_slot_level); + + } + + } + + + /* Push deeper into the nesting level for stack temporaries. */ + + *************** pop_temp_slots () + *** 1208,1211 **** + --- 1228,1242 ---- + temp_slot_level--; + } + + + + /* Initialize temporary slots. */ + + + + void + + init_temp_slots () + + { + + /* We have not allocated any temporaries yet. */ + + temp_slots = 0; + + temp_slot_level = 0; + + target_temp_slot_level = 0; + + } + + /* Retroactively move an auto variable from a register to a stack slot. + *************** instantiate_virtual_regs_1 (loc, object, + *** 2838,2842 **** + case MEM: + /* Most cases of MEM that convert to valid addresses have already been + ! handled by our scan of regno_reg_rtx. The only special handling we + need here is to make a copy of the rtx to ensure it isn't being + shared if we have to change it to a pseudo. + --- 2869,2873 ---- + case MEM: + /* Most cases of MEM that convert to valid addresses have already been + ! handled by our scan of decls. The only special handling we + need here is to make a copy of the rtx to ensure it isn't being + shared if we have to change it to a pseudo. + *************** instantiate_virtual_regs_1 (loc, object, + *** 2896,2900 **** + has less restrictions on an address that some other insn. + In that case, we will modify the shared address. This case + ! doesn't seem very likely, though. */ + + if (instantiate_virtual_regs_1 (&XEXP (x, 0), + --- 2927,2933 ---- + has less restrictions on an address that some other insn. + In that case, we will modify the shared address. This case + ! doesn't seem very likely, though. One case where this could + ! happen is in the case of a USE or CLOBBER reference, but we + ! take care of that below. */ + + if (instantiate_virtual_regs_1 (&XEXP (x, 0), + *************** instantiate_virtual_regs_1 (loc, object, + *** 2909,2914 **** + + /* Fall through to generic unary operation case. */ + - case USE: + - case CLOBBER: + case SUBREG: + case STRICT_LOW_PART: + --- 2942,2945 ---- + *************** instantiate_virtual_regs_1 (loc, object, + *** 2927,2930 **** + --- 2958,2978 ---- + goto restart; + + + case USE: + + case CLOBBER: + + /* If the operand is a MEM, see if the change is a valid MEM. If not, + + go ahead and make the invalid one, but do it to a copy. For a REG, + + just make the recursive call, since there's no chance of a problem. */ + + + + if ((GET_CODE (XEXP (x, 0)) == MEM + + && instantiate_virtual_regs_1 (&XEXP (XEXP (x, 0), 0), XEXP (x, 0), + + 0)) + + || (GET_CODE (XEXP (x, 0)) == REG + + && instantiate_virtual_regs_1 (&XEXP (x, 0), object, 0))) + + return 1; + + + + XEXP (x, 0) = copy_rtx (XEXP (x, 0)); + + loc = &XEXP (x, 0); + + goto restart; + + + case REG: + /* Try to replace with a PLUS. If that doesn't work, compute the sum + *************** assign_parms (fndecl, second_time) + *** 3404,3409 **** + + /* If this is a memory ref that contains aggregate components, + ! mark it as such for cse and loop optimize. */ + MEM_IN_STRUCT_P (stack_parm) = aggregate; + } + + --- 3452,3459 ---- + + /* If this is a memory ref that contains aggregate components, + ! mark it as such for cse and loop optimize. Likewise if it + ! is readonly. */ + MEM_IN_STRUCT_P (stack_parm) = aggregate; + + RTX_UNCHANGING_P (stack_parm) = TREE_READONLY (parm); + } + + *************** assign_parms (fndecl, second_time) + *** 3627,3631 **** + + parmreg = gen_reg_rtx (promoted_nominal_mode); + ! REG_USERVAR_P (parmreg) = 1; + + /* If this was an item that we received a pointer to, set DECL_RTL + --- 3677,3681 ---- + + parmreg = gen_reg_rtx (promoted_nominal_mode); + ! mark_user_reg (parmreg); + + /* If this was an item that we received a pointer to, set DECL_RTL + *************** assign_parms (fndecl, second_time) + *** 3695,3699 **** + Pmode above. We must use the actual mode of the parm. */ + parmreg = gen_reg_rtx (TYPE_MODE (TREE_TYPE (parm))); + ! REG_USERVAR_P (parmreg) = 1; + emit_move_insn (parmreg, DECL_RTL (parm)); + DECL_RTL (parm) = parmreg; + --- 3745,3749 ---- + Pmode above. We must use the actual mode of the parm. */ + parmreg = gen_reg_rtx (TYPE_MODE (TREE_TYPE (parm))); + ! mark_user_reg (parmreg); + emit_move_insn (parmreg, DECL_RTL (parm)); + DECL_RTL (parm) = parmreg; + *************** init_function_start (subr, filename, lin + *** 4814,4821 **** + rtl_expr_chain = 0; + + ! /* We have not allocated any temporaries yet. */ + ! temp_slots = 0; + ! temp_slot_level = 0; + ! target_temp_slot_level = 0; + + /* Within function body, compute a type's size as soon it is laid out. */ + --- 4864,4869 ---- + rtl_expr_chain = 0; + + ! /* Set up to allocate temporaries. */ + ! init_temp_slots (); + + /* Within function body, compute a type's size as soon it is laid out. */ + *************** expand_function_end (filename, line, end + *** 5295,5298 **** + --- 5343,5366 ---- + /* Put those insns at entry to the containing function (this one). */ + emit_insns_before (seq, tail_recursion_reentry); + + } + + + + /* If we are doing stack checking and this function makes calls, + + do a stack probe at the start of the function to ensure we have enough + + space for another stack frame. */ + + if (flag_stack_check && ! STACK_CHECK_BUILTIN) + + { + + rtx insn, seq; + + + + for (insn = get_insns (); insn; insn = NEXT_INSN (insn)) + + if (GET_CODE (insn) == CALL_INSN) + + { + + start_sequence (); + + probe_stack_range (STACK_CHECK_PROTECT, + + GEN_INT (STACK_CHECK_MAX_FRAME_SIZE)); + + seq = get_insns (); + + end_sequence (); + + emit_insns_before (seq, tail_recursion_reentry); + + break; + + } + } + + diff -rcp2N gcc-2.7.2.3/gcc.c gcc-2.7.2.3.f.1/gcc.c + *** gcc-2.7.2.3/gcc.c Sun Aug 31 09:39:48 1997 + --- gcc-2.7.2.3.f.1/gcc.c Sun Aug 31 09:21:16 1997 + *************** static int is_directory PROTO((char *, + *** 296,300 **** + static void validate_switches PROTO((char *)); + static void validate_all_switches PROTO((void)); + ! static void give_switch PROTO((int, int)); + static int used_arg PROTO((char *, int)); + static int default_arg PROTO((char *, int)); + --- 296,300 ---- + static void validate_switches PROTO((char *)); + static void validate_all_switches PROTO((void)); + ! static void give_switch PROTO((int, int, int)); + static int used_arg PROTO((char *, int)); + static int default_arg PROTO((char *, int)); + *************** or with constant text in a single argume + *** 405,408 **** + --- 405,409 ---- + name starts with `o'. %{o*} would substitute this text, + including the space; thus, two arguments would be generated. + + %{^S*} likewise, but don't put a blank between a switch and any args. + %{S*:X} substitutes X if one or more switches whose names start with -S are + specified to CC. Note that the tail part of the -S option + *************** process_command (argc, argv) + *** 2649,2655 **** + else + { + ! char *string = xmalloc (len + 1); + strncpy (string, value, len-7); + ! strcat (string, "include"); + add_prefix (&include_prefixes, string, 1, 0, 0); + } + --- 2650,2656 ---- + else + { + ! char *string = xmalloc (len); + strncpy (string, value, len-7); + ! strcpy (string+len-7, "include"); + add_prefix (&include_prefixes, string, 1, 0, 0); + } + *************** process_command (argc, argv) + *** 2828,2831 **** + --- 2829,2835 ---- + infiles[n_infiles++].name = argv[i]; + } + + /* -save-temps overrides -pipe, so that temp files are produced */ + + else if (save_temps_flag && strcmp (argv[i], "-pipe") == 0) + + ; + else if (argv[i][0] == '-' && argv[i][1] != 0) + { + *************** handle_braces (p) + *** 3832,3835 **** + --- 3836,3844 ---- + int negate = 0; + int suffix = 0; + + int include_blanks = 1; + + + + if (*p == '^') + + /* A '^' after the open-brace means to not give blanks before args. */ + + include_blanks = 0, ++p; + + if (*p == '|') + *************** handle_braces (p) + *** 3897,3901 **** + if (!strncmp (switches[i].part1, filter, p - filter) + && check_live_switch (i, p - filter)) + ! give_switch (i, 0); + } + else + --- 3906,3910 ---- + if (!strncmp (switches[i].part1, filter, p - filter) + && check_live_switch (i, p - filter)) + ! give_switch (i, 0, include_blanks); + } + else + *************** handle_braces (p) + *** 3936,3940 **** + do_spec_1 (string, 0, &switches[i].part1[hard_match_len]); + /* Pass any arguments this switch has. */ + ! give_switch (i, 1); + } + + --- 3945,3949 ---- + do_spec_1 (string, 0, &switches[i].part1[hard_match_len]); + /* Pass any arguments this switch has. */ + ! give_switch (i, 1, 1); + } + + *************** handle_braces (p) + *** 3980,3984 **** + if (*p == '}') + { + ! give_switch (i, 0); + } + else + --- 3989,3993 ---- + if (*p == '}') + { + ! give_switch (i, 0, include_blanks); + } + else + *************** check_live_switch (switchnum, prefix_len + *** 4081,4090 **** + This cannot fail since it never finishes a command line. + + ! If OMIT_FIRST_WORD is nonzero, then we omit .part1 of the argument. */ + + static void + ! give_switch (switchnum, omit_first_word) + int switchnum; + int omit_first_word; + { + if (!omit_first_word) + --- 4090,4103 ---- + This cannot fail since it never finishes a command line. + + ! If OMIT_FIRST_WORD is nonzero, then we omit .part1 of the argument. + ! + ! If INCLUDE_BLANKS is nonzero, then we include blanks before each argument + ! of the switch. */ + + static void + ! give_switch (switchnum, omit_first_word, include_blanks) + int switchnum; + int omit_first_word; + + int include_blanks; + { + if (!omit_first_word) + *************** give_switch (switchnum, omit_first_word) + *** 4093,4097 **** + do_spec_1 (switches[switchnum].part1, 1, NULL_PTR); + } + ! do_spec_1 (" ", 0, NULL_PTR); + if (switches[switchnum].args != 0) + { + --- 4106,4110 ---- + do_spec_1 (switches[switchnum].part1, 1, NULL_PTR); + } + ! + if (switches[switchnum].args != 0) + { + *************** give_switch (switchnum, omit_first_word) + *** 4099,4106 **** + for (p = switches[switchnum].args; *p; p++) + { + do_spec_1 (*p, 1, NULL_PTR); + - do_spec_1 (" ", 0, NULL_PTR); + } + } + switches[switchnum].valid = 1; + } + --- 4112,4122 ---- + for (p = switches[switchnum].args; *p; p++) + { + + if (include_blanks) + + do_spec_1 (" ", 0, NULL_PTR); + do_spec_1 (*p, 1, NULL_PTR); + } + } + + + + do_spec_1 (" ", 0, NULL_PTR); + switches[switchnum].valid = 1; + } + diff -rcp2N gcc-2.7.2.3/gcc.texi gcc-2.7.2.3.f.1/gcc.texi + *** gcc-2.7.2.3/gcc.texi Wed Jul 24 18:57:41 1996 + --- gcc-2.7.2.3.f.1/gcc.texi Fri Jul 11 00:08:58 1997 + *************** original English. + *** 149,152 **** + --- 149,153 ---- + @sp 3 + @center Last updated 29 June 1996 + + @center (Revised for GNU Fortran 1997-01-10) + @sp 1 + @c The version number appears twice more in this file. + diff -rcp2N gcc-2.7.2.3/glimits.h gcc-2.7.2.3.f.1/glimits.h + *** gcc-2.7.2.3/glimits.h Wed Sep 29 21:30:54 1993 + --- gcc-2.7.2.3.f.1/glimits.h Fri Jul 11 00:08:58 1997 + *************** + *** 64,68 **** + (Same as `int'). */ + #ifndef __LONG_MAX__ + ! #define __LONG_MAX__ 2147483647L + #endif + #undef LONG_MIN + --- 64,72 ---- + (Same as `int'). */ + #ifndef __LONG_MAX__ + ! # ifndef __alpha__ + ! # define __LONG_MAX__ 2147483647L + ! # else + ! # define __LONG_MAX__ 9223372036854775807LL + ! # endif /* __alpha__ */ + #endif + #undef LONG_MIN + diff -rcp2N gcc-2.7.2.3/integrate.c gcc-2.7.2.3.f.1/integrate.c + *** gcc-2.7.2.3/integrate.c Fri Oct 20 22:48:13 1995 + --- gcc-2.7.2.3.f.1/integrate.c Sun Aug 10 22:46:31 1997 + *************** static rtx copy_for_inline PROTO((rtx)); + *** 67,70 **** + --- 67,71 ---- + static void integrate_parm_decls PROTO((tree, struct inline_remap *, rtvec)); + static void integrate_decl_tree PROTO((tree, int, struct inline_remap *)); + + static void save_constants_in_decl_trees PROTO ((tree)); + static void subst_constants PROTO((rtx *, rtx, struct inline_remap *)); + static void restore_constants PROTO((rtx *)); + *************** save_for_inline_copying (fndecl) + *** 435,438 **** + --- 436,443 ---- + } + + + /* Also scan all decls, and replace any constant pool references with the + + actual constant. */ + + save_constants_in_decl_trees (DECL_INITIAL (fndecl)); + + + /* Clear out the constant pool so that we can recreate it with the + copied constants below. */ + *************** save_for_inline_nocopy (fndecl) + *** 781,784 **** + --- 786,793 ---- + } + + + /* Also scan all decls, and replace any constant pool references with the + + actual constant. */ + + save_constants_in_decl_trees (DECL_INITIAL (fndecl)); + + + /* We have now allocated all that needs to be allocated permanently + on the rtx obstack. Set our high-water mark, so that we + *************** expand_inline_function (fndecl, parms, t + *** 1571,1575 **** + if (GET_CODE (XEXP (loc, 0)) == REG) + { + ! temp = force_reg (Pmode, structure_value_addr); + map->reg_map[REGNO (XEXP (loc, 0))] = temp; + if ((CONSTANT_P (structure_value_addr) + --- 1580,1585 ---- + if (GET_CODE (XEXP (loc, 0)) == REG) + { + ! temp = force_reg (Pmode, + ! force_operand (structure_value_addr, NULL_RTX)); + map->reg_map[REGNO (XEXP (loc, 0))] = temp; + if ((CONSTANT_P (structure_value_addr) + *************** integrate_decl_tree (let, level, map) + *** 2029,2032 **** + --- 2039,2059 ---- + } + } + + } + + + + /* Given a BLOCK node LET, search for all DECL_RTL fields, and pass them + + through save_constants. */ + + + + static void + + save_constants_in_decl_trees (let) + + tree let; + + { + + tree t; + + + + for (t = BLOCK_VARS (let); t; t = TREE_CHAIN (t)) + + if (DECL_RTL (t) != 0) + + save_constants (&DECL_RTL (t)); + + + + for (t = BLOCK_SUBBLOCKS (let); t; t = TREE_CHAIN (t)) + + save_constants_in_decl_trees (t); + } + + diff -rcp2N gcc-2.7.2.3/invoke.texi gcc-2.7.2.3.f.1/invoke.texi + *** gcc-2.7.2.3/invoke.texi Tue Oct 3 15:40:43 1995 + --- gcc-2.7.2.3.f.1/invoke.texi Fri Aug 29 07:52:17 1997 + *************** + *** 1,3 **** + ! @c Copyright (C) 1988, 89, 92, 93, 94, 1995 Free Software Foundation, Inc. + @c This is part of the GCC manual. + @c For copying conditions, see the file gcc.texi. + --- 1,3 ---- + ! @c Copyright (C) 1988, 89, 92-95, 1997 Free Software Foundation, Inc. + @c This is part of the GCC manual. + @c For copying conditions, see the file gcc.texi. + *************** in the following sections. + *** 149,152 **** + --- 149,153 ---- + -fschedule-insns2 -fstrength-reduce -fthread-jumps + -funroll-all-loops -funroll-loops + + -fmove-all-movables -freduce-all-givs -frerun-loop-opt + -O -O0 -O1 -O2 -O3 + @end smallexample + *************** in addition to the above: + *** 330,334 **** + -freg-struct-return -fshared-data -fshort-enums + -fshort-double -fvolatile -fvolatile-global + ! -fverbose-asm -fpack-struct +e0 +e1 + @end smallexample + @end table + --- 331,337 ---- + -freg-struct-return -fshared-data -fshort-enums + -fshort-double -fvolatile -fvolatile-global + ! -fverbose-asm -fpack-struct -fstack-check +e0 +e1 + ! -fargument-alias -fargument-noalias + ! -fargument-noalias-global + @end smallexample + @end table + *************** Print extra warning messages for these e + *** 1253,1256 **** + --- 1256,1304 ---- + + @itemize @bullet + + @cindex division by zero + + @cindex zero, division by + + @item + + An integer division by zero is detected. + + + + Some cases of division by zero might occur as the result + + of using so-called ``safe'' macros. + + For example: + + + + @smallexample + + #define BUCKETS(b) (((b) != NULL) ? (b)->buckets : 0) + + @dots{...} + + i = j / BUCKETS(b); + + @end smallexample + + + + Although analysis of the context of the above code could + + prove that @samp{b} is never null when it is executed, + + the division-by-zero warning is still useful, because + + @code{gcc} generates code to do the division by zero at + + run time so as to generate a run-time fault, + + and tidy programmers will want to find ways to prevent + + this needless code from being generated. + + + + Note that @code{gcc} transforms expressions so as to find + + opportunities for performing expensive operations + + (such as division) at compile time instead of generating + + code to perform them at run time. + + For example, @code{gcc} transforms: + + + + @smallexample + + 2 / (i == 0) + + @end smallexample + + + + into: + + + + @smallexample + + (i == 0) ? (2 / 1) : (2 / 0) + + @end smallexample + + + + As a result, the division-by-zero warning might occur + + in contexts where the divisor seems to be a non-constant. + + It is useful in this case as well, because programmers might want + + to clean up the code so the compiled code does not include + + dead code to divide by zero. + + + @cindex @code{longjmp} warnings + @item + *************** and usually makes programs run more slow + *** 1941,1944 **** + --- 1989,2037 ---- + implies @samp{-fstrength-reduce} as well as @samp{-frerun-cse-after-loop}. + + + @item -fmove-all-movables + + Forces all invariant computations in loops to be moved + + outside the loop. + + This option is provided primarily to improve performance + + for some Fortran code, though it might improve code written + + in other languages. + + + + @emph{Note:} When compiling programs written in Fortran, + + this option is enabled by default. + + + + Analysis of Fortran code optimization and the resulting + + optimizations triggered by this option, and the + + @samp{-freduce-all-givs} and @samp{-frerun-loop-opt} + + options as well, were + + contributed by Toon Moene (@code{toon@@moene.indiv.nluug.nl}). + + + + These three options are intended to be removed someday, once + + they have helped determine the efficacy of various + + approaches to improving the performance of Fortran code. + + + + Please let us (@code{fortran@@gnu.ai.mit.edu}) + + know how use of these options affects + + the performance of your production code. + + We're very interested in code that runs @emph{slower} + + when these options are @emph{enabled}. + + + + @item -freduce-all-givs + + Forces all general-induction variables in loops to be + + strength-reduced. + + This option is provided primarily to improve performance + + for some Fortran code, though it might improve code written + + in other languages. + + + + @emph{Note:} When compiling programs written in Fortran, + + this option is enabled by default. + + + + @item -frerun-loop-opt + + Runs loop optimizations a second time. + + This option is provided primarily to improve performance + + for some Fortran code, though it might improve code written + + in other languages. + + + + @emph{Note:} When compiling programs written in Fortran, + + this option is enabled by default. + + + @item -fno-peephole + Disable any machine-specific peephole optimizations. + *************** not want to use this option, since it ma + *** 4212,4215 **** + --- 4305,4315 ---- + the offsets of structure members won't agree with system libraries. + + + @item -fstack-check + + Generate code to verify that you do not go beyond the boundary of the + + stack. You should specify this flag if you are running in an + + environment with multiple threads, but only rarely need to specify it in + + a single-threaded environment since stack overflow is automatically + + detected on nearly all systems if there is only one stack. + + + @item +e0 + @itemx +e1 + *************** compilation). + *** 4229,4232 **** + --- 4329,4404 ---- + With @samp{+e1}, G++ actually generates the code implementing virtual + functions defined in the code, and makes them publicly visible. + + + + @cindex aliasing of parameters + + @cindex parameters, aliased + + @item -fargument-alias + + @item -fargument-noalias + + @item -fargument-noalias-global + + Specify the possible relationships among parameters and between + + parameters and global data. + + + + @samp{-fargument-alias} specifies that arguments (parameters) may + + alias each other and may alias global storage. + + @samp{-fargument-noalias} specifies that arguments do not alias + + each other, but may alias global storage. + + @samp{-fargument-noalias-global} specifies that arguments do not + + alias each other and do not alias global storage. + + + + For code written in C, C++, and Objective-C, @samp{-fargument-alias} + + is the default. + + For code written in Fortran, @samp{-fargument-noalias-global} is + + the default, though this is pertinent only on systems where + + @code{g77} is installed. + + (See the documentation for other compilers for information on the + + defaults for their respective languages.) + + + + Normally, @code{gcc} assumes that a write through a pointer + + passed as a parameter to the current function might modify a + + value pointed to by another pointer passed as a parameter, or + + in global storage. + + + + For example, consider this code: + + + + @example + + void x(int *i, int *j) + + @{ + + extern int k; + + + + ++*i; + + ++*j; + + ++k; + + @} + + @end example + + + + When compiling the above function, @code{gcc} assumes that @samp{i} might + + be a pointer to the same variable as @samp{j}, and that either @samp{i}, + + @samp{j}, or both might be a pointer to @samp{k}. + + + + Therefore, @code{gcc} does not assume it can generate code to read + + @samp{*i}, @samp{*j}, and @samp{k} into separate registers, increment + + each register, then write the incremented values back out. + + + + Instead, @code{gcc} must generate code that reads @samp{*i}, + + increments it, and writes it back before reading @samp{*j}, + + in case @samp{i} and @samp{j} are aliased, and, similarly, + + that writes @samp{*j} before reading @samp{k}. + + The result is code that, on many systems, takes longer to execute, + + due to the way many processors schedule instruction execution. + + + + Compiling the above code with the @samp{-fargument-noalias} option + + allows @code{gcc} to assume that @samp{i} and @samp{j} do not alias + + each other, but either might alias @samp{k}. + + + + Compiling the above code with the @samp{-fargument-noalias-global} + + option allows @code{gcc} to assume that no combination of @samp{i}, + + @samp{j}, and @samp{k} are aliases for each other. + + + + @emph{Note:} Use the @samp{-fargument-noalias} and + + @samp{-fargument-noalias-global} options with care. + + While they can result in faster executables, they can + + also result in executables with subtle bugs, bugs that + + show up only when compiled for specific target systems, + + or bugs that show up only when compiled by specific versions + + of @code{g77}. + @end table + + diff -rcp2N gcc-2.7.2.3/libgcc2.c gcc-2.7.2.3.f.1/libgcc2.c + *** gcc-2.7.2.3/libgcc2.c Sun Nov 26 19:39:21 1995 + --- gcc-2.7.2.3.f.1/libgcc2.c Sun Aug 10 22:46:07 1997 + *************** __gcc_bcmp (s1, s2, size) + *** 1193,1196 **** + --- 1193,1201 ---- + #endif + + + #ifdef L__dummy + + void + + __dummy () {} + + #endif + + + #ifdef L_varargs + #ifdef __i860__ + diff -rcp2N gcc-2.7.2.3/local-alloc.c gcc-2.7.2.3.f.1/local-alloc.c + *** gcc-2.7.2.3/local-alloc.c Mon Aug 21 17:15:44 1995 + --- gcc-2.7.2.3.f.1/local-alloc.c Sun Aug 10 22:46:10 1997 + *************** static int this_insn_number; + *** 243,246 **** + --- 243,250 ---- + static rtx this_insn; + + + /* Used to communicate changes made by update_equiv_regs to + + memref_referenced_p. */ + + static rtx *reg_equiv_replacement; + + + static void alloc_qty PROTO((int, enum machine_mode, int, int)); + static void alloc_qty_for_scratch PROTO((rtx, int, rtx, int, int)); + *************** validate_equiv_mem_from_store (dest, set + *** 545,549 **** + && reg_overlap_mentioned_p (dest, equiv_mem)) + || (GET_CODE (dest) == MEM + ! && true_dependence (dest, equiv_mem))) + equiv_mem_modified = 1; + } + --- 549,553 ---- + && reg_overlap_mentioned_p (dest, equiv_mem)) + || (GET_CODE (dest) == MEM + ! && true_dependence (dest, VOIDmode, equiv_mem, rtx_varies_p))) + equiv_mem_modified = 1; + } + *************** memref_referenced_p (memref, x) + *** 617,621 **** + switch (code) + { + - case REG: + case CONST_INT: + case CONST: + --- 621,624 ---- + *************** memref_referenced_p (memref, x) + *** 629,634 **** + return 0; + + case MEM: + ! if (true_dependence (memref, x)) + return 1; + break; + --- 632,642 ---- + return 0; + + + case REG: + + return (reg_equiv_replacement[REGNO (x)] == 0 + + || memref_referenced_p (memref, + + reg_equiv_replacement[REGNO (x)])); + + + case MEM: + ! if (true_dependence (memref, VOIDmode, x, rtx_varies_p)) + return 1; + break; + *************** optimize_reg_copy_1 (insn, dest, src) + *** 818,827 **** + if (sregno >= FIRST_PSEUDO_REGISTER) + { + ! reg_live_length[sregno] -= length; + ! /* reg_live_length is only an approximation after combine + ! if sched is not run, so make sure that we still have + ! a reasonable value. */ + ! if (reg_live_length[sregno] < 2) + ! reg_live_length[sregno] = 2; + reg_n_calls_crossed[sregno] -= n_calls; + } + --- 826,839 ---- + if (sregno >= FIRST_PSEUDO_REGISTER) + { + ! if (reg_live_length[sregno] >= 0) + ! { + ! reg_live_length[sregno] -= length; + ! /* reg_live_length is only an approximation after + ! combine if sched is not run, so make sure that we + ! still have a reasonable value. */ + ! if (reg_live_length[sregno] < 2) + ! reg_live_length[sregno] = 2; + ! } + ! + reg_n_calls_crossed[sregno] -= n_calls; + } + *************** optimize_reg_copy_1 (insn, dest, src) + *** 829,833 **** + if (dregno >= FIRST_PSEUDO_REGISTER) + { + ! reg_live_length[dregno] += d_length; + reg_n_calls_crossed[dregno] += d_n_calls; + } + --- 841,847 ---- + if (dregno >= FIRST_PSEUDO_REGISTER) + { + ! if (reg_live_length[dregno] >= 0) + ! reg_live_length[dregno] += d_length; + ! + reg_n_calls_crossed[dregno] += d_n_calls; + } + *************** update_equiv_regs () + *** 948,953 **** + { + rtx *reg_equiv_init_insn = (rtx *) alloca (max_regno * sizeof (rtx *)); + - rtx *reg_equiv_replacement = (rtx *) alloca (max_regno * sizeof (rtx *)); + rtx insn; + + bzero ((char *) reg_equiv_init_insn, max_regno * sizeof (rtx *)); + --- 962,968 ---- + { + rtx *reg_equiv_init_insn = (rtx *) alloca (max_regno * sizeof (rtx *)); + rtx insn; + + + + reg_equiv_replacement = (rtx *) alloca (max_regno * sizeof (rtx *)); + + bzero ((char *) reg_equiv_init_insn, max_regno * sizeof (rtx *)); + diff -rcp2N gcc-2.7.2.3/loop.c gcc-2.7.2.3.f.1/loop.c + *** gcc-2.7.2.3/loop.c Sat Jun 29 16:26:59 1996 + --- gcc-2.7.2.3.f.1/loop.c Sun Aug 10 22:46:43 1997 + *************** int *loop_number_exit_count; + *** 111,116 **** + unsigned HOST_WIDE_INT loop_n_iterations; + + ! /* Nonzero if there is a subroutine call in the current loop. + ! (unknown_address_altered is also nonzero in this case.) */ + + static int loop_has_call; + --- 111,115 ---- + unsigned HOST_WIDE_INT loop_n_iterations; + + ! /* Nonzero if there is a subroutine call in the current loop. */ + + static int loop_has_call; + *************** static char *moved_once; + *** 160,164 **** + here, we just turn on unknown_address_altered. */ + + ! #define NUM_STORES 20 + static rtx loop_store_mems[NUM_STORES]; + + --- 159,163 ---- + here, we just turn on unknown_address_altered. */ + + ! #define NUM_STORES 30 + static rtx loop_store_mems[NUM_STORES]; + + *************** scan_loop (loop_start, end, nregs) + *** 669,673 **** + { + temp = find_reg_note (p, REG_EQUAL, NULL_RTX); + ! if (temp && CONSTANT_P (XEXP (temp, 0))) + src = XEXP (temp, 0), move_insn = 1; + if (temp && find_reg_note (p, REG_RETVAL, NULL_RTX)) + --- 668,673 ---- + { + temp = find_reg_note (p, REG_EQUAL, NULL_RTX); + ! if (temp && CONSTANT_P (XEXP (temp, 0)) + ! && LEGITIMATE_CONSTANT_P (XEXP (temp, 0))) + src = XEXP (temp, 0), move_insn = 1; + if (temp && find_reg_note (p, REG_RETVAL, NULL_RTX)) + *************** move_movables (movables, threshold, insn + *** 1629,1632 **** + --- 1629,1633 ---- + + if (already_moved[regno] + + || flag_move_all_movables + || (threshold * savings * m->lifetime) >= insn_count + || (m->forces && m->forces->done + *************** prescan_loop (start, end) + *** 2199,2203 **** + else if (GET_CODE (insn) == CALL_INSN) + { + ! unknown_address_altered = 1; + loop_has_call = 1; + } + --- 2200,2205 ---- + else if (GET_CODE (insn) == CALL_INSN) + { + ! if (! CONST_CALL_P (insn)) + ! unknown_address_altered = 1; + loop_has_call = 1; + } + *************** invariant_p (x) + *** 2777,2781 **** + /* See if there is any dependence between a store and this load. */ + for (i = loop_store_mems_idx - 1; i >= 0; i--) + ! if (true_dependence (loop_store_mems[i], x)) + return 0; + + --- 2779,2783 ---- + /* See if there is any dependence between a store and this load. */ + for (i = loop_store_mems_idx - 1; i >= 0; i--) + ! if (true_dependence (loop_store_mems[i], VOIDmode, x, rtx_varies_p)) + return 0; + + *************** strength_reduce (scan_start, end, loop_t + *** 3821,3826 **** + exit. */ + + ! if (v->lifetime * threshold * benefit < insn_count + ! && ! bl->reversed) + { + if (loop_dump_stream) + --- 3823,3828 ---- + exit. */ + + ! if ( ! flag_reduce_all_givs && v->lifetime * threshold * benefit < insn_count + ! && ! bl->reversed ) + { + if (loop_dump_stream) + *************** record_giv (v, insn, src_reg, dest_reg, + *** 4375,4378 **** + --- 4377,4382 ---- + v->final_value = 0; + v->same_insn = 0; + + v->unrolled = 0; + + v->shared = 0; + + /* The v->always_computable field is used in update_giv_derive, to + *************** check_final_value (v, loop_start, loop_e + *** 4652,4657 **** + if (GET_CODE (p) == JUMP_INSN && JUMP_LABEL (p) + && LABEL_NAME (JUMP_LABEL (p)) + ! && ((INSN_LUID (JUMP_LABEL (p)) < INSN_LUID (v->insn) + ! && INSN_LUID (JUMP_LABEL (p)) > INSN_LUID (loop_start)) + || (INSN_LUID (JUMP_LABEL (p)) > INSN_LUID (last_giv_use) + && INSN_LUID (JUMP_LABEL (p)) < INSN_LUID (loop_end)))) + --- 4656,4664 ---- + if (GET_CODE (p) == JUMP_INSN && JUMP_LABEL (p) + && LABEL_NAME (JUMP_LABEL (p)) + ! && ((INSN_UID (JUMP_LABEL (p)) >= max_uid_for_loop) + ! || (INSN_UID (v->insn) >= max_uid_for_loop) + ! || (INSN_UID (last_giv_use) >= max_uid_for_loop) + ! || (INSN_LUID (JUMP_LABEL (p)) < INSN_LUID (v->insn) + ! && INSN_LUID (JUMP_LABEL (p)) > INSN_LUID (loop_start)) + || (INSN_LUID (JUMP_LABEL (p)) > INSN_LUID (last_giv_use) + && INSN_LUID (JUMP_LABEL (p)) < INSN_LUID (loop_end)))) + *************** emit_iv_add_mult (b, m, a, reg, insert_b + *** 5560,5563 **** + --- 5567,5572 ---- + + emit_insn_before (seq, insert_before); + + + + record_base_value (REGNO (reg), b); + } + + diff -rcp2N gcc-2.7.2.3/loop.h gcc-2.7.2.3.f.1/loop.h + *** gcc-2.7.2.3/loop.h Fri Jul 14 12:23:28 1995 + --- gcc-2.7.2.3.f.1/loop.h Fri Jul 11 00:09:03 1997 + *************** struct induction + *** 89,92 **** + --- 89,95 ---- + we won't use it to eliminate a biv, it + would probably lose. */ + + unsigned unrolled : 1; /* 1 if new register has been allocated in + + unrolled loop. */ + + unsigned shared : 1; + int lifetime; /* Length of life of this giv */ + int times_used; /* # times this giv is used. */ + diff -rcp2N gcc-2.7.2.3/md.texi gcc-2.7.2.3.f.1/md.texi + *** gcc-2.7.2.3/md.texi Sun Nov 26 19:05:33 1995 + --- gcc-2.7.2.3.f.1/md.texi Fri Aug 29 07:52:18 1997 + *************** Some machines require other operations s + *** 2334,2337 **** + --- 2334,2347 ---- + maintaining the back chain. Define this pattern to emit those + operations in addition to updating the stack pointer. + + + + @cindex @code{check_stack} instruction pattern + + @item @samp{check_stack} + + If stack checking cannot be done on your system by probing the stack with + + a load or store instruction (@pxref{Stack Checking}), define this pattern + + to perform the needed check and signaling an error if the stack + + has overflowed. The single operand is the location in the stack furthest + + from the current stack pointer that you need to validate. Normally, + + on machines where this pattern is needed, you would obtain the stack + + limit from a global or thread-specific variable or register. + @end table + + diff -rcp2N gcc-2.7.2.3/optabs.c gcc-2.7.2.3.f.1/optabs.c + *** gcc-2.7.2.3/optabs.c Sat Oct 21 22:16:13 1995 + --- gcc-2.7.2.3.f.1/optabs.c Fri Aug 29 07:51:36 1997 + *************** expand_fix (to, from, unsignedp) + *** 3878,3885 **** + } + + ! if (GET_MODE (to) == GET_MODE (target)) + ! emit_move_insn (to, target); + ! else + ! convert_move (to, target, 0); + } + + --- 3878,3888 ---- + } + + ! if (target != to) + ! { + ! if (GET_MODE (to) == GET_MODE (target)) + ! emit_move_insn (to, target); + ! else + ! convert_move (to, target, 0); + ! } + } + + diff -rcp2N gcc-2.7.2.3/real.c gcc-2.7.2.3.f.1/real.c + *** gcc-2.7.2.3/real.c Tue Aug 15 21:57:18 1995 + --- gcc-2.7.2.3.f.1/real.c Fri Jul 11 00:09:04 1997 + *************** make_nan (nan, sign, mode) + *** 5625,5633 **** + } + + ! /* Convert an SFmode target `float' value to a REAL_VALUE_TYPE. + ! This is the inverse of the function `etarsingle' invoked by + REAL_VALUE_TO_TARGET_SINGLE. */ + + REAL_VALUE_TYPE + ereal_from_float (f) + HOST_WIDE_INT f; + --- 5625,5699 ---- + } + + ! /* This is the inverse of the function `etarsingle' invoked by + REAL_VALUE_TO_TARGET_SINGLE. */ + + REAL_VALUE_TYPE + + ereal_unto_float (f) + + long f; + + { + + REAL_VALUE_TYPE r; + + unsigned EMUSHORT s[2]; + + unsigned EMUSHORT e[NE]; + + + + /* Convert 32 bit integer to array of 16 bit pieces in target machine order. + + This is the inverse operation to what the function `endian' does. */ + + if (REAL_WORDS_BIG_ENDIAN) + + { + + s[0] = (unsigned EMUSHORT) (f >> 16); + + s[1] = (unsigned EMUSHORT) f; + + } + + else + + { + + s[0] = (unsigned EMUSHORT) f; + + s[1] = (unsigned EMUSHORT) (f >> 16); + + } + + /* Convert and promote the target float to E-type. */ + + e24toe (s, e); + + /* Output E-type to REAL_VALUE_TYPE. */ + + PUT_REAL (e, &r); + + return r; + + } + + + + + + /* This is the inverse of the function `etardouble' invoked by + + REAL_VALUE_TO_TARGET_DOUBLE. */ + + + + REAL_VALUE_TYPE + + ereal_unto_double (d) + + long d[]; + + { + + REAL_VALUE_TYPE r; + + unsigned EMUSHORT s[4]; + + unsigned EMUSHORT e[NE]; + + + + /* Convert array of HOST_WIDE_INT to equivalent array of 16-bit pieces. */ + + if (REAL_WORDS_BIG_ENDIAN) + + { + + s[0] = (unsigned EMUSHORT) (d[0] >> 16); + + s[1] = (unsigned EMUSHORT) d[0]; + + s[2] = (unsigned EMUSHORT) (d[1] >> 16); + + s[3] = (unsigned EMUSHORT) d[1]; + + } + + else + + { + + /* Target float words are little-endian. */ + + s[0] = (unsigned EMUSHORT) d[0]; + + s[1] = (unsigned EMUSHORT) (d[0] >> 16); + + s[2] = (unsigned EMUSHORT) d[1]; + + s[3] = (unsigned EMUSHORT) (d[1] >> 16); + + } + + /* Convert target double to E-type. */ + + e53toe (s, e); + + /* Output E-type to REAL_VALUE_TYPE. */ + + PUT_REAL (e, &r); + + return r; + + } + + + + + + /* Convert an SFmode target `float' value to a REAL_VALUE_TYPE. + + This is somewhat like ereal_unto_float, but the input types + + for these are different. */ + + + + REAL_VALUE_TYPE + ereal_from_float (f) + HOST_WIDE_INT f; + *************** ereal_from_float (f) + *** 5658,5663 **** + + /* Convert a DFmode target `double' value to a REAL_VALUE_TYPE. + ! This is the inverse of the function `etardouble' invoked by + ! REAL_VALUE_TO_TARGET_DOUBLE. + + The DFmode is stored as an array of HOST_WIDE_INT in the target's + --- 5724,5729 ---- + + /* Convert a DFmode target `double' value to a REAL_VALUE_TYPE. + ! This is somewhat like ereal_unto_double, but the input types + ! for these are different. + + The DFmode is stored as an array of HOST_WIDE_INT in the target's + diff -rcp2N gcc-2.7.2.3/real.h gcc-2.7.2.3.f.1/real.h + *** gcc-2.7.2.3/real.h Thu Jun 15 11:57:56 1995 + --- gcc-2.7.2.3.f.1/real.h Fri Jul 11 00:09:05 1997 + *************** extern void ereal_to_decimal PROTO((REAL + *** 152,155 **** + --- 152,157 ---- + extern int ereal_cmp PROTO((REAL_VALUE_TYPE, REAL_VALUE_TYPE)); + extern int ereal_isneg PROTO((REAL_VALUE_TYPE)); + + extern REAL_VALUE_TYPE ereal_unto_float PROTO((long)); + + extern REAL_VALUE_TYPE ereal_unto_double PROTO((long *)); + extern REAL_VALUE_TYPE ereal_from_float PROTO((HOST_WIDE_INT)); + extern REAL_VALUE_TYPE ereal_from_double PROTO((HOST_WIDE_INT *)); + *************** extern REAL_VALUE_TYPE real_value_trunca + *** 197,200 **** + --- 199,208 ---- + /* IN is a REAL_VALUE_TYPE. OUT is a long. */ + #define REAL_VALUE_TO_TARGET_SINGLE(IN, OUT) ((OUT) = etarsingle ((IN))) + + + + /* Inverse of REAL_VALUE_TO_TARGET_DOUBLE. */ + + #define REAL_VALUE_UNTO_TARGET_DOUBLE(d) (ereal_unto_double (d)) + + + + /* Inverse of REAL_VALUE_TO_TARGET_SINGLE. */ + + #define REAL_VALUE_UNTO_TARGET_SINGLE(f) (ereal_unto_float (f)) + + /* d is an array of HOST_WIDE_INT that holds a double precision + diff -rcp2N gcc-2.7.2.3/recog.c gcc-2.7.2.3.f.1/recog.c + *** gcc-2.7.2.3/recog.c Sat Jul 1 10:52:35 1995 + --- gcc-2.7.2.3.f.1/recog.c Sun Aug 10 22:46:55 1997 + *************** register_operand (op, mode) + *** 872,876 **** + REGNO (SUBREG_REG (op))) + && (GET_MODE_SIZE (mode) + ! != GET_MODE_SIZE (GET_MODE (SUBREG_REG (op))))) + return 0; + #endif + --- 872,878 ---- + REGNO (SUBREG_REG (op))) + && (GET_MODE_SIZE (mode) + ! != GET_MODE_SIZE (GET_MODE (SUBREG_REG (op)))) + ! && GET_MODE_CLASS (GET_MODE (SUBREG_REG (op))) != MODE_COMPLEX_INT + ! && GET_MODE_CLASS (GET_MODE (SUBREG_REG (op))) != MODE_COMPLEX_FLOAT) + return 0; + #endif + diff -rcp2N gcc-2.7.2.3/reg-stack.c gcc-2.7.2.3.f.1/reg-stack.c + *** gcc-2.7.2.3/reg-stack.c Thu Jun 15 21:36:05 1995 + --- gcc-2.7.2.3.f.1/reg-stack.c Wed Aug 27 11:44:55 1997 + *************** subst_stack_regs (insn, regstack) + *** 2620,2623 **** + --- 2620,2624 ---- + register rtx *note_link, note; + register int i; + + rtx head, jump, pat, cipat; + int n_operands; + + *************** subst_stack_regs (insn, regstack) + *** 2690,2693 **** + --- 2691,2728 ---- + if (GET_CODE (insn) == NOTE) + return; + + + + /* If we are reached by a computed goto which sets this same stack register, + + then pop this stack register, but maintain regstack. */ + + + + if (INSN_UID (insn) <= max_uid) + + { + + head = block_begin[BLOCK_NUM(insn)]; + + pat = PATTERN(insn); + + if (GET_CODE (head) == CODE_LABEL + + && GET_CODE (pat) == SET && STACK_REG_P (SET_DEST (pat))) + + for (jump = LABEL_REFS (head); + + jump != head; + + jump = LABEL_NEXTREF (jump)) + + { + + cipat = PATTERN (CONTAINING_INSN (jump)); + + if (GET_CODE (cipat) == SET + + && SET_DEST (cipat) == pc_rtx + + && uses_reg_or_mem (SET_SRC (cipat)) + + && INSN_UID (CONTAINING_INSN (jump)) <= max_uid) + + { + + int from_block = BLOCK_NUM (CONTAINING_INSN (jump)); + + if (TEST_HARD_REG_BIT (block_out_reg_set[from_block], + + REGNO (SET_DEST (pat)))) + + { + + struct stack_def old; + + bcopy (regstack->reg, old.reg, sizeof (old.reg)); + + emit_pop_insn (insn, regstack, SET_DEST (pat), emit_insn_before); + + regstack->top += 1; + + bcopy (old.reg, regstack->reg, sizeof (old.reg)); + + SET_HARD_REG_BIT (regstack->reg_set, REGNO (SET_DEST (pat))); + + } + + } + + } + + } + + /* If there is a REG_UNUSED note on a stack register on this insn, + diff -rcp2N gcc-2.7.2.3/reload.c gcc-2.7.2.3.f.1/reload.c + *** gcc-2.7.2.3/reload.c Sat Nov 11 13:23:54 1995 + --- gcc-2.7.2.3.f.1/reload.c Sat Aug 30 20:42:37 1997 + *************** + *** 1,4 **** + /* Search an insn for pseudo regs that must be in hard regs and are not. + ! Copyright (C) 1987, 88, 89, 92, 93, 94, 1995 Free Software Foundation, Inc. + + This file is part of GNU CC. + --- 1,4 ---- + /* Search an insn for pseudo regs that must be in hard regs and are not. + ! Copyright (C) 1987, 88, 89, 92-5, 1996 Free Software Foundation, Inc. + + This file is part of GNU CC. + *************** static int push_secondary_reload PROTO(( + *** 292,295 **** + --- 292,296 ---- + enum machine_mode, enum reload_type, + enum insn_code *)); + + static enum reg_class find_valid_class PROTO((enum machine_mode, int)); + static int push_reload PROTO((rtx, rtx, rtx *, rtx *, enum reg_class, + enum machine_mode, enum machine_mode, + *************** static struct decomposition decompose PR + *** 305,312 **** + static int immune_p PROTO((rtx, rtx, struct decomposition)); + static int alternative_allows_memconst PROTO((char *, int)); + ! static rtx find_reloads_toplev PROTO((rtx, int, enum reload_type, int, int)); + static rtx make_memloc PROTO((rtx, int)); + static int find_reloads_address PROTO((enum machine_mode, rtx *, rtx, rtx *, + ! int, enum reload_type, int)); + static rtx subst_reg_equivs PROTO((rtx)); + static rtx subst_indexed_address PROTO((rtx)); + --- 306,313 ---- + static int immune_p PROTO((rtx, rtx, struct decomposition)); + static int alternative_allows_memconst PROTO((char *, int)); + ! static rtx find_reloads_toplev PROTO((rtx, int, enum reload_type, int, int, short *)); + static rtx make_memloc PROTO((rtx, int)); + static int find_reloads_address PROTO((enum machine_mode, rtx *, rtx, rtx *, + ! int, enum reload_type, int, short *)); + static rtx subst_reg_equivs PROTO((rtx)); + static rtx subst_indexed_address PROTO((rtx)); + *************** push_secondary_reload (in_p, x, opnum, o + *** 590,599 **** + + if (in_p && icode == CODE_FOR_nothing + ! && SECONDARY_MEMORY_NEEDED (class, reload_class, reload_mode)) + ! get_secondary_mem (x, reload_mode, opnum, type); + + if (! in_p && icode == CODE_FOR_nothing + ! && SECONDARY_MEMORY_NEEDED (reload_class, class, reload_mode)) + ! get_secondary_mem (x, reload_mode, opnum, type); + #endif + } + --- 591,600 ---- + + if (in_p && icode == CODE_FOR_nothing + ! && SECONDARY_MEMORY_NEEDED (class, reload_class, mode)) + ! get_secondary_mem (x, mode, opnum, type); + + if (! in_p && icode == CODE_FOR_nothing + ! && SECONDARY_MEMORY_NEEDED (reload_class, class, mode)) + ! get_secondary_mem (x, mode, opnum, type); + #endif + } + *************** get_secondary_mem (x, mode, opnum, type) + *** 673,677 **** + + find_reloads_address (mode, NULL_PTR, XEXP (loc, 0), &XEXP (loc, 0), + ! opnum, type, 0); + } + + --- 674,678 ---- + + find_reloads_address (mode, NULL_PTR, XEXP (loc, 0), &XEXP (loc, 0), + ! opnum, type, 0, NULL); + } + + *************** clear_secondary_mem () + *** 689,692 **** + --- 690,725 ---- + #endif /* SECONDARY_MEMORY_NEEDED */ + + + /* Find the largest class for which every register number plus N is valid in + + M1 (if in range). Abort if no such class exists. */ + + + + static enum reg_class + + find_valid_class (m1, n) + + enum machine_mode m1; + + int n; + + { + + int class; + + int regno; + + enum reg_class best_class; + + int best_size = 0; + + + + for (class = 1; class < N_REG_CLASSES; class++) + + { + + int bad = 0; + + for (regno = 0; regno < FIRST_PSEUDO_REGISTER && ! bad; regno++) + + if (TEST_HARD_REG_BIT (reg_class_contents[class], regno) + + && TEST_HARD_REG_BIT (reg_class_contents[class], regno + n) + + && ! HARD_REGNO_MODE_OK (regno + n, m1)) + + bad = 1; + + + + if (! bad && reg_class_size[class] > best_size) + + best_class = class, best_size = reg_class_size[class]; + + } + + + + if (best_size == 0) + + abort (); + + + + return best_class; + + } + + + /* Record one reload that needs to be performed. + IN is an rtx saying where the data are to be found before this instruction. + *************** push_reload (in, out, inloc, outloc, cla + *** 894,898 **** + && GET_CODE (SUBREG_REG (in)) == REG + && REGNO (SUBREG_REG (in)) < FIRST_PSEUDO_REGISTER + ! && (! HARD_REGNO_MODE_OK (REGNO (SUBREG_REG (in)), inmode) + || (GET_MODE_SIZE (inmode) <= UNITS_PER_WORD + && (GET_MODE_SIZE (GET_MODE (SUBREG_REG (in))) + --- 927,932 ---- + && GET_CODE (SUBREG_REG (in)) == REG + && REGNO (SUBREG_REG (in)) < FIRST_PSEUDO_REGISTER + ! && (! HARD_REGNO_MODE_OK (REGNO (SUBREG_REG (in)) + SUBREG_WORD (in), + ! inmode) + || (GET_MODE_SIZE (inmode) <= UNITS_PER_WORD + && (GET_MODE_SIZE (GET_MODE (SUBREG_REG (in))) + *************** push_reload (in, out, inloc, outloc, cla + *** 909,913 **** + output before the outer reload. */ + push_reload (SUBREG_REG (in), NULL_RTX, &SUBREG_REG (in), NULL_PTR, + ! GENERAL_REGS, VOIDmode, VOIDmode, 0, 0, opnum, type); + dont_remove_subreg = 1; + } + --- 943,948 ---- + output before the outer reload. */ + push_reload (SUBREG_REG (in), NULL_RTX, &SUBREG_REG (in), NULL_PTR, + ! find_valid_class (inmode, SUBREG_WORD (in)), + ! VOIDmode, VOIDmode, 0, 0, opnum, type); + dont_remove_subreg = 1; + } + *************** push_reload (in, out, inloc, outloc, cla + *** 982,986 **** + && GET_CODE (SUBREG_REG (out)) == REG + && REGNO (SUBREG_REG (out)) < FIRST_PSEUDO_REGISTER + ! && (! HARD_REGNO_MODE_OK (REGNO (SUBREG_REG (out)), outmode) + || (GET_MODE_SIZE (outmode) <= UNITS_PER_WORD + && (GET_MODE_SIZE (GET_MODE (SUBREG_REG (out))) + --- 1017,1022 ---- + && GET_CODE (SUBREG_REG (out)) == REG + && REGNO (SUBREG_REG (out)) < FIRST_PSEUDO_REGISTER + ! && (! HARD_REGNO_MODE_OK (REGNO (SUBREG_REG (out)) + SUBREG_WORD (out), + ! outmode) + || (GET_MODE_SIZE (outmode) <= UNITS_PER_WORD + && (GET_MODE_SIZE (GET_MODE (SUBREG_REG (out))) + *************** push_reload (in, out, inloc, outloc, cla + *** 998,1002 **** + dont_remove_subreg = 1; + push_reload (SUBREG_REG (out), SUBREG_REG (out), &SUBREG_REG (out), + ! &SUBREG_REG (out), ALL_REGS, VOIDmode, VOIDmode, 0, 0, + opnum, RELOAD_OTHER); + } + --- 1034,1040 ---- + dont_remove_subreg = 1; + push_reload (SUBREG_REG (out), SUBREG_REG (out), &SUBREG_REG (out), + ! &SUBREG_REG (out), + ! find_valid_class (outmode, SUBREG_WORD (out)), + ! VOIDmode, VOIDmode, 0, 0, + opnum, RELOAD_OTHER); + } + *************** find_reloads (insn, replace, ind_levels, + *** 2241,2244 **** + --- 2279,2283 ---- + int goal_earlyclobber, this_earlyclobber; + enum machine_mode operand_mode[MAX_RECOG_OPERANDS]; + + short force_update[MAX_RECOG_OPERANDS]; + + this_insn = insn; + *************** find_reloads (insn, replace, ind_levels, + *** 2272,2275 **** + --- 2311,2316 ---- + #endif + + + bzero ((char *) force_update, sizeof force_update); + + + /* Find what kind of insn this is. NOPERANDS gets number of operands. + Make OPERANDS point to a vector of operand values. + *************** find_reloads (insn, replace, ind_levels, + *** 2469,2473 **** + find_reloads_address (VOIDmode, NULL_PTR, + recog_operand[i], recog_operand_loc[i], + ! i, operand_type[i], ind_levels); + substed_operand[i] = recog_operand[i] = *recog_operand_loc[i]; + } + --- 2510,2515 ---- + find_reloads_address (VOIDmode, NULL_PTR, + recog_operand[i], recog_operand_loc[i], + ! i, operand_type[i], ind_levels, + ! &force_update[i]); + substed_operand[i] = recog_operand[i] = *recog_operand_loc[i]; + } + *************** find_reloads (insn, replace, ind_levels, + *** 2478,2482 **** + XEXP (recog_operand[i], 0), + &XEXP (recog_operand[i], 0), + ! i, address_type[i], ind_levels)) + address_reloaded[i] = 1; + substed_operand[i] = recog_operand[i] = *recog_operand_loc[i]; + --- 2520,2525 ---- + XEXP (recog_operand[i], 0), + &XEXP (recog_operand[i], 0), + ! i, address_type[i], ind_levels, + ! &force_update[i])) + address_reloaded[i] = 1; + substed_operand[i] = recog_operand[i] = *recog_operand_loc[i]; + *************** find_reloads (insn, replace, ind_levels, + *** 2487,2491 **** + ind_levels, + set != 0 + ! && &SET_DEST (set) == recog_operand_loc[i]); + else if (code == PLUS) + /* We can get a PLUS as an "operand" as a result of + --- 2530,2535 ---- + ind_levels, + set != 0 + ! && &SET_DEST (set) == recog_operand_loc[i], + ! &force_update[i]); + else if (code == PLUS) + /* We can get a PLUS as an "operand" as a result of + *************** find_reloads (insn, replace, ind_levels, + *** 2493,2497 **** + substed_operand[i] = recog_operand[i] = *recog_operand_loc[i] + = find_reloads_toplev (recog_operand[i], i, address_type[i], + ! ind_levels, 0); + else if (code == REG) + { + --- 2537,2541 ---- + substed_operand[i] = recog_operand[i] = *recog_operand_loc[i] + = find_reloads_toplev (recog_operand[i], i, address_type[i], + ! ind_levels, 0, &force_update[i]); + else if (code == REG) + { + *************** find_reloads (insn, replace, ind_levels, + *** 2505,2510 **** + if (reg_equiv_constant[regno] != 0 + && (set == 0 || &SET_DEST (set) != recog_operand_loc[i])) + ! substed_operand[i] = recog_operand[i] + ! = reg_equiv_constant[regno]; + #if 0 /* This might screw code in reload1.c to delete prior output-reload + that feeds this insn. */ + --- 2549,2557 ---- + if (reg_equiv_constant[regno] != 0 + && (set == 0 || &SET_DEST (set) != recog_operand_loc[i])) + ! { + ! substed_operand[i] = recog_operand[i] + ! = reg_equiv_constant[regno]; + ! force_update[i] = 1; + ! } + #if 0 /* This might screw code in reload1.c to delete prior output-reload + that feeds this insn. */ + *************** find_reloads (insn, replace, ind_levels, + *** 2545,2549 **** + XEXP (recog_operand[i], 0), + &XEXP (recog_operand[i], 0), + ! i, address_type[i], ind_levels); + substed_operand[i] = recog_operand[i] = *recog_operand_loc[i]; + } + --- 2592,2597 ---- + XEXP (recog_operand[i], 0), + &XEXP (recog_operand[i], 0), + ! i, address_type[i], ind_levels, + ! &force_update[i]); + substed_operand[i] = recog_operand[i] = *recog_operand_loc[i]; + } + *************** find_reloads (insn, replace, ind_levels, + *** 3415,3419 **** + = find_reloads_toplev (force_const_mem (operand_mode[i], + recog_operand[i]), + ! i, address_type[i], ind_levels, 0); + if (alternative_allows_memconst (constraints1[i], + goal_alternative_number)) + --- 3463,3467 ---- + = find_reloads_toplev (force_const_mem (operand_mode[i], + recog_operand[i]), + ! i, address_type[i], ind_levels, 0, NULL); + if (alternative_allows_memconst (constraints1[i], + goal_alternative_number)) + *************** find_reloads (insn, replace, ind_levels, + *** 3595,3604 **** + Don't do this if we aren't making replacements because we might be + propagating things allocated by frame pointer elimination into places + ! it doesn't expect. */ + + ! if (insn_code_number >= 0 && replace) + for (i = insn_n_dups[insn_code_number] - 1; i >= 0; i--) + { + int opno = recog_dup_num[i]; + *recog_dup_loc[i] = *recog_operand_loc[opno]; + if (operand_reloadnum[opno] >= 0) + --- 3643,3657 ---- + Don't do this if we aren't making replacements because we might be + propagating things allocated by frame pointer elimination into places + ! it doesn't expect. However, always do it for replaces of pseudos + ! by constants. */ + + ! if (insn_code_number >= 0) + for (i = insn_n_dups[insn_code_number] - 1; i >= 0; i--) + { + int opno = recog_dup_num[i]; + + + + if (! replace && ! force_update[opno]) + + continue; + + + *recog_dup_loc[i] = *recog_operand_loc[opno]; + if (operand_reloadnum[opno] >= 0) + *************** find_reloads (insn, replace, ind_levels, + *** 3829,3832 **** + --- 3882,3886 ---- + register RTX_CODE code = GET_CODE (recog_operand[i]); + int is_set_dest = GET_CODE (body) == SET && (i == 0); + + short ign; + + if (insn_code_number >= 0) + *************** find_reloads (insn, replace, ind_levels, + *** 3834,3838 **** + find_reloads_address (VOIDmode, NULL_PTR, + recog_operand[i], recog_operand_loc[i], + ! i, RELOAD_FOR_INPUT, ind_levels); + + /* In these cases, we can't tell if the operand is an input + --- 3888,3892 ---- + find_reloads_address (VOIDmode, NULL_PTR, + recog_operand[i], recog_operand_loc[i], + ! i, RELOAD_FOR_INPUT, ind_levels, &ign); + + /* In these cases, we can't tell if the operand is an input + *************** find_reloads (insn, replace, ind_levels, + *** 3845,3853 **** + XEXP (recog_operand[i], 0), + &XEXP (recog_operand[i], 0), + ! i, RELOAD_OTHER, ind_levels); + if (code == SUBREG) + recog_operand[i] = *recog_operand_loc[i] + = find_reloads_toplev (recog_operand[i], i, RELOAD_OTHER, + ! ind_levels, is_set_dest); + if (code == REG) + { + --- 3899,3907 ---- + XEXP (recog_operand[i], 0), + &XEXP (recog_operand[i], 0), + ! i, RELOAD_OTHER, ind_levels, &ign); + if (code == SUBREG) + recog_operand[i] = *recog_operand_loc[i] + = find_reloads_toplev (recog_operand[i], i, RELOAD_OTHER, + ! ind_levels, is_set_dest, &ign); + if (code == REG) + { + *************** alternative_allows_memconst (constraint, + *** 3908,3915 **** + + IS_SET_DEST is true if X is the destination of a SET, which is not + ! appropriate to be replaced by a constant. */ + + static rtx + ! find_reloads_toplev (x, opnum, type, ind_levels, is_set_dest) + rtx x; + int opnum; + --- 3962,3972 ---- + + IS_SET_DEST is true if X is the destination of a SET, which is not + ! appropriate to be replaced by a constant. + ! + ! FORCE_UPDATE, if non-NULL, is the address of a SHORT that is set to + ! 1 if X is replaced with something based on reg_equiv_constant. */ + + static rtx + ! find_reloads_toplev (x, opnum, type, ind_levels, is_set_dest, force_update) + rtx x; + int opnum; + *************** find_reloads_toplev (x, opnum, type, ind + *** 3917,3920 **** + --- 3974,3978 ---- + int ind_levels; + int is_set_dest; + + short *force_update; + { + register RTX_CODE code = GET_CODE (x); + *************** find_reloads_toplev (x, opnum, type, ind + *** 3928,3932 **** + register int regno = REGNO (x); + if (reg_equiv_constant[regno] != 0 && !is_set_dest) + ! x = reg_equiv_constant[regno]; + #if 0 + /* This creates (subreg (mem...)) which would cause an unnecessary + --- 3986,3996 ---- + register int regno = REGNO (x); + if (reg_equiv_constant[regno] != 0 && !is_set_dest) + ! { + ! x = reg_equiv_constant[regno]; + ! if (force_update) + ! *force_update = 1; + ! else + ! abort (); /* Learn why this happens. */ + ! } + #if 0 + /* This creates (subreg (mem...)) which would cause an unnecessary + *************** find_reloads_toplev (x, opnum, type, ind + *** 3951,3955 **** + find_reloads_address (GET_MODE (x), NULL_PTR, + XEXP (x, 0), + ! &XEXP (x, 0), opnum, type, ind_levels); + } + return x; + --- 4015,4020 ---- + find_reloads_address (GET_MODE (x), NULL_PTR, + XEXP (x, 0), + ! &XEXP (x, 0), opnum, type, ind_levels, + ! force_update); + } + return x; + *************** find_reloads_toplev (x, opnum, type, ind + *** 3959,3963 **** + rtx tem = x; + find_reloads_address (GET_MODE (x), &tem, XEXP (x, 0), &XEXP (x, 0), + ! opnum, type, ind_levels); + return tem; + } + --- 4024,4028 ---- + rtx tem = x; + find_reloads_address (GET_MODE (x), &tem, XEXP (x, 0), &XEXP (x, 0), + ! opnum, type, ind_levels, force_update); + return tem; + } + *************** find_reloads_toplev (x, opnum, type, ind + *** 3982,3986 **** + && (tem = gen_lowpart_common (GET_MODE (x), + reg_equiv_constant[regno])) != 0) + ! return tem; + + if (GET_MODE_BITSIZE (GET_MODE (x)) == BITS_PER_WORD + --- 4047,4057 ---- + && (tem = gen_lowpart_common (GET_MODE (x), + reg_equiv_constant[regno])) != 0) + ! { + ! if (force_update) + ! *force_update = 1; + ! else + ! abort (); /* Learn why this happens. */ + ! return tem; + ! } + + if (GET_MODE_BITSIZE (GET_MODE (x)) == BITS_PER_WORD + *************** find_reloads_toplev (x, opnum, type, ind + *** 3990,3994 **** + SUBREG_WORD (x), 0, + GET_MODE (SUBREG_REG (x)))) != 0) + ! return tem; + + if (regno >= FIRST_PSEUDO_REGISTER && reg_renumber[regno] < 0 + --- 4061,4071 ---- + SUBREG_WORD (x), 0, + GET_MODE (SUBREG_REG (x)))) != 0) + ! { + ! if (force_update) + ! *force_update = 1; + ! else + ! abort (); /* Learn why this happens. */ + ! return tem; + ! } + + if (regno >= FIRST_PSEUDO_REGISTER && reg_renumber[regno] < 0 + *************** find_reloads_toplev (x, opnum, type, ind + *** 4040,4044 **** + find_reloads_address (GET_MODE (x), NULL_PTR, + XEXP (x, 0), + ! &XEXP (x, 0), opnum, type, ind_levels); + } + + --- 4117,4122 ---- + find_reloads_address (GET_MODE (x), NULL_PTR, + XEXP (x, 0), + ! &XEXP (x, 0), opnum, type, ind_levels, + ! force_update); + } + + *************** find_reloads_toplev (x, opnum, type, ind + *** 4049,4053 **** + if (fmt[i] == 'e') + XEXP (x, i) = find_reloads_toplev (XEXP (x, i), opnum, type, + ! ind_levels, is_set_dest); + } + return x; + --- 4127,4131 ---- + if (fmt[i] == 'e') + XEXP (x, i) = find_reloads_toplev (XEXP (x, i), opnum, type, + ! ind_levels, is_set_dest, NULL); + } + return x; + *************** make_memloc (ad, regno) + *** 4110,4114 **** + + static int + ! find_reloads_address (mode, memrefloc, ad, loc, opnum, type, ind_levels) + enum machine_mode mode; + rtx *memrefloc; + --- 4188,4193 ---- + + static int + ! find_reloads_address (mode, memrefloc, ad, loc, opnum, type, ind_levels, + ! force_update) + enum machine_mode mode; + rtx *memrefloc; + *************** find_reloads_address (mode, memrefloc, a + *** 4118,4121 **** + --- 4197,4201 ---- + enum reload_type type; + int ind_levels; + + short *force_update; + { + register int regno; + *************** find_reloads_address (mode, memrefloc, a + *** 4134,4137 **** + --- 4214,4221 ---- + { + *loc = ad = reg_equiv_constant[regno]; + + if (force_update) + + *force_update = 1; + + else + + abort (); /* Learn why this happens. */ + return 1; + } + *************** find_reloads_address (mode, memrefloc, a + *** 4141,4145 **** + tem = make_memloc (ad, regno); + find_reloads_address (GET_MODE (tem), NULL_PTR, XEXP (tem, 0), + ! &XEXP (tem, 0), opnum, type, ind_levels); + push_reload (tem, NULL_RTX, loc, NULL_PTR, BASE_REG_CLASS, + GET_MODE (ad), VOIDmode, 0, 0, + --- 4225,4229 ---- + tem = make_memloc (ad, regno); + find_reloads_address (GET_MODE (tem), NULL_PTR, XEXP (tem, 0), + ! &XEXP (tem, 0), opnum, type, ind_levels, NULL); + push_reload (tem, NULL_RTX, loc, NULL_PTR, BASE_REG_CLASS, + GET_MODE (ad), VOIDmode, 0, 0, + *************** find_reloads_address (mode, memrefloc, a + *** 4214,4218 **** + tem = ad; + find_reloads_address (GET_MODE (ad), &tem, XEXP (ad, 0), &XEXP (ad, 0), + ! opnum, type, ind_levels == 0 ? 0 : ind_levels - 1); + + /* If tem was changed, then we must create a new memory reference to + --- 4298,4303 ---- + tem = ad; + find_reloads_address (GET_MODE (ad), &tem, XEXP (ad, 0), &XEXP (ad, 0), + ! opnum, type, ind_levels == 0 ? 0 : ind_levels - 1, + ! NULL); + + /* If tem was changed, then we must create a new memory reference to + *************** find_reloads_address_1 (x, context, loc, + *** 4722,4726 **** + /* First reload the memory location's address. */ + find_reloads_address (GET_MODE (tem), 0, XEXP (tem, 0), + ! &XEXP (tem, 0), opnum, type, ind_levels); + /* Put this inside a new increment-expression. */ + x = gen_rtx (GET_CODE (x), GET_MODE (x), tem); + --- 4807,4812 ---- + /* First reload the memory location's address. */ + find_reloads_address (GET_MODE (tem), 0, XEXP (tem, 0), + ! &XEXP (tem, 0), opnum, type, ind_levels, + ! NULL); + /* Put this inside a new increment-expression. */ + x = gen_rtx (GET_CODE (x), GET_MODE (x), tem); + *************** find_reloads_address_1 (x, context, loc, + *** 4788,4792 **** + find_reloads_address (GET_MODE (x), &XEXP (x, 0), + XEXP (XEXP (x, 0), 0), &XEXP (XEXP (x, 0), 0), + ! opnum, type, ind_levels); + + reloadnum = push_reload (x, NULL_RTX, loc, NULL_PTR, + --- 4874,4878 ---- + find_reloads_address (GET_MODE (x), &XEXP (x, 0), + XEXP (XEXP (x, 0), 0), &XEXP (XEXP (x, 0), 0), + ! opnum, type, ind_levels, NULL); + + reloadnum = push_reload (x, NULL_RTX, loc, NULL_PTR, + *************** find_reloads_address_1 (x, context, loc, + *** 4818,4822 **** + + find_reloads_address (GET_MODE (x), loc, XEXP (x, 0), &XEXP (x, 0), + ! opnum, type, ind_levels); + push_reload (*loc, NULL_RTX, loc, NULL_PTR, + context ? INDEX_REG_CLASS : BASE_REG_CLASS, + --- 4904,4908 ---- + + find_reloads_address (GET_MODE (x), loc, XEXP (x, 0), &XEXP (x, 0), + ! opnum, type, ind_levels, NULL); + push_reload (*loc, NULL_RTX, loc, NULL_PTR, + context ? INDEX_REG_CLASS : BASE_REG_CLASS, + *************** find_reloads_address_1 (x, context, loc, + *** 4852,4856 **** + x = make_memloc (x, regno); + find_reloads_address (GET_MODE (x), 0, XEXP (x, 0), &XEXP (x, 0), + ! opnum, type, ind_levels); + } + + --- 4938,4942 ---- + x = make_memloc (x, regno); + find_reloads_address (GET_MODE (x), 0, XEXP (x, 0), &XEXP (x, 0), + ! opnum, type, ind_levels, NULL); + } + + *************** find_reloads_address_part (x, loc, class + *** 4965,4969 **** + rtx tem = x = force_const_mem (mode, x); + find_reloads_address (mode, &tem, XEXP (tem, 0), &XEXP (tem, 0), + ! opnum, type, ind_levels); + } + + --- 5051,5055 ---- + rtx tem = x = force_const_mem (mode, x); + find_reloads_address (mode, &tem, XEXP (tem, 0), &XEXP (tem, 0), + ! opnum, type, ind_levels, NULL); + } + + *************** find_reloads_address_part (x, loc, class + *** 4977,4981 **** + x = gen_rtx (PLUS, GET_MODE (x), XEXP (x, 0), tem); + find_reloads_address (mode, &tem, XEXP (tem, 0), &XEXP (tem, 0), + ! opnum, type, ind_levels); + } + + --- 5063,5067 ---- + x = gen_rtx (PLUS, GET_MODE (x), XEXP (x, 0), tem); + find_reloads_address (mode, &tem, XEXP (tem, 0), &XEXP (tem, 0), + ! opnum, type, ind_levels, NULL); + } + + *************** find_equiv_reg (goal, insn, class, other + *** 5518,5522 **** + and is also a register that appears in the address of GOAL. */ + + ! if (goal_mem && value == SET_DEST (PATTERN (where)) + && refers_to_regno_for_reload_p (valueno, + (valueno + --- 5604,5608 ---- + and is also a register that appears in the address of GOAL. */ + + ! if (goal_mem && value == SET_DEST (single_set (where)) + && refers_to_regno_for_reload_p (valueno, + (valueno + *************** debug_reload() + *** 5900,5904 **** + + if (reload_nocombine[r]) + ! fprintf (stderr, ", can combine", reload_nocombine[r]); + + if (reload_secondary_p[r]) + --- 5986,5990 ---- + + if (reload_nocombine[r]) + ! fprintf (stderr, ", can't combine %d", reload_nocombine[r]); + + if (reload_secondary_p[r]) + diff -rcp2N gcc-2.7.2.3/reload1.c gcc-2.7.2.3.f.1/reload1.c + *** gcc-2.7.2.3/reload1.c Sun Nov 5 16:22:22 1995 + --- gcc-2.7.2.3.f.1/reload1.c Fri Aug 29 07:52:04 1997 + *************** reload (first, global, dumpfile) + *** 542,546 **** + Also find all paradoxical subregs and find largest such for each pseudo. + On machines with small register classes, record hard registers that + ! are used for user variables. These can never be used for spills. */ + + for (insn = first; insn; insn = NEXT_INSN (insn)) + --- 542,548 ---- + Also find all paradoxical subregs and find largest such for each pseudo. + On machines with small register classes, record hard registers that + ! are used for user variables. These can never be used for spills. + ! Also look for a "constant" NOTE_INSN_SETJMP. This means that all + ! caller-saved registers must be marked live. */ + + for (insn = first; insn; insn = NEXT_INSN (insn)) + *************** reload (first, global, dumpfile) + *** 548,551 **** + --- 550,559 ---- + rtx set = single_set (insn); + + + if (GET_CODE (insn) == NOTE && CONST_CALL_P (insn) + + && NOTE_LINE_NUMBER (insn) == NOTE_INSN_SETJMP) + + for (i = 0; i < FIRST_PSEUDO_REGISTER; i++) + + if (! call_used_regs[i]) + + regs_ever_live[i] = 1; + + + if (set != 0 && GET_CODE (SET_DEST (set)) == REG) + { + *************** reload (first, global, dumpfile) + *** 564,568 **** + if (GET_CODE (x) == MEM) + reg_equiv_memory_loc[i] = x; + ! else if (CONSTANT_P (x)) + { + if (LEGITIMATE_CONSTANT_P (x)) + --- 572,578 ---- + if (GET_CODE (x) == MEM) + reg_equiv_memory_loc[i] = x; + ! else if (CONSTANT_P (x) + ! && ! (GET_CODE (x) == CONST + ! && GET_CODE (XEXP (x, 0)) == MINUS)) + { + if (LEGITIMATE_CONSTANT_P (x)) + *************** reload (first, global, dumpfile) + *** 2013,2016 **** + --- 2023,2040 ---- + #endif + + + /* If we are doing stack checking, give a warning if this function's + + frame size is larger than we expect. */ + + if (flag_stack_check && ! STACK_CHECK_BUILTIN) + + { + + HOST_WIDE_INT size = get_frame_size () + STACK_CHECK_FIXED_FRAME_SIZE; + + + + for (i = 0; i < FIRST_PSEUDO_REGISTER; i++) + + if (regs_ever_live[i] && ! fixed_regs[i] && call_used_regs[i]) + + size += UNITS_PER_WORD; + + + + if (size > STACK_CHECK_MAX_FRAME_SIZE) + + warning ("frame size too large for reliable stack checking"); + + } + + + /* Indicate that we no longer have known memory locations or constants. */ + reg_equiv_constant = 0; + *************** eliminate_regs (x, mem_mode, insn) + *** 2886,2890 **** + + /* Fall through to generic unary operation case. */ + - case USE: + case STRICT_LOW_PART: + case NEG: case NOT: + --- 2910,2913 ---- + *************** eliminate_regs (x, mem_mode, insn) + *** 2975,2978 **** + --- 2998,3014 ---- + return x; + + + case USE: + + /* If using a register that is the source of an eliminate we still + + think can be performed, note it cannot be performed since we don't + + know how this register is used. */ + + for (ep = reg_eliminate; ep < ®_eliminate[NUM_ELIMINABLE_REGS]; ep++) + + if (ep->from_rtx == XEXP (x, 0)) + + ep->can_eliminate = 0; + + + + new = eliminate_regs (XEXP (x, 0), mem_mode, insn); + + if (new != XEXP (x, 0)) + + return gen_rtx (code, GET_MODE (x), new); + + return x; + + + case CLOBBER: + /* If clobbering a register that is the replacement register for an + *************** gen_reload (out, in, opnum, type) + *** 6736,6741 **** + --- 6772,6779 ---- + if (GET_CODE (in) == PLUS + && (GET_CODE (XEXP (in, 0)) == REG + + || GET_CODE (XEXP (in, 0)) == SUBREG + || GET_CODE (XEXP (in, 0)) == MEM) + && (GET_CODE (XEXP (in, 1)) == REG + + || GET_CODE (XEXP (in, 1)) == SUBREG + || CONSTANT_P (XEXP (in, 1)) + || GET_CODE (XEXP (in, 1)) == MEM)) + *************** gen_reload (out, in, opnum, type) + *** 6798,6807 **** + we emit below. */ + + ! if (CONSTANT_P (op1) || GET_CODE (op1) == MEM + || (GET_CODE (op1) == REG + && REGNO (op1) >= FIRST_PSEUDO_REGISTER)) + tem = op0, op0 = op1, op1 = tem; + + ! emit_insn (gen_move_insn (out, op0)); + + /* If OP0 and OP1 are the same, we can use OUT for OP1. + --- 6836,6845 ---- + we emit below. */ + + ! if (CONSTANT_P (op1) || GET_CODE (op1) == MEM || GET_CODE (op1) == SUBREG + || (GET_CODE (op1) == REG + && REGNO (op1) >= FIRST_PSEUDO_REGISTER)) + tem = op0, op0 = op1, op1 = tem; + + ! gen_reload (out, op0, opnum, type); + + /* If OP0 and OP1 are the same, we can use OUT for OP1. + *************** gen_reload (out, in, opnum, type) + *** 6831,6835 **** + delete_insns_since (last); + + ! emit_insn (gen_move_insn (out, op1)); + emit_insn (gen_add2_insn (out, op0)); + } + --- 6869,6873 ---- + delete_insns_since (last); + + ! gen_reload (out, op1, opnum, type); + emit_insn (gen_add2_insn (out, op0)); + } + *************** gen_reload (out, in, opnum, type) + *** 6852,6857 **** + in = gen_rtx (REG, GET_MODE (loc), REGNO (in)); + + ! emit_insn (gen_move_insn (loc, in)); + ! emit_insn (gen_move_insn (out, loc)); + } + #endif + --- 6890,6895 ---- + in = gen_rtx (REG, GET_MODE (loc), REGNO (in)); + + ! gen_reload (loc, in, opnum, type); + ! gen_reload (out, loc, opnum, type); + } + #endif + diff -rcp2N gcc-2.7.2.3/reorg.c gcc-2.7.2.3.f.1/reorg.c + *** gcc-2.7.2.3/reorg.c Fri Sep 15 21:38:55 1995 + --- gcc-2.7.2.3.f.1/reorg.c Fri Aug 29 07:52:00 1997 + *************** redundant_insn (insn, target, delay_list + *** 1961,1964 **** + --- 1961,1969 ---- + int i; + + + /* If INSN has any REG_UNUSED notes, it can't match anything since we + + are allowed to not actually assign to such a register. */ + + if (find_reg_note (insn, REG_UNUSED, NULL_RTX) != 0) + + return 0; + + + /* Scan backwards looking for a match. */ + for (trial = PREV_INSN (target); trial; trial = PREV_INSN (trial)) + *************** redundant_insn (insn, target, delay_list + *** 1999,2003 **** + for (i = XVECLEN (pat, 0) - 1; i > 0; i--) + if (GET_CODE (XVECEXP (pat, 0, i)) == GET_CODE (insn) + ! && rtx_equal_p (PATTERN (XVECEXP (pat, 0, i)), ipat)) + break; + + --- 2004,2009 ---- + for (i = XVECLEN (pat, 0) - 1; i > 0; i--) + if (GET_CODE (XVECEXP (pat, 0, i)) == GET_CODE (insn) + ! && rtx_equal_p (PATTERN (XVECEXP (pat, 0, i)), ipat) + ! && ! find_reg_note (XVECEXP (pat, 0, i), REG_UNUSED, NULL_RTX)) + break; + + *************** redundant_insn (insn, target, delay_list + *** 2007,2011 **** + } + + ! else if (GET_CODE (trial) == GET_CODE (insn) && rtx_equal_p (pat, ipat)) + break; + } + --- 2013,2018 ---- + } + + ! else if (GET_CODE (trial) == GET_CODE (insn) && rtx_equal_p (pat, ipat) + ! && ! find_reg_note (trial, REG_UNUSED, NULL_RTX)) + break; + } + diff -rcp2N gcc-2.7.2.3/rtl.c gcc-2.7.2.3.f.1/rtl.c + *** gcc-2.7.2.3/rtl.c Thu Jun 15 12:02:59 1995 + --- gcc-2.7.2.3.f.1/rtl.c Fri Jul 11 00:09:06 1997 + *************** char *reg_note_name[] = { "", "REG_DEAD" + *** 179,183 **** + "REG_NONNEG", "REG_NO_CONFLICT", "REG_UNUSED", + "REG_CC_SETTER", "REG_CC_USER", "REG_LABEL", + ! "REG_DEP_ANTI", "REG_DEP_OUTPUT" }; + + /* Allocate an rtx vector of N elements. + --- 179,183 ---- + "REG_NONNEG", "REG_NO_CONFLICT", "REG_UNUSED", + "REG_CC_SETTER", "REG_CC_USER", "REG_LABEL", + ! "REG_DEP_ANTI", "REG_DEP_OUTPUT", "REG_NOALIAS" }; + + /* Allocate an rtx vector of N elements. + diff -rcp2N gcc-2.7.2.3/rtl.h gcc-2.7.2.3.f.1/rtl.h + *** gcc-2.7.2.3/rtl.h Thu Jun 15 12:03:16 1995 + --- gcc-2.7.2.3.f.1/rtl.h Fri Jul 11 00:09:07 1997 + *************** enum reg_note { REG_DEAD = 1, REG_INC = + *** 349,353 **** + REG_NONNEG = 8, REG_NO_CONFLICT = 9, REG_UNUSED = 10, + REG_CC_SETTER = 11, REG_CC_USER = 12, REG_LABEL = 13, + ! REG_DEP_ANTI = 14, REG_DEP_OUTPUT = 15 }; + + /* Define macros to extract and insert the reg-note kind in an EXPR_LIST. */ + --- 349,353 ---- + REG_NONNEG = 8, REG_NO_CONFLICT = 9, REG_UNUSED = 10, + REG_CC_SETTER = 11, REG_CC_USER = 12, REG_LABEL = 13, + ! REG_DEP_ANTI = 14, REG_DEP_OUTPUT = 15, REG_NOALIAS = 16 }; + + /* Define macros to extract and insert the reg-note kind in an EXPR_LIST. */ + *************** extern char *reg_note_name[]; + *** 432,436 **** + #define NOTE_INSN_FUNCTION_BEG -13 + + - + #if 0 /* These are not used, and I don't know what they were for. --rms. */ + #define NOTE_DECL_NAME(INSN) ((INSN)->fld[3].rtstr) + --- 432,435 ---- + *************** extern char *note_insn_name[]; + *** 576,579 **** + --- 575,579 ---- + /* For a TRAP_IF rtx, TRAP_CONDITION is an expression. */ + #define TRAP_CONDITION(RTX) ((RTX)->fld[0].rtx) + + #define TRAP_CODE(RTX) ((RTX)->fld[1].rtint) + + /* 1 in a SYMBOL_REF if it addresses this function's constants pool. */ + *************** extern rtx eliminate_constant_term PROTO + *** 817,820 **** + --- 817,830 ---- + extern rtx expand_complex_abs PROTO((enum machine_mode, rtx, rtx, int)); + extern enum machine_mode choose_hard_reg_mode PROTO((int, int)); + + extern int rtx_varies_p PROTO((rtx)); + + extern int may_trap_p PROTO((rtx)); + + extern int side_effects_p PROTO((rtx)); + + extern int volatile_refs_p PROTO((rtx)); + + extern int volatile_insn_p PROTO((rtx)); + + extern void remove_note PROTO((rtx, rtx)); + + extern void note_stores PROTO((rtx, void (*)())); + + extern int refers_to_regno_p PROTO((int, int, rtx, rtx *)); + + extern int reg_overlap_mentioned_p PROTO((rtx, rtx)); + + + + /* Maximum number of parallel sets and clobbers in any insn in this fn. + *************** extern rtx *regno_reg_rtx; + *** 967,968 **** + --- 977,987 ---- + + extern int rtx_to_tree_code PROTO((enum rtx_code)); + + + + extern int true_dependence PROTO((rtx, enum machine_mode, rtx, int (*)())); + + extern int read_dependence PROTO((rtx, rtx)); + + extern int anti_dependence PROTO((rtx, rtx)); + + extern int output_dependence PROTO((rtx, rtx)); + + extern void init_alias_analysis PROTO((void)); + + extern void end_alias_analysis PROTO((void)); + + extern void mark_user_reg PROTO((rtx)); + + extern void mark_reg_pointer PROTO((rtx)); + diff -rcp2N gcc-2.7.2.3/sched.c gcc-2.7.2.3.f.1/sched.c + *** gcc-2.7.2.3/sched.c Thu Jun 15 12:06:39 1995 + --- gcc-2.7.2.3.f.1/sched.c Sun Aug 10 22:46:13 1997 + *************** Boston, MA 02111-1307, USA. */ + *** 126,129 **** + --- 126,132 ---- + #include "insn-attr.h" + + + extern char *reg_known_equiv_p; + + extern rtx *reg_known_value; + + + #ifdef INSN_SCHEDULING + /* Arrays set up by scheduling for the same respective purposes as + *************** static int *sched_reg_live_length; + *** 143,146 **** + --- 146,150 ---- + by splitting insns. */ + static rtx *reg_last_uses; + + static int reg_last_uses_size; + static rtx *reg_last_sets; + static regset reg_pending_sets; + *************** struct sometimes + *** 294,302 **** + + /* Forward declarations. */ + - static rtx canon_rtx PROTO((rtx)); + - static int rtx_equal_for_memref_p PROTO((rtx, rtx)); + - static rtx find_symbolic_term PROTO((rtx)); + - static int memrefs_conflict_p PROTO((int, rtx, int, rtx, + - HOST_WIDE_INT)); + static void add_dependence PROTO((rtx, rtx, enum reg_note)); + static void remove_dependence PROTO((rtx, rtx)); + --- 298,301 ---- + *************** static int priority PROTO((rtx)); + *** 314,318 **** + static void free_pending_lists PROTO((void)); + static void add_insn_mem_dependence PROTO((rtx *, rtx *, rtx, rtx)); + ! static void flush_pending_lists PROTO((rtx)); + static void sched_analyze_1 PROTO((rtx, rtx)); + static void sched_analyze_2 PROTO((rtx, rtx)); + --- 313,317 ---- + static void free_pending_lists PROTO((void)); + static void add_insn_mem_dependence PROTO((rtx *, rtx *, rtx, rtx)); + ! static void flush_pending_lists PROTO((rtx, int)); + static void sched_analyze_1 PROTO((rtx, rtx)); + static void sched_analyze_2 PROTO((rtx, rtx)); + *************** void schedule_insns PROTO((FILE *)); + *** 346,885 **** + #endif /* INSN_SCHEDULING */ + + - #define SIZE_FOR_MODE(X) (GET_MODE_SIZE (GET_MODE (X))) + - + - /* Vector indexed by N giving the initial (unchanging) value known + - for pseudo-register N. */ + - static rtx *reg_known_value; + - + - /* Vector recording for each reg_known_value whether it is due to a + - REG_EQUIV note. Future passes (viz., reload) may replace the + - pseudo with the equivalent expression and so we account for the + - dependences that would be introduced if that happens. */ + - /* ??? This is a problem only on the Convex. The REG_EQUIV notes created in + - assign_parms mention the arg pointer, and there are explicit insns in the + - RTL that modify the arg pointer. Thus we must ensure that such insns don't + - get scheduled across each other because that would invalidate the REG_EQUIV + - notes. One could argue that the REG_EQUIV notes are wrong, but solving + - the problem in the scheduler will likely give better code, so we do it + - here. */ + - static char *reg_known_equiv_p; + - + - /* Indicates number of valid entries in reg_known_value. */ + - static int reg_known_value_size; + - + - static rtx + - canon_rtx (x) + - rtx x; + - { + - if (GET_CODE (x) == REG && REGNO (x) >= FIRST_PSEUDO_REGISTER + - && REGNO (x) <= reg_known_value_size) + - return reg_known_value[REGNO (x)]; + - else if (GET_CODE (x) == PLUS) + - { + - rtx x0 = canon_rtx (XEXP (x, 0)); + - rtx x1 = canon_rtx (XEXP (x, 1)); + - + - if (x0 != XEXP (x, 0) || x1 != XEXP (x, 1)) + - { + - /* We can tolerate LO_SUMs being offset here; these + - rtl are used for nothing other than comparisons. */ + - if (GET_CODE (x0) == CONST_INT) + - return plus_constant_for_output (x1, INTVAL (x0)); + - else if (GET_CODE (x1) == CONST_INT) + - return plus_constant_for_output (x0, INTVAL (x1)); + - return gen_rtx (PLUS, GET_MODE (x), x0, x1); + - } + - } + - return x; + - } + - + - /* Set up all info needed to perform alias analysis on memory references. */ + - + - void + - init_alias_analysis () + - { + - int maxreg = max_reg_num (); + - rtx insn; + - rtx note; + - rtx set; + - + - reg_known_value_size = maxreg; + - + - reg_known_value + - = (rtx *) oballoc ((maxreg-FIRST_PSEUDO_REGISTER) * sizeof (rtx)) + - - FIRST_PSEUDO_REGISTER; + - bzero ((char *) (reg_known_value + FIRST_PSEUDO_REGISTER), + - (maxreg-FIRST_PSEUDO_REGISTER) * sizeof (rtx)); + - + - reg_known_equiv_p + - = (char *) oballoc ((maxreg -FIRST_PSEUDO_REGISTER) * sizeof (char)) + - - FIRST_PSEUDO_REGISTER; + - bzero (reg_known_equiv_p + FIRST_PSEUDO_REGISTER, + - (maxreg - FIRST_PSEUDO_REGISTER) * sizeof (char)); + - + - /* Fill in the entries with known constant values. */ + - for (insn = get_insns (); insn; insn = NEXT_INSN (insn)) + - if ((set = single_set (insn)) != 0 + - && GET_CODE (SET_DEST (set)) == REG + - && REGNO (SET_DEST (set)) >= FIRST_PSEUDO_REGISTER + - && (((note = find_reg_note (insn, REG_EQUAL, 0)) != 0 + - && reg_n_sets[REGNO (SET_DEST (set))] == 1) + - || (note = find_reg_note (insn, REG_EQUIV, NULL_RTX)) != 0) + - && GET_CODE (XEXP (note, 0)) != EXPR_LIST) + - { + - int regno = REGNO (SET_DEST (set)); + - reg_known_value[regno] = XEXP (note, 0); + - reg_known_equiv_p[regno] = REG_NOTE_KIND (note) == REG_EQUIV; + - } + - + - /* Fill in the remaining entries. */ + - while (--maxreg >= FIRST_PSEUDO_REGISTER) + - if (reg_known_value[maxreg] == 0) + - reg_known_value[maxreg] = regno_reg_rtx[maxreg]; + - } + - + - /* Return 1 if X and Y are identical-looking rtx's. + - + - We use the data in reg_known_value above to see if two registers with + - different numbers are, in fact, equivalent. */ + - + - static int + - rtx_equal_for_memref_p (x, y) + - rtx x, y; + - { + - register int i; + - register int j; + - register enum rtx_code code; + - register char *fmt; + - + - if (x == 0 && y == 0) + - return 1; + - if (x == 0 || y == 0) + - return 0; + - x = canon_rtx (x); + - y = canon_rtx (y); + - + - if (x == y) + - return 1; + - + - code = GET_CODE (x); + - /* Rtx's of different codes cannot be equal. */ + - if (code != GET_CODE (y)) + - return 0; + - + - /* (MULT:SI x y) and (MULT:HI x y) are NOT equivalent. + - (REG:SI x) and (REG:HI x) are NOT equivalent. */ + - + - if (GET_MODE (x) != GET_MODE (y)) + - return 0; + - + - /* REG, LABEL_REF, and SYMBOL_REF can be compared nonrecursively. */ + - + - if (code == REG) + - return REGNO (x) == REGNO (y); + - if (code == LABEL_REF) + - return XEXP (x, 0) == XEXP (y, 0); + - if (code == SYMBOL_REF) + - return XSTR (x, 0) == XSTR (y, 0); + - + - /* For commutative operations, the RTX match if the operand match in any + - order. Also handle the simple binary and unary cases without a loop. */ + - if (code == EQ || code == NE || GET_RTX_CLASS (code) == 'c') + - return ((rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)) + - && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1))) + - || (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 1)) + - && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 0)))); + - else if (GET_RTX_CLASS (code) == '<' || GET_RTX_CLASS (code) == '2') + - return (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)) + - && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1))); + - else if (GET_RTX_CLASS (code) == '1') + - return rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)); + - + - /* Compare the elements. If any pair of corresponding elements + - fail to match, return 0 for the whole things. */ + - + - fmt = GET_RTX_FORMAT (code); + - for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--) + - { + - switch (fmt[i]) + - { + - case 'w': + - if (XWINT (x, i) != XWINT (y, i)) + - return 0; + - break; + - + - case 'n': + - case 'i': + - if (XINT (x, i) != XINT (y, i)) + - return 0; + - break; + - + - case 'V': + - case 'E': + - /* Two vectors must have the same length. */ + - if (XVECLEN (x, i) != XVECLEN (y, i)) + - return 0; + - + - /* And the corresponding elements must match. */ + - for (j = 0; j < XVECLEN (x, i); j++) + - if (rtx_equal_for_memref_p (XVECEXP (x, i, j), XVECEXP (y, i, j)) == 0) + - return 0; + - break; + - + - case 'e': + - if (rtx_equal_for_memref_p (XEXP (x, i), XEXP (y, i)) == 0) + - return 0; + - break; + - + - case 'S': + - case 's': + - if (strcmp (XSTR (x, i), XSTR (y, i))) + - return 0; + - break; + - + - case 'u': + - /* These are just backpointers, so they don't matter. */ + - break; + - + - case '0': + - break; + - + - /* It is believed that rtx's at this level will never + - contain anything but integers and other rtx's, + - except for within LABEL_REFs and SYMBOL_REFs. */ + - default: + - abort (); + - } + - } + - return 1; + - } + - + - /* Given an rtx X, find a SYMBOL_REF or LABEL_REF within + - X and return it, or return 0 if none found. */ + - + - static rtx + - find_symbolic_term (x) + - rtx x; + - { + - register int i; + - register enum rtx_code code; + - register char *fmt; + - + - code = GET_CODE (x); + - if (code == SYMBOL_REF || code == LABEL_REF) + - return x; + - if (GET_RTX_CLASS (code) == 'o') + - return 0; + - + - fmt = GET_RTX_FORMAT (code); + - for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--) + - { + - rtx t; + - + - if (fmt[i] == 'e') + - { + - t = find_symbolic_term (XEXP (x, i)); + - if (t != 0) + - return t; + - } + - else if (fmt[i] == 'E') + - break; + - } + - return 0; + - } + - + - /* Return nonzero if X and Y (memory addresses) could reference the + - same location in memory. C is an offset accumulator. When + - C is nonzero, we are testing aliases between X and Y + C. + - XSIZE is the size in bytes of the X reference, + - similarly YSIZE is the size in bytes for Y. + - + - If XSIZE or YSIZE is zero, we do not know the amount of memory being + - referenced (the reference was BLKmode), so make the most pessimistic + - assumptions. + - + - We recognize the following cases of non-conflicting memory: + - + - (1) addresses involving the frame pointer cannot conflict + - with addresses involving static variables. + - (2) static variables with different addresses cannot conflict. + - + - Nice to notice that varying addresses cannot conflict with fp if no + - local variables had their addresses taken, but that's too hard now. */ + - + - /* ??? In Fortran, references to a array parameter can never conflict with + - another array parameter. */ + - + - static int + - memrefs_conflict_p (xsize, x, ysize, y, c) + - rtx x, y; + - int xsize, ysize; + - HOST_WIDE_INT c; + - { + - if (GET_CODE (x) == HIGH) + - x = XEXP (x, 0); + - else if (GET_CODE (x) == LO_SUM) + - x = XEXP (x, 1); + - else + - x = canon_rtx (x); + - if (GET_CODE (y) == HIGH) + - y = XEXP (y, 0); + - else if (GET_CODE (y) == LO_SUM) + - y = XEXP (y, 1); + - else + - y = canon_rtx (y); + - + - if (rtx_equal_for_memref_p (x, y)) + - return (xsize == 0 || ysize == 0 || + - (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); + - + - if (y == frame_pointer_rtx || y == hard_frame_pointer_rtx + - || y == stack_pointer_rtx) + - { + - rtx t = y; + - int tsize = ysize; + - y = x; ysize = xsize; + - x = t; xsize = tsize; + - } + - + - if (x == frame_pointer_rtx || x == hard_frame_pointer_rtx + - || x == stack_pointer_rtx) + - { + - rtx y1; + - + - if (CONSTANT_P (y)) + - return 0; + - + - if (GET_CODE (y) == PLUS + - && canon_rtx (XEXP (y, 0)) == x + - && (y1 = canon_rtx (XEXP (y, 1))) + - && GET_CODE (y1) == CONST_INT) + - { + - c += INTVAL (y1); + - return (xsize == 0 || ysize == 0 + - || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); + - } + - + - if (GET_CODE (y) == PLUS + - && (y1 = canon_rtx (XEXP (y, 0))) + - && CONSTANT_P (y1)) + - return 0; + - + - return 1; + - } + - + - if (GET_CODE (x) == PLUS) + - { + - /* The fact that X is canonicalized means that this + - PLUS rtx is canonicalized. */ + - rtx x0 = XEXP (x, 0); + - rtx x1 = XEXP (x, 1); + - + - if (GET_CODE (y) == PLUS) + - { + - /* The fact that Y is canonicalized means that this + - PLUS rtx is canonicalized. */ + - rtx y0 = XEXP (y, 0); + - rtx y1 = XEXP (y, 1); + - + - if (rtx_equal_for_memref_p (x1, y1)) + - return memrefs_conflict_p (xsize, x0, ysize, y0, c); + - if (rtx_equal_for_memref_p (x0, y0)) + - return memrefs_conflict_p (xsize, x1, ysize, y1, c); + - if (GET_CODE (x1) == CONST_INT) + - if (GET_CODE (y1) == CONST_INT) + - return memrefs_conflict_p (xsize, x0, ysize, y0, + - c - INTVAL (x1) + INTVAL (y1)); + - else + - return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1)); + - else if (GET_CODE (y1) == CONST_INT) + - return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1)); + - + - /* Handle case where we cannot understand iteration operators, + - but we notice that the base addresses are distinct objects. */ + - x = find_symbolic_term (x); + - if (x == 0) + - return 1; + - y = find_symbolic_term (y); + - if (y == 0) + - return 1; + - return rtx_equal_for_memref_p (x, y); + - } + - else if (GET_CODE (x1) == CONST_INT) + - return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1)); + - } + - else if (GET_CODE (y) == PLUS) + - { + - /* The fact that Y is canonicalized means that this + - PLUS rtx is canonicalized. */ + - rtx y0 = XEXP (y, 0); + - rtx y1 = XEXP (y, 1); + - + - if (GET_CODE (y1) == CONST_INT) + - return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1)); + - else + - return 1; + - } + - + - if (GET_CODE (x) == GET_CODE (y)) + - switch (GET_CODE (x)) + - { + - case MULT: + - { + - /* Handle cases where we expect the second operands to be the + - same, and check only whether the first operand would conflict + - or not. */ + - rtx x0, y0; + - rtx x1 = canon_rtx (XEXP (x, 1)); + - rtx y1 = canon_rtx (XEXP (y, 1)); + - if (! rtx_equal_for_memref_p (x1, y1)) + - return 1; + - x0 = canon_rtx (XEXP (x, 0)); + - y0 = canon_rtx (XEXP (y, 0)); + - if (rtx_equal_for_memref_p (x0, y0)) + - return (xsize == 0 || ysize == 0 + - || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); + - + - /* Can't properly adjust our sizes. */ + - if (GET_CODE (x1) != CONST_INT) + - return 1; + - xsize /= INTVAL (x1); + - ysize /= INTVAL (x1); + - c /= INTVAL (x1); + - return memrefs_conflict_p (xsize, x0, ysize, y0, c); + - } + - } + - + - if (CONSTANT_P (x)) + - { + - if (GET_CODE (x) == CONST_INT && GET_CODE (y) == CONST_INT) + - { + - c += (INTVAL (y) - INTVAL (x)); + - return (xsize == 0 || ysize == 0 + - || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); + - } + - + - if (GET_CODE (x) == CONST) + - { + - if (GET_CODE (y) == CONST) + - return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)), + - ysize, canon_rtx (XEXP (y, 0)), c); + - else + - return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)), + - ysize, y, c); + - } + - if (GET_CODE (y) == CONST) + - return memrefs_conflict_p (xsize, x, ysize, + - canon_rtx (XEXP (y, 0)), c); + - + - if (CONSTANT_P (y)) + - return (rtx_equal_for_memref_p (x, y) + - && (xsize == 0 || ysize == 0 + - || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0))); + - + - return 1; + - } + - return 1; + - } + - + - /* Functions to compute memory dependencies. + - + - Since we process the insns in execution order, we can build tables + - to keep track of what registers are fixed (and not aliased), what registers + - are varying in known ways, and what registers are varying in unknown + - ways. + - + - If both memory references are volatile, then there must always be a + - dependence between the two references, since their order can not be + - changed. A volatile and non-volatile reference can be interchanged + - though. + - + - A MEM_IN_STRUCT reference at a non-QImode varying address can never + - conflict with a non-MEM_IN_STRUCT reference at a fixed address. We must + - allow QImode aliasing because the ANSI C standard allows character + - pointers to alias anything. We are assuming that characters are + - always QImode here. */ + - + - /* Read dependence: X is read after read in MEM takes place. There can + - only be a dependence here if both reads are volatile. */ + - + - int + - read_dependence (mem, x) + - rtx mem; + - rtx x; + - { + - return MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem); + - } + - + - /* True dependence: X is read after store in MEM takes place. */ + - + - int + - true_dependence (mem, x) + - rtx mem; + - rtx x; + - { + - /* If X is an unchanging read, then it can't possibly conflict with any + - non-unchanging store. It may conflict with an unchanging write though, + - because there may be a single store to this address to initialize it. + - Just fall through to the code below to resolve the case where we have + - both an unchanging read and an unchanging write. This won't handle all + - cases optimally, but the possible performance loss should be + - negligible. */ + - if (RTX_UNCHANGING_P (x) && ! RTX_UNCHANGING_P (mem)) + - return 0; + - + - return ((MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) + - || (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0), + - SIZE_FOR_MODE (x), XEXP (x, 0), 0) + - && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem) + - && GET_MODE (mem) != QImode + - && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x)) + - && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x) + - && GET_MODE (x) != QImode + - && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem)))); + - } + - + - /* Anti dependence: X is written after read in MEM takes place. */ + - + - int + - anti_dependence (mem, x) + - rtx mem; + - rtx x; + - { + - /* If MEM is an unchanging read, then it can't possibly conflict with + - the store to X, because there is at most one store to MEM, and it must + - have occurred somewhere before MEM. */ + - if (RTX_UNCHANGING_P (mem)) + - return 0; + - + - return ((MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) + - || (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0), + - SIZE_FOR_MODE (x), XEXP (x, 0), 0) + - && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem) + - && GET_MODE (mem) != QImode + - && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x)) + - && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x) + - && GET_MODE (x) != QImode + - && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem)))); + - } + - + - /* Output dependence: X is written after store in MEM takes place. */ + - + - int + - output_dependence (mem, x) + - rtx mem; + - rtx x; + - { + - return ((MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) + - || (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0), + - SIZE_FOR_MODE (x), XEXP (x, 0), 0) + - && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem) + - && GET_MODE (mem) != QImode + - && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x)) + - && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x) + - && GET_MODE (x) != QImode + - && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem)))); + - } + - + /* Helper functions for instruction scheduling. */ + + --- 345,348 ---- + *************** add_insn_mem_dependence (insn_list, mem_ + *** 1609,1621 **** + + /* Make a dependency between every memory reference on the pending lists + ! and INSN, thus flushing the pending lists. */ + + static void + ! flush_pending_lists (insn) + rtx insn; + { + rtx link; + + ! while (pending_read_insns) + { + add_dependence (insn, XEXP (pending_read_insns, 0), REG_DEP_ANTI); + --- 1072,1086 ---- + + /* Make a dependency between every memory reference on the pending lists + ! and INSN, thus flushing the pending lists. If ONLY_WRITE, don't flush + ! the read list. */ + + static void + ! flush_pending_lists (insn, only_write) + rtx insn; + + int only_write; + { + rtx link; + + ! while (pending_read_insns && ! only_write) + { + add_dependence (insn, XEXP (pending_read_insns, 0), REG_DEP_ANTI); + *************** sched_analyze_1 (x, insn) + *** 1746,1750 **** + this flush occurs 8 times for sparc, and 10 times for m88k using + the number 32. */ + ! flush_pending_lists (insn); + } + else + --- 1211,1215 ---- + this flush occurs 8 times for sparc, and 10 times for m88k using + the number 32. */ + ! flush_pending_lists (insn, 0); + } + else + *************** sched_analyze_2 (x, insn) + *** 1922,1926 **** + /* If a dependency already exists, don't create a new one. */ + if (! find_insn_list (XEXP (pending, 0), LOG_LINKS (insn))) + ! if (true_dependence (XEXP (pending_mem, 0), x)) + add_dependence (insn, XEXP (pending, 0), 0); + + --- 1387,1392 ---- + /* If a dependency already exists, don't create a new one. */ + if (! find_insn_list (XEXP (pending, 0), LOG_LINKS (insn))) + ! if (true_dependence (XEXP (pending_mem, 0), VOIDmode, + ! x, rtx_varies_p)) + add_dependence (insn, XEXP (pending, 0), 0); + + *************** sched_analyze_2 (x, insn) + *** 1968,1972 **** + reg_pending_sets_all = 1; + + ! flush_pending_lists (insn); + } + + --- 1434,1438 ---- + reg_pending_sets_all = 1; + + ! flush_pending_lists (insn, 0); + } + + *************** sched_analyze_insn (x, insn, loop_notes) + *** 2021,2025 **** + register RTX_CODE code = GET_CODE (x); + rtx link; + ! int maxreg = max_reg_num (); + int i; + + --- 1487,1491 ---- + register RTX_CODE code = GET_CODE (x); + rtx link; + ! int maxreg = reg_last_uses_size; + int i; + + *************** sched_analyze_insn (x, insn, loop_notes) + *** 2058,2062 **** + if (loop_notes) + { + ! int max_reg = max_reg_num (); + rtx link; + + --- 1524,1528 ---- + if (loop_notes) + { + ! int max_reg = reg_last_uses_size; + rtx link; + + *************** sched_analyze_insn (x, insn, loop_notes) + *** 2072,2076 **** + reg_pending_sets_all = 1; + + ! flush_pending_lists (insn); + + link = loop_notes; + --- 1538,1542 ---- + reg_pending_sets_all = 1; + + ! flush_pending_lists (insn, 0); + + link = loop_notes; + *************** sched_analyze (head, tail) + *** 2202,2207 **** + && NOTE_LINE_NUMBER (NEXT_INSN (insn)) == NOTE_INSN_SETJMP) + { + ! int max_reg = max_reg_num (); + ! for (i = 0; i < max_reg; i++) + { + for (u = reg_last_uses[i]; u; u = XEXP (u, 1)) + --- 1668,1672 ---- + && NOTE_LINE_NUMBER (NEXT_INSN (insn)) == NOTE_INSN_SETJMP) + { + ! for (i = 0; i < reg_last_uses_size; i++) + { + for (u = reg_last_uses[i]; u; u = XEXP (u, 1)) + *************** sched_analyze (head, tail) + *** 2247,2259 **** + loop_notes = 0; + + ! /* We don't need to flush memory for a function call which does + ! not involve memory. */ + ! if (! CONST_CALL_P (insn)) + ! { + ! /* In the absence of interprocedural alias analysis, + ! we must flush all pending reads and writes, and + ! start new dependencies starting from here. */ + ! flush_pending_lists (insn); + ! } + + /* Depend this function call (actually, the user of this + --- 1712,1720 ---- + loop_notes = 0; + + ! /* In the absence of interprocedural alias analysis, we must flush + ! all pending reads and writes, and start new dependencies starting + ! from here. But only flush writes for constant calls (which may + ! be passed a pointer to something we haven't written yet). */ + ! flush_pending_lists (insn, CONST_CALL_P (insn)); + + /* Depend this function call (actually, the user of this + *************** sched_analyze (head, tail) + *** 2264,2270 **** + else if (GET_CODE (insn) == NOTE + && (NOTE_LINE_NUMBER (insn) == NOTE_INSN_LOOP_BEG + ! || NOTE_LINE_NUMBER (insn) == NOTE_INSN_LOOP_END)) + ! loop_notes = gen_rtx (EXPR_LIST, REG_DEAD, + ! GEN_INT (NOTE_LINE_NUMBER (insn)), loop_notes); + + if (insn == tail) + --- 1725,1736 ---- + else if (GET_CODE (insn) == NOTE + && (NOTE_LINE_NUMBER (insn) == NOTE_INSN_LOOP_BEG + ! || NOTE_LINE_NUMBER (insn) == NOTE_INSN_LOOP_END + ! || (NOTE_LINE_NUMBER (insn) == NOTE_INSN_SETJMP + ! && GET_CODE (PREV_INSN (insn)) != CALL_INSN))) + ! { + ! loop_notes = gen_rtx (EXPR_LIST, REG_DEAD, + ! GEN_INT (NOTE_LINE_NUMBER (insn)), loop_notes); + ! CONST_CALL_P (loop_notes) = CONST_CALL_P (insn); + ! } + + if (insn == tail) + *************** sched_note_set (b, x, death) + *** 2372,2380 **** + + #define SCHED_SORT(READY, NEW_READY, OLD_READY) \ + ! do { if ((NEW_READY) - (OLD_READY) == 1) \ + ! swap_sort (READY, NEW_READY); \ + ! else if ((NEW_READY) - (OLD_READY) > 1) \ + ! qsort (READY, NEW_READY, sizeof (rtx), rank_for_schedule); } \ + ! while (0) + + /* Returns a positive value if y is preferred; returns a negative value if + --- 1838,1845 ---- + + #define SCHED_SORT(READY, NEW_READY, OLD_READY) \ + ! if ((NEW_READY) - (OLD_READY) == 1) \ + ! swap_sort (READY, NEW_READY); \ + ! else if ((NEW_READY) - (OLD_READY) > 1) \ + ! qsort (READY, NEW_READY, sizeof (rtx), rank_for_schedule); else \ + + /* Returns a positive value if y is preferred; returns a negative value if + *************** reemit_notes (insn, last) + *** 3128,3132 **** + { + if (INTVAL (XEXP (note, 0)) == NOTE_INSN_SETJMP) + ! emit_note_after (INTVAL (XEXP (note, 0)), insn); + else + last = emit_note_before (INTVAL (XEXP (note, 0)), last); + --- 2593,2598 ---- + { + if (INTVAL (XEXP (note, 0)) == NOTE_INSN_SETJMP) + ! CONST_CALL_P (emit_note_after (INTVAL (XEXP (note, 0)), insn)) + ! = CONST_CALL_P (note); + else + last = emit_note_before (INTVAL (XEXP (note, 0)), last); + *************** schedule_block (b, file) + *** 3174,3178 **** + b, INSN_UID (basic_block_head[b]), INSN_UID (basic_block_end[b])); + + ! i = max_reg_num (); + reg_last_uses = (rtx *) alloca (i * sizeof (rtx)); + bzero ((char *) reg_last_uses, i * sizeof (rtx)); + --- 2640,2644 ---- + b, INSN_UID (basic_block_head[b]), INSN_UID (basic_block_end[b])); + + ! reg_last_uses_size = i = max_reg_num (); + reg_last_uses = (rtx *) alloca (i * sizeof (rtx)); + bzero ((char *) reg_last_uses, i * sizeof (rtx)); + *************** schedule_block (b, file) + *** 3800,3804 **** + made live again later. */ + for (i = 0; i < FIRST_PSEUDO_REGISTER; i++) + ! if (call_used_regs[i] || global_regs[i]) + { + register int offset = i / REGSET_ELT_BITS; + --- 3266,3271 ---- + made live again later. */ + for (i = 0; i < FIRST_PSEUDO_REGISTER; i++) + ! if ((call_used_regs[i] && ! fixed_regs[i]) + ! || global_regs[i]) + { + register int offset = i / REGSET_ELT_BITS; + *************** schedule_insns (dump_file) + *** 4717,4721 **** + bcopy ((char *) reg_n_deaths, (char *) sched_reg_n_deaths, + max_regno * sizeof (short)); + - init_alias_analysis (); + } + else + --- 4184,4187 ---- + *************** schedule_insns (dump_file) + *** 4726,4732 **** + bb_dead_regs = 0; + bb_live_regs = 0; + - if (! flag_schedule_insns) + - init_alias_analysis (); + } + + if (write_symbols != NO_DEBUG) + --- 4192,4213 ---- + bb_dead_regs = 0; + bb_live_regs = 0; + } + + init_alias_analysis (); + + #if 0 + + if (dump_file) + + { + + extern rtx *reg_base_value; + + extern int reg_base_value_size; + + int i; + + for (i = 0; i < reg_base_value_size; i++) + + if (reg_base_value[i]) + + { + + fprintf (dump_file, ";; reg_base_value[%d] = ", i); + + print_rtl (dump_file, reg_base_value[i]); + + fputc ('\n', dump_file); + + } + + } + + #endif + + + + if (write_symbols != NO_DEBUG) + diff -rcp2N gcc-2.7.2.3/sdbout.c gcc-2.7.2.3.f.1/sdbout.c + *** gcc-2.7.2.3/sdbout.c Thu Jun 15 12:07:11 1995 + --- gcc-2.7.2.3.f.1/sdbout.c Mon Aug 11 05:42:22 1997 + *************** plain_type_1 (type, level) + *** 539,543 **** + sdb_dims[sdb_n_dims++] + = (TYPE_DOMAIN (type) + ! ? TREE_INT_CST_LOW (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) + 1 + : 0); + return PUSH_DERIVED_LEVEL (DT_ARY, m); + --- 539,546 ---- + sdb_dims[sdb_n_dims++] + = (TYPE_DOMAIN (type) + ! && TREE_CODE (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) == INTEGER_CST + ! && TREE_CODE (TYPE_MIN_VALUE (TYPE_DOMAIN (type))) == INTEGER_CST + ! ? (TREE_INT_CST_LOW (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) + ! - TREE_INT_CST_LOW (TYPE_MIN_VALUE (TYPE_DOMAIN (type))) + 1) + : 0); + return PUSH_DERIVED_LEVEL (DT_ARY, m); + diff -rcp2N gcc-2.7.2.3/stmt.c gcc-2.7.2.3.f.1/stmt.c + *** gcc-2.7.2.3/stmt.c Tue Sep 12 23:01:54 1995 + --- gcc-2.7.2.3.f.1/stmt.c Fri Aug 29 07:52:05 1997 + *************** fixup_gotos (thisblock, stack_level, cle + *** 1244,1249 **** + poplevel (1, 0, 0); + end_sequence (); + ! f->before_jump + ! = emit_insns_after (cleanup_insns, f->before_jump); + + f->cleanup_list_list = TREE_CHAIN (lists); + --- 1244,1250 ---- + poplevel (1, 0, 0); + end_sequence (); + ! if (cleanup_insns != 0) + ! f->before_jump + ! = emit_insns_after (cleanup_insns, f->before_jump); + + f->cleanup_list_list = TREE_CHAIN (lists); + *************** expand_expr_stmt (exp) + *** 1721,1725 **** + + last_expr_type = TREE_TYPE (exp); + ! if (! flag_syntax_only) + last_expr_value = expand_expr (exp, + (expr_stmts_for_value + --- 1722,1726 ---- + + last_expr_type = TREE_TYPE (exp); + ! if (! flag_syntax_only || expr_stmts_for_value) + last_expr_value = expand_expr (exp, + (expr_stmts_for_value + *************** expand_end_bindings (vars, mark_ends, do + *** 3160,3163 **** + --- 3161,3169 ---- + #endif + + + #ifdef HAVE_nonlocal_goto_receiver + + if (HAVE_nonlocal_goto_receiver) + + emit_insn (gen_nonlocal_goto_receiver ()); + + #endif + + + /* The handler expects the desired label address in the static chain + register. It tests the address and does an appropriate jump + *************** expand_decl (decl) + *** 3369,3395 **** + = promote_mode (type, DECL_MODE (decl), &unsignedp, 0); + + ! if (TREE_CODE (type) == COMPLEX_TYPE) + ! { + ! rtx realpart, imagpart; + ! enum machine_mode partmode = TYPE_MODE (TREE_TYPE (type)); + + ! /* For a complex type variable, make a CONCAT of two pseudos + ! so that the real and imaginary parts + ! can be allocated separately. */ + ! realpart = gen_reg_rtx (partmode); + ! REG_USERVAR_P (realpart) = 1; + ! imagpart = gen_reg_rtx (partmode); + ! REG_USERVAR_P (imagpart) = 1; + ! DECL_RTL (decl) = gen_rtx (CONCAT, reg_mode, realpart, imagpart); + ! } + ! else + ! { + ! DECL_RTL (decl) = gen_reg_rtx (reg_mode); + ! if (TREE_CODE (type) == POINTER_TYPE) + ! mark_reg_pointer (DECL_RTL (decl)); + ! REG_USERVAR_P (DECL_RTL (decl)) = 1; + ! } + } + ! else if (TREE_CODE (DECL_SIZE (decl)) == INTEGER_CST) + { + /* Variable of fixed size that goes on the stack. */ + --- 3375,3389 ---- + = promote_mode (type, DECL_MODE (decl), &unsignedp, 0); + + ! DECL_RTL (decl) = gen_reg_rtx (reg_mode); + ! mark_user_reg (DECL_RTL (decl)); + + ! if (TREE_CODE (type) == POINTER_TYPE) + ! mark_reg_pointer (DECL_RTL (decl)); + } + ! else if (TREE_CODE (DECL_SIZE (decl)) == INTEGER_CST + ! && ! (flag_stack_check && ! STACK_CHECK_BUILTIN + ! && (TREE_INT_CST_HIGH (DECL_SIZE (decl)) != 0 + ! || (TREE_INT_CST_LOW (DECL_SIZE (decl)) + ! > STACK_CHECK_MAX_VAR_SIZE * BITS_PER_UNIT)))) + { + /* Variable of fixed size that goes on the stack. */ + *************** expand_decl (decl) + *** 3462,3468 **** + free_temp_slots (); + + ! /* Allocate space on the stack for the variable. */ + address = allocate_dynamic_stack_space (size, NULL_RTX, + ! DECL_ALIGN (decl)); + + /* Reference the variable indirect through that rtx. */ + --- 3456,3465 ---- + free_temp_slots (); + + ! /* Allocate space on the stack for the variable. Note that + ! DECL_ALIGN says how the variable is to be aligned and we + ! cannot use it to conclude anything about the alignment of + ! the size. */ + address = allocate_dynamic_stack_space (size, NULL_RTX, + ! TYPE_ALIGN (TREE_TYPE (decl))); + + /* Reference the variable indirect through that rtx. */ + *************** pushcase_range (value1, value2, converte + *** 4155,4158 **** + --- 4152,4159 ---- + return 1; + + + /* Fail if the range is empty. */ + + if (tree_int_cst_lt (value2, value1)) + + return 4; + + + if (stack_block_stack + && stack_block_stack->depth > case_stack->depth) + *************** pushcase_range (value1, value2, converte + *** 4189,4197 **** + /* Convert VALUEs to type in which the comparisons are nominally done. */ + if (value1 == 0) /* Negative infinity. */ + ! value1 = TYPE_MIN_VALUE(index_type); + value1 = (*converter) (nominal_type, value1); + + if (value2 == 0) /* Positive infinity. */ + ! value2 = TYPE_MAX_VALUE(index_type); + value2 = (*converter) (nominal_type, value2); + + --- 4190,4198 ---- + /* Convert VALUEs to type in which the comparisons are nominally done. */ + if (value1 == 0) /* Negative infinity. */ + ! value1 = TYPE_MIN_VALUE (index_type); + value1 = (*converter) (nominal_type, value1); + + if (value2 == 0) /* Positive infinity. */ + ! value2 = TYPE_MAX_VALUE (index_type); + value2 = (*converter) (nominal_type, value2); + + *************** pushcase_range (value1, value2, converte + *** 4202,4209 **** + if (! int_fits_type_p (value2, index_type)) + return 3; + - + - /* Fail if the range is empty. */ + - if (tree_int_cst_lt (value2, value1)) + - return 4; + + /* If the bounds are equal, turn this into the one-value case. */ + --- 4203,4206 ---- + diff -rcp2N gcc-2.7.2.3/stor-layout.c gcc-2.7.2.3.f.1/stor-layout.c + *** gcc-2.7.2.3/stor-layout.c Sat Jun 29 16:26:51 1996 + --- gcc-2.7.2.3.f.1/stor-layout.c Mon Aug 11 10:47:50 1997 + *************** layout_decl (decl, known_align) + *** 255,259 **** + if (maximum_field_alignment != 0) + DECL_ALIGN (decl) = MIN (DECL_ALIGN (decl), maximum_field_alignment); + ! else if (flag_pack_struct) + DECL_ALIGN (decl) = MIN (DECL_ALIGN (decl), BITS_PER_UNIT); + } + --- 255,259 ---- + if (maximum_field_alignment != 0) + DECL_ALIGN (decl) = MIN (DECL_ALIGN (decl), maximum_field_alignment); + ! else if (DECL_PACKED (decl)) + DECL_ALIGN (decl) = MIN (DECL_ALIGN (decl), BITS_PER_UNIT); + } + *************** layout_decl (decl, known_align) + *** 261,265 **** + if (DECL_BIT_FIELD (decl) + && TYPE_SIZE (type) != 0 + ! && TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST) + { + register enum machine_mode xmode + --- 261,266 ---- + if (DECL_BIT_FIELD (decl) + && TYPE_SIZE (type) != 0 + ! && TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST + ! && GET_MODE_CLASS (TYPE_MODE (type)) == MODE_INT) + { + register enum machine_mode xmode + *************** layout_decl (decl, known_align) + *** 278,281 **** + --- 279,291 ---- + } + + + /* Turn off DECL_BIT_FIELD if we won't need it set. */ + + if (DECL_BIT_FIELD (decl) && TYPE_MODE (type) == BLKmode + + && known_align % TYPE_ALIGN (type) == 0 + + && DECL_SIZE (decl) != 0 + + && (TREE_CODE (DECL_SIZE (decl)) != INTEGER_CST + + || (TREE_INT_CST_LOW (DECL_SIZE (decl)) % BITS_PER_UNIT) == 0) + + && DECL_ALIGN (decl) >= TYPE_ALIGN (type)) + + DECL_BIT_FIELD (decl) = 0; + + + /* Evaluate nonconstant size only once, either now or as soon as safe. */ + if (DECL_SIZE (decl) != 0 && TREE_CODE (DECL_SIZE (decl)) != INTEGER_CST) + *************** layout_record (rec) + *** 380,384 **** + if (maximum_field_alignment != 0) + type_align = MIN (type_align, maximum_field_alignment); + ! else if (flag_pack_struct) + type_align = MIN (type_align, BITS_PER_UNIT); + + --- 390,394 ---- + if (maximum_field_alignment != 0) + type_align = MIN (type_align, maximum_field_alignment); + ! else if (TYPE_PACKED (rec)) + type_align = MIN (type_align, BITS_PER_UNIT); + + *************** layout_record (rec) + *** 422,428 **** + && DECL_BIT_FIELD_TYPE (field) + && !DECL_PACKED (field) + - /* If #pragma pack is in effect, turn off this feature. */ + && maximum_field_alignment == 0 + - && !flag_pack_struct + && !integer_zerop (DECL_SIZE (field))) + { + --- 432,436 ---- + *************** layout_record (rec) + *** 459,463 **** + if (maximum_field_alignment != 0) + type_align = MIN (type_align, maximum_field_alignment); + ! else if (flag_pack_struct) + type_align = MIN (type_align, BITS_PER_UNIT); + + --- 467,471 ---- + if (maximum_field_alignment != 0) + type_align = MIN (type_align, maximum_field_alignment); + ! else if (TYPE_PACKED (rec)) + type_align = MIN (type_align, BITS_PER_UNIT); + + *************** layout_record (rec) + *** 500,505 **** + /* Do nothing. */; + else if (TREE_CODE (dsize) == INTEGER_CST + && TREE_INT_CST_HIGH (dsize) == 0 + ! && TREE_INT_CST_LOW (dsize) + const_size > const_size) + /* Use const_size if there's no overflow. */ + const_size += TREE_INT_CST_LOW (dsize); + --- 508,514 ---- + /* Do nothing. */; + else if (TREE_CODE (dsize) == INTEGER_CST + + && ! TREE_CONSTANT_OVERFLOW (dsize) + && TREE_INT_CST_HIGH (dsize) == 0 + ! && TREE_INT_CST_LOW (dsize) + const_size >= const_size) + /* Use const_size if there's no overflow. */ + const_size += TREE_INT_CST_LOW (dsize); + *************** get_best_mode (bitsize, bitpos, align, l + *** 1172,1175 **** + --- 1181,1192 ---- + enum machine_mode mode; + int unit; + + + + if (bitpos < 0) + + { + + /* For correct calculations and convenience, bias negative bitpos + + to become a non-negative value that is [1,bitsize], such that + + the relative bit offset to a multiple of bitsize is preserved. */ + + bitpos = bitsize - ((-bitpos) % bitsize); + + } + + /* Find the narrowest integer mode that contains the bit field. */ + diff -rcp2N gcc-2.7.2.3/stupid.c gcc-2.7.2.3.f.1/stupid.c + *** gcc-2.7.2.3/stupid.c Sun Oct 29 12:45:22 1995 + --- gcc-2.7.2.3.f.1/stupid.c Sun Aug 10 22:46:01 1997 + *************** static int *uid_suid; + *** 66,69 **** + --- 66,74 ---- + static int last_call_suid; + + + /* Record the suid of the last NOTE_INSN_SETJMP + + so we can tell whether a pseudo reg crosses any setjmp. */ + + + + static int last_setjmp_suid; + + + /* Element N is suid of insn where life span of pseudo reg N ends. + Element is 0 if register N has not been seen yet on backward scan. */ + *************** static char *regs_live; + *** 89,92 **** + --- 94,101 ---- + static char *regs_change_size; + + + /* Indexed by reg number, nonzero if reg crosses a setjmp. */ + + + + static char *regs_crosses_setjmp; + + + /* Indexed by insn's suid, the set of hard regs live after that insn. */ + + *************** stupid_life_analysis (f, nregs, file) + *** 149,152 **** + --- 158,162 ---- + + last_call_suid = i + 1; + + last_setjmp_suid = i + 1; + max_suid = i + 1; + + *************** stupid_life_analysis (f, nregs, file) + *** 167,170 **** + --- 177,183 ---- + bzero ((char *) regs_change_size, nregs * sizeof (char)); + + + regs_crosses_setjmp = (char *) alloca (nregs * sizeof (char)); + + bzero ((char *) regs_crosses_setjmp, nregs * sizeof (char)); + + + reg_renumber = (short *) oballoc (nregs * sizeof (short)); + for (i = 0; i < FIRST_PSEUDO_REGISTER; i++) + *************** stupid_life_analysis (f, nregs, file) + *** 216,219 **** + --- 229,236 ---- + stupid_mark_refs (PATTERN (insn), insn); + + + if (GET_CODE (insn) == NOTE + + && NOTE_LINE_NUMBER (insn) == NOTE_INSN_SETJMP) + + last_setjmp_suid = INSN_SUID (insn); + + + /* Mark all call-clobbered regs as live after each call insn + so that a pseudo whose life span includes this insn + *************** stupid_life_analysis (f, nregs, file) + *** 254,259 **** + register int r = reg_order[i]; + + ! /* Some regnos disappear from the rtl. Ignore them to avoid crash. */ + ! if (regno_reg_rtx[r] == 0) + continue; + + --- 271,277 ---- + register int r = reg_order[i]; + + ! /* Some regnos disappear from the rtl. Ignore them to avoid crash. + ! Also don't allocate registers that cross a setjmp. */ + ! if (regno_reg_rtx[r] == 0 || regs_crosses_setjmp[r]) + continue; + + *************** stupid_reg_compare (r1p, r2p) + *** 309,314 **** + that can hold a value of machine-mode MODE + (but actually we test only the first of the block for holding MODE) + ! currently free from after insn whose suid is BIRTH + ! through the insn whose suid is DEATH, + and return the number of the first of them. + Return -1 if such a block cannot be found. + --- 327,332 ---- + that can hold a value of machine-mode MODE + (but actually we test only the first of the block for holding MODE) + ! currently free from after insn whose suid is BORN_INSN + ! through the insn whose suid is DEAD_INSN, + and return the number of the first of them. + Return -1 if such a block cannot be found. + *************** stupid_find_reg (call_preserved, class, + *** 338,341 **** + --- 356,366 ---- + #endif + + + /* If this register's life is more than 5,000 insns, we probably + + can't allocate it, so don't waste the time trying. This avoid + + quadratic behavior on programs that have regularly-occurring + + SAVE_EXPRs. */ + + if (dead_insn > born_insn + 5000) + + return -1; + + + COPY_HARD_REG_SET (used, + call_preserved ? call_used_reg_set : fixed_reg_set); + *************** stupid_mark_refs (x, insn) + *** 488,491 **** + --- 513,519 ---- + if (last_call_suid < reg_where_dead[regno]) + reg_n_calls_crossed[regno] += 1; + + + + if (last_setjmp_suid < reg_where_dead[regno]) + + regs_crosses_setjmp[regno] = 1; + } + } + diff -rcp2N gcc-2.7.2.3/tm.texi gcc-2.7.2.3.f.1/tm.texi + *** gcc-2.7.2.3/tm.texi Sun Sep 3 12:59:01 1995 + --- gcc-2.7.2.3.f.1/tm.texi Fri Aug 29 07:52:19 1997 + *************** This describes the stack layout and call + *** 1951,1954 **** + --- 1951,1955 ---- + @menu + * Frame Layout:: + + * Stack Checking:: + * Frame Registers:: + * Elimination:: + *************** This discusses registers that address th + *** 2070,2073 **** + --- 2071,2156 ---- + @table @code + @findex STACK_POINTER_REGNUM + + @end table + + + + @node Stack Checking + + @subsection Specifying How Stack Checking is Done + + + + GNU CC will check that stack references are within the boundaries of + + the stack, if the @samp{-fstack-check} is specified, in one of three ways: + + + + @enumerate + + @item + + If the value of the @code{STACK_CHECK_BUILTIN} macro is nonzero, GNU CC + + will assume that you have arranged for stack checking to be done at + + appropriate places in the configuration files, e.g., in + + @code{FUNCTION_PROLOGUE}. GNU CC will do not other special processing. + + + + @item + + If @code{STACK_CHECK_BUILTIN} is zero and you defined a named pattern + + called @code{check_stack} in your @file{md} file, GNU CC will call that + + pattern with one argument which is the address to compare the stack + + value against. You must arrange for this pattern to report an error if + + the stack pointer is out of range. + + + + @item + + If neither of the above are true, GNU CC will generate code to periodically + + ``probe'' the stack pointer using the values of the macros defined below. + + @end enumerate + + + + Normally, you will use the default values of these macros, so GNU CC + + will use the third approach. + + + + @table @code + + @findex STACK_CHECK_BUILTIN + + @item STACK_CHECK_BUILTIN + + A nonzero value if stack checking is done by the configuration files in a + + machine-dependent manner. You should define this macro if stack checking + + is require by the ABI of your machine or if you would like to have to stack + + checking in some more efficient way than GNU CC's portable approach. + + The default value of this macro is zero. + + + + @findex STACK_CHECK_PROBE_INTERVAL + + @item STACK_CHECK_PROBE_INTERVAL + + An integer representing the interval at which GNU CC must generate stack + + probe instructions. You will normally define this macro to be no larger + + than the size of the ``guard pages'' at the end of a stack area. The + + default value of 4096 is suitable for most systems. + + + + @findex STACK_CHECK_PROBE_LOAD + + @item STACK_CHECK_PROBE_LOAD + + A integer which is nonzero if GNU CC should perform the stack probe + + as a load instruction and zero if GNU CC should use a store instruction. + + The default is zero, which is the most efficient choice on most systems. + + + + @findex STACK_CHECK_PROTECT + + @item STACK_CHECK_PROTECT + + The number of bytes of stack needed to recover from a stack overflow, + + for languages where such a recovery is supported. The default value of + + 75 words should be adequate for most machines. + + + + @findex STACK_CHECK_MAX_FRAME_SIZE + + @item STACK_CHECK_MAX_FRAME_SIZE + + The maximum size of a stack frame, in bytes. GNU CC will generate probe + + instructions in non-leaf functions to ensure at least this many bytes of + + stack are available. If a stack frame is larger than this size, stack + + checking will not be reliable and GNU CC will issue a warning. The + + default is chosen so that GNU CC only generates one instruction on most + + systems. You should normally not change the default value of this macro. + + + + @findex STACK_CHECK_FIXED_FRAME_SIZE + + @item STACK_CHECK_FIXED_FRAME_SIZE + + GNU CC uses this value to generate the above warning message. It + + represents the amount of fixed frame used by a function, not including + + space for any callee-saved registers, temporaries and user variables. + + You need only specify an upper bound for this amount and will normally + + use the default of four words. + + + + @findex STACK_CHECK_MAX_VAR_SIZE + + @item STACK_CHECK_MAX_VAR_SIZE + + The maximum size, in bytes, of an object that GNU CC will place in the + + fixed area of the stack frame when the user specifies + + @samp{-fstack-check}. + + GNU CC computed the default from the values of the above macros and you will + + normally not need to override that default. + @item STACK_POINTER_REGNUM + The register number of the stack pointer register, which must also be a + diff -rcp2N gcc-2.7.2.3/toplev.c gcc-2.7.2.3.f.1/toplev.c + *** gcc-2.7.2.3/toplev.c Fri Oct 20 21:56:35 1995 + --- gcc-2.7.2.3.f.1/toplev.c Fri Aug 29 09:13:14 1997 + *************** int flag_unroll_loops; + *** 388,391 **** + --- 388,405 ---- + int flag_unroll_all_loops; + + + /* Nonzero forces all invariant computations in loops to be moved + + outside the loop. */ + + + + int flag_move_all_movables = 0; + + + + /* Nonzero forces all general induction variables in loops to be + + strength reduced. */ + + + + int flag_reduce_all_givs = 0; + + + + /* Nonzero gets another run of loop_optimize performed. */ + + + + int flag_rerun_loop_opt = 0; + + + /* Nonzero for -fwritable-strings: + store string constants in data segment and don't uniquize them. */ + *************** int flag_gnu_linker = 1; + *** 522,525 **** + --- 536,554 ---- + int flag_pack_struct = 0; + + + /* 1 if alias checking is on (by default, when -O). */ + + int flag_alias_check = 0; + + + + /* 0 if pointer arguments may alias each other. True in C. + + 1 if pointer arguments may not alias each other but may alias + + global variables. + + 2 if pointer arguments may not alias each other and may not + + alias global variables. True in Fortran. + + This defaults to 0 for C. */ + + int flag_argument_noalias = 0; + + + + /* Emit code to check for stack overflow; also may cause large objects + + to be allocated dynamically. */ + + int flag_stack_check; + + + /* Table of language-independent -f options. + STRING is the option name. VARIABLE is the address of the variable. + *************** struct { char *string; int *variable; in + *** 542,545 **** + --- 571,577 ---- + {"unroll-loops", &flag_unroll_loops, 1}, + {"unroll-all-loops", &flag_unroll_all_loops, 1}, + + {"move-all-movables", &flag_move_all_movables, 1}, + + {"reduce-all-givs", &flag_reduce_all_givs, 1}, + + {"rerun-loop-opt", &flag_rerun_loop_opt, 1}, + {"writable-strings", &flag_writable_strings, 1}, + {"peephole", &flag_no_peephole, 0}, + *************** struct { char *string; int *variable; in + *** 568,572 **** + {"gnu-linker", &flag_gnu_linker, 1}, + {"pack-struct", &flag_pack_struct, 1}, + ! {"bytecode", &output_bytecode, 1} + }; + + --- 600,609 ---- + {"gnu-linker", &flag_gnu_linker, 1}, + {"pack-struct", &flag_pack_struct, 1}, + ! {"bytecode", &output_bytecode, 1}, + ! {"alias-check", &flag_alias_check, 1}, + ! {"argument-alias", &flag_argument_noalias, 0}, + ! {"argument-noalias", &flag_argument_noalias, 1}, + ! {"argument-noalias-global", &flag_argument_noalias, 2}, + ! {"stack-check", &flag_stack_check, 1} + }; + + *************** rest_of_compilation (decl) + *** 2715,2725 **** + finish_compilation will call rest_of_compilation again + for those functions that need to be output. Also defer those + ! functions that we are supposed to defer. */ + ! + ! if (DECL_DEFER_OUTPUT (decl) + ! || ((specd || DECL_INLINE (decl)) + ! && ((! TREE_PUBLIC (decl) && ! TREE_ADDRESSABLE (decl) + ! && ! flag_keep_inline_functions) + ! || DECL_EXTERNAL (decl)))) + { + DECL_DEFER_OUTPUT (decl) = 1; + --- 2752,2765 ---- + finish_compilation will call rest_of_compilation again + for those functions that need to be output. Also defer those + ! functions that we are supposed to defer. We cannot defer + ! functions containing nested functions since the nested function + ! data is in our non-saved obstack. */ + ! + ! if (! current_function_contains_functions + ! && (DECL_DEFER_OUTPUT (decl) + ! || ((specd || DECL_INLINE (decl)) + ! && ((! TREE_PUBLIC (decl) && ! TREE_ADDRESSABLE (decl) + ! && ! flag_keep_inline_functions) + ! || DECL_EXTERNAL (decl))))) + { + DECL_DEFER_OUTPUT (decl) = 1; + *************** rest_of_compilation (decl) + *** 2893,2897 **** + --- 2933,2956 ---- + TIMEVAR (loop_time, + { + + int save_unroll_flag; + + int save_unroll_all_flag; + + + + if (flag_rerun_loop_opt) + + { + + save_unroll_flag = flag_unroll_loops; + + save_unroll_all_flag = flag_unroll_all_loops; + + flag_unroll_loops = 0; + + flag_unroll_all_loops = 0; + + } + + + loop_optimize (insns, loop_dump_file); + + + + if (flag_rerun_loop_opt) + + { + + flag_unroll_loops = save_unroll_flag; + + flag_unroll_all_loops = save_unroll_all_flag; + + + + loop_optimize (insns, loop_dump_file); + + } + }); + } + *************** rest_of_compilation (decl) + *** 3280,3283 **** + --- 3339,3346 ---- + resume_temporary_allocation (); + + + /* Show no temporary slots allocated. */ + + + + init_temp_slots (); + + + /* The parsing time is all the time spent in yyparse + *except* what is spent in this function. */ + *************** main (argc, argv, envp) + *** 3383,3386 **** + --- 3446,3450 ---- + flag_omit_frame_pointer = 1; + #endif + + flag_alias_check = 1; + } + + diff -rcp2N gcc-2.7.2.3/tree.c gcc-2.7.2.3.f.1/tree.c + *** gcc-2.7.2.3/tree.c Mon Oct 2 01:26:56 1995 + --- gcc-2.7.2.3.f.1/tree.c Fri Aug 29 08:15:03 1997 + *************** build_string (len, str) + *** 1428,1436 **** + /* Return a newly constructed COMPLEX_CST node whose value is + specified by the real and imaginary parts REAL and IMAG. + ! Both REAL and IMAG should be constant nodes. + ! The TREE_TYPE is not initialized. */ + + tree + ! build_complex (real, imag) + tree real, imag; + { + --- 1428,1437 ---- + /* Return a newly constructed COMPLEX_CST node whose value is + specified by the real and imaginary parts REAL and IMAG. + ! Both REAL and IMAG should be constant nodes. TYPE, if specified, + ! will be the type of the COMPLEX_CST; otherwise a new type will be made. */ + + tree + ! build_complex (type, real, imag) + ! tree type; + tree real, imag; + { + *************** build_complex (real, imag) + *** 1439,1443 **** + TREE_REALPART (t) = real; + TREE_IMAGPART (t) = imag; + ! TREE_TYPE (t) = build_complex_type (TREE_TYPE (real)); + TREE_OVERFLOW (t) = TREE_OVERFLOW (real) | TREE_OVERFLOW (imag); + TREE_CONSTANT_OVERFLOW (t) + --- 1440,1444 ---- + TREE_REALPART (t) = real; + TREE_IMAGPART (t) = imag; + ! TREE_TYPE (t) = type ? type : build_complex_type (TREE_TYPE (real)); + TREE_OVERFLOW (t) = TREE_OVERFLOW (real) | TREE_OVERFLOW (imag); + TREE_CONSTANT_OVERFLOW (t) + *************** integer_zerop (expr) + *** 1484,1487 **** + --- 1485,1489 ---- + + return ((TREE_CODE (expr) == INTEGER_CST + + && ! TREE_CONSTANT_OVERFLOW (expr) + && TREE_INT_CST_LOW (expr) == 0 + && TREE_INT_CST_HIGH (expr) == 0) + *************** integer_onep (expr) + *** 1501,1504 **** + --- 1503,1507 ---- + + return ((TREE_CODE (expr) == INTEGER_CST + + && ! TREE_CONSTANT_OVERFLOW (expr) + && TREE_INT_CST_LOW (expr) == 1 + && TREE_INT_CST_HIGH (expr) == 0) + *************** integer_all_onesp (expr) + *** 1525,1529 **** + return 1; + + ! else if (TREE_CODE (expr) != INTEGER_CST) + return 0; + + --- 1528,1533 ---- + return 1; + + ! else if (TREE_CODE (expr) != INTEGER_CST + ! || TREE_CONSTANT_OVERFLOW (expr)) + return 0; + + *************** integer_pow2p (expr) + *** 1574,1578 **** + return 1; + + ! if (TREE_CODE (expr) != INTEGER_CST) + return 0; + + --- 1578,1582 ---- + return 1; + + ! if (TREE_CODE (expr) != INTEGER_CST || TREE_CONSTANT_OVERFLOW (expr)) + return 0; + + *************** real_zerop (expr) + *** 1596,1599 **** + --- 1600,1604 ---- + + return ((TREE_CODE (expr) == REAL_CST + + && ! TREE_CONSTANT_OVERFLOW (expr) + && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst0)) + || (TREE_CODE (expr) == COMPLEX_CST + *************** real_onep (expr) + *** 1611,1614 **** + --- 1616,1620 ---- + + return ((TREE_CODE (expr) == REAL_CST + + && ! TREE_CONSTANT_OVERFLOW (expr) + && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst1)) + || (TREE_CODE (expr) == COMPLEX_CST + *************** real_twop (expr) + *** 1626,1629 **** + --- 1632,1636 ---- + + return ((TREE_CODE (expr) == REAL_CST + + && ! TREE_CONSTANT_OVERFLOW (expr) + && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst2)) + || (TREE_CODE (expr) == COMPLEX_CST + *************** staticp (arg) + *** 2055,2061 **** + return 1; + + case COMPONENT_REF: + case BIT_FIELD_REF: + ! return staticp (TREE_OPERAND (arg, 0)); + + #if 0 + --- 2062,2073 ---- + return 1; + + + /* If we are referencing a bitfield, we can't evaluate an + + ADDR_EXPR at compile time and so it isn't a constant. */ + case COMPONENT_REF: + + return (! DECL_BIT_FIELD (TREE_OPERAND (arg, 1)) + + && staticp (TREE_OPERAND (arg, 0))); + + + case BIT_FIELD_REF: + ! return 0; + + #if 0 + *************** save_expr (expr) + *** 2141,2148 **** + + /* Return 1 if EXP contains a PLACEHOLDER_EXPR; i.e., if it represents a size + ! or offset that depends on a field within a record. + ! + ! Note that we only allow such expressions within simple arithmetic + ! or a COND_EXPR. */ + + int + --- 2153,2157 ---- + + /* Return 1 if EXP contains a PLACEHOLDER_EXPR; i.e., if it represents a size + ! or offset that depends on a field within a record. */ + + int + *************** contains_placeholder_p (exp) + *** 2151,2155 **** + { + register enum tree_code code = TREE_CODE (exp); + - tree inner; + + /* If we have a WITH_RECORD_EXPR, it "cancels" any PLACEHOLDER_EXPR + --- 2160,2163 ---- + *************** contains_placeholder_p (exp) + *** 2157,2173 **** + if (code == WITH_RECORD_EXPR) + return 0; + + switch (TREE_CODE_CLASS (code)) + { + case 'r': + ! for (inner = TREE_OPERAND (exp, 0); + ! TREE_CODE_CLASS (TREE_CODE (inner)) == 'r'; + ! inner = TREE_OPERAND (inner, 0)) + ! ; + ! return TREE_CODE (inner) == PLACEHOLDER_EXPR; + + case '1': + case '2': case '<': + case 'e': + switch (tree_code_length[(int) code]) + { + --- 2165,2203 ---- + if (code == WITH_RECORD_EXPR) + return 0; + + else if (code == PLACEHOLDER_EXPR) + + return 1; + + switch (TREE_CODE_CLASS (code)) + { + case 'r': + ! /* Don't look at any PLACEHOLDER_EXPRs that might be in index or bit + ! position computations since they will be converted into a + ! WITH_RECORD_EXPR involving the reference, which will assume + ! here will be valid. */ + ! return contains_placeholder_p (TREE_OPERAND (exp, 0)); + + case '1': + case '2': case '<': + case 'e': + + switch (code) + + { + + case COMPOUND_EXPR: + + /* Ignoring the first operand isn't quite right, but works best. */ + + return contains_placeholder_p (TREE_OPERAND (exp, 1)); + + + + case RTL_EXPR: + + case CONSTRUCTOR: + + return 0; + + + + case COND_EXPR: + + return (contains_placeholder_p (TREE_OPERAND (exp, 0)) + + || contains_placeholder_p (TREE_OPERAND (exp, 1)) + + || contains_placeholder_p (TREE_OPERAND (exp, 2))); + + + + case SAVE_EXPR: + + return (SAVE_EXPR_RTL (exp) == 0 + + && contains_placeholder_p (TREE_OPERAND (exp, 0))); + + } + + + switch (tree_code_length[(int) code]) + { + *************** contains_placeholder_p (exp) + *** 2175,2189 **** + return contains_placeholder_p (TREE_OPERAND (exp, 0)); + case 2: + ! return (code != RTL_EXPR + ! && code != CONSTRUCTOR + ! && ! (code == SAVE_EXPR && SAVE_EXPR_RTL (exp) != 0) + ! && code != WITH_RECORD_EXPR + ! && (contains_placeholder_p (TREE_OPERAND (exp, 0)) + ! || contains_placeholder_p (TREE_OPERAND (exp, 1)))); + ! case 3: + ! return (code == COND_EXPR + ! && (contains_placeholder_p (TREE_OPERAND (exp, 0)) + ! || contains_placeholder_p (TREE_OPERAND (exp, 1)) + ! || contains_placeholder_p (TREE_OPERAND (exp, 2)))); + } + } + --- 2205,2210 ---- + return contains_placeholder_p (TREE_OPERAND (exp, 0)); + case 2: + ! return (contains_placeholder_p (TREE_OPERAND (exp, 0)) + ! || contains_placeholder_p (TREE_OPERAND (exp, 1))); + } + } + *************** substitute_in_expr (exp, f, r) + *** 2204,2207 **** + --- 2225,2229 ---- + { + enum tree_code code = TREE_CODE (exp); + + tree op0, op1, op2; + tree new = 0; + tree inner; + *************** substitute_in_expr (exp, f, r) + *** 2225,2231 **** + { + case 1: + ! new = fold (build1 (code, TREE_TYPE (exp), + ! substitute_in_expr (TREE_OPERAND (exp, 0), + ! f, r))); + break; + + --- 2247,2255 ---- + { + case 1: + ! op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r); + ! if (op0 == TREE_OPERAND (exp, 0)) + ! return exp; + ! + ! new = fold (build1 (code, TREE_TYPE (exp), op0)); + break; + + *************** substitute_in_expr (exp, f, r) + *** 2238,2245 **** + abort (); + + ! new = fold (build (code, TREE_TYPE (exp), + ! substitute_in_expr (TREE_OPERAND (exp, 0), f, r), + ! substitute_in_expr (TREE_OPERAND (exp, 1), + ! f, r))); + break; + + --- 2262,2271 ---- + abort (); + + ! op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r); + ! op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r); + ! if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1)) + ! return exp; + ! + ! new = fold (build (code, TREE_TYPE (exp), op0, op1)); + break; + + *************** substitute_in_expr (exp, f, r) + *** 2253,2261 **** + abort (); + + ! new = fold (build (code, TREE_TYPE (exp), + ! substitute_in_expr (TREE_OPERAND (exp, 0), f, r), + ! substitute_in_expr (TREE_OPERAND (exp, 1), f, r), + ! substitute_in_expr (TREE_OPERAND (exp, 2), + ! f, r))); + } + + --- 2279,2290 ---- + abort (); + + ! op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r); + ! op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r); + ! op2 = substitute_in_expr (TREE_OPERAND (exp, 2), f, r); + ! if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1) + ! && op2 == TREE_OPERAND (exp, 2)) + ! return exp; + ! + ! new = fold (build (code, TREE_TYPE (exp), op0, op1, op2)); + } + + *************** substitute_in_expr (exp, f, r) + *** 2276,2302 **** + return r; + + ! new = fold (build (code, TREE_TYPE (exp), + ! substitute_in_expr (TREE_OPERAND (exp, 0), f, r), + TREE_OPERAND (exp, 1))); + break; + + case BIT_FIELD_REF: + ! new = fold (build (code, TREE_TYPE (exp), + ! substitute_in_expr (TREE_OPERAND (exp, 0), f, r), + ! substitute_in_expr (TREE_OPERAND (exp, 1), f, r), + ! substitute_in_expr (TREE_OPERAND (exp, 2), f, r))); + break; + + case INDIRECT_REF: + case BUFFER_REF: + ! new = fold (build1 (code, TREE_TYPE (exp), + ! substitute_in_expr (TREE_OPERAND (exp, 0), + ! f, r))); + break; + + case OFFSET_REF: + ! new = fold (build (code, TREE_TYPE (exp), + ! substitute_in_expr (TREE_OPERAND (exp, 0), f, r), + ! substitute_in_expr (TREE_OPERAND (exp, 1), f, r))); + break; + } + --- 2305,2349 ---- + return r; + + ! /* If this expression hasn't been completed let, leave it + ! alone. */ + ! if (TREE_CODE (inner) == PLACEHOLDER_EXPR + ! && TREE_TYPE (inner) == 0) + ! return exp; + ! + ! op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r); + ! if (op0 == TREE_OPERAND (exp, 0)) + ! return exp; + ! + ! new = fold (build (code, TREE_TYPE (exp), op0, + TREE_OPERAND (exp, 1))); + break; + + case BIT_FIELD_REF: + ! op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r); + ! op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r); + ! op2 = substitute_in_expr (TREE_OPERAND (exp, 2), f, r); + ! if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1) + ! && op2 == TREE_OPERAND (exp, 2)) + ! return exp; + ! + ! new = fold (build (code, TREE_TYPE (exp), op0, op1, op2)); + break; + + case INDIRECT_REF: + case BUFFER_REF: + ! op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r); + ! if (op0 == TREE_OPERAND (exp, 0)) + ! return exp; + ! + ! new = fold (build1 (code, TREE_TYPE (exp), op0)); + break; + + case OFFSET_REF: + ! op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r); + ! op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r); + ! if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1)) + ! return exp; + ! + ! new = fold (build (code, TREE_TYPE (exp), op0, op1)); + break; + } + *************** substitute_in_expr (exp, f, r) + *** 2311,2454 **** + } + + - /* Given a type T, a FIELD_DECL F, and a replacement value R, + - return a new type with all size expressions that contain F + - updated by replacing F with R. */ + - + - tree + - substitute_in_type (t, f, r) + - tree t, f, r; + - { + - switch (TREE_CODE (t)) + - { + - case POINTER_TYPE: + - case VOID_TYPE: + - return t; + - case INTEGER_TYPE: + - case ENUMERAL_TYPE: + - case BOOLEAN_TYPE: + - case CHAR_TYPE: + - if ((TREE_CODE (TYPE_MIN_VALUE (t)) != INTEGER_CST + - && contains_placeholder_p (TYPE_MIN_VALUE (t))) + - || (TREE_CODE (TYPE_MAX_VALUE (t)) != INTEGER_CST + - && contains_placeholder_p (TYPE_MAX_VALUE (t)))) + - return build_range_type (t, + - substitute_in_expr (TYPE_MIN_VALUE (t), f, r), + - substitute_in_expr (TYPE_MAX_VALUE (t), f, r)); + - return t; + - + - case REAL_TYPE: + - if ((TYPE_MIN_VALUE (t) != 0 + - && TREE_CODE (TYPE_MIN_VALUE (t)) != REAL_CST + - && contains_placeholder_p (TYPE_MIN_VALUE (t))) + - || (TYPE_MAX_VALUE (t) != 0 + - && TREE_CODE (TYPE_MAX_VALUE (t)) != REAL_CST + - && contains_placeholder_p (TYPE_MAX_VALUE (t)))) + - { + - t = build_type_copy (t); + - + - if (TYPE_MIN_VALUE (t)) + - TYPE_MIN_VALUE (t) = substitute_in_expr (TYPE_MIN_VALUE (t), f, r); + - if (TYPE_MAX_VALUE (t)) + - TYPE_MAX_VALUE (t) = substitute_in_expr (TYPE_MAX_VALUE (t), f, r); + - } + - return t; + - + - case COMPLEX_TYPE: + - return build_complex_type (substitute_in_type (TREE_TYPE (t), f, r)); + - + - case OFFSET_TYPE: + - case METHOD_TYPE: + - case REFERENCE_TYPE: + - case FILE_TYPE: + - case SET_TYPE: + - case FUNCTION_TYPE: + - case LANG_TYPE: + - /* Don't know how to do these yet. */ + - abort (); + - + - case ARRAY_TYPE: + - t = build_array_type (substitute_in_type (TREE_TYPE (t), f, r), + - substitute_in_type (TYPE_DOMAIN (t), f, r)); + - TYPE_SIZE (t) = 0; + - layout_type (t); + - return t; + - + - case RECORD_TYPE: + - case UNION_TYPE: + - case QUAL_UNION_TYPE: + - { + - tree new = copy_node (t); + - tree field; + - tree last_field = 0; + - + - /* Start out with no fields, make new fields, and chain them + - in. */ + - + - TYPE_FIELDS (new) = 0; + - TYPE_SIZE (new) = 0; + - + - for (field = TYPE_FIELDS (t); field; + - field = TREE_CHAIN (field)) + - { + - tree new_field = copy_node (field); + - + - TREE_TYPE (new_field) + - = substitute_in_type (TREE_TYPE (new_field), f, r); + - + - /* If this is an anonymous field and the type of this field is + - a UNION_TYPE or RECORD_TYPE with no elements, ignore it. If + - the type just has one element, treat that as the field. + - But don't do this if we are processing a QUAL_UNION_TYPE. */ + - if (TREE_CODE (t) != QUAL_UNION_TYPE && DECL_NAME (new_field) == 0 + - && (TREE_CODE (TREE_TYPE (new_field)) == UNION_TYPE + - || TREE_CODE (TREE_TYPE (new_field)) == RECORD_TYPE)) + - { + - if (TYPE_FIELDS (TREE_TYPE (new_field)) == 0) + - continue; + - + - if (TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (new_field))) == 0) + - new_field = TYPE_FIELDS (TREE_TYPE (new_field)); + - } + - + - DECL_CONTEXT (new_field) = new; + - DECL_SIZE (new_field) = 0; + - + - if (TREE_CODE (t) == QUAL_UNION_TYPE) + - { + - /* Do the substitution inside the qualifier and if we find + - that this field will not be present, omit it. */ + - DECL_QUALIFIER (new_field) + - = substitute_in_expr (DECL_QUALIFIER (field), f, r); + - if (integer_zerop (DECL_QUALIFIER (new_field))) + - continue; + - } + - + - if (last_field == 0) + - TYPE_FIELDS (new) = new_field; + - else + - TREE_CHAIN (last_field) = new_field; + - + - last_field = new_field; + - + - /* If this is a qualified type and this field will always be + - present, we are done. */ + - if (TREE_CODE (t) == QUAL_UNION_TYPE + - && integer_onep (DECL_QUALIFIER (new_field))) + - break; + - } + - + - /* If this used to be a qualified union type, but we now know what + - field will be present, make this a normal union. */ + - if (TREE_CODE (new) == QUAL_UNION_TYPE + - && (TYPE_FIELDS (new) == 0 + - || integer_onep (DECL_QUALIFIER (TYPE_FIELDS (new))))) + - TREE_SET_CODE (new, UNION_TYPE); + - + - layout_type (new); + - return new; + - } + - } + - } + - + /* Stabilize a reference so that we can use it any number of times + without causing its operands to be evaluated more than once. + --- 2358,2361 ---- + *************** build_type_variant (type, constp, volati + *** 3141,3145 **** + preserve the TYPE_NAME, since there is code that depends on this. */ + + ! for (t = TYPE_MAIN_VARIANT(type); t; t = TYPE_NEXT_VARIANT (t)) + if (constp == TYPE_READONLY (t) && volatilep == TYPE_VOLATILE (t) + && TYPE_NAME (t) == TYPE_NAME (type)) + --- 3048,3052 ---- + preserve the TYPE_NAME, since there is code that depends on this. */ + + ! for (t = TYPE_MAIN_VARIANT (type); t; t = TYPE_NEXT_VARIANT (t)) + if (constp == TYPE_READONLY (t) && volatilep == TYPE_VOLATILE (t) + && TYPE_NAME (t) == TYPE_NAME (type)) + *************** get_unwidened (op, for_type) + *** 4051,4055 **** + if (TREE_CODE (op) == COMPONENT_REF + /* Since type_for_size always gives an integer type. */ + ! && TREE_CODE (type) != REAL_TYPE) + { + unsigned innerprec = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1))); + --- 3958,3964 ---- + if (TREE_CODE (op) == COMPONENT_REF + /* Since type_for_size always gives an integer type. */ + ! && TREE_CODE (type) != REAL_TYPE + ! /* Don't crash if field not layed out yet. */ + ! && DECL_SIZE (TREE_OPERAND (op, 1)) != 0) + { + unsigned innerprec = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1))); + diff -rcp2N gcc-2.7.2.3/tree.h gcc-2.7.2.3.f.1/tree.h + *** gcc-2.7.2.3/tree.h Mon Sep 25 21:49:40 1995 + --- gcc-2.7.2.3.f.1/tree.h Sun Aug 10 22:47:08 1997 + *************** enum built_in_function + *** 98,101 **** + --- 98,103 ---- + BUILT_IN_APPLY, + BUILT_IN_RETURN, + + BUILT_IN_SETJMP, + + BUILT_IN_LONGJMP, + + /* C++ extensions */ + *************** struct tree_int_cst + *** 408,411 **** + --- 410,415 ---- + { + char common[sizeof (struct tree_common)]; + + struct rtx_def *rtl; /* acts as link to register transfer language + + (rtl) info */ + HOST_WIDE_INT int_cst_low; + HOST_WIDE_INT int_cst_high; + *************** struct tree_type + *** 957,960 **** + --- 961,967 ---- + #define DECL_STATIC_DESTRUCTOR(NODE) ((NODE)->decl.static_dtor_flag) + + + /* In a PARM_DECL, nonzero if this is a restricted pointer. */ + + #define DECL_RESTRICT(NODE) (NODE)->decl.static_ctor_flag + + + /* Used to indicate that this DECL represents a compiler-generated entity. */ + #define DECL_ARTIFICIAL(NODE) ((NODE)->decl.artificial_flag) + *************** extern tree build_int_2_wide PROTO((HOS + *** 1176,1180 **** + extern tree build_real PROTO((tree, REAL_VALUE_TYPE)); + extern tree build_real_from_int_cst PROTO((tree, tree)); + ! extern tree build_complex PROTO((tree, tree)); + extern tree build_string PROTO((int, char *)); + extern tree build1 PROTO((enum tree_code, tree, tree)); + --- 1183,1187 ---- + extern tree build_real PROTO((tree, REAL_VALUE_TYPE)); + extern tree build_real_from_int_cst PROTO((tree, tree)); + ! extern tree build_complex PROTO((tree, tree, tree)); + extern tree build_string PROTO((int, char *)); + extern tree build1 PROTO((enum tree_code, tree, tree)); + *************** extern int contains_placeholder_p PROTO( + *** 1378,1387 **** + extern tree substitute_in_expr PROTO((tree, tree, tree)); + + - /* Given a type T, a FIELD_DECL F, and a replacement value R, + - return a new type with all size expressions that contain F + - updated by replacing the reference to F with R. */ + - + - extern tree substitute_in_type PROTO((tree, tree, tree)); + - + /* variable_size (EXP) is like save_expr (EXP) except that it + is for the special case of something that is part of a + --- 1385,1388 ---- + *************** extern tree maybe_build_cleanup PROTO(( + *** 1456,1460 **** + and find the ultimate containing object, which is returned. */ + + ! extern tree get_inner_reference PROTO((tree, int *, int *, tree *, enum machine_mode *, int *, int *)); + + /* Return the FUNCTION_DECL which provides this _DECL with its context, + --- 1457,1463 ---- + and find the ultimate containing object, which is returned. */ + + ! extern tree get_inner_reference PROTO((tree, int *, int *, tree *, + ! enum machine_mode *, int *, + ! int *, int *)); + + /* Return the FUNCTION_DECL which provides this _DECL with its context, + diff -rcp2N gcc-2.7.2.3/unroll.c gcc-2.7.2.3.f.1/unroll.c + *** gcc-2.7.2.3/unroll.c Sun Aug 31 09:39:49 1997 + --- gcc-2.7.2.3.f.1/unroll.c Sun Aug 31 09:21:17 1997 + *************** unroll_loop (loop_end, insn_count, loop_ + *** 268,273 **** + structure of the function. This can happen as a result of the + "if (foo) bar; else break;" optimization in jump.c. */ + + ! if (write_symbols != NO_DEBUG) + { + int block_begins = 0; + --- 268,277 ---- + structure of the function. This can happen as a result of the + "if (foo) bar; else break;" optimization in jump.c. */ + + /* ??? Gcc has a general policy that -g is never supposed to change the code + + that the compiler emits, so we must disable this optimization always, + + even if debug info is not being output. This is rare, so this should + + not be a significant performance problem. */ + + ! if (1 /* write_symbols != NO_DEBUG */) + { + int block_begins = 0; + *************** unroll_loop (loop_end, insn_count, loop_ + *** 633,636 **** + --- 637,657 ---- + } + + + if (unroll_type == UNROLL_NAIVE + + && GET_CODE (last_loop_insn) == JUMP_INSN + + && start_label != JUMP_LABEL (last_loop_insn)) + + { + + /* ??? The loop ends with a conditional branch that does not branch back + + to the loop start label. In this case, we must emit an unconditional + + branch to the loop exit after emitting the final branch. + + copy_loop_body does not have support for this currently, so we + + give up. It doesn't seem worthwhile to unroll anyways since + + unrolling would increase the number of branch instructions + + executed. */ + + if (loop_dump_stream) + + fprintf (loop_dump_stream, + + "Unrolling failure: final conditional branch not to loop start\n"); + + return; + + } + + + /* Allocate a translation table for the labels and insn numbers. + They will be filled in as we copy the insns in the loop. */ + *************** unroll_loop (loop_end, insn_count, loop_ + *** 995,999 **** + for (j = FIRST_PSEUDO_REGISTER; j < max_reg_before_loop; j++) + if (local_regno[j]) + ! map->reg_map[j] = gen_reg_rtx (GET_MODE (regno_reg_rtx[j])); + + /* The last copy needs the compare/branch insns at the end, + --- 1016,1024 ---- + for (j = FIRST_PSEUDO_REGISTER; j < max_reg_before_loop; j++) + if (local_regno[j]) + ! { + ! map->reg_map[j] = gen_reg_rtx (GET_MODE (regno_reg_rtx[j])); + ! record_base_value (REGNO (map->reg_map[j]), + ! regno_reg_rtx[j]); + ! } + + /* The last copy needs the compare/branch insns at the end, + *************** unroll_loop (loop_end, insn_count, loop_ + *** 1136,1140 **** + for (j = FIRST_PSEUDO_REGISTER; j < max_reg_before_loop; j++) + if (local_regno[j]) + ! map->reg_map[j] = gen_reg_rtx (GET_MODE (regno_reg_rtx[j])); + + /* If loop starts with a branch to the test, then fix it so that + --- 1161,1169 ---- + for (j = FIRST_PSEUDO_REGISTER; j < max_reg_before_loop; j++) + if (local_regno[j]) + ! { + ! map->reg_map[j] = gen_reg_rtx (GET_MODE (regno_reg_rtx[j])); + ! record_base_value (REGNO (map->reg_map[j]), + ! regno_reg_rtx[j]); + ! } + + /* If loop starts with a branch to the test, then fix it so that + *************** copy_loop_body (copy_start, copy_end, ma + *** 1605,1608 **** + --- 1634,1641 ---- + int this_giv_inc = INTVAL (giv_inc); + + + /* If this DEST_ADDR giv was not split, then ignore it. */ + + if (*tv->location != tv->dest_reg) + + continue; + + + /* Scale this_giv_inc if the multiplicative factors of + the two givs are different. */ + *************** copy_loop_body (copy_start, copy_end, ma + *** 1631,1635 **** + incrementing the shared pseudo reg more than + once. */ + ! if (! tv->same_insn) + { + /* tv->dest_reg may actually be a (PLUS (REG) + --- 1664,1668 ---- + incrementing the shared pseudo reg more than + once. */ + ! if (! tv->same_insn && ! tv->shared) + { + /* tv->dest_reg may actually be a (PLUS (REG) + *************** copy_loop_body (copy_start, copy_end, ma + *** 1757,1760 **** + --- 1790,1794 ---- + giv_dest_reg = tem; + map->reg_map[regno] = tem; + + record_base_value (REGNO (tem), giv_src_reg); + } + else + *************** iteration_info (iteration_var, initial_v + *** 2220,2231 **** + return; + } + ! /* Reject iteration variables larger than the host long size, since they + could result in a number of iterations greater than the range of our + ! `unsigned long' variable loop_n_iterations. */ + ! else if (GET_MODE_BITSIZE (GET_MODE (iteration_var)) > HOST_BITS_PER_LONG) + { + if (loop_dump_stream) + fprintf (loop_dump_stream, + ! "Loop unrolling: Iteration var rejected because mode larger than host long.\n"); + return; + } + --- 2254,2266 ---- + return; + } + ! /* Reject iteration variables larger than the host wide int size, since they + could result in a number of iterations greater than the range of our + ! `unsigned HOST_WIDE_INT' variable loop_n_iterations. */ + ! else if ((GET_MODE_BITSIZE (GET_MODE (iteration_var)) + ! > HOST_BITS_PER_WIDE_INT)) + { + if (loop_dump_stream) + fprintf (loop_dump_stream, + ! "Loop unrolling: Iteration var rejected because mode too large.\n"); + return; + } + *************** find_splittable_regs (unroll_type, loop_ + *** 2443,2447 **** + { + rtx tem = gen_reg_rtx (bl->biv->mode); + ! + emit_insn_before (gen_move_insn (tem, bl->biv->src_reg), + loop_start); + --- 2478,2483 ---- + { + rtx tem = gen_reg_rtx (bl->biv->mode); + ! + ! record_base_value (REGNO (tem), bl->biv->add_val); + emit_insn_before (gen_move_insn (tem, bl->biv->src_reg), + loop_start); + *************** find_splittable_regs (unroll_type, loop_ + *** 2500,2503 **** + --- 2536,2541 ---- + exits. */ + rtx tem = gen_reg_rtx (bl->biv->mode); + + record_base_value (REGNO (tem), bl->biv->add_val); + + + emit_insn_before (gen_move_insn (tem, bl->biv->src_reg), + loop_start); + *************** find_splittable_givs (bl, unroll_type, l + *** 2675,2678 **** + --- 2713,2717 ---- + rtx tem = gen_reg_rtx (bl->biv->mode); + + + record_base_value (REGNO (tem), bl->biv->add_val); + emit_insn_before (gen_move_insn (tem, bl->biv->src_reg), + loop_start); + *************** find_splittable_givs (bl, unroll_type, l + *** 2716,2719 **** + --- 2755,2759 ---- + { + rtx tem = gen_reg_rtx (v->mode); + + record_base_value (REGNO (tem), v->add_val); + emit_iv_add_mult (bl->initial_value, v->mult_val, + v->add_val, tem, loop_start); + *************** find_splittable_givs (bl, unroll_type, l + *** 2734,2747 **** + register for the split addr giv, just to be safe. */ + + ! /* ??? If there are multiple address givs which have been + ! combined with the same dest_reg giv, then we may only need + ! one new register for them. Pulling out constants below will + ! catch some of the common cases of this. Currently, I leave + ! the work of simplifying multiple address givs to the + ! following cse pass. */ + ! + ! /* As a special case, if we have multiple identical address givs + ! within a single instruction, then we do use a single pseudo + ! reg for both. This is necessary in case one is a match_dup + of the other. */ + + --- 2774,2780 ---- + register for the split addr giv, just to be safe. */ + + ! /* If we have multiple identical address givs within a + ! single instruction, then use a single pseudo reg for + ! both. This is necessary in case one is a match_dup + of the other. */ + + *************** find_splittable_givs (bl, unroll_type, l + *** 2756,2759 **** + --- 2789,2812 ---- + INSN_UID (v->insn)); + } + + /* If multiple address GIVs have been combined with the + + same dest_reg GIV, do not create a new register for + + each. */ + + else if (unroll_type != UNROLL_COMPLETELY + + && v->giv_type == DEST_ADDR + + && v->same && v->same->giv_type == DEST_ADDR + + && v->same->unrolled + + #ifdef ADDRESS_COST + + /* combine_givs_p may return true when ADDRESS_COST is + + defined even if the multiply and add values are + + not equal. To share a register here, the values + + must be equal, as well as related. */ + + && rtx_equal_p (v->mult_val, v->same->mult_val) + + && rtx_equal_p (v->add_val, v->same->add_val) + + #endif + + ) + + { + + v->dest_reg = v->same->dest_reg; + + v->shared = 1; + + } + else if (unroll_type != UNROLL_COMPLETELY) + { + *************** find_splittable_givs (bl, unroll_type, l + *** 2761,2765 **** + register to hold the split value of the DEST_ADDR giv. + Emit insn to initialize its value before loop start. */ + ! tem = gen_reg_rtx (v->mode); + + /* If the address giv has a constant in its new_reg value, + --- 2814,2821 ---- + register to hold the split value of the DEST_ADDR giv. + Emit insn to initialize its value before loop start. */ + ! + ! rtx tem = gen_reg_rtx (v->mode); + ! record_base_value (REGNO (tem), v->add_val); + ! v->unrolled = 1; + + /* If the address giv has a constant in its new_reg value, + *************** find_splittable_givs (bl, unroll_type, l + *** 2772,2781 **** + v->dest_reg + = plus_constant (tem, INTVAL (XEXP (v->new_reg,1))); + ! + /* Only succeed if this will give valid addresses. + Try to validate both the first and the last + address resulting from loop unrolling, if + one fails, then can't do const elim here. */ + ! if (! verify_addresses (v, giv_inc, unroll_number)) + { + /* Save the negative of the eliminated const, so + --- 2828,2837 ---- + v->dest_reg + = plus_constant (tem, INTVAL (XEXP (v->new_reg,1))); + ! + /* Only succeed if this will give valid addresses. + Try to validate both the first and the last + address resulting from loop unrolling, if + one fails, then can't do const elim here. */ + ! if (verify_addresses (v, giv_inc, unroll_number)) + { + /* Save the negative of the eliminated const, so + *************** final_biv_value (bl, loop_start, loop_en + *** 3068,3071 **** + --- 3124,3128 ---- + + tem = gen_reg_rtx (bl->biv->mode); + + record_base_value (REGNO (tem), bl->biv->add_val); + /* Make sure loop_end is not the last insn. */ + if (NEXT_INSN (loop_end) == 0) + *************** final_giv_value (v, loop_start, loop_end + *** 3161,3164 **** + --- 3218,3222 ---- + /* Put the final biv value in tem. */ + tem = gen_reg_rtx (bl->biv->mode); + + record_base_value (REGNO (tem), bl->biv->add_val); + emit_iv_add_mult (increment, GEN_INT (loop_n_iterations), + bl->initial_value, tem, insert_before); + diff -rcp2N gcc-2.7.2.3/varasm.c gcc-2.7.2.3.f.1/varasm.c + *** gcc-2.7.2.3/varasm.c Sun Aug 31 09:39:49 1997 + --- gcc-2.7.2.3.f.1/varasm.c Sun Aug 31 09:21:18 1997 + *************** assemble_variable (decl, top_level, at_e + *** 1067,1070 **** + --- 1067,1072 ---- + if (! dont_output_data) + { + + int size; + + + if (TREE_CODE (DECL_SIZE (decl)) != INTEGER_CST) + goto finish; + *************** assemble_variable (decl, top_level, at_e + *** 1072,1078 **** + /* This is better than explicit arithmetic, since it avoids overflow. */ + size_tree = size_binop (CEIL_DIV_EXPR, + ! DECL_SIZE (decl), size_int (BITS_PER_UNIT)); + + ! if (TREE_INT_CST_HIGH (size_tree) != 0) + { + error_with_decl (decl, "size of variable `%s' is too large"); + --- 1074,1082 ---- + /* This is better than explicit arithmetic, since it avoids overflow. */ + size_tree = size_binop (CEIL_DIV_EXPR, + ! DECL_SIZE (decl), size_int (BITS_PER_UNIT)); + + ! size = TREE_INT_CST_LOW (size_tree); + ! if (TREE_INT_CST_HIGH (size_tree) != 0 + ! || size != TREE_INT_CST_LOW (size_tree)) + { + error_with_decl (decl, "size of variable `%s' is too large"); + *************** decode_addr_const (exp, value) + *** 2134,2137 **** + --- 2138,2142 ---- + case COMPLEX_CST: + case CONSTRUCTOR: + + case INTEGER_CST: + x = TREE_CST_RTL (target); + break; + *************** const_hash (exp) + *** 2249,2253 **** + return const_hash (TREE_OPERAND (exp, 0)) * 9 + + const_hash (TREE_OPERAND (exp, 1)); + ! else if (code == NOP_EXPR || code == CONVERT_EXPR) + return const_hash (TREE_OPERAND (exp, 0)) * 7 + 2; + + --- 2254,2258 ---- + return const_hash (TREE_OPERAND (exp, 0)) * 9 + + const_hash (TREE_OPERAND (exp, 1)); + ! else if (code == NOP_EXPR || code == CONVERT_EXPR || code == NON_LVALUE_EXPR) + return const_hash (TREE_OPERAND (exp, 0)) * 7 + 2; + + *************** compare_constant_1 (exp, p) + *** 2314,2317 **** + --- 2319,2324 ---- + if (flag_writable_strings) + return 0; + + if (*p++ != TYPE_MODE (TREE_TYPE (exp))) + + return 0; + strp = TREE_STRING_POINTER (exp); + len = TREE_STRING_LENGTH (exp); + *************** compare_constant_1 (exp, p) + *** 2403,2407 **** + return p; + } + ! else if (code == NOP_EXPR || code == CONVERT_EXPR) + { + p = compare_constant_1 (TREE_OPERAND (exp, 0), p); + --- 2410,2414 ---- + return p; + } + ! else if (code == NOP_EXPR || code == CONVERT_EXPR || code == NON_LVALUE_EXPR) + { + p = compare_constant_1 (TREE_OPERAND (exp, 0), p); + *************** record_constant_1 (exp) + *** 2469,2472 **** + --- 2476,2480 ---- + return; + + + obstack_1grow (&permanent_obstack, TYPE_MODE (TREE_TYPE (exp))); + strp = TREE_STRING_POINTER (exp); + len = TREE_STRING_LENGTH (exp); + *************** copy_constant (exp) + *** 2635,2639 **** + + case COMPLEX_CST: + ! return build_complex (copy_constant (TREE_REALPART (exp)), + copy_constant (TREE_IMAGPART (exp))); + + --- 2643,2648 ---- + + case COMPLEX_CST: + ! return build_complex (TREE_TYPE (exp), + ! copy_constant (TREE_REALPART (exp)), + copy_constant (TREE_IMAGPART (exp))); + + *************** copy_constant (exp) + *** 2646,2649 **** + --- 2655,2659 ---- + case NOP_EXPR: + case CONVERT_EXPR: + + case NON_LVALUE_EXPR: + return build1 (TREE_CODE (exp), TREE_TYPE (exp), + copy_constant (TREE_OPERAND (exp, 0))); + *************** output_constant_def (exp) + *** 2692,2698 **** + register rtx def; + + - if (TREE_CODE (exp) == INTEGER_CST) + - abort (); /* No TREE_CST_RTL slot in these. */ + - + if (TREE_CST_RTL (exp)) + return TREE_CST_RTL (exp); + --- 2702,2705 ---- + *************** bc_assemble_integer (exp, size) + *** 3622,3626 **** + exp = fold (exp); + + ! while (TREE_CODE (exp) == NOP_EXPR || TREE_CODE (exp) == CONVERT_EXPR) + exp = TREE_OPERAND (exp, 0); + if (TREE_CODE (exp) == INTEGER_CST) + --- 3629,3634 ---- + exp = fold (exp); + + ! while (TREE_CODE (exp) == NOP_EXPR || TREE_CODE (exp) == CONVERT_EXPR + ! || TREE_CODE (exp) == NON_LVALUE_EXPR) + exp = TREE_OPERAND (exp, 0); + if (TREE_CODE (exp) == INTEGER_CST) + *************** bc_assemble_integer (exp, size) + *** 3633,3641 **** + const_part = TREE_OPERAND (exp, 0); + while (TREE_CODE (const_part) == NOP_EXPR + ! || TREE_CODE (const_part) == CONVERT_EXPR) + const_part = TREE_OPERAND (const_part, 0); + addr_part = TREE_OPERAND (exp, 1); + while (TREE_CODE (addr_part) == NOP_EXPR + ! || TREE_CODE (addr_part) == CONVERT_EXPR) + addr_part = TREE_OPERAND (addr_part, 0); + if (TREE_CODE (const_part) != INTEGER_CST) + --- 3641,3651 ---- + const_part = TREE_OPERAND (exp, 0); + while (TREE_CODE (const_part) == NOP_EXPR + ! || TREE_CODE (const_part) == CONVERT_EXPR + ! || TREE_CODE (const_part) == NON_LVALUE_EXPR) + const_part = TREE_OPERAND (const_part, 0); + addr_part = TREE_OPERAND (exp, 1); + while (TREE_CODE (addr_part) == NOP_EXPR + ! || TREE_CODE (addr_part) == CONVERT_EXPR + ! || TREE_CODE (addr_part) == NON_LVALUE_EXPR) + addr_part = TREE_OPERAND (addr_part, 0); + if (TREE_CODE (const_part) != INTEGER_CST) + diff -rcp2N gcc-2.7.2.3/version.c gcc-2.7.2.3.f.1/version.c + *** gcc-2.7.2.3/version.c Sun Aug 31 09:39:50 1997 + --- gcc-2.7.2.3.f.1/version.c Tue Sep 9 04:13:48 1997 + *************** + *** 1 **** + ! char *version_string = "2.7.2.3"; + --- 1 ---- + ! char *version_string = "2.7.2.3.f.1"; diff -rcp2N g77-0.5.20/f/gbe/README g77-0.5.21/f/gbe/README *** g77-0.5.20/f/gbe/README Sun Feb 23 21:28:41 1997 --- g77-0.5.21/f/gbe/README Tue Sep 9 06:13:59 1997 *************** *** 1,3 **** ! 970223 This directory contains .diff files for various GNU CC distributions --- 1,3 ---- ! 970909 This directory contains .diff files for various GNU CC distributions *************** supported by this version of GNU Fortran *** 5,19 **** The name of a file includes which gcc version to which it applies. ! For example, 2.7.2.2.diff is the patch file for gcc version 2.7.2.2. ! To apply a .diff file to, say, gcc 2.7.2.2, one might use the following command (where the current directory contains the gcc source distribution after merging into it the g77 source distribution, which would be ! named gcc-2.7.2.2 in this example): ! patch -p1 -d gcc-2.7.2.2 < gcc-2.7.2.2/f/gbe/2.7.2.2.diff ! This version of g77 is best combined with gcc versions 2.7.2.2. However, note that applying any of these patches does _not_ update --- 5,19 ---- The name of a file includes which gcc version to which it applies. ! For example, 2.7.2.3.diff is the patch file for gcc version 2.7.2.3. ! To apply a .diff file to, say, gcc 2.7.2.3, one might use the following command (where the current directory contains the gcc source distribution after merging into it the g77 source distribution, which would be ! named gcc-2.7.2.3 in this example): ! patch -p1 -d gcc-2.7.2.3 < gcc-2.7.2.3/f/gbe/2.7.2.3.diff ! This version of g77 is best combined with gcc versions 2.7.2.3. However, note that applying any of these patches does _not_ update *************** documentation yourself via: *** 26,35 **** If the above command doesn't work because you don't have makeinfo installed, you are STRONGLY encouraged to obtain the most recent ! version of the GNU texinfo package (texinfo-3.9.tar.gz as of this writing), build, and install it, then try the above command (as makeinfo is part of texinfo). This distribution of g77 is not supported for versions of gcc prior ! to 2.7.2.2. If you are using a version of gcc more recent than the most --- 26,35 ---- If the above command doesn't work because you don't have makeinfo installed, you are STRONGLY encouraged to obtain the most recent ! version of the GNU texinfo package (texinfo-3.11.tar.gz as of this writing), build, and install it, then try the above command (as makeinfo is part of texinfo). This distribution of g77 is not supported for versions of gcc prior ! to 2.7.2.3. If you are using a version of gcc more recent than the most *************** released. On the other hand, it probabl *** 40,45 **** a more major release like gcc-2.8.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 place ! (ftp://alpha.gnu.ai.mit.edu:g77.plan) for information on support for the recent versions of gcc. --- 40,45 ---- a more major release like gcc-2.8.0 or gcc-3.0.0, and you shouldn't try it. If the .diff file is missing, don't bother ! asking for it -- it is certainly ! being worked on. In the meantime, watch our progress at ! for information on support for the recent versions of gcc. diff -rcp2N g77-0.5.20/f/global.c g77-0.5.21/f/global.c *** g77-0.5.20/f/global.c Sat Mar 1 04:23:57 1997 --- g77-0.5.21/f/global.c Tue Sep 9 06:11:36 1997 *************** *** 1,4 **** /* global.c -- Implementation File (module.c template V1.0) ! Copyright (C) 1995 Free Software Foundation, Inc. Contributed by James Craig Burley (burley@gnu.ai.mit.edu). --- 1,4 ---- /* global.c -- Implementation File (module.c template V1.0) ! Copyright (C) 1995, 1997 Free Software Foundation, Inc. Contributed by James Craig Burley (burley@gnu.ai.mit.edu). *************** the Free Software Foundation, 59 Temple *** 35,38 **** --- 35,39 ---- #include "proj.h" #include "global.h" + #include "info.h" #include "lex.h" #include "malloc.h" *************** the Free Software Foundation, 59 Temple *** 60,63 **** --- 61,75 ---- #if FFEGLOBAL_ENABLED static ffenameSpace ffeglobal_filewide_ = NULL; + static char *ffeglobal_type_string_[] = + { + [FFEGLOBAL_typeNONE] "??", + [FFEGLOBAL_typeMAIN] "main program", + [FFEGLOBAL_typeEXT] "external", + [FFEGLOBAL_typeSUBR] "subroutine", + [FFEGLOBAL_typeFUNC] "function", + [FFEGLOBAL_typeBDATA] "block data", + [FFEGLOBAL_typeCOMMON] "common block", + [FFEGLOBAL_typeANY] "?any?" + }; #endif *************** ffeglobal_new_ (ffename n) *** 102,105 **** --- 114,118 ---- g->hook = FFECOM_globalNULL; #endif + g->tick = 0; ffename_set_global (n, g); *************** ffeglobal_init_common (ffesymbol s, ffel *** 141,159 **** g = ffesymbol_global (s); if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON)) return; ! if (g->init == ffe_count_2) return; ! if (g->init != 0) { ! if (g->initt != NULL) { ffebad_start (FFEBAD_COMMON_ALREADY_INIT); ffebad_string (ffesymbol_text (s)); ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); ! ffebad_here (1, ffelex_token_where_line (g->initt), ! ffelex_token_where_column (g->initt)); ffebad_finish (); } --- 154,175 ---- g = ffesymbol_global (s); + if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON)) return; + if (g->type == FFEGLOBAL_typeANY) + return; ! if (g->tick == ffe_count_2) return; ! if (g->tick != 0) { ! if (g->u.common.initt != NULL) { ffebad_start (FFEBAD_COMMON_ALREADY_INIT); ffebad_string (ffesymbol_text (s)); ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); ! ffebad_here (1, ffelex_token_where_line (g->u.common.initt), ! ffelex_token_where_column (g->u.common.initt)); ffebad_finish (); } *************** ffeglobal_init_common (ffesymbol s, ffel *** 164,168 **** else { ! if (g->blank) { ffebad_start (FFEBAD_COMMON_BLANK_INIT); --- 180,184 ---- else { ! if (g->u.common.blank) { ffebad_start (FFEBAD_COMMON_BLANK_INIT); *************** ffeglobal_init_common (ffesymbol s, ffel *** 171,178 **** } ! g->initt = ffelex_token_use (t); } ! g->init = ffe_count_2; #endif } --- 187,194 ---- } ! g->u.common.initt = ffelex_token_use (t); } ! g->tick = ffe_count_2; #endif } *************** ffeglobal_new_common (ffesymbol s, ffele *** 207,237 **** } ! if (g != NULL) { if (g->type == FFEGLOBAL_typeCOMMON) { ! assert (g->blank == blank); } else { ! ffebad_start (FFEBAD_FILEWIDE_ALREADY_SEEN); ffebad_string (ffelex_token_text (t)); ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); ffebad_here (1, ffelex_token_where_line (g->t), ffelex_token_where_column (g->t)); ffebad_finish (); - g->type = FFEGLOBAL_typeANY; } - } - else - { - g = ffeglobal_new_ (n); g->t = ffelex_token_use (t); - g->init = 0; g->type = FFEGLOBAL_typeCOMMON; ! g->have_pad = FALSE; ! g->have_save = FALSE; ! g->have_size = FALSE; ! g->blank = blank; } --- 223,277 ---- } ! if ((g != NULL) && (g->type == FFEGLOBAL_typeANY)) ! return; ! ! if ((g != NULL) && (g->type != FFEGLOBAL_typeNONE)) { if (g->type == FFEGLOBAL_typeCOMMON) { ! assert (g->u.common.blank == blank); } else { ! if (ffe_is_globals () || ffe_is_warn_globals ()) ! { ! ffebad_start (ffe_is_globals () ! ? FFEBAD_FILEWIDE_ALREADY_SEEN ! : FFEBAD_FILEWIDE_ALREADY_SEEN_W); ! ffebad_string (ffelex_token_text (t)); ! ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); ! ffebad_here (1, ffelex_token_where_line (g->t), ! ffelex_token_where_column (g->t)); ! ffebad_finish (); ! } ! g->type = FFEGLOBAL_typeANY; ! } ! } ! else ! { ! if (g == NULL) ! { ! g = ffeglobal_new_ (n); ! g->intrinsic = FALSE; ! } ! else if (g->intrinsic ! && !g->explicit_intrinsic ! && ffe_is_warn_globals ()) ! { ! ffebad_start (FFEBAD_INTRINSIC_GLOBAL); ffebad_string (ffelex_token_text (t)); + ffebad_string ("common block"); + ffebad_string ("intrinsic"); ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); ffebad_here (1, ffelex_token_where_line (g->t), ffelex_token_where_column (g->t)); ffebad_finish (); } g->t = ffelex_token_use (t); g->type = FFEGLOBAL_typeCOMMON; ! g->u.common.have_pad = FALSE; ! g->u.common.have_save = FALSE; ! g->u.common.have_size = FALSE; ! g->u.common.blank = blank; } *************** ffeglobal_new_progunit_ (ffesymbol s, ff *** 259,278 **** n = ffename_find (ffeglobal_filewide_, t); g = ffename_global (n); ! if (g != NULL) { ! ffebad_start (FFEBAD_FILEWIDE_ALREADY_SEEN); ! ffebad_string (ffelex_token_text (t)); ! ffebad_here (0, ffelex_token_where_line (t), ! ffelex_token_where_column (t)); ! ffebad_here (1, ffelex_token_where_line (g->t), ! ffelex_token_where_column (g->t)); ! ffebad_finish (); g->type = FFEGLOBAL_typeANY; } else { ! g = ffeglobal_new_ (n); g->t = ffelex_token_use (t); g->type = type; } --- 299,405 ---- n = ffename_find (ffeglobal_filewide_, t); g = ffename_global (n); ! if ((g != NULL) && (g->type == FFEGLOBAL_typeANY)) ! return; ! ! if ((g != NULL) ! && ((g->type == FFEGLOBAL_typeMAIN) ! || (g->type == FFEGLOBAL_typeSUBR) ! || (g->type == FFEGLOBAL_typeFUNC) ! || (g->type == FFEGLOBAL_typeBDATA)) ! && g->u.proc.defined) { ! if (ffe_is_globals () || ffe_is_warn_globals ()) ! { ! ffebad_start (ffe_is_globals () ! ? FFEBAD_FILEWIDE_ALREADY_SEEN ! : FFEBAD_FILEWIDE_ALREADY_SEEN_W); ! ffebad_string (ffelex_token_text (t)); ! ffebad_here (0, ffelex_token_where_line (t), ! ffelex_token_where_column (t)); ! ffebad_here (1, ffelex_token_where_line (g->t), ! ffelex_token_where_column (g->t)); ! ffebad_finish (); ! } ! g->type = FFEGLOBAL_typeANY; ! } ! else if ((g != NULL) ! && (g->type != FFEGLOBAL_typeNONE) ! && (g->type != FFEGLOBAL_typeEXT) ! && (g->type != type)) ! { ! if (ffe_is_globals () || ffe_is_warn_globals ()) ! { ! ffebad_start (ffe_is_globals () ! ? FFEBAD_FILEWIDE_DISAGREEMENT ! : FFEBAD_FILEWIDE_DISAGREEMENT_W); ! ffebad_string (ffelex_token_text (t)); ! ffebad_string (ffeglobal_type_string_[type]); ! ffebad_string (ffeglobal_type_string_[g->type]); ! ffebad_here (0, ffelex_token_where_line (t), ! ffelex_token_where_column (t)); ! ffebad_here (1, ffelex_token_where_line (g->t), ! ffelex_token_where_column (g->t)); ! ffebad_finish (); ! } g->type = FFEGLOBAL_typeANY; } else { ! if (g == NULL) ! { ! g = ffeglobal_new_ (n); ! g->intrinsic = FALSE; ! g->u.proc.n_args = -1; ! g->u.proc.other_t = NULL; ! } ! else if ((ffesymbol_basictype (s) != FFEINFO_basictypeNONE) ! && ((ffesymbol_basictype (s) != g->u.proc.bt) ! || (ffesymbol_kindtype (s) != g->u.proc.kt) ! || ((ffesymbol_size (s) != FFETARGET_charactersizeNONE) ! && (ffesymbol_size (s) != g->u.proc.sz)))) ! { ! if (ffe_is_globals () || ffe_is_warn_globals ()) ! { ! ffebad_start (ffe_is_globals () ! ? FFEBAD_FILEWIDE_TYPE_MISMATCH ! : FFEBAD_FILEWIDE_TYPE_MISMATCH_W); ! ffebad_string (ffelex_token_text (t)); ! ffebad_here (0, ffelex_token_where_line (t), ! ffelex_token_where_column (t)); ! ffebad_here (1, ffelex_token_where_line (g->t), ! ffelex_token_where_column (g->t)); ! ffebad_finish (); ! } ! g->type = FFEGLOBAL_typeANY; ! return; ! } ! if (g->intrinsic ! && !g->explicit_intrinsic ! && ffe_is_warn_globals ()) ! { ! ffebad_start (FFEBAD_INTRINSIC_GLOBAL); ! ffebad_string (ffelex_token_text (t)); ! ffebad_string ("global"); ! ffebad_string ("intrinsic"); ! ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); ! ffebad_here (1, ffelex_token_where_line (g->t), ! ffelex_token_where_column (g->t)); ! ffebad_finish (); ! } g->t = ffelex_token_use (t); + if ((g->tick == 0) + || (g->u.proc.bt == FFEINFO_basictypeNONE) + || (g->u.proc.kt == FFEINFO_kindtypeNONE)) + { + g->u.proc.bt = ffesymbol_basictype (s); + g->u.proc.kt = ffesymbol_kindtype (s); + g->u.proc.sz = ffesymbol_size (s); + } + g->tick = ffe_count_2; + if ((g->tick != 0) + && (g->type != type)) + g->u.proc.n_args = -1; g->type = type; + g->u.proc.defined = TRUE; } *************** ffeglobal_pad_common (ffesymbol s, ffeta *** 302,316 **** if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON)) return; /* Let someone else catch this! */ ! if (!g->have_pad) { ! g->have_pad = TRUE; ! g->pad = pad; ! g->pad_where_line = ffewhere_line_use (wl); ! g->pad_where_col = ffewhere_column_use (wc); } else { ! if (g->pad != pad) { char padding_1[20]; --- 429,445 ---- if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON)) return; /* Let someone else catch this! */ + if (g->type == FFEGLOBAL_typeANY) + return; ! if (!g->u.common.have_pad) { ! g->u.common.have_pad = TRUE; ! g->u.common.pad = pad; ! g->u.common.pad_where_line = ffewhere_line_use (wl); ! g->u.common.pad_where_col = ffewhere_column_use (wc); } else { ! if (g->u.common.pad != pad) { char padding_1[20]; *************** ffeglobal_pad_common (ffesymbol s, ffeta *** 318,322 **** sprintf (&padding_1[0], "%" ffetargetAlign_f "u", pad); ! sprintf (&padding_2[0], "%" ffetargetAlign_f "u", g->pad); ffebad_start (FFEBAD_COMMON_DIFF_PAD); ffebad_string (ffesymbol_text (s)); --- 447,451 ---- sprintf (&padding_1[0], "%" ffetargetAlign_f "u", pad); ! sprintf (&padding_2[0], "%" ffetargetAlign_f "u", g->u.common.pad); ffebad_start (FFEBAD_COMMON_DIFF_PAD); ffebad_string (ffesymbol_text (s)); *************** ffeglobal_pad_common (ffesymbol s, ffeta *** 326,332 **** ffebad_string ((pad == 1) ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS); ! ffebad_string ((g->pad == 1) ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS); ! ffebad_here (1, g->pad_where_line, g->pad_where_col); ffebad_finish (); } --- 455,461 ---- ffebad_string ((pad == 1) ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS); ! ffebad_string ((g->u.common.pad == 1) ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS); ! ffebad_here (1, g->u.common.pad_where_line, g->u.common.pad_where_col); ffebad_finish (); } *************** ffeglobal_pad_common (ffesymbol s, ffeta *** 349,352 **** --- 478,1099 ---- } + /* Collect info for a global's argument. */ + + void + ffeglobal_proc_def_arg (ffesymbol s, int argno, char *name, ffeglobalArgSummary as, + ffeinfoBasictype bt, ffeinfoKindtype kt, + bool array) + { + ffeglobal g = ffesymbol_global (s); + ffeglobalArgInfo_ ai; + + assert (g != NULL); + + if (g->type == FFEGLOBAL_typeANY) + return; + + assert (g->u.proc.n_args >= 0); + + if (argno >= g->u.proc.n_args) + return; /* Already complained about this discrepancy. */ + + ai = &g->u.proc.arg_info[argno]; + + /* Maybe warn about previous references. */ + + if ((ai->t != NULL) + && ffe_is_warn_globals ()) + { + char *refwhy = NULL; + char *defwhy = NULL; + bool warn = FALSE; + + switch (as) + { + case FFEGLOBAL_argsummaryREF: + if ((ai->as != FFEGLOBAL_argsummaryREF) + && (ai->as != FFEGLOBAL_argsummaryNONE) + && ((ai->as != FFEGLOBAL_argsummaryDESCR) /* Choose better message. */ + || (ai->bt != FFEINFO_basictypeCHARACTER) + || (ai->bt == bt))) + { + warn = TRUE; + refwhy = "passed by reference"; + } + break; + + case FFEGLOBAL_argsummaryDESCR: + if ((ai->as != FFEGLOBAL_argsummaryDESCR) + && (ai->as != FFEGLOBAL_argsummaryNONE) + && ((ai->as != FFEGLOBAL_argsummaryREF) /* Choose better message. */ + || (bt != FFEINFO_basictypeCHARACTER) + || (ai->bt == bt))) + { + warn = TRUE; + refwhy = "passed by descriptor"; + } + break; + + case FFEGLOBAL_argsummaryPROC: + if ((ai->as != FFEGLOBAL_argsummaryPROC) + && (ai->as != FFEGLOBAL_argsummarySUBR) + && (ai->as != FFEGLOBAL_argsummaryFUNC) + && (ai->as != FFEGLOBAL_argsummaryNONE)) + { + warn = TRUE; + refwhy = "a procedure"; + } + break; + + case FFEGLOBAL_argsummarySUBR: + if ((ai->as != FFEGLOBAL_argsummaryPROC) + && (ai->as != FFEGLOBAL_argsummarySUBR) + && (ai->as != FFEGLOBAL_argsummaryNONE)) + { + warn = TRUE; + refwhy = "a subroutine"; + } + break; + + case FFEGLOBAL_argsummaryFUNC: + if ((ai->as != FFEGLOBAL_argsummaryPROC) + && (ai->as != FFEGLOBAL_argsummaryFUNC) + && (ai->as != FFEGLOBAL_argsummaryNONE)) + { + warn = TRUE; + refwhy = "a function"; + } + break; + + case FFEGLOBAL_argsummaryALTRTN: + if ((ai->as != FFEGLOBAL_argsummaryALTRTN) + && (ai->as != FFEGLOBAL_argsummaryNONE)) + { + warn = TRUE; + refwhy = "an alternate-return label"; + } + break; + + default: + break; + } + + if ((refwhy != NULL) && (defwhy == NULL)) + { + /* Fill in the def info. */ + + switch (ai->as) + { + case FFEGLOBAL_argsummaryNONE: + defwhy = "omitted"; + break; + + case FFEGLOBAL_argsummaryVAL: + defwhy = "passed by value"; + break; + + case FFEGLOBAL_argsummaryREF: + defwhy = "passed by reference"; + break; + + case FFEGLOBAL_argsummaryDESCR: + defwhy = "passed by descriptor"; + break; + + case FFEGLOBAL_argsummaryPROC: + defwhy = "a procedure"; + break; + + case FFEGLOBAL_argsummarySUBR: + defwhy = "a subroutine"; + break; + + case FFEGLOBAL_argsummaryFUNC: + defwhy = "a function"; + break; + + case FFEGLOBAL_argsummaryALTRTN: + defwhy = "an alternate-return label"; + break; + + case FFEGLOBAL_argsummaryPTR: + defwhy = "a pointer"; + break; + + default: + defwhy = "???"; + break; + } + } + + if (!warn + && (bt != FFEINFO_basictypeHOLLERITH) + && (bt != FFEINFO_basictypeTYPELESS) + && (bt != FFEINFO_basictypeNONE) + && (ai->bt != FFEINFO_basictypeHOLLERITH) + && (ai->bt != FFEINFO_basictypeTYPELESS) + && (ai->bt != FFEINFO_basictypeNONE)) + { + /* Check types. */ + + if ((bt != ai->bt) + && ((bt != FFEINFO_basictypeREAL) + || (ai->bt != FFEINFO_basictypeCOMPLEX)) + && ((bt != FFEINFO_basictypeCOMPLEX) + || (ai->bt != FFEINFO_basictypeREAL))) + { + warn = TRUE; /* We can cope with these differences. */ + refwhy = "one type"; + defwhy = "some other type"; + } + + if (!warn && (kt != ai->kt)) + { + warn = TRUE; + refwhy = "one precision"; + defwhy = "some other precision"; + } + } + + if (warn) + { + char num[60]; + + if (name == NULL) + sprintf (&num[0], "%d", argno + 1); + else + { + if (strlen (name) < 30) + sprintf (&num[0], "%d (named `%s')", argno + 1, name); + else + sprintf (&num[0], "%d (named `%.*s...')", argno + 1, 30, name); + } + ffebad_start (FFEBAD_FILEWIDE_ARG_W); + ffebad_string (ffesymbol_text (s)); + ffebad_string (num); + ffebad_string (refwhy); + ffebad_string (defwhy); + ffebad_here (0, ffelex_token_where_line (g->t), ffelex_token_where_column (g->t)); + ffebad_here (1, ffelex_token_where_line (ai->t), ffelex_token_where_column (ai->t)); + ffebad_finish (); + } + } + + /* Define this argument. */ + + if (ai->t != NULL) + ffelex_token_kill (ai->t); + if ((as != FFEGLOBAL_argsummaryPROC) + || (ai->t == NULL)) + ai->as = as; /* Otherwise leave SUBR/FUNC info intact. */ + ai->t = ffelex_token_use (g->t); + if (name == NULL) + ai->name = NULL; + else + { + ai->name = malloc_new_ks (malloc_pool_image (), + "ffeglobalArgInfo_ name", + strlen (name) + 1); + strcpy (ai->name, name); + } + ai->bt = bt; + ai->kt = kt; + ai->array = array; + } + + /* Collect info on #args a global accepts. */ + + void + ffeglobal_proc_def_nargs (ffesymbol s, int n_args) + { + ffeglobal g = ffesymbol_global (s); + + assert (g != NULL); + + if (g->type == FFEGLOBAL_typeANY) + return; + + if (g->u.proc.n_args >= 0) + { + if (g->u.proc.n_args == n_args) + return; + + if (ffe_is_warn_globals ()) + { + ffebad_start (FFEBAD_FILEWIDE_NARGS_W); + ffebad_string (ffesymbol_text (s)); + if (g->u.proc.n_args > n_args) + ffebad_string ("few"); + else + ffebad_string ("many"); + ffebad_here (0, ffelex_token_where_line (g->u.proc.other_t), + ffelex_token_where_column (g->u.proc.other_t)); + ffebad_here (1, ffelex_token_where_line (g->t), + ffelex_token_where_column (g->t)); + ffebad_finish (); + } + } + + /* This is new info we can use in cross-checking future references + and a possible future definition. */ + + g->u.proc.n_args = n_args; + g->u.proc.other_t = NULL; /* No other reference yet. */ + + if (n_args == 0) + { + g->u.proc.arg_info = NULL; + return; + } + + g->u.proc.arg_info + = (ffeglobalArgInfo_) malloc_new_ks (malloc_pool_image (), + "ffeglobalArgInfo_", + n_args * sizeof (g->u.proc.arg_info[0])); + while (n_args-- > 0) + g->u.proc.arg_info[n_args].t = NULL; + } + + /* Verify that the info for a global's argument is valid. */ + + bool + ffeglobal_proc_ref_arg (ffesymbol s, int argno, ffeglobalArgSummary as, + ffeinfoBasictype bt, ffeinfoKindtype kt, + bool array, ffelexToken t) + { + ffeglobal g = ffesymbol_global (s); + ffeglobalArgInfo_ ai; + + assert (g != NULL); + + if (g->type == FFEGLOBAL_typeANY) + return FALSE; + + assert (g->u.proc.n_args >= 0); + + if (argno >= g->u.proc.n_args) + return TRUE; /* Already complained about this discrepancy. */ + + ai = &g->u.proc.arg_info[argno]; + + /* Warn about previous references. */ + + if (ai->t != NULL) + { + char *refwhy = NULL; + char *defwhy = NULL; + bool fail = FALSE; + bool warn = FALSE; + + switch (as) + { + case FFEGLOBAL_argsummaryNONE: + if (g->u.proc.defined) + { + fail = TRUE; + refwhy = "omitted"; + defwhy = "not optional"; + } + break; + + case FFEGLOBAL_argsummaryVAL: + if (ai->as != FFEGLOBAL_argsummaryVAL) + { + fail = TRUE; + refwhy = "passed by value"; + } + break; + + case FFEGLOBAL_argsummaryREF: + if ((ai->as != FFEGLOBAL_argsummaryREF) + && (ai->as != FFEGLOBAL_argsummaryNONE) + && ((ai->as != FFEGLOBAL_argsummaryDESCR) /* Choose better message. */ + || (ai->bt != FFEINFO_basictypeCHARACTER) + || (ai->bt == bt))) + { + fail = TRUE; + refwhy = "passed by reference"; + } + break; + + case FFEGLOBAL_argsummaryDESCR: + if ((ai->as != FFEGLOBAL_argsummaryDESCR) + && (ai->as != FFEGLOBAL_argsummaryNONE) + && ((ai->as != FFEGLOBAL_argsummaryREF) /* Choose better message. */ + || (bt != FFEINFO_basictypeCHARACTER) + || (ai->bt == bt))) + { + fail = TRUE; + refwhy = "passed by descriptor"; + } + break; + + case FFEGLOBAL_argsummaryPROC: + if ((ai->as != FFEGLOBAL_argsummaryPROC) + && (ai->as != FFEGLOBAL_argsummarySUBR) + && (ai->as != FFEGLOBAL_argsummaryFUNC) + && (ai->as != FFEGLOBAL_argsummaryNONE)) + { + fail = TRUE; + refwhy = "a procedure"; + } + break; + + case FFEGLOBAL_argsummarySUBR: + if ((ai->as != FFEGLOBAL_argsummaryPROC) + && (ai->as != FFEGLOBAL_argsummarySUBR) + && (ai->as != FFEGLOBAL_argsummaryNONE)) + { + fail = TRUE; + refwhy = "a subroutine"; + } + break; + + case FFEGLOBAL_argsummaryFUNC: + if ((ai->as != FFEGLOBAL_argsummaryPROC) + && (ai->as != FFEGLOBAL_argsummaryFUNC) + && (ai->as != FFEGLOBAL_argsummaryNONE)) + { + fail = TRUE; + refwhy = "a function"; + } + break; + + case FFEGLOBAL_argsummaryALTRTN: + if ((ai->as != FFEGLOBAL_argsummaryALTRTN) + && (ai->as != FFEGLOBAL_argsummaryNONE)) + { + fail = TRUE; + refwhy = "an alternate-return label"; + } + break; + + case FFEGLOBAL_argsummaryPTR: + if ((ai->as != FFEGLOBAL_argsummaryPTR) + && (ai->as != FFEGLOBAL_argsummaryNONE)) + { + fail = TRUE; + refwhy = "a pointer"; + } + break; + + default: + break; + } + + if ((refwhy != NULL) && (defwhy == NULL)) + { + /* Fill in the def info. */ + + switch (ai->as) + { + case FFEGLOBAL_argsummaryNONE: + defwhy = "omitted"; + break; + + case FFEGLOBAL_argsummaryVAL: + defwhy = "passed by value"; + break; + + case FFEGLOBAL_argsummaryREF: + defwhy = "passed by reference"; + break; + + case FFEGLOBAL_argsummaryDESCR: + defwhy = "passed by descriptor"; + break; + + case FFEGLOBAL_argsummaryPROC: + defwhy = "a procedure"; + break; + + case FFEGLOBAL_argsummarySUBR: + defwhy = "a subroutine"; + break; + + case FFEGLOBAL_argsummaryFUNC: + defwhy = "a function"; + break; + + case FFEGLOBAL_argsummaryALTRTN: + defwhy = "an alternate-return label"; + break; + + case FFEGLOBAL_argsummaryPTR: + defwhy = "a pointer"; + break; + + default: + defwhy = "???"; + break; + } + } + + if (!fail && !warn + && (bt != FFEINFO_basictypeHOLLERITH) + && (bt != FFEINFO_basictypeTYPELESS) + && (bt != FFEINFO_basictypeNONE) + && (ai->bt != FFEINFO_basictypeHOLLERITH) + && (ai->bt != FFEINFO_basictypeNONE) + && (ai->bt != FFEINFO_basictypeTYPELESS)) + { + /* Check types. */ + + if ((bt != ai->bt) + && ((bt != FFEINFO_basictypeREAL) + || (ai->bt != FFEINFO_basictypeCOMPLEX)) + && ((bt != FFEINFO_basictypeCOMPLEX) + || (ai->bt != FFEINFO_basictypeREAL))) + { + if (((bt == FFEINFO_basictypeINTEGER) + && (ai->bt == FFEINFO_basictypeLOGICAL)) + || ((bt == FFEINFO_basictypeLOGICAL) + && (ai->bt == FFEINFO_basictypeINTEGER))) + warn = TRUE; /* We can cope with these differences. */ + else + fail = TRUE; + refwhy = "one type"; + defwhy = "some other type"; + } + + if (!fail && !warn && (kt != ai->kt)) + { + fail = TRUE; + refwhy = "one precision"; + defwhy = "some other precision"; + } + } + + if (fail && ! g->u.proc.defined) + { + /* No point failing if we're worried only about invocations. */ + fail = FALSE; + warn = TRUE; + } + + if (fail && ! ffe_is_globals ()) + { + warn = TRUE; + fail = FALSE; + } + + if (fail || (warn && ffe_is_warn_globals ())) + { + char num[60]; + + if (ai->name == NULL) + sprintf (&num[0], "%d", argno + 1); + else + { + if (strlen (ai->name) < 30) + sprintf (&num[0], "%d (named `%s')", argno + 1, ai->name); + else + sprintf (&num[0], "%d (named `%.*s...')", argno + 1, 30, ai->name); + } + ffebad_start (fail ? FFEBAD_FILEWIDE_ARG : FFEBAD_FILEWIDE_ARG_W); + ffebad_string (ffesymbol_text (s)); + ffebad_string (num); + ffebad_string (refwhy); + ffebad_string (defwhy); + ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); + ffebad_here (1, ffelex_token_where_line (ai->t), ffelex_token_where_column (ai->t)); + ffebad_finish (); + return (fail ? FALSE : TRUE); + } + + if (warn) + return TRUE; + } + + /* Define this argument. */ + + if (ai->t != NULL) + ffelex_token_kill (ai->t); + if ((as != FFEGLOBAL_argsummaryPROC) + || (ai->t == NULL)) + ai->as = as; + ai->t = ffelex_token_use (g->t); + ai->name = NULL; + ai->bt = bt; + ai->kt = kt; + ai->array = array; + return TRUE; + } + + bool + ffeglobal_proc_ref_nargs (ffesymbol s, int n_args, ffelexToken t) + { + ffeglobal g = ffesymbol_global (s); + + assert (g != NULL); + + if (g->type == FFEGLOBAL_typeANY) + return FALSE; + + if (g->u.proc.n_args >= 0) + { + if (g->u.proc.n_args == n_args) + return TRUE; + + if (g->u.proc.defined && ffe_is_globals ()) + { + ffebad_start (FFEBAD_FILEWIDE_NARGS); + ffebad_string (ffesymbol_text (s)); + if (g->u.proc.n_args > n_args) + ffebad_string ("few"); + else + ffebad_string ("many"); + ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); + ffebad_here (1, ffelex_token_where_line (g->t), + ffelex_token_where_column (g->t)); + ffebad_finish (); + return FALSE; + } + + if (ffe_is_warn_globals ()) + { + ffebad_start (FFEBAD_FILEWIDE_NARGS_W); + ffebad_string (ffesymbol_text (s)); + if (g->u.proc.n_args > n_args) + ffebad_string ("few"); + else + ffebad_string ("many"); + ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); + ffebad_here (1, ffelex_token_where_line (g->t), + ffelex_token_where_column (g->t)); + ffebad_finish (); + } + + return TRUE; /* Don't replace the info we already have. */ + } + + /* This is new info we can use in cross-checking future references + and a possible future definition. */ + + g->u.proc.n_args = n_args; + g->u.proc.other_t = ffelex_token_use (t); + + /* Make this "the" place we found the global, since it has the most info. */ + + if (g->t != NULL) + ffelex_token_kill (g->t); + g->t = ffelex_token_use (t); + + if (n_args == 0) + { + g->u.proc.arg_info = NULL; + return TRUE; + } + + g->u.proc.arg_info + = (ffeglobalArgInfo_) malloc_new_ks (malloc_pool_image (), + "ffeglobalArgInfo_", + n_args * sizeof (g->u.proc.arg_info[0])); + while (n_args-- > 0) + g->u.proc.arg_info[n_args].t = NULL; + + return TRUE; + } + /* Return a global for a promoted symbol (one that has heretofore been assumed to be local, but since discovered to be global). */ *************** ffeglobal_promoted (ffesymbol s) *** 370,373 **** --- 1117,1371 ---- } + /* Register a reference to an intrinsic. Such a reference is always + valid, though a warning might be in order if the same name has + already been used for a global. */ + + void + ffeglobal_ref_intrinsic (ffesymbol s, ffelexToken t, bool explicit) + { + #if FFEGLOBAL_ENABLED + ffename n; + ffeglobal g; + + if (ffesymbol_global (s) == NULL) + { + n = ffename_find (ffeglobal_filewide_, t); + g = ffename_global (n); + } + else + { + g = ffesymbol_global (s); + n = NULL; + } + + if ((g != NULL) && (g->type == FFEGLOBAL_typeANY)) + return; + + if ((g != NULL) && (g->type != FFEGLOBAL_typeNONE)) + { + if (! explicit + && ! g->intrinsic + && ffe_is_warn_globals ()) + { + ffebad_start (FFEBAD_INTRINSIC_GLOBAL); + ffebad_string (ffelex_token_text (t)); + ffebad_string ("intrinsic"); + ffebad_string ("global"); + ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); + ffebad_here (1, ffelex_token_where_line (g->t), + ffelex_token_where_column (g->t)); + ffebad_finish (); + } + } + else + { + if (g == NULL) + { + g = ffeglobal_new_ (n); + g->tick = ffe_count_2; + g->type = FFEGLOBAL_typeNONE; + g->intrinsic = TRUE; + g->explicit_intrinsic = explicit; + g->t = ffelex_token_use (t); + } + else if (g->intrinsic + && (explicit != g->explicit_intrinsic) + && (g->tick != ffe_count_2) + && ffe_is_warn_globals ()) + { + ffebad_start (FFEBAD_INTRINSIC_EXPIMP); + ffebad_string (ffelex_token_text (t)); + ffebad_string (explicit ? "explicit" : "implicit"); + ffebad_string (explicit ? "implicit" : "explicit"); + ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); + ffebad_here (1, ffelex_token_where_line (g->t), + ffelex_token_where_column (g->t)); + ffebad_finish (); + } + } + + g->intrinsic = TRUE; + if (explicit) + g->explicit_intrinsic = TRUE; + + ffesymbol_set_global (s, g); + #endif + } + + /* Register a reference to a global. Returns TRUE if the reference + is valid. */ + + bool + ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type) + { + #if FFEGLOBAL_ENABLED + ffename n = NULL; + ffeglobal g; + + /* It is never really _known_ that an EXTERNAL statement + names a BLOCK DATA by just looking at the program unit, + so override a different notion here. */ + if (type == FFEGLOBAL_typeBDATA) + type = FFEGLOBAL_typeEXT; + + g = ffesymbol_global (s); + if (g == NULL) + { + n = ffename_find (ffeglobal_filewide_, t); + g = ffename_global (n); + if (g != NULL) + ffesymbol_set_global (s, g); + } + + if ((g != NULL) && (g->type == FFEGLOBAL_typeANY)) + return TRUE; + + if ((g != NULL) + && (g->type != FFEGLOBAL_typeNONE) + && (g->type != type) + && (g->type != FFEGLOBAL_typeEXT) + && (type != FFEGLOBAL_typeEXT)) + { + if ((((type == FFEGLOBAL_typeBDATA) + && (g->type != FFEGLOBAL_typeCOMMON)) + || ((g->type == FFEGLOBAL_typeBDATA) + && (type != FFEGLOBAL_typeCOMMON) + && ! g->u.proc.defined))) + { + #if 0 /* This is likely to just annoy people. */ + if (ffe_is_warn_globals ()) + { + ffebad_start (FFEBAD_FILEWIDE_TIFF); + ffebad_string (ffelex_token_text (t)); + ffebad_string (ffeglobal_type_string_[type]); + ffebad_string (ffeglobal_type_string_[g->type]); + ffebad_here (0, ffelex_token_where_line (t), + ffelex_token_where_column (t)); + ffebad_here (1, ffelex_token_where_line (g->t), + ffelex_token_where_column (g->t)); + ffebad_finish (); + } + #endif + } + else if (ffe_is_globals ()) + { + ffebad_start (FFEBAD_FILEWIDE_DISAGREEMENT); + ffebad_string (ffelex_token_text (t)); + ffebad_string (ffeglobal_type_string_[type]); + ffebad_string (ffeglobal_type_string_[g->type]); + ffebad_here (0, ffelex_token_where_line (t), + ffelex_token_where_column (t)); + ffebad_here (1, ffelex_token_where_line (g->t), + ffelex_token_where_column (g->t)); + ffebad_finish (); + g->type = FFEGLOBAL_typeANY; + return FALSE; + } + else if (ffe_is_warn_globals ()) + { + ffebad_start (FFEBAD_FILEWIDE_DISAGREEMENT_W); + ffebad_string (ffelex_token_text (t)); + ffebad_string (ffeglobal_type_string_[type]); + ffebad_string (ffeglobal_type_string_[g->type]); + ffebad_here (0, ffelex_token_where_line (t), + ffelex_token_where_column (t)); + ffebad_here (1, ffelex_token_where_line (g->t), + ffelex_token_where_column (g->t)); + ffebad_finish (); + g->type = FFEGLOBAL_typeANY; + return TRUE; + } + } + + if ((g != NULL) + && (type == FFEGLOBAL_typeFUNC)) + { + /* If just filling in this function's type, do so. */ + if ((g->tick == ffe_count_2) + && (ffesymbol_basictype (s) != FFEINFO_basictypeNONE) + && (ffesymbol_kindtype (s) != FFEINFO_kindtypeNONE)) + { + g->u.proc.bt = ffesymbol_basictype (s); + g->u.proc.kt = ffesymbol_kindtype (s); + g->u.proc.sz = ffesymbol_size (s); + } + /* Else, make sure there is type agreement. */ + else if ((g->u.proc.bt != FFEINFO_basictypeNONE) + && (ffesymbol_basictype (s) != FFEINFO_basictypeNONE) + && ((ffesymbol_basictype (s) != g->u.proc.bt) + || (ffesymbol_kindtype (s) != g->u.proc.kt) + || ((ffesymbol_size (s) != g->u.proc.sz) + && g->u.proc.defined + && (g->u.proc.sz != FFETARGET_charactersizeNONE)))) + { + if (ffe_is_globals ()) + { + ffebad_start (FFEBAD_FILEWIDE_TYPE_MISMATCH); + ffebad_string (ffelex_token_text (t)); + ffebad_here (0, ffelex_token_where_line (t), + ffelex_token_where_column (t)); + ffebad_here (1, ffelex_token_where_line (g->t), + ffelex_token_where_column (g->t)); + ffebad_finish (); + g->type = FFEGLOBAL_typeANY; + return FALSE; + } + if (ffe_is_warn_globals ()) + { + ffebad_start (FFEBAD_FILEWIDE_TYPE_MISMATCH_W); + ffebad_string (ffelex_token_text (t)); + ffebad_here (0, ffelex_token_where_line (t), + ffelex_token_where_column (t)); + ffebad_here (1, ffelex_token_where_line (g->t), + ffelex_token_where_column (g->t)); + ffebad_finish (); + } + g->type = FFEGLOBAL_typeANY; + return TRUE; + } + } + + if (g == NULL) + { + g = ffeglobal_new_ (n); + g->t = ffelex_token_use (t); + g->tick = ffe_count_2; + g->intrinsic = FALSE; + g->type = type; + g->u.proc.defined = FALSE; + g->u.proc.bt = ffesymbol_basictype (s); + g->u.proc.kt = ffesymbol_kindtype (s); + g->u.proc.sz = ffesymbol_size (s); + g->u.proc.n_args = -1; + ffesymbol_set_global (s, g); + } + else if (g->intrinsic + && !g->explicit_intrinsic + && (g->tick != ffe_count_2) + && ffe_is_warn_globals ()) + { + ffebad_start (FFEBAD_INTRINSIC_GLOBAL); + ffebad_string (ffelex_token_text (t)); + ffebad_string ("global"); + ffebad_string ("intrinsic"); + ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); + ffebad_here (1, ffelex_token_where_line (g->t), + ffelex_token_where_column (g->t)); + ffebad_finish (); + } + + if ((g->type != type) + && (type != FFEGLOBAL_typeEXT)) + { + /* We've learned more, so point to where we learned it. */ + g->t = ffelex_token_use (t); + g->type = type; + g->u.proc.n_args = -1; + } + + return TRUE; + #endif + } + /* ffeglobal_save_common -- Check SAVE status of common area *************** ffeglobal_save_common (ffesymbol s, bool *** 391,410 **** if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON)) return; /* Let someone else catch this! */ ! if (!g->have_save) { ! g->have_save = TRUE; ! g->save = save; ! g->save_where_line = ffewhere_line_use (wl); ! g->save_where_col = ffewhere_column_use (wc); } else { ! if ((g->save != save) && ffe_is_pedantic ()) { ffebad_start (FFEBAD_COMMON_DIFF_SAVE); ffebad_string (ffesymbol_text (s)); ffebad_here (save ? 0 : 1, wl, wc); ! ffebad_here (save ? 1 : 0, g->pad_where_line, g->pad_where_col); ffebad_finish (); } --- 1389,1410 ---- if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON)) return; /* Let someone else catch this! */ + if (g->type == FFEGLOBAL_typeANY) + return; ! if (!g->u.common.have_save) { ! g->u.common.have_save = TRUE; ! g->u.common.save = save; ! g->u.common.save_where_line = ffewhere_line_use (wl); ! g->u.common.save_where_col = ffewhere_column_use (wc); } else { ! if ((g->u.common.save != save) && ffe_is_pedantic ()) { ffebad_start (FFEBAD_COMMON_DIFF_SAVE); ffebad_string (ffesymbol_text (s)); ffebad_here (save ? 0 : 1, wl, wc); ! ffebad_here (save ? 1 : 0, g->u.common.pad_where_line, g->u.common.pad_where_col); ffebad_finish (); } *************** ffeglobal_size_common (ffesymbol s, long *** 434,451 **** if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON)) return FALSE; ! if (!g->have_size) { ! g->have_size = TRUE; ! g->size = size; return TRUE; } ! if ((g->size < size) && (g->init > 0) && (g->init < ffe_count_2)) { char oldsize[40]; char newsize[40]; ! sprintf (&oldsize[0], "%ld", g->size); sprintf (&newsize[0], "%ld", size); --- 1434,1453 ---- if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON)) return FALSE; + if (g->type == FFEGLOBAL_typeANY) + return FALSE; ! if (!g->u.common.have_size) { ! g->u.common.have_size = TRUE; ! g->u.common.size = size; return TRUE; } ! if ((g->u.common.size < size) && (g->tick > 0) && (g->tick < ffe_count_2)) { char oldsize[40]; char newsize[40]; ! sprintf (&oldsize[0], "%ld", g->u.common.size); sprintf (&newsize[0], "%ld", size); *************** ffeglobal_size_common (ffesymbol s, long *** 454,468 **** ffebad_string (oldsize); ffebad_string (newsize); ! ffebad_string ((g->size == 1) ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS); ffebad_string ((size == 1) ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS); ! ffebad_here (0, ffelex_token_where_line (g->initt), ! ffelex_token_where_column (g->initt)); ffebad_here (1, ffesymbol_where_line (s), ffesymbol_where_column (s)); ffebad_finish (); } ! else if ((g->size != size) && !g->blank) { char oldsize[40]; --- 1456,1470 ---- ffebad_string (oldsize); ffebad_string (newsize); ! ffebad_string ((g->u.common.size == 1) ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS); ffebad_string ((size == 1) ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS); ! ffebad_here (0, ffelex_token_where_line (g->u.common.initt), ! ffelex_token_where_column (g->u.common.initt)); ffebad_here (1, ffesymbol_where_line (s), ffesymbol_where_column (s)); ffebad_finish (); } ! else if ((g->u.common.size != size) && !g->u.common.blank) { char oldsize[40]; *************** ffeglobal_size_common (ffesymbol s, long *** 480,484 **** always be issued. */ ! sprintf (&oldsize[0], "%ld", g->size); sprintf (&newsize[0], "%ld", size); --- 1482,1486 ---- always be issued. */ ! sprintf (&oldsize[0], "%ld", g->u.common.size); sprintf (&newsize[0], "%ld", size); *************** ffeglobal_size_common (ffesymbol s, long *** 487,491 **** ffebad_string (oldsize); ffebad_string (newsize); ! ffebad_string ((g->size == 1) ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS); ffebad_string ((size == 1) --- 1489,1493 ---- ffebad_string (oldsize); ffebad_string (newsize); ! ffebad_string ((g->u.common.size == 1) ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS); ffebad_string ((size == 1) *************** ffeglobal_size_common (ffesymbol s, long *** 498,504 **** } ! if (size > g->size) { ! g->size = size; return TRUE; } --- 1500,1506 ---- } ! if (size > g->u.common.size) { ! g->u.common.size = size; return TRUE; } diff -rcp2N g77-0.5.20/f/global.h g77-0.5.21/f/global.h *** g77-0.5.20/f/global.h Sat Mar 1 04:24:12 1997 --- g77-0.5.21/f/global.h Tue Sep 9 06:11:36 1997 *************** *** 1,4 **** /* global.h -- Public #include File (module.h template V1.0) ! Copyright (C) 1995 Free Software Foundation, Inc. Contributed by James Craig Burley (burley@gnu.ai.mit.edu). --- 1,4 ---- /* global.h -- Public #include File (module.h template V1.0) ! Copyright (C) 1995, 1997 Free Software Foundation, Inc. Contributed by James Craig Burley (burley@gnu.ai.mit.edu). *************** the Free Software Foundation, 59 Temple *** 35,39 **** --- 35,41 ---- typedef enum { + FFEGLOBAL_typeNONE, FFEGLOBAL_typeMAIN, + FFEGLOBAL_typeEXT, /* EXTERNAL is all we know. */ FFEGLOBAL_typeSUBR, FFEGLOBAL_typeFUNC, *************** typedef enum *** 44,53 **** --- 46,72 ---- } ffeglobalType; + typedef enum + { + FFEGLOBAL_argsummaryNONE, /* No arg present. */ + FFEGLOBAL_argsummaryVAL, /* Pass-by-value. */ + FFEGLOBAL_argsummaryREF, /* Pass-by-reference. */ + FFEGLOBAL_argsummaryDESCR, /* Pass-by-descriptor. */ + FFEGLOBAL_argsummaryPROC, /* Procedure (intrinsic, external). */ + FFEGLOBAL_argsummarySUBR, /* Subroutine (intrinsic, external). */ + FFEGLOBAL_argsummaryFUNC, /* Function (intrinsic, external). */ + FFEGLOBAL_argsummaryALTRTN, /* Alternate-return (label). */ + FFEGLOBAL_argsummaryPTR, /* Pointer (%LOC, LOC()). */ + FFEGLOBAL_argsummaryANY, + FFEGLOBAL_argsummary + } ffeglobalArgSummary; + /* Typedefs. */ + typedef struct _ffeglobal_arginfo_ *ffeglobalArgInfo_; typedef struct _ffeglobal_ *ffeglobal; /* Include files needed by this one. */ + #include "info.h" #include "lex.h" #include "name.h" *************** typedef struct _ffeglobal_ *ffeglobal; *** 58,84 **** /* Structure definitions. */ struct _ffeglobal_ ! { ! ffelexToken t; ! ffename n; #ifdef FFECOM_globalHOOK ! ffecomGlobal hook; #endif ! ffeCounter init; /* COMMON block given initial value(s) in ! this progunit. */ ! ffelexToken initt; /* First initial value. */ ! ffeglobalType type; ! bool have_pad; /* Padding info avail for COMMON? */ ! ffetargetAlign pad; /* Initial padding for COMMON. */ ! ffewhereLine pad_where_line; ! ffewhereColumn pad_where_col; ! bool have_save; /* Save info avail for COMMON? */ ! bool save; /* Save info for COMMON. */ ! ffewhereLine save_where_line; ! ffewhereColumn save_where_col; ! bool have_size; /* Size info avail for COMMON? */ ! long size; /* Size info for COMMON. */ ! bool blank; /* TRUE if blank COMMON. */ ! }; /* Global objects accessed by users of this module. */ --- 77,127 ---- /* Structure definitions. */ + struct _ffeglobal_arginfo_ + { + ffelexToken t; /* Different from master token when difference is important. */ + char *name; /* Name of dummy arg, or NULL if not yet known. */ + ffeglobalArgSummary as; + ffeinfoBasictype bt; + ffeinfoKindtype kt; + bool array; + }; + struct _ffeglobal_ ! { ! ffelexToken t; ! ffename n; #ifdef FFECOM_globalHOOK ! ffecomGlobal hook; #endif ! ffeCounter tick; /* Recent transition in this progunit. */ ! ffeglobalType type; ! bool intrinsic; /* Known as intrinsic? */ ! bool explicit_intrinsic; /* Explicit intrinsic? */ ! union { ! struct { ! ffelexToken initt; /* First initial value. */ ! bool have_pad; /* Padding info avail for COMMON? */ ! ffetargetAlign pad; /* Initial padding for COMMON. */ ! ffewhereLine pad_where_line; ! ffewhereColumn pad_where_col; ! bool have_save; /* Save info avail for COMMON? */ ! bool save; /* Save info for COMMON. */ ! ffewhereLine save_where_line; ! ffewhereColumn save_where_col; ! bool have_size; /* Size info avail for COMMON? */ ! long size; /* Size info for COMMON. */ ! bool blank; /* TRUE if blank COMMON. */ ! } common; ! struct { ! bool defined; /* Seen actual code yet? */ ! ffeinfoBasictype bt; /* NONE for non-function. */ ! ffeinfoKindtype kt; /* NONE for non-function. */ ! ffetargetCharacterSize sz; ! int n_args; /* 0 for main/blockdata. */ ! ffelexToken other_t; /* Location of reference. */ ! ffeglobalArgInfo_ arg_info; /* Info on each argument. */ ! } proc; ! } u; ! }; /* Global objects accessed by users of this module. */ *************** void ffeglobal_new_common (ffesymbol s, *** 94,98 **** --- 137,151 ---- void ffeglobal_pad_common (ffesymbol s, ffetargetAlign pad, ffewhereLine wl, ffewhereColumn wc); + void ffeglobal_proc_def_arg (ffesymbol s, int argno, char *name, ffeglobalArgSummary as, + ffeinfoBasictype bt, ffeinfoKindtype kt, + bool array); + void ffeglobal_proc_def_nargs (ffesymbol s, int n_args); + bool ffeglobal_proc_ref_arg (ffesymbol s, int argno, ffeglobalArgSummary as, + ffeinfoBasictype bt, ffeinfoKindtype kt, + bool array, ffelexToken t); + bool ffeglobal_proc_ref_nargs (ffesymbol s, int n_args, ffelexToken t); ffeglobal ffeglobal_promoted (ffesymbol s); + void ffeglobal_ref_intrinsic (ffesymbol s, ffelexToken t, bool explicit); + bool ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type); void ffeglobal_save_common (ffesymbol s, bool save, ffewhereLine wl, ffewhereColumn wc); *************** void ffeglobal_terminate_1 (void); *** 110,116 **** #endif ! #define ffeglobal_common_init(g) ((g)->init != 0) ! #define ffeglobal_have_pad(g) ((g)->have_pad) ! #define ffeglobal_have_size(g) ((g)->have_size) #define ffeglobal_hook(g) ((g)->hook) #define ffeglobal_init_0() --- 163,170 ---- #endif ! #define ffeglobal_common_init(g) ((g)->tick != 0) ! #define ffeglobal_common_have_pad(g) ((g)->u.common.have_pad) ! #define ffeglobal_common_have_size(g) ((g)->u.common.have_size) ! #define ffeglobal_common_size(g) ((g)->u.common.size) #define ffeglobal_hook(g) ((g)->hook) #define ffeglobal_init_0() *************** void ffeglobal_terminate_1 (void); *** 127,132 **** ffeglobal_new_progunit_(s,t,FFEGLOBAL_typeSUBR) #define ffeglobal_pad(g) ((g)->pad) #define ffeglobal_set_hook(g,h) ((g)->hook = (h)) - #define ffeglobal_size(g) ((g)->size) #define ffeglobal_terminate_0() #define ffeglobal_terminate_2() --- 181,193 ---- ffeglobal_new_progunit_(s,t,FFEGLOBAL_typeSUBR) #define ffeglobal_pad(g) ((g)->pad) + #define ffeglobal_ref_blockdata(s,t) \ + ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeBDATA) + #define ffeglobal_ref_external(s,t) \ + ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeEXT) + #define ffeglobal_ref_function(s,t) \ + ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeFUNC) + #define ffeglobal_ref_subroutine(s,t) \ + ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeSUBR) #define ffeglobal_set_hook(g,h) ((g)->hook = (h)) #define ffeglobal_terminate_0() #define ffeglobal_terminate_2() diff -rcp2N g77-0.5.20/f/install.texi g77-0.5.21/f/install.texi *** g77-0.5.20/f/install.texi Thu Feb 27 05:13:04 1997 --- g77-0.5.21/f/install.texi Tue Sep 9 06:11:36 1997 *************** *** 6,10 **** @c in the G77 distribution, as well as in the G77 manual. ! @c 1997-02-25 @ifclear INSTALLONLY --- 6,10 ---- @c in the G77 distribution, as well as in the G77 manual. ! @c 1997-09-09 @ifclear INSTALLONLY *************** a complete GNU UNIX system can be put to *** 62,74 **** most systems, if desired. ! @item @file{gcc-2.7.2.2.tar.gz} You need to have this, or some other applicable, version of @code{gcc} on your system. The version should be an exact copy of a distribution from the FSF. ! It is approximately 7MB large. ! If you've already unpacked @file{gcc-2.7.2.2.tar.gz} into a ! directory (named @file{gcc-2.7.2.2}) called the @dfn{source tree} for @code{gcc}, you can delete the distribution itself, but you'll need to remember to skip any instructions to unpack --- 62,79 ---- most systems, if desired. ! The version of GNU @code{gzip} used to package this release ! is 1.24. ! (The version of GNU @code{tar} used to package this release ! is 1.11.2.) ! ! @item @file{gcc-2.7.2.3.tar.gz} You need to have this, or some other applicable, version of @code{gcc} on your system. The version should be an exact copy of a distribution from the FSF. ! Its size is approximately 7.1MB. ! If you've already unpacked @file{gcc-2.7.2.3.tar.gz} into a ! directory (named @file{gcc-2.7.2.3}) called the @dfn{source tree} for @code{gcc}, you can delete the distribution itself, but you'll need to remember to skip any instructions to unpack *************** build @code{g77}. *** 79,108 **** You can obtain an FSF distribution of @code{gcc} from the FSF. ! @item @file{g77-0.5.20.tar.gz} ! You probably have already unpacked this distribution, ! or you are reading an advanced copy of this manual, ! which is contained in this distribution. ! This distribution approximately 1MB large. You can obtain an FSF distribution of @code{g77} from the FSF, the same way you obtained @code{gcc}. ! @item 100MB disk space ! For a complete @dfn{bootstrap} build, about 100MB ! of disk space is required for @code{g77} by the author's ! current GNU/Linux system. ! ! Some juggling can reduce the amount of space needed; ! during the bootstrap process, once Stage 3 starts, ! during which the version of @code{gcc} that has been copied ! into the @file{stage2/} directory is used to rebuild the ! system, you can delete the @file{stage1/} directory ! to free up some space. ! ! It is likely that many systems don't require the complete ! bootstrap build, as they already have a recent version of ! @code{gcc} installed. ! Such systems might be able to build @code{g77} with only ! about 75MB of free space. @item @code{patch} --- 84,189 ---- You can obtain an FSF distribution of @code{gcc} from the FSF. ! @item @file{g77-0.5.21.tar.gz} ! You probably have already unpacked this package, ! or you are reading an advance copy of these installation instructions, ! which are contained in this distribution. ! The size of this package is approximately 1.5MB. You can obtain an FSF distribution of @code{g77} from the FSF, the same way you obtained @code{gcc}. ! @item Enough disk space ! The amount of disk space needed to unpack, build, install, ! and use @code{g77} depends on the type of system you're ! using, how you build @code{g77}, and how much of it you ! install (primarily, which languages you install). ! ! The sizes shown below assume all languages distributed ! in @code{gcc-2.7.2.3}, plus @code{g77}, will be built ! and installed. ! These sizes are indicative of GNU/Linux systems on ! Intel x86 running COFF and on Digital Alpha (AXP) systems ! running ELF. ! These should be fairly representative of 32-bit and 64-bit ! systems, respectively. ! ! Note that all sizes are approximate and subject to change without ! notice! ! They are based on preliminary releases of g77 made shortly ! before the public beta release. ! ! @itemize --- ! @item ! @code{gcc} and @code{g77} distributions occupy 8.6MB ! packed, 35MB unpacked. ! These consist of the source code and documentation, ! plus some derived files (mostly documentation), for ! @code{gcc} and @code{g77}. ! Any deviations from these numbers for different ! kinds of systems are likely to be very minor. ! ! @item ! A ``bootstrap'' build requires an additional 67.3MB ! for a total of 102MB on an ix86, and an additional ! 98MB for a total of 165MB on an Alpha. ! ! @item ! Removing @file{gcc/stage1} after the build recovers ! 10.7MB for a total of 91MB on an ix86, and recovers ! ??MB for a total of ??MB on an Alpha. ! ! After doing this, the integrity of the build can ! still be verified via @samp{make compare}, and the ! @code{gcc} compiler modified and used to build itself for ! testing fairly quickly, using the copy of the compiler ! kept in @code{gcc/stage2}. ! ! @item ! Removing @file{gcc/stage2} after the build further ! recovers 27.3MB for a total of 64.3MB, and recovers ! ??MB for a total of ??MB on an Alpha. ! ! After doing this, the compiler can still be installed, ! especially if GNU @code{make} is used to avoid ! gratuitous rebuilds (or, the installation can be done ! by hand). ! ! @item ! Installing @code{gcc} and @code{g77} copies ! 14.9MB onto the @samp{--prefix} disk for a total of 79.2MB ! on an ix86, and copies ??MB onto the @samp{--prefix} ! disk for a total of ??MB on an Alpha. ! @end itemize ! ! After installation, if no further modifications and ! builds of @code{gcc} or @code{g77} are planned, the ! source and build directory may be removed, leaving ! the total impact on a system's disk storage as ! that of the amount copied during installation. ! ! Systems with the appropriate version of @code{gcc} ! installed don't require the complete ! bootstrap build. ! Doing a ``straight build'' requires about as much ! space as does a bootstrap build followed by removing ! both the @file{gcc/stage1} and @file{gcc/stage2} ! directories. ! ! Installing @code{gcc} and @code{g77} over existing ! versions might require less @emph{new} disk space, ! but note that, unlike many products, @code{gcc} ! installs itself in a way that avoids overwriting other ! installed versions of itself, so that other versions may ! easily be invoked (via @samp{gcc -V @var{version}}). ! ! So, the amount of space saved as a result of having ! an existing version of @code{gcc} and @code{g77} ! already installed is not much---typically only the ! command drivers (@code{gcc}, @code{g77}, @code{g++}, ! and so on, which are small) and the documentation ! is overwritten by the new installation. ! The rest of the new installation is done without ! replacing existing installed versions (assuming ! they have different version numbers). @item @code{patch} *************** In any case, you can apply patches by ha *** 117,120 **** --- 198,204 ---- are designed for humans to read them. + The version of GNU @code{patch} used to develop this release + is 2.4. + @item @code{make} Your system must have @code{make}, and you will probably save *************** yourself a lot of trouble if it is GNU @ *** 122,125 **** --- 206,212 ---- referred to as @code{gmake}). + The version of GNU @code{make} used to develop this release + is 3.73. + @item @code{cc} Your system must have a working C compiler. *************** You can obtain @code{bison} the same way *** 136,139 **** --- 223,229 ---- @code{gcc} and @code{g77}. + The version of GNU @code{bison} used to develop this release + is 1.25. + @xref{Missing bison?}, for information on how to work around not having @code{bison}. *************** You can obtain @code{makeinfo} the same *** 145,155 **** @code{gcc} and @code{g77}. @xref{Missing makeinfo?}, for information on getting around the lack of @code{makeinfo}. ! @item @code{root} access To perform the complete installation procedures on a system, you need to have @code{root} access to that system, or ! equivalent access. Portions of the procedure (such as configuring and building --- 235,261 ---- @code{gcc} and @code{g77}. + The version of GNU @code{makeinfo} used to develop this release + is 1.68, from GNU @code{texinfo} version 3.11. + @xref{Missing makeinfo?}, for information on getting around the lack of @code{makeinfo}. ! @item @code{sed} ! All UNIX systems have @code{sed}, but some have a broken ! version that cannot handle configuring, building, or ! installing @code{gcc} or @code{g77}. ! ! The version of GNU @code{sed} used to develop this release ! is 2.05. ! (Note that GNU @code{sed} version 3.0 was withdrawn by the ! FSF---if you happen to have this version installed, replace ! it with version 2.05 immediately. ! See a GNU distribution site for further explanation.) ! ! @item @code{root} access or equivalent To perform the complete installation procedures on a system, you need to have @code{root} access to that system, or ! equivalent access to the @samp{--prefix} directory tree ! specified on the @code{configure} command line. Portions of the procedure (such as configuring and building *************** These problems can occur on most or all *** 199,202 **** --- 305,309 ---- flag @file{f/zzz.o}. * Cleanup Kills Stage Directories:: A minor nit for @code{g77} developers. + * Missing gperf?:: When building requires @code{gperf}. @end menu *************** subdirectories, so developers and expert *** 318,321 **** --- 425,470 ---- reconfigure after cleaning up. + @node Missing gperf? + @subsubsection Missing @code{gperf}? + @cindex @code{gperf} + @cindex missing @code{gperf} + + If a build aborts trying to invoke @code{gperf}, that + strongly suggests an improper method was used to + create the @code{gcc} source directory, + such as the UNIX @samp{cp -r} command instead + of @samp{cp -pr}, since this problem very likely + indicates that the date-time-modified information on + the @code{gcc} source files is incorrect. + + The proper solution is to recreate the @code{gcc} source + directory from a @code{gcc} distribution known to be + provided by the FSF. + + It is possible you might be able to temporarily + work around the problem, however, by trying these + commands: + + @example + sh# @kbd{cd gcc} + sh# @kbd{touch c-gperf.h} + sh# + @end example + + These commands update the date-time-modified information for + the file produced by the invocation of @code{gperf} + in the current versions of @code{gcc}, so that @code{make} no + longer believes it needs to update it. + This file should already exist in a @code{gcc} + distribution, but mistakes made when copying the @code{gcc} + directory can leave the modification information + set such that the @code{gperf} input files look more ``recent'' + than the corresponding output files. + + If the above does not work, definitely start from scratch + and avoid copying the @code{gcc} using any method that does + not reliably preserve date-time-modified information, such + as the UNIX @samp{cp -r} command. + @node Cross-compiler Problems @subsection Cross-compiler Problems *************** constants. *** 364,368 **** Improvements to the way @code{libf2c} is built could make building @code{g77} as a cross-compiler easier---for example, ! passing and using @samp{LD} and @samp{AR} in the appropriate ways. --- 513,517 ---- Improvements to the way @code{libf2c} is built could make building @code{g77} as a cross-compiler easier---for example, ! passing and using @samp{$(LD)} and @samp{$(AR)} in the appropriate ways. *************** be pertinent in future versions of @code *** 390,397 **** * Larger File Unit Numbers:: Raising @samp{MXUNIT}. * Always Flush Output:: Synchronizing write errors. ! * Maximum Stackable Size:: Large arrays are forced off the stack frame. ! * Floating-point Bit Patterns:: Possible programs building cross-compiler. ! * Large Initialization:: Large arrays with @code{DATA} initialization. ! * Alpha Problems Fixed:: Problems 64-bit systems like Alphas now fixed? @end menu --- 539,549 ---- * Larger File Unit Numbers:: Raising @samp{MXUNIT}. * Always Flush Output:: Synchronizing write errors. ! * Maximum Stackable Size:: Large arrays forced off the stack. ! * Floating-point Bit Patterns:: Possible programs building @code{g77} ! as a cross-compiler. ! * Large Initialization:: Large arrays with @code{DATA} ! initialization. ! * Alpha Problems Fixed:: Problems with 64-bit systems like ! Alphas now fixed? @end menu *************** used by the author of @code{g77} on his *** 630,635 **** @example ! /usr/FSF/gcc-2.7.2.2.tar.gz ! /usr/FSF/g77-0.5.20.tar.gz @end example --- 782,787 ---- @example ! /usr/FSF/gcc-2.7.2.3.tar.gz ! /usr/FSF/g77-0.5.21.tar.gz @end example *************** These explanations follow this list of s *** 672,689 **** sh[ 1]# @kbd{cd /usr/src} @set source-dir 1 ! sh[ 2]# @kbd{gunzip -c < /usr/FSF/gcc-2.7.2.2.tar.gz | tar xf -} [Might say "Broken pipe"...that is normal on some systems.] @set unpack-gcc 2 ! sh[ 3]# @kbd{gunzip -c < /usr/FSF/g77-0.5.20.tar.gz | tar xf -} ["Broken pipe" again possible.] @set unpack-g77 3 ! sh[ 4]# @kbd{ln -s gcc-2.7.2.2 gcc} @set link-gcc 4 ! sh[ 5]# @kbd{ln -s g77-0.5.20 g77} @set link-g77 5 sh[ 6]# @kbd{mv -i g77/* gcc} [No questions should be asked by mv here; or, you made a mistake.] @set merge-g77 6 ! sh[ 7]# @kbd{patch -p1 -V t -d gcc < gcc/f/gbe/2.7.2.2.diff} [Unless patch complains about rejected patches, this step worked.] @set apply-patch 7 --- 824,841 ---- sh[ 1]# @kbd{cd /usr/src} @set source-dir 1 ! sh[ 2]# @kbd{gunzip -c < /usr/FSF/gcc-2.7.2.3.tar.gz | tar xf -} [Might say "Broken pipe"...that is normal on some systems.] @set unpack-gcc 2 ! sh[ 3]# @kbd{gunzip -c < /usr/FSF/g77-0.5.21.tar.gz | tar xf -} ["Broken pipe" again possible.] @set unpack-g77 3 ! sh[ 4]# @kbd{ln -s gcc-2.7.2.3 gcc} @set link-gcc 4 ! sh[ 5]# @kbd{ln -s g77-0.5.21 g77} @set link-g77 5 sh[ 6]# @kbd{mv -i g77/* gcc} [No questions should be asked by mv here; or, you made a mistake.] @set merge-g77 6 ! sh[ 7]# @kbd{patch -p1 -V t -d gcc < gcc/f/gbe/2.7.2.3.diff} [Unless patch complains about rejected patches, this step worked.] @set apply-patch 7 *************** sh[12]# @kbd{make bootstrap} *** 707,720 **** [This takes a long time, and is where most problems occur.] @set build-gcc 12 ! sh[13]# @kbd{rm -fr stage1} ! @set rm-stage1 13 ! sh[14]# @kbd{make -k install} [The actual installation.] ! @set install-g77 14 ! sh[15]# @kbd{g77 -v} [Verify that g77 is installed, obtain version info.] ! @set show-version 15 ! sh[16]# ! @set end-procedure 16 @end example --- 859,879 ---- [This takes a long time, and is where most problems occur.] @set build-gcc 12 ! sh[13]# @kbd{make compare} ! [This verifies that the compiler is `sane'. Only ! the file `f/zzz.o' (aka `tmp-foo1' and `tmp-foo2') ! should be in the list of object files this command ! prints as having different contents. If other files ! are printed, you have likely found a g77 bug.] ! @set compare-gcc 13 ! sh[14]# @kbd{rm -fr stage1} ! @set rm-stage1 14 ! sh[15]# @kbd{make -k install} [The actual installation.] ! @set install-g77 15 ! sh[16]# @kbd{g77 -v} [Verify that g77 is installed, obtain version info.] ! @set show-version 16 ! sh[17]# ! @set end-procedure 17 @end example *************** installed version of @code{g77} and @cod *** 740,744 **** @c similar results. ! @item Step @value{unpack-g77}: @kbd{gunzip -d < /usr/FSF/g77-0.5.20.tar.gz | tar xf -} It is not always necessary to obtain the latest version of @code{g77} as a complete @file{.tar.gz} file if you have --- 899,903 ---- @c similar results. ! @item Step @value{unpack-g77}: @kbd{gunzip -d < /usr/FSF/g77-0.5.21.tar.gz | tar xf -} It is not always necessary to obtain the latest version of @code{g77} as a complete @file{.tar.gz} file if you have *************** If appropriate, you can unpack that earl *** 747,754 **** version of @code{g77}, and then apply the appropriate patches to achieve the same result---a source tree containing version ! 0.5.20 of @code{g77}. ! @item Step @value{link-gcc}: @kbd{ln -s gcc-2.7.2.2 gcc} ! @item Step @value{link-g77}: @kbd{ln -s g77-0.5.20 g77} These commands mainly help reduce typing, and help reduce visual clutter in examples --- 906,913 ---- version of @code{g77}, and then apply the appropriate patches to achieve the same result---a source tree containing version ! 0.5.21 of @code{g77}. ! @item Step @value{link-gcc}: @kbd{ln -s gcc-2.7.2.3 gcc} ! @item Step @value{link-g77}: @kbd{ln -s g77-0.5.21 g77} These commands mainly help reduce typing, and help reduce visual clutter in examples *************** other than the FSF. *** 764,768 **** @item Step @value{merge-g77}: @kbd{mv -i g77/* gcc} After doing this, you can, if you like, type ! @samp{rm g77} and @samp{rmdir g77-0.5.20} to remove the empty directory and the symbol link to it. But, it might be helpful to leave them around as --- 923,927 ---- @item Step @value{merge-g77}: @kbd{mv -i g77/* gcc} After doing this, you can, if you like, type ! @samp{rm g77} and @samp{rmdir g77-0.5.21} to remove the empty directory and the symbol link to it. But, it might be helpful to leave them around as *************** this procedure. *** 843,846 **** --- 1002,1014 ---- information on this step. + @item Step @value{compare-gcc}: @kbd{make compare} + @xref{Bug Lists,,Where to Port Bugs}, for information + on where to report that you observed more than + @file{f/zzz.o} having different contents during this + phase. + + @xref{Bug Reporting,,How to Report Bugs}, for + information on @emph{how} to report bugs like this. + @item Step @value{rm-stage1}: @kbd{rm -fr stage1} You don't need to do this, but it frees up disk space. *************** and @code{g77} is: *** 963,970 **** @example sh# @kbd{cd /usr/src} ! sh# @kbd{gunzip -d < /usr/FSF/gcc-2.7.2.2.tar.gz | tar xf -} ! sh# @kbd{gunzip -d < /usr/FSF/g77-0.5.20.tar.gz | tar xf -} ! sh# @kbd{ln -s gcc-2.7.2.2 gcc} ! sh# @kbd{ln -s g77-0.5.20 g77} sh# @kbd{mv -i g77/* gcc} @end example --- 1131,1138 ---- @example sh# @kbd{cd /usr/src} ! sh# @kbd{gunzip -c /usr/FSF/gcc-2.7.2.3.tar.gz | tar xf -} ! sh# @kbd{gunzip -c /usr/FSF/g77-0.5.21.tar.gz | tar xf -} ! sh# @kbd{ln -s gcc-2.7.2.3 gcc} ! sh# @kbd{ln -s g77-0.5.21 g77} sh# @kbd{mv -i g77/* gcc} @end example *************** g77/f *** 991,995 **** All three entries should be moved (or copied) into a @code{gcc} source tree (typically named after its version number and ! as it appears in the FSF distributions---e.g. @file{gcc-2.7.2.2}). @file{g77/f} is the subdirectory containing all of the --- 1159,1163 ---- All three entries should be moved (or copied) into a @code{gcc} source tree (typically named after its version number and ! as it appears in the FSF distributions---e.g. @file{gcc-2.7.2.3}). @file{g77/f} is the subdirectory containing all of the *************** to dealing with this problem that have a *** 1317,1320 **** --- 1485,1490 ---- @node Where to Install @subsection Where in the World Does Fortran (and GNU CC) Go? + @cindex language f77 not recognized + @cindex gcc will not compile Fortran programs Before configuring, you should make sure you know *************** All sorts of interesting information on *** 1365,1368 **** --- 1535,1540 ---- @code{gcc}-related programs and data files should be visible in the output of the above command. + (The output also is likely to include a diagnostic from + the linker, since there's no @samp{main_()} function.) However, you do have to sift through it yourself; @code{gcc} currently provides no easy way to ask it where it is installed *************** printed by them when they work: *** 1607,1616 **** sh# @kbd{cd /usr/src/gcc} sh# @kbd{./g77 --driver=./xgcc -B./ -v} ! g77 version 0.5.20 ./xgcc -B./ -v -fnull-version -o /tmp/gfa18047 @dots{} Reading specs from ./specs ! gcc version 2.7.2.2.f.2 ./cpp -lang-c -v -isystem ./include -undef @dots{} ! GNU CPP version 2.7.2.2.f.2 (Linux/Alpha) #include "..." search starts here: #include <...> search starts here: --- 1779,1788 ---- sh# @kbd{cd /usr/src/gcc} sh# @kbd{./g77 --driver=./xgcc -B./ -v} ! g77 version 0.5.21 ./xgcc -B./ -v -fnull-version -o /tmp/gfa18047 @dots{} Reading specs from ./specs ! gcc version 2.7.2.3.f.1 ./cpp -lang-c -v -isystem ./include -undef @dots{} ! GNU CPP version 2.7.2.3.f.1 (Linux/Alpha) #include "..." search starts here: #include <...> search starts here: *************** GNU CPP version 2.7.2.2.f.2 (Linux/Alpha *** 1618,1640 **** /usr/local/include /usr/alpha-unknown-linux/include ! /usr/lib/gcc-lib/alpha-unknown-linux/2.7.2.2.f.2/include /usr/include End of search list. ./f771 /tmp/cca18048.i -fset-g77-defaults -quiet -dumpbase @dots{} ! GNU F77 version 2.7.2.2.f.2 (Linux/Alpha) compiled @dots{} ! GNU Fortran Front End version 0.5.20-970224 compiled: @dots{} as -nocpp -o /tmp/cca180481.o /tmp/cca18048.s ld -G 8 -O1 -o /tmp/gfa18047 /usr/lib/crt0.o -L. @dots{} ! __G77_LIBF77_VERSION__: 0.5.20 ! @@(#)LIBF77 VERSION 19960619 ! __G77_LIBI77_VERSION__: 0.5.20 ! @@(#) LIBI77 VERSION pjw,dmg-mods 19961209 ! __G77_LIBU77_VERSION__: 0.5.20 ! @@(#) LIBU77 VERSION 19970204 sh# @kbd{./xgcc -B./ -v -o /tmp/delete-me -xc /dev/null -xnone} Reading specs from ./specs ! gcc version 2.7.2.2.f.2 ./cpp -lang-c -v -isystem ./include -undef @dots{} ! GNU CPP version 2.7.2.2.f.2 (Linux/Alpha) #include "..." search starts here: #include <...> search starts here: --- 1790,1812 ---- /usr/local/include /usr/alpha-unknown-linux/include ! /usr/lib/gcc-lib/alpha-unknown-linux/2.7.2.3.f.1/include /usr/include End of search list. ./f771 /tmp/cca18048.i -fset-g77-defaults -quiet -dumpbase @dots{} ! GNU F77 version 2.7.2.3.f.1 (Linux/Alpha) compiled @dots{} ! GNU Fortran Front End version 0.5.21 compiled: @dots{} as -nocpp -o /tmp/cca180481.o /tmp/cca18048.s ld -G 8 -O1 -o /tmp/gfa18047 /usr/lib/crt0.o -L. @dots{} ! __G77_LIBF77_VERSION__: 0.5.21 ! @@(#)LIBF77 VERSION 19970404 ! __G77_LIBI77_VERSION__: 0.5.21 ! @@(#) LIBI77 VERSION pjw,dmg-mods 19970816 ! __G77_LIBU77_VERSION__: 0.5.21 ! @@(#) LIBU77 VERSION 19970609 sh# @kbd{./xgcc -B./ -v -o /tmp/delete-me -xc /dev/null -xnone} Reading specs from ./specs ! gcc version 2.7.2.3.f.1 ./cpp -lang-c -v -isystem ./include -undef @dots{} ! GNU CPP version 2.7.2.3.f.1 (Linux/Alpha) #include "..." search starts here: #include <...> search starts here: *************** GNU CPP version 2.7.2.2.f.2 (Linux/Alpha *** 1642,1650 **** /usr/local/include /usr/alpha-unknown-linux/include ! /usr/lib/gcc-lib/alpha-unknown-linux/2.7.2.2.f.2/include /usr/include End of search list. ./cc1 /tmp/cca18063.i -quiet -dumpbase null.c -version @dots{} ! GNU C version 2.7.2.2.f.2 (Linux/Alpha) compiled @dots{} as -nocpp -o /tmp/cca180631.o /tmp/cca18063.s ld -G 8 -O1 -o /tmp/delete-me /usr/lib/crt0.o -L. @dots{} --- 1814,1822 ---- /usr/local/include /usr/alpha-unknown-linux/include ! /usr/lib/gcc-lib/alpha-unknown-linux/2.7.2.3.f.1/include /usr/include End of search list. ./cc1 /tmp/cca18063.i -quiet -dumpbase null.c -version @dots{} ! GNU C version 2.7.2.3.f.1 (Linux/Alpha) compiled @dots{} as -nocpp -o /tmp/cca180631.o /tmp/cca18063.s ld -G 8 -O1 -o /tmp/delete-me /usr/lib/crt0.o -L. @dots{} diff -rcp2N g77-0.5.20/f/intdoc.c g77-0.5.21/f/intdoc.c *** g77-0.5.20/f/intdoc.c Fri Feb 28 06:54:54 1997 --- g77-0.5.21/f/intdoc.c Tue Sep 9 06:11:36 1997 *************** the Free Software Foundation, 59 Temple *** 20,27 **** 02111-1307, USA. */ ! #include "proj.h" #define FFEINTRIN_DOC 1 #include "intrin.h" char *family_name (ffeintrinFamily family); static void dumpif (ffeintrinFamily fam); --- 20,48 ---- 02111-1307, USA. */ ! /* From f/proj.h, which uses #error -- not all C compilers ! support that, and we want _this_ program to be compilable ! by pretty much any C compiler. */ ! ! #include "assert.j" /* Use gcc's assert.h. */ ! #include ! #include ! #include ! #include #define FFEINTRIN_DOC 1 #include "intrin.h" + typedef enum + { + #if !defined(false) || !defined(true) + false = 0, true = 1, + #endif + #if !defined(FALSE) || !defined(TRUE) + FALSE = 0, TRUE = 1, + #endif + Doggone_Trailing_Comma_Dont_Work = 1 + } bool; + + #define ARRAY_SIZE(a) (sizeof(a)/sizeof(a[0])) + char *family_name (ffeintrinFamily family); static void dumpif (ffeintrinFamily fam); *************** static void dumpgen (int menu, char *nam *** 33,38 **** static void dumpspec (int menu, char *name, char *name_uc, ffeintrinSpec spec); ! static void dumpimp (int menu, char *name, char *name_uc, ! size_t genno, ffeintrinFamily family, ffeintrinImp imp); static char *argument_info_ptr (ffeintrinImp imp, int argno); static char *argument_info_string (ffeintrinImp imp, int argno); --- 54,59 ---- static void dumpspec (int menu, char *name, char *name_uc, ffeintrinSpec spec); ! static void dumpimp (int menu, char *name, char *name_uc, size_t genno, ffeintrinFamily family, ! ffeintrinImp imp, ffeintrinSpec spec); static char *argument_info_ptr (ffeintrinImp imp, int argno); static char *argument_info_string (ffeintrinImp imp, int argno); *************** main (int argc, char **argv __attribute_ *** 52,57 **** { fprintf (stderr, "\ ! Usage: intdoc > intdoc.texi ! Collects and dumps documentation on g77 intrinsics to the file named intdoc.texi.\n"); exit (1); --- 73,78 ---- { fprintf (stderr, "\ ! Usage: intdoc > intdoc.texi\n\ ! Collects and dumps documentation on g77 intrinsics\n\ to the file named intdoc.texi.\n"); exit (1); *************** struct _ffeintrin_imp_ *** 90,94 **** { char *name; /* Name of implementation. */ - ffeintrinImp cg_imp; /* Unique code-generation code. */ #if 0 /* FFECOM_targetCURRENT == FFECOM_targetGCC */ ffecomGfrt gfrt; /* gfrt index in library. */ --- 111,114 ---- *************** static struct _ffeintrin_name_ names[] = *** 102,107 **** #define DEFGEN(CODE,NAME,SPEC1,SPEC2) #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) ! #define DEFIMP(CODE,NAME,GFRT,CONTROL) ! #define DEFIMQ(CODE,NAME,GFRT,CONTROL,CGIMP) #include "intrin.def" #undef DEFNAME --- 122,126 ---- #define DEFGEN(CODE,NAME,SPEC1,SPEC2) #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) ! #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) #include "intrin.def" #undef DEFNAME *************** static struct _ffeintrin_name_ names[] = *** 109,113 **** #undef DEFSPEC #undef DEFIMP - #undef DEFIMQ }; --- 128,131 ---- *************** static struct _ffeintrin_gen_ gens[] = { *** 117,122 **** { NAME, { SPEC1, SPEC2, }, }, #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) ! #define DEFIMP(CODE,NAME,GFRT,CONTROL) ! #define DEFIMQ(CODE,NAME,GFRT,CONTROL,CGIMP) #include "intrin.def" #undef DEFNAME --- 135,139 ---- { NAME, { SPEC1, SPEC2, }, }, #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) ! #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) #include "intrin.def" #undef DEFNAME *************** static struct _ffeintrin_gen_ gens[] = { *** 124,128 **** #undef DEFSPEC #undef DEFIMP - #undef DEFIMQ }; --- 141,144 ---- *************** static struct _ffeintrin_imp_ imps[] = { *** 132,144 **** #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) #if 0 /* FFECOM_targetCURRENT == FFECOM_targetGCC */ ! #define DEFIMP(CODE,NAME,GFRT,CONTROL) \ ! { NAME, FFEINTRIN_imp ## CODE, FFECOM_gfrt ## GFRT, CONTROL }, ! #define DEFIMQ(CODE,NAME,GFRT,CONTROL,CGIMP) \ ! { NAME, FFEINTRIN_imp ## CGIMP, FFECOM_gfrt ## GFRT, CONTROL }, #elif 1 /* FFECOM_targetCURRENT == FFECOM_targetFFE */ ! #define DEFIMP(CODE,NAME,GFRT,CONTROL) \ ! { NAME, FFEINTRIN_imp ## CODE, CONTROL }, ! #define DEFIMQ(CODE,NAME,GFRT,CONTROL,CGIMP) \ ! { NAME, FFEINTRIN_imp ## CGIMP, CONTROL }, #else #error --- 148,156 ---- #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) #if 0 /* FFECOM_targetCURRENT == FFECOM_targetGCC */ ! #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \ ! { NAME, FFECOM_gfrt ## GFRT, CONTROL }, #elif 1 /* FFECOM_targetCURRENT == FFECOM_targetFFE */ ! #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \ ! { NAME, CONTROL }, #else #error *************** static struct _ffeintrin_imp_ imps[] = { *** 149,153 **** #undef DEFSPEC #undef DEFIMP - #undef DEFIMQ }; --- 161,164 ---- *************** static struct _ffeintrin_spec_ specs[] = *** 157,178 **** #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) \ { NAME, CALLABLE, FAMILY, IMP, }, ! #define DEFIMP(CODE,NAME,GFRT,CONTROL) ! #define DEFIMQ(CODE,NAME,GFRT,CONTROL,CGIMP) #include "intrin.def" #undef DEFGEN #undef DEFSPEC #undef DEFIMP - #undef DEFIMQ }; ! static char *descriptions[FFEINTRIN_imp] = { ! #define DEFDOC(IMP,SUMMARY,DESCRIPTION) [FFEINTRIN_imp ## IMP] DESCRIPTION, ! #include "intdoc.h" #undef DEFDOC }; ! static char *summaries[FFEINTRIN_imp] = { ! #define DEFDOC(IMP,SUMMARY,DESCRIPTION) [FFEINTRIN_imp ## IMP] SUMMARY, ! #include "intdoc.h" #undef DEFDOC }; --- 168,191 ---- #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) \ { NAME, CALLABLE, FAMILY, IMP, }, ! #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) #include "intrin.def" #undef DEFGEN #undef DEFSPEC #undef DEFIMP }; ! struct cc_pair { ffeintrinImp imp; char *text; }; ! ! static char *descriptions[FFEINTRIN_imp] = { 0 }; ! static struct cc_pair cc_descriptions[] = { ! #define DEFDOC(IMP,SUMMARY,DESCRIPTION) { FFEINTRIN_imp ## IMP, DESCRIPTION }, ! #include "intdoc.h0" #undef DEFDOC }; ! static char *summaries[FFEINTRIN_imp] = { 0 }; ! static struct cc_pair cc_summaries[] = { ! #define DEFDOC(IMP,SUMMARY,DESCRIPTION) { FFEINTRIN_imp ## IMP, SUMMARY }, ! #include "intdoc.h0" #undef DEFDOC }; *************** family_name (ffeintrinFamily family) *** 210,213 **** --- 223,229 ---- return "familyF2U"; + case FFEINTRIN_familyBADU77: + return "familyBADU77"; + default: assert ("bad family" == NULL); *************** dumpem () *** 255,258 **** --- 271,288 ---- int i; + for (i = 0; ((size_t) i) < ARRAY_SIZE (cc_descriptions); ++i) + { + assert (descriptions[cc_descriptions[i].imp] == NULL); + descriptions[cc_descriptions[i].imp] = cc_descriptions[i].text; + } + + for (i = 0; ((size_t) i) < ARRAY_SIZE (cc_summaries); ++i) + { + assert (summaries[cc_summaries[i].imp] == NULL); + summaries[cc_summaries[i].imp] = cc_summaries[i].text; + } + + printf ("@c This file is automatically derived from intdoc.c, intdoc.in,\n"); + printf ("@c ansify.c, intrin.def, and intrin.h. Edit those files instead.\n"); printf ("@menu\n"); for (i = 0; ((size_t) i) < ARRAY_SIZE (names); ++i) *************** dumpgen (int menu, char *name, char *nam *** 285,301 **** { size_t i; for (i = 0; i < ARRAY_SIZE (gens[gen].specs); ++i) { ffeintrinSpec spec; if ((spec = gens[gen].specs[i]) == FFEINTRIN_specNONE) continue; - if (specs[spec].implementation == FFEINTRIN_impNONE) - continue; - dumpif (specs[spec].family); ! dumpimp (menu, name, name_uc, i, specs[spec].family, specs[spec].implementation); dumpendif (); } --- 315,363 ---- { size_t i; + int total = 0; + + if (!menu) + { + for (i = 0; i < ARRAY_SIZE (gens[gen].specs); ++i) + { + if (gens[gen].specs[i] != FFEINTRIN_specNONE) + ++total; + } + } for (i = 0; i < ARRAY_SIZE (gens[gen].specs); ++i) { ffeintrinSpec spec; + size_t j; if ((spec = gens[gen].specs[i]) == FFEINTRIN_specNONE) continue; dumpif (specs[spec].family); ! dumpimp (menu, name, name_uc, i, specs[spec].family, specs[spec].implementation, ! spec); ! if (!menu && (total > 0)) ! { ! if (total == 1) ! { ! printf ("\ ! For information on another intrinsic with the same name:\n"); ! } ! else ! { ! printf ("\ ! For information on other intrinsics with the same name:\n"); ! } ! for (j = 0; j < ARRAY_SIZE (gens[gen].specs); ++j) ! { ! if (j == i) ! continue; ! if ((spec = gens[gen].specs[j]) == FFEINTRIN_specNONE) ! continue; ! printf ("@xref{%s Intrinsic (%s)}.\n", ! name, specs[spec].name); ! } ! printf ("\n"); ! } dumpendif (); } *************** static void *** 305,341 **** dumpspec (int menu, char *name, char *name_uc, ffeintrinSpec spec) { - if (specs[spec].implementation == FFEINTRIN_impNONE) - return; - dumpif (specs[spec].family); ! dumpimp (menu, name, name_uc, 0, specs[spec].family, specs[spec].implementation); dumpendif (); } static void ! dumpimp (int menu, char *name, char *name_uc, size_t genno, ffeintrinFamily family, ffeintrinImp imp) { ! char *c = imps[imp].control; ! bool subr = (c[0] == '-'); char *argc; char *argi; ! int colon = (c[2] == ':') ? 2 : 3; int argno; if (menu) { printf ("* %s Intrinsic", name); ! if (genno) ! printf (" (Form %s)", imps[imp].name); printf ("::"); - if (summaries[imp] != NULL) - { #define INDENT_SUMMARY 24 int spaces = INDENT_SUMMARY - 14 - strlen (name); ! char *c = summaries[imp]; ! if (genno != 0) ! spaces -= (8 + strlen (imps[imp].name)); if (spaces < 1) spaces = 1; --- 367,405 ---- dumpspec (int menu, char *name, char *name_uc, ffeintrinSpec spec) { dumpif (specs[spec].family); ! dumpimp (menu, name, name_uc, 0, specs[spec].family, specs[spec].implementation, ! FFEINTRIN_specNONE); dumpendif (); } static void ! dumpimp (int menu, char *name, char *name_uc, size_t genno, ffeintrinFamily family, ffeintrinImp imp, ! ffeintrinSpec spec) { ! char *c; ! bool subr; char *argc; char *argi; ! int colon; int argno; + assert ((imp != FFEINTRIN_impNONE) || !genno); + if (menu) { printf ("* %s Intrinsic", name); ! if (spec != FFEINTRIN_specNONE) ! printf (" (%s)", specs[spec].name); /* See XYZZY1 below */ printf ("::"); #define INDENT_SUMMARY 24 + if ((imp == FFEINTRIN_impNONE) + || (summaries[imp] != NULL)) + { int spaces = INDENT_SUMMARY - 14 - strlen (name); ! char *c; ! if (spec != FFEINTRIN_specNONE) ! spaces -= (3 + strlen (specs[spec].name)); /* See XYZZY1 above */ if (spaces < 1) spaces = 1; *************** dumpimp (int menu, char *name, char *nam *** 343,347 **** fputc (' ', stdout); ! while (c[0] != '\0') { if ((c[0] == '@') --- 407,417 ---- fputc (' ', stdout); ! if (imp == FFEINTRIN_impNONE) ! { ! printf ("(Reserved for future use.)\n"); ! return; ! } ! ! for (c = summaries[imp]; c[0] != '\0'; ++c) { if ((c[0] == '@') *************** dumpimp (int menu, char *name, char *nam *** 373,377 **** else fputc (c[0], stdout); - ++c; } } --- 443,446 ---- *************** dumpimp (int menu, char *name, char *nam *** 381,394 **** printf ("@node %s Intrinsic", name); ! if (genno) ! printf (" (Form %s)", imps[imp].name); printf ("\n@subsubsection %s Intrinsic", name); ! if (genno) ! printf (" (Form %s)", imps[imp].name); ! printf ("\n@cindex %s intrinsic\n@cindex intrinsics, %s\n ! @noindent ! @example %s%s(", ! name, name, (subr ? "CALL " : ""), name); fflush (stdout); --- 450,483 ---- printf ("@node %s Intrinsic", name); ! if (spec != FFEINTRIN_specNONE) ! printf (" (%s)", specs[spec].name); printf ("\n@subsubsection %s Intrinsic", name); ! if (spec != FFEINTRIN_specNONE) ! printf (" (%s)", specs[spec].name); ! printf ("\n@cindex %s intrinsic\n@cindex intrinsics, %s\n", ! name, name); ! ! if (imp == FFEINTRIN_impNONE) ! { ! printf ("\n\ ! This intrinsic is not yet implemented.\n\ ! The name is, however, reserved as an intrinsic.\n\ ! Use @samp{EXTERNAL %s} to use this name for an\n\ ! external procedure.\n\ ! \n\ ! ", ! name); ! return; ! } ! ! c = imps[imp].control; ! subr = (c[0] == '-'); ! colon = (c[2] == ':') ? 2 : 3; ! ! printf ("\n\ ! @noindent\n\ ! @example\n\ %s%s(", ! (subr ? "CALL " : ""), name); fflush (stdout); *************** dumpimp (int menu, char *name, char *nam *** 411,416 **** } ! printf (") ! @end example\n "); --- 500,506 ---- } ! printf (")\n\ ! @end example\n\ ! \n\ "); *************** dumpimp (int menu, char *name, char *nam *** 436,440 **** printf ("\ ! @noindent %s: ", name); print_type_string (c); --- 526,530 ---- printf ("\ ! @noindent\n\ %s: ", name); print_type_string (c); *************** dumpimp (int menu, char *name, char *nam *** 450,467 **** ++arg_info; if ((arg_info[0] == 'F') || (arg_info[0] == 'N')) ! printf (". ! The exact type is @samp{REAL(KIND=1)} when argument @var{%s} is ! any type other than @code{COMPLEX}, or when it is @code{COMPLEX(KIND=1)}. ! When @var{%s} is any @code{COMPLEX} type other than @code{COMPLEX(KIND=1)}, ! this intrinsic is valid only when used as the argument to @code{REAL()}, as explained below.\n\n", arg_string, arg_string); else ! printf (". ! This intrinsic is valid when argument @var{%s} is ! @code{COMPLEX(KIND=1)}. ! When @var{%s} is any other @code{COMPLEX} type, ! this intrinsic is valid only when used as the argument to @code{REAL()}, as explained below.\n\n", arg_string, --- 540,557 ---- ++arg_info; if ((arg_info[0] == 'F') || (arg_info[0] == 'N')) ! printf (".\n\ ! The exact type is @samp{REAL(KIND=1)} when argument @var{%s} is\n\ ! any type other than @code{COMPLEX}, or when it is @code{COMPLEX(KIND=1)}.\n\ ! When @var{%s} is any @code{COMPLEX} type other than @code{COMPLEX(KIND=1)},\n\ ! this intrinsic is valid only when used as the argument to\n\ @code{REAL()}, as explained below.\n\n", arg_string, arg_string); else ! printf (".\n\ ! This intrinsic is valid when argument @var{%s} is\n\ ! @code{COMPLEX(KIND=1)}.\n\ ! When @var{%s} is any other @code{COMPLEX} type,\n\ ! this intrinsic is valid only when used as the argument to\n\ @code{REAL()}, as explained below.\n\n", arg_string, *************** this intrinsic is valid only when used a *** 471,475 **** else if ((c[0] == 'I') && (c[1] == 'p')) ! printf (", the exact type being wide enough to hold a pointer on the target system (typically @code{INTEGER(KIND=1)} or @code{INTEGER(KIND=4)}).\n\n"); #endif --- 561,565 ---- else if ((c[0] == 'I') && (c[1] == 'p')) ! printf (", the exact type being wide enough to hold a pointer\n\ on the target system (typically @code{INTEGER(KIND=1)} or @code{INTEGER(KIND=4)}).\n\n"); #endif *************** on the target system (typically @code{IN *** 497,504 **** || (arg_info[0] == 'F') || (arg_info[0] == 'N'))) ! printf (". ! The exact type depends on that of argument @var{%s}---if @var{%s} is ! @code{COMPLEX}, this function's type is @code{REAL} ! with the same @samp{KIND=} value as the type of @var{%s}. Otherwise, this function's type is the same as that of @var{%s}.\n\n", arg_string, arg_string, arg_string, arg_string); --- 587,594 ---- || (arg_info[0] == 'F') || (arg_info[0] == 'N'))) ! printf (".\n\ ! The exact type depends on that of argument @var{%s}---if @var{%s} is\n\ ! @code{COMPLEX}, this function's type is @code{REAL}\n\ ! with the same @samp{KIND=} value as the type of @var{%s}.\n\ Otherwise, this function's type is the same as that of @var{%s}.\n\n", arg_string, arg_string, arg_string, arg_string); *************** Otherwise, this function's type is the s *** 509,513 **** else if ((c[1] == '=') && (c[colon + 1] == '*')) ! printf (", the exact type being the result of cross-promoting the types of all the arguments.\n\n"); else if (c[1] == '=') --- 599,603 ---- else if ((c[1] == '=') && (c[colon + 1] == '*')) ! printf (", the exact type being the result of cross-promoting the\n\ types of all the arguments.\n\n"); else if (c[1] == '=') *************** types of all the arguments.\n\n"); *** 527,531 **** printf ("\ ! @noindent @var{"); for (; ; ++argc) --- 617,621 ---- printf ("\ ! @noindent\n\ @var{"); for (; ; ++argc) *************** types of all the arguments.\n\n"); *** 789,798 **** case 'g': ! printf ("@samp{*@var{label}}, where @var{label} is the label of an executable statement"); break; case 's': ! printf ("Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE}) or dummy/global @code{INTEGER(KIND=1)} scalar"); break; --- 879,888 ---- case 'g': ! printf ("@samp{*@var{label}}, where @var{label} is the label\n\ of an executable statement"); break; case 's': ! printf ("Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE})\n\ or dummy/global @code{INTEGER(KIND=1)} scalar"); break; *************** or dummy/global @code{INTEGER(KIND=1)} s *** 879,883 **** printf ("\ ! @noindent Intrinsic groups: "); switch (family) --- 969,973 ---- printf ("\ ! @noindent\n\ Intrinsic groups: "); switch (family) *************** Intrinsic groups: "); *** 919,922 **** --- 1009,1016 ---- break; + case FFEINTRIN_familyBADU77: + printf ("@code{badu77}."); + break; + default: assert ("bad family" == NULL); *************** Intrinsic groups: "); *** 931,936 **** printf ("\ ! @noindent ! Description: \n"); --- 1025,1030 ---- printf ("\ ! @noindent\n\ ! Description:\n\ \n"); diff -rcp2N g77-0.5.20/f/intdoc.h g77-0.5.21/f/intdoc.h *** g77-0.5.20/f/intdoc.h Thu Feb 27 04:52:15 1997 --- g77-0.5.21/f/intdoc.h Thu Jan 1 00:00:00 1970 *************** *** 1,1297 **** - /* Copyright (C) 1997 Free Software Foundation, Inc. - * This is part of the G77 manual. - * For copying conditions, see the file g77.texi. */ - - /* This is the file containing the verbage for the - intrinsics. It consists of a data base built up - via DEFDOC macros of the form: - - DEFDOC (IMP, SUMMARY, DESCRIPTION) - - IMP is the implementation keyword used in the intrin module. - SUMMARY is the short summary to go in the "* Menu:" section - of the Info document. DESCRIPTION is the longer description - to go in the documentation itself. - - Note that IMP is leveraged across multiple intrinsic names. - - To make for more accurate and consistent documentation, - the translation made by intdoc.c of the text in SUMMARY - and DESCRIPTION includes the special sequence - - @ARGNO@ - - where ARGNO is a series of digits forming a number that - is substituted by intdoc.c as follows: - - 0 The initial-caps form of the intrinsic name (e.g. Float). - 1-98 The initial-caps form of the ARGNO'th argument. - 99 (SUMMARY only) a newline plus the appropriate # of spaces. - - Hope this info is enough to encourage people to feel free to - add documentation to this file! - - */ - - DEFDOC (ABS, "Absolute value.", "\ - Returns the absolute value of @var{@1@}. - - If @var{@1@} is type @code{COMPLEX}, the absolute - value is computed as: - - @example - SQRT(REALPART(@var{@1@})**2, IMAGPART(@var{@1@})**2) - @end example - - @noindent - Otherwise, it is computed by negating the @var{@1@} if - it is negative, or returning @var{@1@}. - - @xref{Sign Intrinsic}, for how to explicitly - compute the positive or negative form of the absolute - value of an expression. - ") - - DEFDOC (CABS, "Absolute value (archaic).", "\ - Archaic form of @code{ABS()} that is specific - to one type for @var{@1@}. - @xref{Abs Intrinsic}. - ") - - DEFDOC (DABS, "Absolute value (archaic).", "\ - Archaic form of @code{ABS()} that is specific - to one type for @var{@1@}. - @xref{Abs Intrinsic}. - ") - - DEFDOC (IABS, "Absolute value (archaic).", "\ - Archaic form of @code{ABS()} that is specific - to one type for @var{@1@}. - @xref{Abs Intrinsic}. - ") - - DEFDOC (CDABS, "Absolute value (archaic).", "\ - Archaic form of @code{ABS()} that is specific - to one type for @var{@1@}. - @xref{Abs Intrinsic}. - ") - - DEFDOC (ACHAR, "ASCII character from code.", "\ - Returns the ASCII character corresponding to the - code specified by @var{@1@}. - - @xref{IAChar Intrinsic}, for the inverse function. - - @xref{Char Intrinsic}, for the function corresponding - to the system's native character set. - ") - - DEFDOC (IACHAR, "ASCII code for character.", "\ - Returns the code for the ASCII character in the - first character position of @var{@1@}. - - @xref{AChar Intrinsic}, for the inverse function. - - @xref{IChar Intrinsic}, for the function corresponding - to the system's native character set. - ") - - DEFDOC (CHAR, "Character from code.", "\ - Returns the character corresponding to the - code specified by @var{@1@}, using the system's - native character set. - - Because the system's native character set is used, - the correspondence between character and their codes - is not necessarily the same between GNU Fortran - implementations. - - @xref{IChar Intrinsic}, for the inverse function. - - @xref{AChar Intrinsic}, for the function corresponding - to the ASCII character set. - ") - - DEFDOC (ICHAR, "Code for character.", "\ - Returns the code for the character in the - first character position of @var{@1@}. - - Because the system's native character set is used, - the correspondence between character and their codes - is not necessarily the same between GNU Fortran - implementations. - - @xref{Char Intrinsic}, for the inverse function. - - @xref{IAChar Intrinsic}, for the function corresponding - to the ASCII character set. - ") - - DEFDOC (ACOS, "Arc cosine.", "\ - Returns the arc-cosine (inverse cosine) of @var{@1@} - in radians. - - @xref{Cos Intrinsic}, for the inverse function. - ") - - DEFDOC (DACOS, "Arc cosine (archaic).", "\ - Archaic form of @code{ACOS()} that is specific - to one type for @var{@1@}. - @xref{ACos Intrinsic}. - ") - - DEFDOC (AIMAG, "Convert/extract imaginary part of complex.", "\ - Returns the (possibly converted) imaginary part of @var{@1@}. - - Use of @code{@0@()} with an argument of a type - other than @code{COMPLEX(KIND=1)} is restricted to the following case: - - @example - REAL(AIMAG(@1@)) - @end example - - @noindent - This expression converts the imaginary part of @1@ to - @code{REAL(KIND=1)}. - - @xref{REAL() and AIMAG() of Complex}, for more information. - ") - - DEFDOC (AINT, "Truncate to whole number.", "\ - Returns @var{@1@} with the fractional portion of its - magnitude truncated and its sign preserved. - (Also called ``truncation towards zero''.) - - @xref{ANInt Intrinsic}, for how to round to nearest - whole number. - - @xref{Int Intrinsic}, for how to truncate and then convert - number to @code{INTEGER}. - ") - - DEFDOC (DINT, "Truncate to whole number (archaic).", "\ - Archaic form of @code{AINT()} that is specific - to one type for @var{@1@}. - @xref{AInt Intrinsic}. - ") - - DEFDOC (INT, "Convert to @code{INTEGER} value truncated@99@to whole number.", "\ - Returns @var{@1@} with the fractional portion of its - magnitude truncated and its sign preserved, converted - to type @code{INTEGER(KIND=1)}. - - If @var{@1@} is type @code{COMPLEX}, its real part is - truncated and converted. - - @xref{NInt Intrinsic}, for how to convert, rounded to nearest - whole number. - - @xref{AInt Intrinsic}, for how to truncate to whole number - without converting. - ") - - DEFDOC (IDINT, "Convert to @code{INTEGER} value truncated@99@to whole number (archaic).", "\ - Archaic form of @code{INT()} that is specific - to one type for @var{@1@}. - @xref{Int Intrinsic}. - ") - - DEFDOC (ANINT, "Round to nearest whole number.", "\ - Returns @var{@1@} with the fractional portion of its - magnitude eliminated by rounding to the nearest whole - number and with its sign preserved. - - A fractional portion exactly equal to - @samp{.5} is rounded to the whole number that - is larger in magnitude. - (Also called ``Fortran round''.) - - @xref{AInt Intrinsic}, for how to truncate to - whole number. - - @xref{NInt Intrinsic}, for how to round and then convert - number to @code{INTEGER}. - ") - - DEFDOC (DNINT, "Round to nearest whole number (archaic).", "\ - Archaic form of @code{ANINT()} that is specific - to one type for @var{@1@}. - @xref{ANInt Intrinsic}. - ") - - DEFDOC (NINT, "Convert to @code{INTEGER} value rounded@99@to nearest whole number.", "\ - Returns @var{@1@} with the fractional portion of its - magnitude eliminated by rounding to the nearest whole - number and with its sign preserved, converted - to type @code{INTEGER(KIND=1)}. - - If @var{@1@} is type @code{COMPLEX}, its real part is - rounded and converted. - - A fractional portion exactly equal to - @samp{.5} is rounded to the whole number that - is larger in magnitude. - (Also called ``Fortran round''.) - - @xref{Int Intrinsic}, for how to convert, truncate to - whole number. - - @xref{ANInt Intrinsic}, for how to round to nearest whole number - without converting. - ") - - DEFDOC (IDNINT, "Convert to @code{INTEGER} value rounded@99@to nearest whole number (archaic).", "\ - Archaic form of @code{NINT()} that is specific - to one type for @var{@1@}. - @xref{NInt Intrinsic}. - ") - - DEFDOC (LOG, "Natural logarithm.", "\ - Returns the natural logarithm of @var{@1@}, which must - be greater than zero or, if type @code{COMPLEX}, must not - be zero. - - @xref{Exp Intrinsic}, for the inverse function. - - @xref{Log10 Intrinsic}, for the base-10 logarithm function. - ") - - DEFDOC (ALOG, "Natural logarithm (archaic).", "\ - Archaic form of @code{LOG()} that is specific - to one type for @var{@1@}. - @xref{Log Intrinsic}. - ") - - DEFDOC (CLOG, "Natural logarithm (archaic).", "\ - Archaic form of @code{LOG()} that is specific - to one type for @var{@1@}. - @xref{Log Intrinsic}. - ") - - DEFDOC (DLOG, "Natural logarithm (archaic).", "\ - Archaic form of @code{LOG()} that is specific - to one type for @var{@1@}. - @xref{Log Intrinsic}. - ") - - DEFDOC (CDLOG, "Natural logarithm (archaic).", "\ - Archaic form of @code{LOG()} that is specific - to one type for @var{@1@}. - @xref{Log Intrinsic}. - ") - - DEFDOC (LOG10, "Natural logarithm.", "\ - Returns the natural logarithm of @var{@1@}, which must - be greater than zero or, if type @code{COMPLEX}, must not - be zero. - - The inverse function is @samp{10. ** LOG10(@var{@1@})}. - - @xref{Log Intrinsic}, for the natural logarithm function. - ") - - DEFDOC (ALOG10, "Natural logarithm (archaic).", "\ - Archaic form of @code{LOG10()} that is specific - to one type for @var{@1@}. - @xref{Log10 Intrinsic}. - ") - - DEFDOC (DLOG10, "Natural logarithm (archaic).", "\ - Archaic form of @code{LOG10()} that is specific - to one type for @var{@1@}. - @xref{Log10 Intrinsic}. - ") - - DEFDOC (MAX, "Maximum value.", "\ - Returns the argument with the largest value. - - @xref{Min Intrinsic}, for the opposite function. - ") - - DEFDOC (AMAX0, "Maximum value (archaic).", "\ - Archaic form of @code{MAX()} that is specific - to one type for @var{@1@} and a different return type. - @xref{Max Intrinsic}. - ") - - DEFDOC (AMAX1, "Maximum value (archaic).", "\ - Archaic form of @code{MAX()} that is specific - to one type for @var{@1@}. - @xref{Max Intrinsic}. - ") - - DEFDOC (DMAX1, "Maximum value (archaic).", "\ - Archaic form of @code{MAX()} that is specific - to one type for @var{@1@}. - @xref{Max Intrinsic}. - ") - - DEFDOC (MAX0, "Maximum value (archaic).", "\ - Archaic form of @code{MAX()} that is specific - to one type for @var{@1@}. - @xref{Max Intrinsic}. - ") - - DEFDOC (MAX1, "Maximum value (archaic).", "\ - Archaic form of @code{MAX()} that is specific - to one type for @var{@1@} and a different return type. - @xref{Max Intrinsic}. - ") - - DEFDOC (MIN, "Minimum value.", "\ - Returns the argument with the smallest value. - - @xref{Max Intrinsic}, for the opposite function. - ") - - DEFDOC (AMIN0, "Minimum value (archaic).", "\ - Archaic form of @code{MIN()} that is specific - to one type for @var{@1@} and a different return type. - @xref{Min Intrinsic}. - ") - - DEFDOC (AMIN1, "Minimum value (archaic).", "\ - Archaic form of @code{MIN()} that is specific - to one type for @var{@1@}. - @xref{Min Intrinsic}. - ") - - DEFDOC (DMIN1, "Minimum value (archaic).", "\ - Archaic form of @code{MIN()} that is specific - to one type for @var{@1@}. - @xref{Min Intrinsic}. - ") - - DEFDOC (MIN0, "Minimum value (archaic).", "\ - Archaic form of @code{MIN()} that is specific - to one type for @var{@1@}. - @xref{Min Intrinsic}. - ") - - DEFDOC (MIN1, "Minimum value (archaic).", "\ - Archaic form of @code{MIN()} that is specific - to one type for @var{@1@} and a different return type. - @xref{Min Intrinsic}. - ") - - DEFDOC (MOD, "Remainder.", "\ - Returns remainder calculated as: - - @smallexample - @var{@1@} - (INT(@var{@1@} / @var{@2@}) * @var{@2@}) - @end smallexample - - @var{@2@} must not be zero. - ") - - DEFDOC (AMOD, "Remainder (archaic).", "\ - Archaic form of @code{MOD()} that is specific - to one type for @var{@1@}. - @xref{Mod Intrinsic}. - ") - - DEFDOC (DMOD, "Remainder (archaic).", "\ - Archaic form of @code{MOD()} that is specific - to one type for @var{@1@}. - @xref{Mod Intrinsic}. - ") - - DEFDOC (AND, "Boolean AND.", "\ - Returns value resulting from boolean AND of - pair of bits in each of @var{@1@} and @var{@2@}. - ") - - DEFDOC (IAND, "Boolean AND.", "\ - Returns value resulting from boolean AND of - pair of bits in each of @var{@1@} and @var{@2@}. - ") - - DEFDOC (OR, "Boolean OR.", "\ - Returns value resulting from boolean OR of - pair of bits in each of @var{@1@} and @var{@2@}. - ") - - DEFDOC (IOR, "Boolean OR.", "\ - Returns value resulting from boolean OR of - pair of bits in each of @var{@1@} and @var{@2@}. - ") - - DEFDOC (XOR, "Boolean XOR.", "\ - Returns value resulting from boolean exclusive-OR of - pair of bits in each of @var{@1@} and @var{@2@}. - ") - - DEFDOC (IEOR, "Boolean XOR.", "\ - Returns value resulting from boolean exclusive-OR of - pair of bits in each of @var{@1@} and @var{@2@}. - ") - - DEFDOC (NOT, "Boolean NOT.", "\ - Returns value resulting from boolean NOT of each bit - in @var{@1@}. - ") - - DEFDOC (ASIN, "Arc sine.", "\ - Returns the arc-sine (inverse sine) of @var{@1@} - in radians. - - @xref{Sin Intrinsic}, for the inverse function. - ") - - DEFDOC (DASIN, "Arc sine (archaic).", "\ - Archaic form of @code{ASIN()} that is specific - to one type for @var{@1@}. - @xref{ASin Intrinsic}. - ") - - DEFDOC (ATAN, "Arc tangent.", "\ - Returns the arc-tangent (inverse tangent) of @var{@1@} - in radians. - - @xref{Tan Intrinsic}, for the inverse function. - ") - - DEFDOC (DATAN, "Arc tangent (archaic).", "\ - Archaic form of @code{ATAN()} that is specific - to one type for @var{@1@}. - @xref{ATan Intrinsic}. - ") - - DEFDOC (ATAN2, "Arc tangent.", "\ - Returns the arc-tangent (inverse tangent) of the complex - number (@var{@1@}, @var{@2@}) in radians. - - @xref{Tan Intrinsic}, for the inverse function. - ") - - DEFDOC (DATAN2, "Arc tangent (archaic).", "\ - Archaic form of @code{ATAN2()} that is specific - to one type for @var{@1@} and @var{@2@}. - @xref{ATan2 Intrinsic}. - ") - - DEFDOC (BIT_SIZE, "Number of bits in argument's type.", "\ - Returns the number of bits (integer precision plus sign bit) - represented by the type for @var{@1@}. - - @xref{BTest Intrinsic}, for how to test the value of a - bit in a variable or array. - - @xref{IBSet Intrinsic}, for how to set a bit in a - variable or array to 1. - ") - - DEFDOC (BTEST, "Test bit.", "\ - Returns @code{.TRUE.} if bit @var{@2@} in @var{@1@} is - 1, @code{.FALSE.} otherwise. - - (Bit 0 is the low-order bit, adding the value 2**0, or 1, - to the number if set to 1; - bit 1 is the next-higher-order bit, adding 2**1, or 2; - bit 2 adds 2**2, or 4; and so on.) - - @xref{Bit_Size Intrinsic}, for how to obtain the number of bits - in a type. - ") - - DEFDOC (CMPLX, "Construct @code{COMPLEX(KIND=1)} value.", "\ - If @var{@1@} is not type @code{COMPLEX}, - constructs a value of type @code{COMPLEX(KIND=1)} from the - real and imaginary values specified by @var{@1@} and - @var{@2@}, respectively. - If @var{@2@} is omitted, @samp{0.} is assumed. - - If @var{@1@} is type @code{COMPLEX}, - converts it to type @code{COMPLEX(KIND=1)}. - - @xref{Complex Intrinsic}, for information on easily constructing - a @code{COMPLEX} value of arbitrary precision from @code{REAL} - arguments. - ") - - DEFDOC (CONJG, "Complex conjugate.", "\ - Returns the complex conjugate: - - @example - COMPLEX(REALPART(@var{@1@}), -IMAGPART(@var{@1@})) - @end example - ") - - DEFDOC (DCONJG, "Complex conjugate (archaic).", "\ - Archaic form of @code{CONJG()} that is specific - to one type for @var{@1@}. - @xref{ATan2 Intrinsic}. - ") - - /* ~~~~~ to do: - COS - COSH - SQRT - DBLE - DIM - ERF - DPROD - SIGN - EXP - FLOAT - IBCLR - IBITS - IBSET - IFIX - INDEX - ISHFT - ISHFTC - LEN - LGE - LONG - SHORT - LSHIFT - RSHIFT - MVBITS - SIN - SINH - SNGL - TAN - TANH - */ - - DEFDOC (REAL, "Convert value to type @code{REAL(KIND=1)}.", "\ - Converts @var{@1@} to @code{REAL(KIND=1)}. - - Use of @code{@0@()} with a @code{COMPLEX} argument - (other than @code{COMPLEX(KIND=1)}) is restricted to the following case: - - @example - REAL(REAL(@1@)) - @end example - - @noindent - This expression converts the real part of @1@ to - @code{REAL(KIND=1)}. - - @xref{REAL() and AIMAG() of Complex}, for more information. - ") - - DEFDOC (IMAGPART, "Extract imaginary part of complex.", "\ - The imaginary part of @var{@1@} is returned, without conversion. - - @emph{Note:} The way to do this in standard Fortran 90 - is @samp{AIMAG(@var{@1@})}. - However, when, for example, @var{@1@} is @code{DOUBLE COMPLEX}, - @samp{AIMAG(@var{@1@})} means something different for some compilers - that are not true Fortran 90 compilers but offer some - extensions standardized by Fortran 90 (such as the - @code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}). - - The advantage of @code{@0@()} is that, while not necessarily - more or less portable than @code{AIMAG()}, it is more likely to - cause a compiler that doesn't support it to produce a diagnostic - than generate incorrect code. - - @xref{REAL() and AIMAG() of Complex}, for more information. - ") - - DEFDOC (COMPLEX, "Build complex value from real and@99@imaginary parts.", "\ - Returns a @code{COMPLEX} value that has @samp{@1@} and @samp{@2@} as its - real and imaginary parts, respectively. - - If @var{@1@} and @var{@2@} are the same type, and that type is not - @code{INTEGER}, no data conversion is performed, and the type of - the resulting value has the same kind value as the types - of @var{@1@} and @var{@2@}. - - If @var{@1@} and @var{@2@} are not the same type, the usual type-promotion - rules are applied to both, converting either or both to the - appropriate @code{REAL} type. - The type of the resulting value has the same kind value as the - type to which both @var{@1@} and @var{@2@} were converted, in this case. - - If @var{@1@} and @var{@2@} are both @code{INTEGER}, they are both converted - to @code{REAL(KIND=1)}, and the result of the @code{@0@()} - invocation is type @code{COMPLEX(KIND=1)}. - - @emph{Note:} The way to do this in standard Fortran 90 - is too hairy to describe here, but it is important to - note that @samp{CMPLX(D1,D2)} returns a @code{COMPLEX(KIND=1)} - result even if @samp{D1} and @samp{D2} are type @code{REAL(KIND=2)}. - Hence the availability of @code{COMPLEX()} in GNU Fortran. - ") - - DEFDOC (LOC, "Address of entity in core.", "\ - The @code{LOC()} intrinsic works the - same way as the @code{%LOC()} construct. - @xref{%LOC(),,The @code{%LOC()} Construct}, for - more information. - ") - - DEFDOC (REALPART, "Extract real part of complex.", "\ - The real part of @var{@1@} is returned, without conversion. - - @emph{Note:} The way to do this in standard Fortran 90 - is @samp{REAL(@var{@1@})}. - However, when, for example, @var{@1@} is @code{COMPLEX(KIND=2)}, - @samp{REAL(@var{@1@})} means something different for some compilers - that are not true Fortran 90 compilers but offer some - extensions standardized by Fortran 90 (such as the - @code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}). - - The advantage of @code{@0@()} is that, while not necessarily - more or less portable than @code{REAL()}, it is more likely to - cause a compiler that doesn't support it to produce a diagnostic - than generate incorrect code. - - @xref{REAL() and AIMAG() of Complex}, for more information. - ") - - DEFDOC (GETARG, "Obtain command-line argument.", "\ - Sets @var{@2@} to the @var{@1@}-th command-line argument (or to all - blanks if there are fewer than @var{@2@} command-line arguments); - @code{CALL @0@(0, @var{value})} sets @var{value} to the name of the - program (on systems that support this feature). - - @xref{IArgC Intrinsic}, for information on how to get the number - of arguments. - ") - - DEFDOC (ABORT, "Abort the program.", "\ - Prints a message and potentially causes a core dump via @code{abort(3)}. - ") - - DEFDOC (EXIT, "Terminate the program.", "\ - Exit the program with status @var{@1@} after closing open Fortran - i/o units and otherwise behaving as @code{exit(2)}. If @var{@1@} - is omitted the canonical `success' value will be returned to the - system. - ") - - DEFDOC (IARGC, "Obtain count of command-line arguments.", "\ - Returns the number of command-line arguments. - - This count does not include the specification of the program - name itself. - ") - - DEFDOC (CTIME, "Convert time to Day Mon dd hh:mm:ss yyyy.", "\ - Converts @var{@1@}, a system time value, such as returned by - @code{TIME()}, to a string of the form @samp{Sat Aug 19 18:13:14 1995}. - - @xref{Time Intrinsic}. - ") - - DEFDOC (DATE, "Get current date as dd-Mon-yy.", "\ - Returns @var{@1@} in the form @samp{@var{dd}-@var{mmm}-@var{yy}}, - representing the numeric day of the month @var{dd}, a three-character - abbreviation of the month name @var{mmm} and the last two digits of - the year @var{yy}, e.g.@ @samp{25-Nov-96}. - - This intrinsic is not recommended, due to the year 2000 approaching. - @xref{CTime Intrinsic}, for information on obtaining more digits - for the current (or any) date. - ") - - DEFDOC (DTIME, "Get elapsed time since last time.", "\ - Initially, return in seconds the runtime (since the start of the - process' execution) as the function value and the user and system - components of this in @samp{@var{@1@}(1)} and @samp{@var{@1@}(2)} - respectively. - The functions' value is equal to @samp{@var{@1@}(1) + @samp{@1@}(2)}. - - Subsequent invocations of @samp{@0@()} return values accumulated since the - previous invocation. - ") - - DEFDOC (ETIME, "Get elapsed time for process.", "\ - Return in seconds the runtime (since the start of the process' - execution) as the function value and the user and system components of - this in @samp{@var{@1@}(1)} and @samp{@var{@1@}(2)} respectively. - The functions' value is equal to @samp{@var{@1@}(1) + @var{@1@}(2)}. - ") - - DEFDOC (FDATE, "Get current time as Day Mon dd hh:mm:ss yyyy.", "\ - Returns the current date in the same format as @code{CTIME()}. - - Equivalent to: - - @example - CTIME(TIME()) - @end example - - @xref{CTime Intrinsic}. - ") - - DEFDOC (GMTIME, "Convert time to GMT time info.", "\ - Given a system time value @var{@1@}, fills @var{@2@} with values - extracted from it appropriate to the GMT time zone using - @code{gmtime(3)}. - - The array elements are as follows: - - @enumerate - @item - Seconds after the minute, range 0--59 or 0--61 to allow for leap - seconds - - @item - Minutes after the hour, range 0--59 - - @item - Hours past midnight, range 0--23 - - @item - Day of month, range 0--31 - - @item - Number of months since January, range 0--12 - - @item - Number of days since Sunday, range 0--6 - - @item - Years since 1900 - - @item - Days since January 1 - - @item - Daylight savings indicator: positive if daylight savings is in effect, - zero if not, and negative if the information isn't available. - @end enumerate - ") - - DEFDOC (LTIME, "Convert time to local time info.", "\ - Given a system time value @var{@1@}, fills @var{@2@} with values - extracted from it appropriate to the GMT time zone using - @code{localtime(3)}. - - The array elements are as follows: - - @enumerate - @item - Seconds after the minute, range 0--59 or 0--61 to allow for leap - seconds - - @item - Minutes after the hour, range 0--59 - - @item - Hours past midnight, range 0--23 - - @item - Day of month, range 0--31 - - @item - Number of months since January, range 0--12 - - @item - Number of days since Sunday, range 0--6 - - @item - Years since 1900 - - @item - Days since January 1 - - @item - Daylight savings indicator: positive if daylight savings is in effect, - zero if not, and negative if the information isn't available. - @end enumerate - ") - - DEFDOC (IDATE, "Get local time info.", "\ - Fills @var{@1@} with the numerical values at the current local time - of day, month (in the range 1--12), and year in elements 1, 2, and 3, - respectively. - The year has four significant digits. - ") - - DEFDOC (IDATEVXT, "Get local time info (VAX/VMS).", "\ - Returns the numerical values of the current local time. - The date is returned in @var{@1@}, - the month in @var{@2@} (in the range 1--12), - and the year in @var{@3@} (in the range 0--99). - - This intrinsic is not recommended, due to the year 2000 approaching. - @xref{IDate Intrinsic}, for information on obtaining more digits - for the current local date. - ") - - DEFDOC (ITIME, "Get local time of day.", "\ - Returns the current local time hour, minutes, and seconds in elements - 1, 2, and 3 of @var{@1@}, respectively. - ") - - DEFDOC (MCLOCK, "Get number of clock ticks for process.", "\ - Returns the number of clock ticks since the start of the process. - Only defined on systems with @code{clock(3)} (q.v.). - ") - - DEFDOC (SECNDS, "Get local time offset since midnight.", "\ - Returns the local time in seconds since midnight minus the value - @var{@1@}. - ") - - DEFDOC (SECONDFUNC, "Get CPU time for process in seconds.", "\ - Returns the process' runtime in seconds---the same value as the - UNIX function @code{etime} returns. - - This routine is known from Cray Fortran. - ") - - DEFDOC (SECONDSUBR, "Get CPU time for process@99@in seconds.", "\ - Returns the process' runtime in seconds in @var{@1@}---the same value - as the UNIX function @code{etime} returns. - - This routine is known from Cray Fortran. - ") - - DEFDOC (SYSTEM_CLOCK, "Get current system clock value.", "\ - Returns in @var{@1@} the current value of the system clock; this is - the value returned by the UNIX function @code{times(2)} - in this implementation, but - isn't in general. - @var{@2@} is the number of clock ticks per second and - @var{@3@} is the maximum value this can take, which isn't very useful - in this implementation since it's just the maximum C @code{unsigned - int} value. - ") - - DEFDOC (TIME, "Get current time as time value.", "\ - Returns the current time encoded as an integer in the manner of - the UNIX function @code{time(3)}. - This value is suitable for passing to @code{CTIME}, - @code{GMTIME}, and @code{LTIME}. - ") - - #define BES(num,n) "\ - Calculates the Bessel function of the " #num " kind of \ - order " #n ".\n\ - See @code{bessel(3m)}, on whose implementation the \ - function depends.\ - " - - DEFDOC (BESJ0, "Bessel function.", BES (first, 0)) - DEFDOC (BESJ1, "Bessel function.", BES (first, 1)) - DEFDOC (BESJN, "Bessel function.", BES (first, @var{N})) - DEFDOC (BESY0, "Bessel function.", BES (second, 0)) - DEFDOC (BESY1, "Bessel function.", BES (second, 1)) - DEFDOC (BESYN, "Bessel function.", BES (second, @var{N})) - - DEFDOC (ERF, "Error function.", "\ - Returns the error function of @var{@1@}. - See @code{erf(3m)}, which provides the implementation. - ") - - DEFDOC (ERFC, "Complementary error function.", "\ - Returns the complementary error function of @var{@1@}: - @code{ERFC(R) = 1 - ERF(R)} (except that the result may be more - accurate than explicitly evaluating that formulae would give). - See @code{erfc(3m)}, which provides the implementation. - ") - - DEFDOC (IRAND, "Random number.", "\ - Returns a uniform quasi-random number up to a system-dependent limit. - If @var{@1@} is 0, the next number in sequence is returned; if - @var{@1@} is 1, the generator is restarted by calling the UNIX function - @samp{srand(0)}; if @var{@1@} has any other value, - it is used as a new seed with @code{srand()}. - - @xref{SRand Intrinsic}. - - @emph{Note:} As typically implemented (by the routine of the same - name in the C library), this random number generator is a very poor - one, though the BSD and GNU libraries provide a much better - implementation than the `traditional' one. - On a different system you almost certainly want to use something better. - ") - - DEFDOC (RAND, "Random number.", "\ - Returns a uniform quasi-random number between 0 and 1. - If @var{@1@} is 0, the next number in sequence is returned; if - @var{@1@} is 1, the generator is restarted by calling @samp{srand(0)}; - if @var{@1@} has any other value, it is used as a new seed with - @code{srand}. - - @xref{SRand Intrinsic}. - - @emph{Note:} As typically implemented (by the routine of the same - name in the C library), this random number generator is a very poor - one, though the BSD and GNU libraries provide a much better - implementation than the `traditional' one. - On a different system you - almost certainly want to use something better. - ") - - DEFDOC (SRAND, "Random seed.", "\ - Reinitialises the generator with the seed in @var{@1@}. - @xref{IRand Intrinsic}. @xref{Rand Intrinsic}. - ") - - DEFDOC (ACCESS, "Check file accessibility.", "\ - Checks file @var{@1@} for accessibility in the mode specified by @var{@2@} and - returns 0 if the file is accessible in that mode, otherwise an error - code if the file is inaccessible or @var{@2@} is invalid. See - @code{access(2)}. @var{@2@} may be a concatenation of any of the - following characters: - - @table @samp - @item r - Read permission - - @item w - Write permission - - @item x - Execute permission - - @item @kbd{SPC} - Existence - @end table - ") - - DEFDOC (CHDIR, "Change directory.", "\ - Sets the current working directory to be @var{@1@}. - If the @var{@2@} argument is supplied, it contains 0 - on success or an error code otherwise upon return. - See @code{chdir(3)}. - ") - - DEFDOC (CHMOD, "Change file modes.", "\ - Changes the access mode of file @var{@1@} according to the - specification @var{@2@}, which is given in the format of - @code{chmod(1)}. - If the @var{Status} argument is supplied, it contains 0 - on success or an error code otherwise upon return. - Note that this currently works - by actually invoking @code{/bin/chmod} (or the @code{chmod} found when - the library was configured) and so may fail in some circumstances and - will, anyway, be slow. - ") - - DEFDOC (GETCWD, "Get current working directory.", "\ - Places the current working directory in @var{@1@}. - Returns 0 on - success, otherwise an error code. - ") - - DEFDOC (FSTAT, "Get file information.", "\ - Obtains data about the file open on Fortran I/O unit @var{@1@} and - places them in the array @var{@2@}. - The values in this array are - extracted from the @code{stat} structure as returned by - @code{fstat(2)} q.v., as follows: - - @enumerate - @item - File mode - - @item - Inode number - - @item - ID of device containing directory entry for file - - @item - Device id (if relevant) - - @item - Number of links - - @item - Owner's uid - - @item - Owner's gid - - @item - File size (bytes) - - @item - Last access time - - @item - Last modification time - - @item - Last file status change time - - @item - Preferred i/o block size - - @item - Number of blocks allocated - @end enumerate - - Not all these elements are relevant on all systems. - If an element is not relevant, it is returned as 0. - - Returns 0 on success, otherwise an error number. - ") - - DEFDOC (LSTAT, "Get file information.", "\ - Obtains data about the given @var{@1@} and places them in the array - @var{@2@}. - If @var{@1@} is a symbolic link it returns data on the - link itself, so the routine is available only on systems that support - symbolic links. - The values in this array are extracted from the - @code{stat} structure as returned by @code{fstat(2)} q.v., as follows: - - @enumerate - @item - File mode - - @item - Inode number - - @item - ID of device containing directory entry for file - - @item - Device id (if relevant) - - @item - Number of links - - @item - Owner's uid - - @item - Owner's gid - - @item - File size (bytes) - - @item - Last access time - - @item - Last modification time - - @item - Last file status change time - - @item - Preferred i/o block size - - @item - Number of blocks allocated - @end enumerate - - Not all these elements are relevant on all systems. - If an element is not relevant, it is returned as 0. - - Returns 0 on success, otherwise an error number. - ") - - DEFDOC (STAT, "Get file information.", "\ - Obtains data about the given @var{@1@} and places them in the array - @var{@2@}. - The values in this array are extracted from the - @code{stat} structure as returned by @code{fstat(2)} q.v., as follows: - - @enumerate - @item - File mode - - @item - Inode number - - @item - ID of device containing directory entry for file - - @item - Device id (if relevant) - - @item - Number of links - - @item - Owner's uid - - @item - Owner's gid - - @item - File size (bytes) - - @item - Last access time - - @item - Last modification time - - @item - Last file status change time - - @item - Preferred i/o block size - - @item - Number of blocks allocated - @end enumerate - - Not all these elements are relevant on all systems. - If an element is not relevant, it is returned as 0. - - Returns 0 on success, otherwise an error number. - ") - - DEFDOC (LINK, "Make hard link in file system.", "\ - Makes a (hard) link from @var{@1@} to @var{@2@}. - If the - @var{@3@} argument is supplied, it contains 0 on success or an error - code otherwise. - See @code{link(2)}. - ") - - DEFDOC (SYMLNK, "Make symbolic link in file system.", "\ - Makes a symbolic link from @var{@1@} to @var{@2@}. - If the - @var{@3@} argument is supplied, it contains 0 on success or an error - code otherwise. - Available only on systems that support symbolic - links (see @code{symlink(2)}). - ") - - DEFDOC (RENAME, "Rename file.", "\ - Renames the file @var{@1@} to @var{@2@}. - See @code{rename(2)}. - If the @var{@3@} argument is supplied, it contains 0 on success or an - error code otherwise upon return. - ") - - DEFDOC (UMASK, "Set file creation permissions mask.", "\ - Sets the file creation mask to @var{@2@} and returns the old value in - argument @var{@2@} if it is supplied. - See @code{umask(2)}. - ") - - DEFDOC (UNLINK, "Unlink file.", "\ - Unlink the file @var{@1@}. - If the @var{@2@} argument is supplied, it - contains 0 on success or an error code otherwise. - See @code{unlink(2)}. - ") - - DEFDOC (GERROR, "Get error message for last error.", "\ - Returns the system error message corresponding to the last system - error (C @code{errno}). - ") - - DEFDOC (IERRNO, "Get error number for last error.", "\ - Returns the last system error number (corresponding to the C - @code{errno}). - ") - - DEFDOC (PERROR, "Print error message for last error.", "\ - Prints (on the C @code{stderr} stream) a newline-terminated error - message corresponding to the last system error. - This is prefixed by @var{@1@}, a colon and a space. - See @code{perror(3)}. - ") - - DEFDOC (GETGID, "Get process group id.", "\ - Returns the group id for the current process. - ") - - DEFDOC (GETUID, "Get process user id.", "\ - Returns the user id for the current process. - ") - - DEFDOC (GETPID, "Get process id.", "\ - Returns the process id for the current process. - ") - - DEFDOC (GETENV, "Get environment variable.", "\ - Sets @var{@2@} to the value of environment variable given by the - value of @var{@1@} (@code{$name} in shell terms) or to blanks if - @code{$name} has not been set. - ") - - DEFDOC (GETLOG, "Get login name.", "\ - Returns the login name for the process in @var{@1@}. - ") - - DEFDOC (HOSTNM, "Get host name.", "\ - Fills @var{@1@} with the system's host name returned by - @code{gethostname(2)}, returning 0 on success or an error code. - This function is not available on all systems. - ") - - /* Fixme: stream i/o */ - - DEFDOC (FLUSH, "Flush buffered output.", "\ - Flushes Fortran unit(s) currently open for output. - Without the optional argument, all such units are flushed, - otherwise just the unit specified by @var{@1@}. - ") - - DEFDOC (FNUM, "Get file descriptor from Fortran unit number.", "\ - Returns the Unix file descriptor number corresponding to the open - Fortran I/O unit @var{@1@}. - This could be passed to an interface to C I/O routines. - ") - - DEFDOC (FSEEK, "Position file (low-level).", "\ - Attempts to move Fortran unit @var{@1@} to the specified - @var{Offset}: absolute offset if @var{@2@}=0; relative to the - current offset if @var{@2@}=1; relative to the end of the file if - @var{@2@}=2. - It branches to label @var{@3@} if @var{@1@} is - not open or if the call otherwise fails. - ") - - DEFDOC (FTELL, "Get file position (low-level).", "\ - Returns the current offset of Fortran unit @var{@1@} (or @minus{}1 if - @var{@1@} is not open). - ") - - DEFDOC (ISATTY, "Is unit connected to a terminal?", "\ - Returns @code{.TRUE.} if and only if the Fortran I/O unit - specified by @var{@1@} is connected - to a terminal device. - See @code{isatty(3)}. - ") - - DEFDOC (TTYNAM, "Get name of terminal device for unit.", "\ - Returns the name of the terminal device open on logical unit - @var{@1@} or a blank string if @var{@1@} is not connected to a - terminal. - ") - - DEFDOC (SIGNAL, "Muck with signal handling.", "\ - If @var{@2@} is a an @code{EXTERNAL} routine, arranges for it to be - invoked with a single integer argument (of system-dependent length) - when signal @var{@1@} occurs. - If @var{@1@} is an integer it can be - used to turn off handling of signal @var{@2@} or revert to its default - action. - See @code{signal(2)}. - - Note that @var{@2@} will be called with C conventions, so its value in - Fortran terms is obtained by applying @code{%loc} (or @var{loc}) to it. - ") - - DEFDOC (KILL, "Signal a process.", "\ - Sends the signal specified by @var{@2@} to the process @var{@1@}. Returns zero - on success, otherwise an error number. - See @code{kill(2)}. - ") - - DEFDOC (LNBLNK, "Get last non-blank character in string.", "\ - Returns the index of the last non-blank character in @var{@1@}. - @code{LNBLNK} and @code{LEN_TRIM} are equivalent. - ") - - DEFDOC (SLEEP, "Sleep for a specified time.", "\ - Causes the process to pause for @var{@1@} seconds. - See @code{sleep(2)}. - ") - - DEFDOC (SYSTEM, "Invoke shell (system) command.", "\ - Passes the command @var{@1@} to a shell (see @code{system(3)}). - If argument @var{@2@} is present, it contains the value returned by - @code{system(3)}, presumably 0 if the shell command succeeded. - Note that which shell is used to invoke the command is system-dependent - and environment-dependent. - ") --- 0 ---- diff -rcp2N g77-0.5.20/f/intdoc.in g77-0.5.21/f/intdoc.in *** g77-0.5.20/f/intdoc.in Thu Jan 1 00:00:00 1970 --- g77-0.5.21/f/intdoc.in Tue Sep 2 21:27:06 1997 *************** *** 0 **** --- 1,2375 ---- + /* Copyright (C) 1997 Free Software Foundation, Inc. + * This is part of the G77 manual. + * For copying conditions, see the file g77.texi. */ + + /* This is the file containing the verbage for the + intrinsics. It consists of a data base built up + via DEFDOC macros of the form: + + DEFDOC (IMP, SUMMARY, DESCRIPTION) + + IMP is the implementation keyword used in the intrin module. + SUMMARY is the short summary to go in the "* Menu:" section + of the Info document. DESCRIPTION is the longer description + to go in the documentation itself. + + Note that IMP is leveraged across multiple intrinsic names. + + To make for more accurate and consistent documentation, + the translation made by intdoc.c of the text in SUMMARY + and DESCRIPTION includes the special sequence + + @ARGNO@ + + where ARGNO is a series of digits forming a number that + is substituted by intdoc.c as follows: + + 0 The initial-caps form of the intrinsic name (e.g. Float). + 1-98 The initial-caps form of the ARGNO'th argument. + 99 (SUMMARY only) a newline plus the appropriate # of spaces. + + Hope this info is enough to encourage people to feel free to + add documentation to this file! + + */ + + #define ARCHAIC(upper,mixed) \ + "Archaic form of @code{" #upper "()} that is specific\n\ + to one type for @var{@1@}.\n\ + @xref{" #mixed " Intrinsic}.\n" + + #define ARCHAIC_2nd(upper,mixed) \ + "Archaic form of @code{" #upper "()} that is specific\n\ + to one type for @var{@2@}.\n\ + @xref{" #mixed " Intrinsic}.\n" + + #define ARCHAIC_2(upper,mixed) \ + "Archaic form of @code{" #upper "()} that is specific\n\ + to one type for @var{@1@} and @var{@2@}.\n\ + @xref{" #mixed " Intrinsic}.\n" + + DEFDOC (ABS, "Absolute value.", "\ + Returns the absolute value of @var{@1@}. + + If @var{@1@} is type @code{COMPLEX}, the absolute + value is computed as: + + @example + SQRT(REALPART(@var{@1@})**2, IMAGPART(@var{@1@})**2) + @end example + + @noindent + Otherwise, it is computed by negating the @var{@1@} if + it is negative, or returning @var{@1@}. + + @xref{Sign Intrinsic}, for how to explicitly + compute the positive or negative form of the absolute + value of an expression. + ") + + DEFDOC (CABS, "Absolute value (archaic).", ARCHAIC (ABS, Abs)) + + DEFDOC (DABS, "Absolute value (archaic).", ARCHAIC (ABS, Abs)) + + DEFDOC (IABS, "Absolute value (archaic).", ARCHAIC (ABS, Abs)) + + DEFDOC (CDABS, "Absolute value (archaic).", ARCHAIC (ABS, Abs)) + + DEFDOC (ACHAR, "ASCII character from code.", "\ + Returns the ASCII character corresponding to the + code specified by @var{@1@}. + + @xref{IAChar Intrinsic}, for the inverse of this function. + + @xref{Char Intrinsic}, for the function corresponding + to the system's native character set. + ") + + DEFDOC (IACHAR, "ASCII code for character.", "\ + Returns the code for the ASCII character in the + first character position of @var{@1@}. + + @xref{AChar Intrinsic}, for the inverse of this function. + + @xref{IChar Intrinsic}, for the function corresponding + to the system's native character set. + ") + + DEFDOC (CHAR, "Character from code.", "\ + Returns the character corresponding to the + code specified by @var{@1@}, using the system's + native character set. + + Because the system's native character set is used, + the correspondence between character and their codes + is not necessarily the same between GNU Fortran + implementations. + + Note that no intrinsic exists to convert a numerical + value to a printable character string. + For example, there is no intrinsic that, given + an @code{INTEGER} or @code{REAL} argument with the + value @samp{154}, returns the @code{CHARACTER} + result @samp{'154'}. + + Instead, you can use internal-file I/O to do this kind + of conversion. + For example: + + @smallexample + INTEGER VALUE + CHARACTER*10 STRING + VALUE = 154 + WRITE (STRING, '(I10)'), VALUE + PRINT *, STRING + END + @end smallexample + + The above program, when run, prints: + + @smallexample + 154 + @end smallexample + + @xref{IChar Intrinsic}, for the inverse of the @code{@0@} function. + + @xref{AChar Intrinsic}, for the function corresponding + to the ASCII character set. + ") + + DEFDOC (ICHAR, "Code for character.", "\ + Returns the code for the character in the + first character position of @var{@1@}. + + Because the system's native character set is used, + the correspondence between character and their codes + is not necessarily the same between GNU Fortran + implementations. + + Note that no intrinsic exists to convert a printable + character string to a numerical value. + For example, there is no intrinsic that, given + the @code{CHARACTER} value @samp{'154'}, returns an + @code{INTEGER} or @code{REAL} value with the value @samp{154}. + + Instead, you can use internal-file I/O to do this kind + of conversion. + For example: + + @smallexample + INTEGER VALUE + CHARACTER*10 STRING + STRING = '154' + READ (STRING, '(I10)'), VALUE + PRINT *, VALUE + END + @end smallexample + + The above program, when run, prints: + + @smallexample + 154 + @end smallexample + + @xref{Char Intrinsic}, for the inverse of the @code{@0@} function. + + @xref{IAChar Intrinsic}, for the function corresponding + to the ASCII character set. + ") + + DEFDOC (ACOS, "Arc cosine.", "\ + Returns the arc-cosine (inverse cosine) of @var{@1@} + in radians. + + @xref{Cos Intrinsic}, for the inverse of this function. + ") + + DEFDOC (DACOS, "Arc cosine (archaic).", ARCHAIC (ACOS, ACos)) + + DEFDOC (AIMAG, "Convert/extract imaginary part of complex.", "\ + Returns the (possibly converted) imaginary part of @var{@1@}. + + Use of @code{@0@()} with an argument of a type + other than @code{COMPLEX(KIND=1)} is restricted to the following case: + + @example + REAL(AIMAG(@1@)) + @end example + + @noindent + This expression converts the imaginary part of @1@ to + @code{REAL(KIND=1)}. + + @xref{REAL() and AIMAG() of Complex}, for more information. + ") + + DEFDOC (DIMAG, "Convert/extract imaginary part of complex (archaic).", ARCHAIC (AIMAG, AImag)) + + DEFDOC (AINT, "Truncate to whole number.", "\ + Returns @var{@1@} with the fractional portion of its + magnitude truncated and its sign preserved. + (Also called ``truncation towards zero''.) + + @xref{ANInt Intrinsic}, for how to round to nearest + whole number. + + @xref{Int Intrinsic}, for how to truncate and then convert + number to @code{INTEGER}. + ") + + DEFDOC (DINT, "Truncate to whole number (archaic).", ARCHAIC (AINT, AInt)) + + DEFDOC (INT, "Convert to @code{INTEGER} value truncated@99@to whole number.", "\ + Returns @var{@1@} with the fractional portion of its + magnitude truncated and its sign preserved, converted + to type @code{INTEGER(KIND=1)}. + + If @var{@1@} is type @code{COMPLEX}, its real part is + truncated and converted, and its imaginary part is disregarded. + + @xref{NInt Intrinsic}, for how to convert, rounded to nearest + whole number. + + @xref{AInt Intrinsic}, for how to truncate to whole number + without converting. + ") + + DEFDOC (IDINT, "Convert to @code{INTEGER} value truncated@99@to whole number (archaic).", ARCHAIC (INT, Int)) + + DEFDOC (ANINT, "Round to nearest whole number.", "\ + Returns @var{@1@} with the fractional portion of its + magnitude eliminated by rounding to the nearest whole + number and with its sign preserved. + + A fractional portion exactly equal to + @samp{.5} is rounded to the whole number that + is larger in magnitude. + (Also called ``Fortran round''.) + + @xref{AInt Intrinsic}, for how to truncate to + whole number. + + @xref{NInt Intrinsic}, for how to round and then convert + number to @code{INTEGER}. + ") + + DEFDOC (DNINT, "Round to nearest whole number (archaic).", ARCHAIC (ANINT, ANInt)) + + DEFDOC (NINT, "Convert to @code{INTEGER} value rounded@99@to nearest whole number.", "\ + Returns @var{@1@} with the fractional portion of its + magnitude eliminated by rounding to the nearest whole + number and with its sign preserved, converted + to type @code{INTEGER(KIND=1)}. + + If @var{@1@} is type @code{COMPLEX}, its real part is + rounded and converted. + + A fractional portion exactly equal to + @samp{.5} is rounded to the whole number that + is larger in magnitude. + (Also called ``Fortran round''.) + + @xref{Int Intrinsic}, for how to convert, truncate to + whole number. + + @xref{ANInt Intrinsic}, for how to round to nearest whole number + without converting. + ") + + DEFDOC (IDNINT, "Convert to @code{INTEGER} value rounded@99@to nearest whole number (archaic).", ARCHAIC (NINT, NInt)) + + DEFDOC (LOG, "Natural logarithm.", "\ + Returns the natural logarithm of @var{@1@}, which must + be greater than zero or, if type @code{COMPLEX}, must not + be zero. + + @xref{Exp Intrinsic}, for the inverse of this function. + + @xref{Log10 Intrinsic}, for the base-10 logarithm function. + ") + + DEFDOC (ALOG, "Natural logarithm (archaic).", ARCHAIC (LOG, Log)) + + DEFDOC (CLOG, "Natural logarithm (archaic).", ARCHAIC (LOG, Log)) + + DEFDOC (DLOG, "Natural logarithm (archaic).", ARCHAIC (LOG, Log)) + + DEFDOC (CDLOG, "Natural logarithm (archaic).", ARCHAIC (LOG, Log)) + + DEFDOC (LOG10, "Natural logarithm.", "\ + Returns the natural logarithm of @var{@1@}, which must + be greater than zero or, if type @code{COMPLEX}, must not + be zero. + + The inverse of this function is @samp{10. ** LOG10(@var{@1@})}. + + @xref{Log Intrinsic}, for the natural logarithm function. + ") + + DEFDOC (ALOG10, "Natural logarithm (archaic).", ARCHAIC (LOG10, Log10)) + + DEFDOC (DLOG10, "Natural logarithm (archaic).", ARCHAIC (LOG10, Log10)) + + DEFDOC (MAX, "Maximum value.", "\ + Returns the argument with the largest value. + + @xref{Min Intrinsic}, for the opposite function. + ") + + DEFDOC (AMAX0, "Maximum value (archaic).", "\ + Archaic form of @code{MAX()} that is specific + to one type for @var{@1@} and a different return type. + @xref{Max Intrinsic}. + ") + + DEFDOC (AMAX1, "Maximum value (archaic).", ARCHAIC (MAX, Max)) + + DEFDOC (DMAX1, "Maximum value (archaic).", ARCHAIC (MAX, Max)) + + DEFDOC (MAX0, "Maximum value (archaic).", ARCHAIC (MAX, Max)) + + DEFDOC (MAX1, "Maximum value (archaic).", "\ + Archaic form of @code{MAX()} that is specific + to one type for @var{@1@} and a different return type. + @xref{Max Intrinsic}. + ") + + DEFDOC (MIN, "Minimum value.", "\ + Returns the argument with the smallest value. + + @xref{Max Intrinsic}, for the opposite function. + ") + + DEFDOC (AMIN0, "Minimum value (archaic).", "\ + Archaic form of @code{MIN()} that is specific + to one type for @var{@1@} and a different return type. + @xref{Min Intrinsic}. + ") + + DEFDOC (AMIN1, "Minimum value (archaic).", ARCHAIC (MIN, Min)) + + DEFDOC (DMIN1, "Minimum value (archaic).", ARCHAIC (MIN, Min)) + + DEFDOC (MIN0, "Minimum value (archaic).", ARCHAIC (MIN, Min)) + + DEFDOC (MIN1, "Minimum value (archaic).", "\ + Archaic form of @code{MIN()} that is specific + to one type for @var{@1@} and a different return type. + @xref{Min Intrinsic}. + ") + + DEFDOC (MOD, "Remainder.", "\ + Returns remainder calculated as: + + @smallexample + @var{@1@} - (INT(@var{@1@} / @var{@2@}) * @var{@2@}) + @end smallexample + + @var{@2@} must not be zero. + ") + + DEFDOC (AMOD, "Remainder (archaic).", ARCHAIC (MOD, Mod)) + + DEFDOC (DMOD, "Remainder (archaic).", ARCHAIC (MOD, Mod)) + + DEFDOC (AND, "Boolean AND.", "\ + Returns value resulting from boolean AND of + pair of bits in each of @var{@1@} and @var{@2@}. + ") + + DEFDOC (IAND, "Boolean AND.", "\ + Returns value resulting from boolean AND of + pair of bits in each of @var{@1@} and @var{@2@}. + ") + + DEFDOC (OR, "Boolean OR.", "\ + Returns value resulting from boolean OR of + pair of bits in each of @var{@1@} and @var{@2@}. + ") + + DEFDOC (IOR, "Boolean OR.", "\ + Returns value resulting from boolean OR of + pair of bits in each of @var{@1@} and @var{@2@}. + ") + + DEFDOC (XOR, "Boolean XOR.", "\ + Returns value resulting from boolean exclusive-OR of + pair of bits in each of @var{@1@} and @var{@2@}. + ") + + DEFDOC (IEOR, "Boolean XOR.", "\ + Returns value resulting from boolean exclusive-OR of + pair of bits in each of @var{@1@} and @var{@2@}. + ") + + DEFDOC (NOT, "Boolean NOT.", "\ + Returns value resulting from boolean NOT of each bit + in @var{@1@}. + ") + + DEFDOC (ASIN, "Arc sine.", "\ + Returns the arc-sine (inverse sine) of @var{@1@} + in radians. + + @xref{Sin Intrinsic}, for the inverse of this function. + ") + + DEFDOC (DASIN, "Arc sine (archaic).", ARCHAIC (ASIN, ASin)) + + DEFDOC (ATAN, "Arc tangent.", "\ + Returns the arc-tangent (inverse tangent) of @var{@1@} + in radians. + + @xref{Tan Intrinsic}, for the inverse of this function. + ") + + DEFDOC (DATAN, "Arc tangent (archaic).", ARCHAIC (ATAN, ATan)) + + DEFDOC (ATAN2, "Arc tangent.", "\ + Returns the arc-tangent (inverse tangent) of the complex + number (@var{@1@}, @var{@2@}) in radians. + + @xref{Tan Intrinsic}, for the inverse of this function. + ") + + DEFDOC (DATAN2, "Arc tangent (archaic).", ARCHAIC_2 (ATAN2, ATan2)) + + DEFDOC (BIT_SIZE, "Number of bits in argument's type.", "\ + Returns the number of bits (integer precision plus sign bit) + represented by the type for @var{@1@}. + + @xref{BTest Intrinsic}, for how to test the value of a + bit in a variable or array. + + @xref{IBSet Intrinsic}, for how to set a bit in a variable to 1. + + @xref{IBClr Intrinsic}, for how to set a bit in a variable to 0. + + ") + + DEFDOC (BTEST, "Test bit.", "\ + Returns @code{.TRUE.} if bit @var{@2@} in @var{@1@} is + 1, @code{.FALSE.} otherwise. + + (Bit 0 is the low-order (rightmost) bit, adding the value + @ifinfo + 2**0, + @end ifinfo + @iftex + @tex + $2^0$, + @end tex + @end iftex + or 1, + to the number if set to 1; + bit 1 is the next-higher-order bit, adding + @ifinfo + 2**1, + @end ifinfo + @iftex + @tex + $2^1$, + @end tex + @end iftex + or 2; + bit 2 adds + @ifinfo + 2**2, + @end ifinfo + @iftex + @tex + $2^2$, + @end tex + @end iftex + or 4; and so on.) + + @xref{Bit_Size Intrinsic}, for how to obtain the number of bits + in a type. + The leftmost bit of @var{@1@} is @samp{BIT_SIZE(@var{@1@}-1)}. + ") + + DEFDOC (CMPLX, "Construct @code{COMPLEX(KIND=1)} value.", "\ + If @var{@1@} is not type @code{COMPLEX}, + constructs a value of type @code{COMPLEX(KIND=1)} from the + real and imaginary values specified by @var{@1@} and + @var{@2@}, respectively. + If @var{@2@} is omitted, @samp{0.} is assumed. + + If @var{@1@} is type @code{COMPLEX}, + converts it to type @code{COMPLEX(KIND=1)}. + + @xref{Complex Intrinsic}, for information on easily constructing + a @code{COMPLEX} value of arbitrary precision from @code{REAL} + arguments. + ") + + DEFDOC (DCMPLX, "Construct @code{COMPLEX(KIND=2)} value.", "\ + If @var{@1@} is not type @code{COMPLEX}, + constructs a value of type @code{COMPLEX(KIND=2)} from the + real and imaginary values specified by @var{@1@} and + @var{@2@}, respectively. + If @var{@2@} is omitted, @samp{0D0} is assumed. + + If @var{@1@} is type @code{COMPLEX}, + converts it to type @code{COMPLEX(KIND=2)}. + + Although this intrinsic is not standard Fortran, + it is a popular extension offered by many compilers + that support @code{DOUBLE COMPLEX}, since it offers + the easiest way to convert to @code{DOUBLE COMPLEX} + without using Fortran 90 features (such as the @samp{KIND=} + argument to the @code{CMPLX()} intrinsic). + + (@samp{CMPLX(0D0, 0D0)} returns a single-precision + @code{COMPLEX} result, as required by standard FORTRAN 77. + That's why so many compilers provide @code{DCMPLX()}, since + @samp{DCMPLX(0D0, 0D0)} returns a @code{DOUBLE COMPLEX} + result. + Still, @code{DCMPLX()} converts even @code{REAL*16} arguments + to their @code{REAL*8} equivalents in most dialects of + Fortran, so neither it nor @code{CMPLX()} allow easy + construction of arbitrary-precision values without + potentially forcing a conversion involving extending or + reducing precision. + GNU Fortran provides such an intrinsic, called @code{COMPLEX()}.) + + @xref{Complex Intrinsic}, for information on easily constructing + a @code{COMPLEX} value of arbitrary precision from @code{REAL} + arguments. + ") + + DEFDOC (CONJG, "Complex conjugate.", "\ + Returns the complex conjugate: + + @example + COMPLEX(REALPART(@var{@1@}), -IMAGPART(@var{@1@})) + @end example + ") + + DEFDOC (DCONJG, "Complex conjugate (archaic).", ARCHAIC (CONJG, Conjg)) + + DEFDOC (COS, "Cosine.", "\ + Returns the cosine of @var{@1@}, an angle measured + in radians. + + @xref{ACos Intrinsic}, for the inverse of this function. + ") + + DEFDOC (CCOS, "Cosine (archaic).", ARCHAIC (COS, Cos)) + + DEFDOC (DCOS, "Cosine (archaic).", ARCHAIC (COS, Cos)) + + DEFDOC (CDCOS, "Cosine (archaic).", ARCHAIC (COS, Cos)) + + DEFDOC (COSH, "Hyperbolic cosine.", "\ + Returns the hyperbolic cosine of @var{@1@}. + ") + + DEFDOC (DCOSH, "Hyperbolic cosine (archaic).", ARCHAIC (COSH, CosH)) + + DEFDOC (SQRT, "Square root.", "\ + Returns the square root of @var{@1@}, which must + not be negative. + + To calculate and represent the square root of a negative + number, complex arithmetic must be used. + For example, @samp{SQRT(COMPLEX(@var{@1@}))}. + + The inverse of this function is @samp{SQRT(@var{@1@}) * SQRT(@var{@1@})}. + ") + + DEFDOC (CSQRT, "Square root (archaic).", ARCHAIC (SQRT, SqRt)) + + DEFDOC (DSQRT, "Square root (archaic).", ARCHAIC (SQRT, SqRt)) + + DEFDOC (CDSQRT, "Square root (archaic).", ARCHAIC (SQRT, SqRt)) + + DEFDOC (DBLE, "Convert to double precision.", "\ + Returns @var{@1@} converted to double precision + (@code{REAL(KIND=2)}). + If @var{@1@} is @code{COMPLEX}, the real part of + @var{@1@} is used for the conversion + and the imaginary part disregarded. + + @xref{Sngl Intrinsic}, for the function that converts + to single precision. + + @xref{Int Intrinsic}, for the function that converts + to @code{INTEGER}. + + @xref{Complex Intrinsic}, for the function that converts + to @code{COMPLEX}. + ") + + DEFDOC (DIM, "Difference magnitude (non-negative subtract).", "\ + Returns @samp{@var{@1@}-@var{@2@}} if @var{@1@} is greater than + @var{@2@}; otherwise returns zero. + ") + + DEFDOC (DDIM, "Difference magnitude (archaic).", ARCHAIC_2 (DIM, DiM)) + DEFDOC (IDIM, "Difference magnitude (archaic).", ARCHAIC_2 (DIM, DiM)) + + DEFDOC (DPROD, "Double-precision product.", "\ + Returns @samp{DBLE(@var{@1@})*DBLE(@var{@2@})}. + ") + + DEFDOC (EXP, "Exponential.", "\ + Returns @samp{@var{e}**@var{@1@}}, where + @var{e} is approximately 2.7182818. + + @xref{Log Intrinsic}, for the inverse of this function. + ") + + DEFDOC (CEXP, "Exponential (archaic).", ARCHAIC (EXP, Exp)) + + DEFDOC (DEXP, "Exponential (archaic).", ARCHAIC (EXP, Exp)) + + DEFDOC (CDEXP, "Exponential (archaic).", ARCHAIC (EXP, Exp)) + + DEFDOC (FLOAT, "Conversion (archaic).", ARCHAIC (REAL, Real)) + DEFDOC (DFLOAT, "Conversion (archaic).", ARCHAIC (REAL, Real)) + + DEFDOC (IFIX, "Conversion (archaic).", ARCHAIC (INT, Int)) + + DEFDOC (LONG, "Conversion to @code{INTEGER(KIND=1)} (archaic).", "\ + Archaic form of @code{INT()} that is specific + to one type for @var{@1@}. + @xref{Int Intrinsic}. + + The precise meaning of this intrinsic might change + in a future version of the GNU Fortran language, + as more is learned about how it is used. + ") + + DEFDOC (SHORT, "Convert to @code{INTEGER(KIND=6)} value@99@truncated to whole number.", "\ + Returns @var{@1@} with the fractional portion of its + magnitude truncated and its sign preserved, converted + to type @code{INTEGER(KIND=6)}. + + If @var{@1@} is type @code{COMPLEX}, its real part + is truncated and converted, and its imaginary part is disgregarded. + + @xref{Int Intrinsic}. + + The precise meaning of this intrinsic might change + in a future version of the GNU Fortran language, + as more is learned about how it is used. + ") + + DEFDOC (INT2, "Convert to @code{INTEGER(KIND=6)} value@99@truncated to whole number.", "\ + Returns @var{@1@} with the fractional portion of its + magnitude truncated and its sign preserved, converted + to type @code{INTEGER(KIND=6)}. + + If @var{@1@} is type @code{COMPLEX}, its real part + is truncated and converted, and its imaginary part is disgregarded. + + @xref{Int Intrinsic}. + + The precise meaning of this intrinsic might change + in a future version of the GNU Fortran language, + as more is learned about how it is used. + ") + + DEFDOC (INT8, "Convert to @code{INTEGER(KIND=2)} value@99@truncated to whole number.", "\ + Returns @var{@1@} with the fractional portion of its + magnitude truncated and its sign preserved, converted + to type @code{INTEGER(KIND=2)}. + + If @var{@1@} is type @code{COMPLEX}, its real part + is truncated and converted, and its imaginary part is disgregarded. + + @xref{Int Intrinsic}. + + The precise meaning of this intrinsic might change + in a future version of the GNU Fortran language, + as more is learned about how it is used. + ") + + DEFDOC (LEN, "Length of character entity.", "\ + Returns the length of @var{@1@}. + + If @var{@1@} is an array, the length of an element + of @var{@1@} is returned. + + Note that @var{@1@} need not be defined when this + intrinsic is invoked, since only the length, not + the content, of @var{@1@} is needed. + + @xref{Bit_Size Intrinsic}, for the function that determines + the size of its argument in bits. + ") + + DEFDOC (TAN, "Tangent.", "\ + Returns the tangent of @var{@1@}, an angle measured + in radians. + + @xref{ATan Intrinsic}, for the inverse of this function. + ") + + DEFDOC (DTAN, "Tangent (archaic).", ARCHAIC (TAN, Tan)) + + DEFDOC (TANH, "Hyperbolic tangent.", "\ + Returns the hyperbolic tangent of @var{@1@}. + ") + + DEFDOC (DTANH, "Hyperbolic tangent (archaic).", ARCHAIC (TANH, TanH)) + + DEFDOC (SNGL, "Convert (archaic).", ARCHAIC (REAL, Real)) + + DEFDOC (SIN, "Sine.", "\ + Returns the sine of @var{@1@}, an angle measured + in radians. + + @xref{ASin Intrinsic}, for the inverse of this function. + ") + + DEFDOC (CSIN, "Sine (archaic).", ARCHAIC (SIN, Sin)) + + DEFDOC (DSIN, "Sine (archaic).", ARCHAIC (SIN, Sin)) + + DEFDOC (CDSIN, "Sine (archaic).", ARCHAIC (SIN, Sin)) + + DEFDOC (SINH, "Hyperbolic sine.", "\ + Returns the hyperbolic sine of @var{@1@}. + ") + + DEFDOC (DSINH, "Hyperbolic sine (archaic).", ARCHAIC (SINH, SinH)) + + DEFDOC (LSHIFT, "Left-shift bits.", "\ + Returns @var{@1@} shifted to the left + @var{@2@} bits. + + Although similar to the expression + @samp{@var{@1@}*(2**@var{@2@})}, there + are important differences. + For example, the sign of the result is + not necessarily the same as the sign of + @var{@1@}. + + Currently this intrinsic is defined assuming + the underlying representation of @var{@1@} + is as a two's-complement integer. + It is unclear at this point whether that + definition will apply when a different + representation is involved. + + @xref{LShift Intrinsic}, for the inverse of this function. + + @xref{IShft Intrinsic}, for information + on a more widely available left-shifting + intrinsic that is also more precisely defined. + ") + + DEFDOC (RSHIFT, "Right-shift bits.", "\ + Returns @var{@1@} shifted to the right + @var{@2@} bits. + + Although similar to the expression + @samp{@var{@1@}/(2**@var{@2@})}, there + are important differences. + For example, the sign of the result is + undefined. + + Currently this intrinsic is defined assuming + the underlying representation of @var{@1@} + is as a two's-complement integer. + It is unclear at this point whether that + definition will apply when a different + representation is involved. + + @xref{RShift Intrinsic}, for the inverse of this function. + + @xref{IShft Intrinsic}, for information + on a more widely available right-shifting + intrinsic that is also more precisely defined. + ") + + DEFDOC (LGE, "Lexically greater than or equal.", "\ + Returns @samp{.TRUE.} if @samp{@var{@1@}.GE.@var{@2@}}, + @samp{.FALSE.} otherwise. + @var{@1@} and @var{@2@} are interpreted as containing + ASCII character codes. + If either value contains a character not in the ASCII + character set, the result is processor dependent. + + If the @var{@1@} and @var{@2@} are not the same length, + the shorter is compared as if spaces were appended to + it to form a value that has the same length as the longer. + + The lexical comparison intrinsics @code{LGe}, @code{LGt}, + @code{LLe}, and @code{LLt} differ from the corresponding + intrinsic operators @code{.GE.}, @code{.GT.}, + @code{.LE.}, @code{.LT.}. + Because the ASCII collating sequence is assumed, + the following expressions always return @samp{.TRUE.}: + + @smallexample + LGE ('0', ' ') + LGE ('A', '0') + LGE ('a', 'A') + @end smallexample + + The following related expressions do @emph{not} always + return @samp{.TRUE.}, as they are not necessarily evaluated + assuming the arguments use ASCII encoding: + + @smallexample + '0' .GE. ' ' + 'A' .GE. '0' + 'a' .GE. 'A' + @end smallexample + + The same difference exists + between @code{LGt} and @code{.GT.}; + between @code{LLe} and @code{.LE.}; and + between @code{LLt} and @code{.LT.}. + ") + + DEFDOC (LGT, "Lexically greater than.", "\ + Returns @samp{.TRUE.} if @samp{@var{@1@}.GT.@var{@2@}}, + @samp{.FALSE.} otherwise. + @var{@1@} and @var{@2@} are interpreted as containing + ASCII character codes. + If either value contains a character not in the ASCII + character set, the result is processor dependent. + + If the @var{@1@} and @var{@2@} are not the same length, + the shorter is compared as if spaces were appended to + it to form a value that has the same length as the longer. + + @xref{LGe Intrinsic}, for information on the distinction + between the @code{@0@} intrinsic and the @code{.GT.} + operator. + ") + + DEFDOC (LLE, "Lexically less than or equal.", "\ + Returns @samp{.TRUE.} if @samp{@var{@1@}.LE.@var{@2@}}, + @samp{.FALSE.} otherwise. + @var{@1@} and @var{@2@} are interpreted as containing + ASCII character codes. + If either value contains a character not in the ASCII + character set, the result is processor dependent. + + If the @var{@1@} and @var{@2@} are not the same length, + the shorter is compared as if spaces were appended to + it to form a value that has the same length as the longer. + + @xref{LGe Intrinsic}, for information on the distinction + between the @code{@0@} intrinsic and the @code{.LE.} + operator. + ") + + DEFDOC (LLT, "Lexically less than.", "\ + Returns @samp{.TRUE.} if @samp{@var{@1@}.LT.@var{@2@}}, + @samp{.FALSE.} otherwise. + @var{@1@} and @var{@2@} are interpreted as containing + ASCII character codes. + If either value contains a character not in the ASCII + character set, the result is processor dependent. + + If the @var{@1@} and @var{@2@} are not the same length, + the shorter is compared as if spaces were appended to + it to form a value that has the same length as the longer. + + @xref{LGe Intrinsic}, for information on the distinction + between the @code{@0@} intrinsic and the @code{.LT.} + operator. + ") + + DEFDOC (SIGN, "Apply sign to magnitude.", "\ + Returns @samp{ABS(@var{@1@})*@var{s}}, where + @var{s} is +1 if @samp{@var{@2@}.GE.0}, + -1 otherwise. + + @xref{Abs Intrinsic}, for the function that returns + the magnitude of a value. + ") + + DEFDOC (DSIGN, "Apply sign to magnitude (archaic).", ARCHAIC_2 (SIGN, Sign)) + DEFDOC (ISIGN, "Apply sign to magnitude (archaic).", ARCHAIC_2 (SIGN, Sign)) + + DEFDOC (REAL, "Convert value to type @code{REAL(KIND=1)}.", "\ + Converts @var{@1@} to @code{REAL(KIND=1)}. + + Use of @code{@0@()} with a @code{COMPLEX} argument + (other than @code{COMPLEX(KIND=1)}) is restricted to the following case: + + @example + REAL(REAL(@1@)) + @end example + + @noindent + This expression converts the real part of @1@ to + @code{REAL(KIND=1)}. + + @xref{RealPart Intrinsic}, for information on a GNU Fortran + intrinsic that extracts the real part of an arbitrary + @code{COMPLEX} value. + + @xref{REAL() and AIMAG() of Complex}, for more information. + ") + + DEFDOC (DREAL, "Convert value to type @code{REAL(KIND=2)}.", "\ + Converts @var{@1@} to @code{REAL(KIND=2)}. + + If @var{@1@} is type @code{COMPLEX}, its real part + is converted (if necessary) to @code{REAL(KIND=2)}, + and its imaginary part is disregarded. + + Although this intrinsic is not standard Fortran, + it is a popular extension offered by many compilers + that support @code{DOUBLE COMPLEX}, since it offers + the easiest way to extract the real part of a @code{DOUBLE COMPLEX} + value without using the Fortran 90 @code{REAL()} intrinsic + in a way that produces a return value inconsistent with + the way many FORTRAN 77 compilers handle @code{REAL()} of + a @code{DOUBLE COMPLEX} value. + + @xref{RealPart Intrinsic}, for information on a GNU Fortran + intrinsic that avoids these areas of confusion. + + @xref{Dble Intrinsic}, for information on the standard FORTRAN 77 + replacement for @code{DREAL()}. + + @xref{REAL() and AIMAG() of Complex}, for more information on + this issue. + ") + + DEFDOC (IMAGPART, "Extract imaginary part of complex.", "\ + The imaginary part of @var{@1@} is returned, without conversion. + + @emph{Note:} The way to do this in standard Fortran 90 + is @samp{AIMAG(@var{@1@})}. + However, when, for example, @var{@1@} is @code{DOUBLE COMPLEX}, + @samp{AIMAG(@var{@1@})} means something different for some compilers + that are not true Fortran 90 compilers but offer some + extensions standardized by Fortran 90 (such as the + @code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}). + + The advantage of @code{@0@()} is that, while not necessarily + more or less portable than @code{AIMAG()}, it is more likely to + cause a compiler that doesn't support it to produce a diagnostic + than generate incorrect code. + + @xref{REAL() and AIMAG() of Complex}, for more information. + ") + + DEFDOC (COMPLEX, "Build complex value from real and@99@imaginary parts.", "\ + Returns a @code{COMPLEX} value that has @samp{@1@} and @samp{@2@} as its + real and imaginary parts, respectively. + + If @var{@1@} and @var{@2@} are the same type, and that type is not + @code{INTEGER}, no data conversion is performed, and the type of + the resulting value has the same kind value as the types + of @var{@1@} and @var{@2@}. + + If @var{@1@} and @var{@2@} are not the same type, the usual type-promotion + rules are applied to both, converting either or both to the + appropriate @code{REAL} type. + The type of the resulting value has the same kind value as the + type to which both @var{@1@} and @var{@2@} were converted, in this case. + + If @var{@1@} and @var{@2@} are both @code{INTEGER}, they are both converted + to @code{REAL(KIND=1)}, and the result of the @code{@0@()} + invocation is type @code{COMPLEX(KIND=1)}. + + @emph{Note:} The way to do this in standard Fortran 90 + is too hairy to describe here, but it is important to + note that @samp{CMPLX(D1,D2)} returns a @code{COMPLEX(KIND=1)} + result even if @samp{D1} and @samp{D2} are type @code{REAL(KIND=2)}. + Hence the availability of @code{COMPLEX()} in GNU Fortran. + ") + + DEFDOC (LOC, "Address of entity in core.", "\ + The @code{LOC()} intrinsic works the + same way as the @code{%LOC()} construct. + @xref{%LOC(),,The @code{%LOC()} Construct}, for + more information. + ") + + DEFDOC (REALPART, "Extract real part of complex.", "\ + The real part of @var{@1@} is returned, without conversion. + + @emph{Note:} The way to do this in standard Fortran 90 + is @samp{REAL(@var{@1@})}. + However, when, for example, @var{@1@} is @code{COMPLEX(KIND=2)}, + @samp{REAL(@var{@1@})} means something different for some compilers + that are not true Fortran 90 compilers but offer some + extensions standardized by Fortran 90 (such as the + @code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}). + + The advantage of @code{@0@()} is that, while not necessarily + more or less portable than @code{REAL()}, it is more likely to + cause a compiler that doesn't support it to produce a diagnostic + than generate incorrect code. + + @xref{REAL() and AIMAG() of Complex}, for more information. + ") + + DEFDOC (GETARG, "Obtain command-line argument.", "\ + Sets @var{@2@} to the @var{@1@}-th command-line argument (or to all + blanks if there are fewer than @var{@2@} command-line arguments); + @code{CALL @0@(0, @var{value})} sets @var{value} to the name of the + program (on systems that support this feature). + + @xref{IArgC Intrinsic}, for information on how to get the number + of arguments. + ") + + DEFDOC (ABORT, "Abort the program.", "\ + Prints a message and potentially causes a core dump via @code{abort(3)}. + ") + + DEFDOC (EXIT, "Terminate the program.", "\ + Exit the program with status @var{@1@} after closing open Fortran + I/O units and otherwise behaving as @code{exit(2)}. + If @var{@1@} is omitted the canonical `success' value + will be returned to the system. + ") + + DEFDOC (IARGC, "Obtain count of command-line arguments.", "\ + Returns the number of command-line arguments. + + This count does not include the specification of the program + name itself. + ") + + DEFDOC (CTIME_func, "Convert time to Day Mon dd hh:mm:ss yyyy.", "\ + Converts @var{@1@}, a system time value, such as returned by + @code{TIME8()}, to a string of the form @samp{Sat Aug 19 18:13:14 1995}, + and returns that string as the function value. + + @xref{Time8 Intrinsic}. + ") + + DEFDOC (CTIME_subr, "Convert time to Day Mon dd hh:mm:ss yyyy.", "\ + Converts @var{@2@}, a system time value, such as returned by + @code{TIME8()}, to a string of the form @samp{Sat Aug 19 18:13:14 1995}, + and returns that string in @var{@1@}. + + @xref{Time8 Intrinsic}. + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine. + ") + + DEFDOC (DATE, "Get current date as dd-Mon-yy.", "\ + Returns @var{@1@} in the form @samp{@var{dd}-@var{mmm}-@var{yy}}, + representing the numeric day of the month @var{dd}, a three-character + abbreviation of the month name @var{mmm} and the last two digits of + the year @var{yy}, e.g.@ @samp{25-Nov-96}. + + This intrinsic is not recommended, due to the year 2000 approaching. + @xref{CTime Intrinsic (subroutine)}, for information on obtaining more digits + for the current (or any) date. + ") + + DEFDOC (DTIME_func, "Get elapsed time since last time.", "\ + Initially, return the number of seconds of runtime + since the start of the process's execution + as the function value, + and the user and system components of this in @samp{@var{@1@}(1)} + and @samp{@var{@1@}(2)} respectively. + The functions' value is equal to @samp{@var{@1@}(1) + @var{@1@}(2)}. + + Subsequent invocations of @samp{@0@()} return values accumulated since the + previous invocation. + + Due to the side effects performed by this intrinsic, the function + form is not recommended. + ") + + DEFDOC (DTIME_subr, "Get elapsed time since last time.", "\ + Initially, return the number of seconds of runtime + since the start of the process's execution + in @var{@1@}, + and the user and system components of this in @samp{@var{@2@}(1)} + and @samp{@var{@2@}(2)} respectively. + The value of @var{@1@} is equal to @samp{@var{@2@}(1) + @var{@2@}(2)}. + + Subsequent invocations of @samp{@0@()} set values based on accumulations + since the previous invocation. + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine. + ") + + DEFDOC (ETIME_func, "Get elapsed time for process.", "\ + Return the number of seconds of runtime + since the start of the process's execution + as the function value, + and the user and system components of this in @samp{@var{@1@}(1)} + and @samp{@var{@1@}(2)} respectively. + The functions' value is equal to @samp{@var{@1@}(1) + @var{@1@}(2)}. + ") + + DEFDOC (ETIME_subr, "Get elapsed time for process.", "\ + Return the number of seconds of runtime + since the start of the process's execution + in @var{@1@}, + and the user and system components of this in @samp{@var{@2@}(1)} + and @samp{@var{@2@}(2)} respectively. + The value of @var{@1@} is equal to @samp{@var{@2@}(1) + @var{@2@}(2)}. + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine. + ") + + DEFDOC (FDATE_func, "Get current time as Day Mon dd hh:mm:ss yyyy.", "\ + Returns the current date (using the same format as @code{CTIME()}). + + Equivalent to: + + @example + CTIME(TIME8()) + @end example + + @xref{CTime Intrinsic (function)}. + ") + + DEFDOC (FDATE_subr, "Get current time as Day Mon dd hh:mm:ss yyyy.", "\ + Returns the current date (using the same format as @code{CTIME()}) + in @var{@1@}. + + Equivalent to: + + @example + CALL CTIME(@var{@1@}, TIME8()) + @end example + + @xref{CTime Intrinsic (subroutine)}. + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine. + ") + + DEFDOC (GMTIME, "Convert time to GMT time info.", "\ + Given a system time value @var{@1@}, fills @var{@2@} with values + extracted from it appropriate to the GMT time zone using + @code{gmtime(3)}. + + The array elements are as follows: + + @enumerate + @item + Seconds after the minute, range 0--59 or 0--61 to allow for leap + seconds + + @item + Minutes after the hour, range 0--59 + + @item + Hours past midnight, range 0--23 + + @item + Day of month, range 0--31 + + @item + Number of months since January, range 0--12 + + @item + Years since 1900 + + @item + Number of days since Sunday, range 0--6 + + @item + Days since January 1 + + @item + Daylight savings indicator: positive if daylight savings is in effect, + zero if not, and negative if the information isn't available. + @end enumerate + ") + + DEFDOC (LTIME, "Convert time to local time info.", "\ + Given a system time value @var{@1@}, fills @var{@2@} with values + extracted from it appropriate to the GMT time zone using + @code{localtime(3)}. + + The array elements are as follows: + + @enumerate + @item + Seconds after the minute, range 0--59 or 0--61 to allow for leap + seconds + + @item + Minutes after the hour, range 0--59 + + @item + Hours past midnight, range 0--23 + + @item + Day of month, range 0--31 + + @item + Number of months since January, range 0--12 + + @item + Years since 1900 + + @item + Number of days since Sunday, range 0--6 + + @item + Days since January 1 + + @item + Daylight savings indicator: positive if daylight savings is in effect, + zero if not, and negative if the information isn't available. + @end enumerate + ") + + DEFDOC (IDATE_unix, "Get local time info.", "\ + Fills @var{@1@} with the numerical values at the current local time + of day, month (in the range 1--12), and year in elements 1, 2, and 3, + respectively. + The year has four significant digits. + ") + + DEFDOC (IDATE_vxt, "Get local time info (VAX/VMS).", "\ + Returns the numerical values of the current local time. + The month (in the range 1--12) is returned in @var{@1@}, + the day (in the range 1--7) in @var{@2@}, + and the year in @var{@3@} (in the range 0--99). + + This intrinsic is not recommended, due to the year 2000 approaching. + ") + + DEFDOC (ITIME, "Get local time of day.", "\ + Returns the current local time hour, minutes, and seconds in elements + 1, 2, and 3 of @var{@1@}, respectively. + ") + + DEFDOC (MCLOCK, "Get number of clock ticks for process.", "\ + Returns the number of clock ticks since the start of the process. + Supported on systems with @code{clock(3)} (q.v.). + + This intrinsic is not fully portable, such as to systems + with 32-bit @code{INTEGER} types but supporting times + wider than 32 bits. + @xref{MClock8 Intrinsic}, for information on a + similar intrinsic that might be portable to more + GNU Fortran implementations, though to fewer + Fortran compilers. + + If the system does not support @code{clock(3)}, + -1 is returned. + ") + + DEFDOC (MCLOCK8, "Get number of clock ticks for process.", "\ + Returns the number of clock ticks since the start of the process. + Supported on systems with @code{clock(3)} (q.v.). + + No Fortran implementations other than GNU Fortran are + known to support this intrinsic at the time of this + writing. + @xref{MClock Intrinsic}, for information on a + similar intrinsic that might be portable to more Fortran + compilers, though to fewer GNU Fortran implementations. + + If the system does not support @code{clock(3)}, + -1 is returned. + ") + + DEFDOC (SECNDS, "Get local time offset since midnight.", "\ + Returns the local time in seconds since midnight minus the value + @var{@1@}. + ") + + DEFDOC (SECOND_func, "Get CPU time for process in seconds.", "\ + Returns the process's runtime in seconds---the same value as the + UNIX function @code{etime} returns. + + This routine is known from Cray Fortran. + ") + + DEFDOC (SECOND_subr, "Get CPU time for process@99@in seconds.", "\ + Returns the process's runtime in seconds in @var{@1@}---the same value + as the UNIX function @code{etime} returns. + + This routine is known from Cray Fortran. @xref{Cpu_Time Intrinsic} + for a standard equivalent. + ") + + DEFDOC (SYSTEM_CLOCK, "Get current system clock value.", "\ + Returns in @var{@1@} the current value of the system clock; this is + the value returned by the UNIX function @code{times(2)} + in this implementation, but + isn't in general. + @var{@2@} is the number of clock ticks per second and + @var{@3@} is the maximum value this can take, which isn't very useful + in this implementation since it's just the maximum C @code{unsigned + int} value. + ") + + DEFDOC (CPU_TIME, "Get current CPU time.", "\ + Returns in @var{@1@} the current value of the system time. + This implementation of the Fortran 95 intrinsic is just an alias for + @code{second} @xref{Second Intrinsic (subroutine)}. + ") + + DEFDOC (TIME8, "Get current time as time value.", "\ + Returns the current time encoded as a long integer + (in the manner of the UNIX function @code{time(3)}). + This value is suitable for passing to @code{CTIME}, + @code{GMTIME}, and @code{LTIME}. + + No Fortran implementations other than GNU Fortran are + known to support this intrinsic at the time of this + writing. + @xref{Time Intrinsic (UNIX)}, for information on a + similar intrinsic that might be portable to more Fortran + compilers, though to fewer GNU Fortran implementations. + ") + + DEFDOC (TIME_unix, "Get current time as time value.", "\ + Returns the current time encoded as an integer + (in the manner of the UNIX function @code{time(3)}). + This value is suitable for passing to @code{CTIME}, + @code{GMTIME}, and @code{LTIME}. + + This intrinsic is not fully portable, such as to systems + with 32-bit @code{INTEGER} types but supporting times + wider than 32 bits. + @xref{Time8 Intrinsic}, for information on a + similar intrinsic that might be portable to more + GNU Fortran implementations, though to fewer + Fortran compilers. + ") + + #define BES(num,n,val) "\ + Calculates the Bessel function of the " #num " kind of \ + order " #n " of @var{@" #val "@}.\n\ + See @code{bessel(3m)}, on whose implementation the \ + function depends.\ + " + + DEFDOC (BESJ0, "Bessel function.", BES (first, 0, 1)) + DEFDOC (BESJ1, "Bessel function.", BES (first, 1, 1)) + DEFDOC (BESJN, "Bessel function.", BES (first, @var{N}, 2)) + DEFDOC (BESY0, "Bessel function.", BES (second, 0, 1)) + DEFDOC (BESY1, "Bessel function.", BES (second, 1, 1)) + DEFDOC (BESYN, "Bessel function.", BES (second, @var{N}, 2)) + DEFDOC (DBESJ0, "Bessel function (archaic).", ARCHAIC (BESJ0, BesJ0)) + DEFDOC (DBESJ1, "Bessel function (archaic).", ARCHAIC (BESJ1, BesJ1)) + DEFDOC (DBESJN, "Bessel function (archaic).", ARCHAIC_2nd (BESJN, BesJN)) + DEFDOC (DBESY0, "Bessel function (archaic).", ARCHAIC (BESY0, BesY0)) + DEFDOC (DBESY1, "Bessel function (archaic).", ARCHAIC (BESY1, BesY1)) + DEFDOC (DBESYN, "Bessel function (archaic).", ARCHAIC_2nd (BESYN, BesYN)) + + DEFDOC (ERF, "Error function.", "\ + Returns the error function of @var{@1@}. + See @code{erf(3m)}, which provides the implementation. + ") + + DEFDOC (ERFC, "Complementary error function.", "\ + Returns the complementary error function of @var{@1@}: + @samp{ERFC(R) = 1 - ERF(R)} (except that the result may be more + accurate than explicitly evaluating that formulae would give). + See @code{erfc(3m)}, which provides the implementation. + ") + + DEFDOC (DERF, "Error function (archaic).", ARCHAIC (ERF, ErF)) + DEFDOC (DERFC, "Complementary error function (archaic).", ARCHAIC (ERFC, ErFC)) + + DEFDOC (IRAND, "Random number.", "\ + Returns a uniform quasi-random number up to a system-dependent limit. + If @var{@1@} is 0, the next number in sequence is returned; if + @var{@1@} is 1, the generator is restarted by calling the UNIX function + @samp{srand(0)}; if @var{@1@} has any other value, + it is used as a new seed with @code{srand()}. + + @xref{SRand Intrinsic}. + + @emph{Note:} As typically implemented (by the routine of the same + name in the C library), this random number generator is a very poor + one, though the BSD and GNU libraries provide a much better + implementation than the `traditional' one. + On a different system you almost certainly want to use something better. + ") + + DEFDOC (RAND, "Random number.", "\ + Returns a uniform quasi-random number between 0 and 1. + If @var{@1@} is 0, the next number in sequence is returned; if + @var{@1@} is 1, the generator is restarted by calling @samp{srand(0)}; + if @var{@1@} has any other value, it is used as a new seed with + @code{srand}. + + @xref{SRand Intrinsic}. + + @emph{Note:} As typically implemented (by the routine of the same + name in the C library), this random number generator is a very poor + one, though the BSD and GNU libraries provide a much better + implementation than the `traditional' one. + On a different system you + almost certainly want to use something better. + ") + + DEFDOC (SRAND, "Random seed.", "\ + Reinitialises the generator with the seed in @var{@1@}. + @xref{IRand Intrinsic}. + @xref{Rand Intrinsic}. + ") + + DEFDOC (ACCESS, "Check file accessibility.", "\ + Checks file @var{@1@} for accessibility in the mode specified by @var{@2@} and + returns 0 if the file is accessible in that mode, otherwise an error + code if the file is inaccessible or @var{@2@} is invalid. + See @code{access(2)}. + A null character (@samp{CHAR(0)}) marks the end of + the name in @var{@1@}---otherwise, + trailing blanks in @var{@1@} are ignored. + @var{@2@} may be a concatenation of any of the following characters: + + @table @samp + @item r + Read permission + + @item w + Write permission + + @item x + Execute permission + + @item @kbd{SPC} + Existence + @end table + ") + + DEFDOC (CHDIR_subr, "Change directory.", "\ + Sets the current working directory to be @var{@1@}. + If the @var{@2@} argument is supplied, it contains 0 + on success or a non-zero error code otherwise upon return. + See @code{chdir(3)}. + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine, or do not support the + (optional) @var{@2@} argument. + ") + + DEFDOC (CHDIR_func, "Change directory.", "\ + Sets the current working directory to be @var{@1@}. + Returns 0 on success or a non-zero error code. + See @code{chdir(3)}. + + Due to the side effects performed by this intrinsic, the function + form is not recommended. + ") + + DEFDOC (CHMOD_func, "Change file modes.", "\ + Changes the access mode of file @var{@1@} according to the + specification @var{@2@}, which is given in the format of + @code{chmod(1)}. + A null character (@samp{CHAR(0)}) marks the end of + the name in @var{@1@}---otherwise, + trailing blanks in @var{@1@} are ignored. + Currently, @var{@1@} must not contain the single quote + character. + + Returns 0 on success or a non-zero error code otherwise. + + Note that this currently works + by actually invoking @code{/bin/chmod} (or the @code{chmod} found when + the library was configured) and so may fail in some circumstances and + will, anyway, be slow. + + Due to the side effects performed by this intrinsic, the function + form is not recommended. + ") + + DEFDOC (CHMOD_subr, "Change file modes.", "\ + Changes the access mode of file @var{@1@} according to the + specification @var{@2@}, which is given in the format of + @code{chmod(1)}. + A null character (@samp{CHAR(0)}) marks the end of + the name in @var{@1@}---otherwise, + trailing blanks in @var{@1@} are ignored. + Currently, @var{@1@} must not contain the single quote + character. + + If the @var{@3@} argument is supplied, it contains + 0 on success or a non-zero error code upon return. + + Note that this currently works + by actually invoking @code{/bin/chmod} (or the @code{chmod} found when + the library was configured) and so may fail in some circumstances and + will, anyway, be slow. + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine, or do not support the + (optional) @var{@3@} argument. + ") + + DEFDOC (GETCWD_func, "Get current working directory.", "\ + Places the current working directory in @var{@1@}. + Returns 0 on + success, otherwise a non-zero error code + (@code{ENOSYS} if the system does not provide @code{getcwd(3)} + or @code{getwd(3)}). + ") + + DEFDOC (GETCWD_subr, "Get current working directory.", "\ + Places the current working directory in @var{@1@}. + If the @var{@2@} argument is supplied, it contains 0 + success or a non-zero error code upon return + (@code{ENOSYS} if the system does not provide @code{getcwd(3)} + or @code{getwd(3)}). + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine, or do not support the + (optional) @var{@2@} argument. + ") + + DEFDOC (FSTAT_func, "Get file information.", "\ + Obtains data about the file open on Fortran I/O unit @var{@1@} and + places them in the array @var{@2@}. + The values in this array are + extracted from the @code{stat} structure as returned by + @code{fstat(2)} q.v., as follows: + + @enumerate + @item + File mode + + @item + Inode number + + @item + ID of device containing directory entry for file + + @item + Device id (if relevant) + + @item + Number of links + + @item + Owner's uid + + @item + Owner's gid + + @item + File size (bytes) + + @item + Last access time + + @item + Last modification time + + @item + Last file status change time + + @item + Preferred I/O block size + + @item + Number of blocks allocated + @end enumerate + + Not all these elements are relevant on all systems. + If an element is not relevant, it is returned as 0. + + Returns 0 on success or a non-zero error code. + ") + + DEFDOC (FSTAT_subr, "Get file information.", "\ + Obtains data about the file open on Fortran I/O unit @var{@1@} and + places them in the array @var{@2@}. + The values in this array are + extracted from the @code{stat} structure as returned by + @code{fstat(2)} q.v., as follows: + + @enumerate + @item + File mode + + @item + Inode number + + @item + ID of device containing directory entry for file + + @item + Device id (if relevant) + + @item + Number of links + + @item + Owner's uid + + @item + Owner's gid + + @item + File size (bytes) + + @item + Last access time + + @item + Last modification time + + @item + Last file status change time + + @item + Preferred I/O block size + + @item + Number of blocks allocated + @end enumerate + + Not all these elements are relevant on all systems. + If an element is not relevant, it is returned as 0. + + If the @var{@3@} argument is supplied, it contains + 0 on success or a non-zero error code upon return. + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine, or do not support the + (optional) @var{@3@} argument. + ") + + DEFDOC (LSTAT_func, "Get file information.", "\ + Obtains data about the given file @var{@1@} and places them in the array + @var{@2@}. + A null character (@samp{CHAR(0)}) marks the end of + the name in @var{@1@}---otherwise, + trailing blanks in @var{@1@} are ignored. + If @var{@1@} is a symbolic link it returns data on the + link itself, so the routine is available only on systems that support + symbolic links. + The values in this array are extracted from the + @code{stat} structure as returned by @code{fstat(2)} q.v., as follows: + + @enumerate + @item + File mode + + @item + Inode number + + @item + ID of device containing directory entry for file + + @item + Device id (if relevant) + + @item + Number of links + + @item + Owner's uid + + @item + Owner's gid + + @item + File size (bytes) + + @item + Last access time + + @item + Last modification time + + @item + Last file status change time + + @item + Preferred I/O block size + + @item + Number of blocks allocated + @end enumerate + + Not all these elements are relevant on all systems. + If an element is not relevant, it is returned as 0. + + Returns 0 on success or a non-zero error code + (@code{ENOSYS} if the system does not provide @code{lstat(2)}). + ") + + DEFDOC (LSTAT_subr, "Get file information.", "\ + Obtains data about the given file @var{@1@} and places them in the array + @var{@2@}. + A null character (@samp{CHAR(0)}) marks the end of + the name in @var{@1@}---otherwise, + trailing blanks in @var{@1@} are ignored. + If @var{@1@} is a symbolic link it returns data on the + link itself, so the routine is available only on systems that support + symbolic links. + The values in this array are extracted from the + @code{stat} structure as returned by @code{fstat(2)} q.v., as follows: + + @enumerate + @item + File mode + + @item + Inode number + + @item + ID of device containing directory entry for file + + @item + Device id (if relevant) + + @item + Number of links + + @item + Owner's uid + + @item + Owner's gid + + @item + File size (bytes) + + @item + Last access time + + @item + Last modification time + + @item + Last file status change time + + @item + Preferred I/O block size + + @item + Number of blocks allocated + @end enumerate + + Not all these elements are relevant on all systems. + If an element is not relevant, it is returned as 0. + + If the @var{@3@} argument is supplied, it contains + 0 on success or a non-zero error code upon return + (@code{ENOSYS} if the system does not provide @code{lstat(2)}). + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine, or do not support the + (optional) @var{@3@} argument. + ") + + DEFDOC (STAT_func, "Get file information.", "\ + Obtains data about the given file @var{@1@} and places them in the array + @var{@2@}. + A null character (@samp{CHAR(0)}) marks the end of + the name in @var{@1@}---otherwise, + trailing blanks in @var{@1@} are ignored. + The values in this array are extracted from the + @code{stat} structure as returned by @code{fstat(2)} q.v., as follows: + + @enumerate + @item + File mode + + @item + Inode number + + @item + ID of device containing directory entry for file + + @item + Device id (if relevant) + + @item + Number of links + + @item + Owner's uid + + @item + Owner's gid + + @item + File size (bytes) + + @item + Last access time + + @item + Last modification time + + @item + Last file status change time + + @item + Preferred I/O block size + + @item + Number of blocks allocated + @end enumerate + + Not all these elements are relevant on all systems. + If an element is not relevant, it is returned as 0. + + Returns 0 on success or a non-zero error code. + ") + + DEFDOC (STAT_subr, "Get file information.", "\ + Obtains data about the given file @var{@1@} and places them in the array + @var{@2@}. + A null character (@samp{CHAR(0)}) marks the end of + the name in @var{@1@}---otherwise, + trailing blanks in @var{@1@} are ignored. + The values in this array are extracted from the + @code{stat} structure as returned by @code{fstat(2)} q.v., as follows: + + @enumerate + @item + File mode + + @item + Inode number + + @item + ID of device containing directory entry for file + + @item + Device id (if relevant) + + @item + Number of links + + @item + Owner's uid + + @item + Owner's gid + + @item + File size (bytes) + + @item + Last access time + + @item + Last modification time + + @item + Last file status change time + + @item + Preferred I/O block size + + @item + Number of blocks allocated + @end enumerate + + Not all these elements are relevant on all systems. + If an element is not relevant, it is returned as 0. + + If the @var{@3@} argument is supplied, it contains + 0 on success or a non-zero error code upon return. + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine, or do not support the + (optional) @var{@3@} argument. + ") + + DEFDOC (LINK_subr, "Make hard link in file system.", "\ + Makes a (hard) link from file @var{@1@} to @var{@2@}. + A null character (@samp{CHAR(0)}) marks the end of + the names in @var{@1@} and @var{@2@}---otherwise, + trailing blanks in @var{@1@} and @var{@2@} are ignored. + If the @var{@3@} argument is supplied, it contains + 0 on success or a non-zero error code upon return. + See @code{link(2)}. + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine, or do not support the + (optional) @var{@3@} argument. + ") + + DEFDOC (LINK_func, "Make hard link in file system.", "\ + Makes a (hard) link from file @var{@1@} to @var{@2@}. + A null character (@samp{CHAR(0)}) marks the end of + the names in @var{@1@} and @var{@2@}---otherwise, + trailing blanks in @var{@1@} and @var{@2@} are ignored. + Returns 0 on success or a non-zero error code. + See @code{link(2)}. + + Due to the side effects performed by this intrinsic, the function + form is not recommended. + ") + + DEFDOC (SYMLNK_subr, "Make symbolic link in file system.", "\ + Makes a symbolic link from file @var{@1@} to @var{@2@}. + A null character (@samp{CHAR(0)}) marks the end of + the names in @var{@1@} and @var{@2@}---otherwise, + trailing blanks in @var{@1@} and @var{@2@} are ignored. + If the @var{@3@} argument is supplied, it contains + 0 on success or a non-zero error code upon return + (@code{ENOSYS} if the system does not provide @code{symlink(2)}). + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine, or do not support the + (optional) @var{@3@} argument. + ") + + DEFDOC (SYMLNK_func, "Make symbolic link in file system.", "\ + Makes a symbolic link from file @var{@1@} to @var{@2@}. + A null character (@samp{CHAR(0)}) marks the end of + the names in @var{@1@} and @var{@2@}---otherwise, + trailing blanks in @var{@1@} and @var{@2@} are ignored. + Returns 0 on success or a non-zero error code + (@code{ENOSYS} if the system does not provide @code{symlink(2)}). + + Due to the side effects performed by this intrinsic, the function + form is not recommended. + ") + + DEFDOC (RENAME_subr, "Rename file.", "\ + Renames the file @var{@1@} to @var{@2@}. + A null character (@samp{CHAR(0)}) marks the end of + the names in @var{@1@} and @var{@2@}---otherwise, + trailing blanks in @var{@1@} and @var{@2@} are ignored. + See @code{rename(2)}. + If the @var{@3@} argument is supplied, it contains + 0 on success or a non-zero error code upon return. + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine, or do not support the + (optional) @var{@3@} argument. + ") + + DEFDOC (RENAME_func, "Rename file.", "\ + Renames the file @var{@1@} to @var{@2@}. + A null character (@samp{CHAR(0)}) marks the end of + the names in @var{@1@} and @var{@2@}---otherwise, + trailing blanks in @var{@1@} and @var{@2@} are ignored. + See @code{rename(2)}. + Returns 0 on success or a non-zero error code. + + Due to the side effects performed by this intrinsic, the function + form is not recommended. + ") + + DEFDOC (UMASK_subr, "Set file creation permissions mask.", "\ + Sets the file creation mask to @var{@1@} and returns the old value in + argument @var{@2@} if it is supplied. + See @code{umask(2)}. + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine. + ") + + DEFDOC (UMASK_func, "Set file creation permissions mask.", "\ + Sets the file creation mask to @var{@1@} and returns the old value. + See @code{umask(2)}. + + Due to the side effects performed by this intrinsic, the function + form is not recommended. + ") + + DEFDOC (UNLINK_subr, "Unlink file.", "\ + Unlink the file @var{@1@}. + A null character (@samp{CHAR(0)}) marks the end of + the name in @var{@1@}---otherwise, + trailing blanks in @var{@1@} are ignored. + If the @var{@2@} argument is supplied, it contains + 0 on success or a non-zero error code upon return. + See @code{unlink(2)}. + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine, or do not support the + (optional) @var{@2@} argument. + ") + + DEFDOC (UNLINK_func, "Unlink file.", "\ + Unlink the file @var{@1@}. + A null character (@samp{CHAR(0)}) marks the end of + the name in @var{@1@}---otherwise, + trailing blanks in @var{@1@} are ignored. + Returns 0 on success or a non-zero error code. + See @code{unlink(2)}. + + Due to the side effects performed by this intrinsic, the function + form is not recommended. + ") + + DEFDOC (GERROR, "Get error message for last error.", "\ + Returns the system error message corresponding to the last system + error (C @code{errno}). + ") + + DEFDOC (IERRNO, "Get error number for last error.", "\ + Returns the last system error number (corresponding to the C + @code{errno}). + ") + + DEFDOC (PERROR, "Print error message for last error.", "\ + Prints (on the C @code{stderr} stream) a newline-terminated error + message corresponding to the last system error. + This is prefixed by @var{@1@}, a colon and a space. + See @code{perror(3)}. + ") + + DEFDOC (GETGID, "Get process group id.", "\ + Returns the group id for the current process. + ") + + DEFDOC (GETUID, "Get process user id.", "\ + Returns the user id for the current process. + ") + + DEFDOC (GETPID, "Get process id.", "\ + Returns the process id for the current process. + ") + + DEFDOC (GETENV, "Get environment variable.", "\ + Sets @var{@2@} to the value of environment variable given by the + value of @var{@1@} (@code{$name} in shell terms) or to blanks if + @code{$name} has not been set. + A null character (@samp{CHAR(0)}) marks the end of + the name in @var{@1@}---otherwise, + trailing blanks in @var{@1@} are ignored. + ") + + DEFDOC (GETLOG, "Get login name.", "\ + Returns the login name for the process in @var{@1@}. + ") + + DEFDOC (HOSTNM_func, "Get host name.", "\ + Fills @var{@1@} with the system's host name returned by + @code{gethostname(2)}, returning 0 on success or a non-zero error code + (@code{ENOSYS} if the system does not provide @code{gethostname(2)}). + ") + + DEFDOC (HOSTNM_subr, "Get host name.", "\ + Fills @var{@1@} with the system's host name returned by + @code{gethostname(2)}. + If the @var{@2@} argument is supplied, it contains + 0 on success or a non-zero error code upon return + (@code{ENOSYS} if the system does not provide @code{gethostname(2)}). + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine, or do not support the + (optional) @var{@2@} argument. + ") + + /* Fixme: stream I/O */ + + DEFDOC (FLUSH, "Flush buffered output.", "\ + Flushes Fortran unit(s) currently open for output. + Without the optional argument, all such units are flushed, + otherwise just the unit specified by @var{@1@}. + + Some non-GNU implementations of Fortran provide this intrinsic + as a library procedure that might or might not support the + (optional) @var{@1@} argument. + ") + + DEFDOC (FNUM, "Get file descriptor from Fortran unit number.", "\ + Returns the Unix file descriptor number corresponding to the open + Fortran I/O unit @var{@1@}. + This could be passed to an interface to C I/O routines. + ") + + #define IOWARN " + Stream I/O should not be mixed with normal record-oriented (formatted or + unformatted) I/O on the same unit; the results are unpredictable. + " + + DEFDOC (FGET_func, "Read a character from unit 5 stream-wise.", "\ + Reads a single character into @var{@1@} in stream mode from unit 5 + (by-passing normal formatted input) using @code{getc(3)}. + Returns 0 on + success, @minus{}1 on end-of-file, and the error code from + @code{ferror(3)} otherwise. + " IOWARN) + + DEFDOC (FGET_subr, "Read a character from unit 5 stream-wise.", "\ + Reads a single character into @var{@1@} in stream mode from unit 5 + (by-passing normal formatted output) using @code{getc(3)}. + Returns in + @var{@2@} 0 on success, @minus{}1 on end-of-file, and the error code + from @code{ferror(3)} otherwise. + " IOWARN) + + DEFDOC (FGETC_func, "Read a character stream-wise.", "\ + Reads a single character into @var{@2@} in stream mode from unit @var{@1@} + (by-passing normal formatted output) using @code{getc(3)}. + Returns 0 on + success, @minus{}1 on end-of-file, and the error code from + @code{ferror(3)} otherwise. + " IOWARN) + + DEFDOC (FGETC_subr, "Read a character stream-wise.", "\ + Reads a single character into @var{@2@} in stream mode from unit @var{@1@} + (by-passing normal formatted output) using @code{getc(3)}. + Returns in + @var{@3@} 0 on success, @minus{}1 on end-of-file, and the error code from + @code{ferror(3)} otherwise. + " IOWARN) + + DEFDOC (FPUT_func, "Write a character to unit 6 stream-wise.", "\ + Writes the single character @var{@1@} in stream mode to unit 6 + (by-passing normal formatted output) using @code{getc(3)}. + Returns 0 on + success, the error code from @code{ferror(3)} otherwise. + " IOWARN) + + DEFDOC (FPUT_subr, "Write a character to unit 6 stream-wise.", "\ + Writes the single character @var{@1@} in stream mode to unit 6 + (by-passing normal formatted output) using @code{putc(3)}. + Returns in + @var{@2@} 0 on success, the error code from @code{ferror(3)} otherwise. + " IOWARN) + + DEFDOC (FPUTC_func, "Write a character stream-wise.", "\ + Writes the single character @var{@2@} in stream mode to unit @var{@1@} + (by-passing normal formatted output) using @code{putc(3)}. + Returns 0 on + success, the error code from @code{ferror(3)} otherwise. + " IOWARN) + + DEFDOC (FPUTC_subr, "Write a character stream-wise.", "\ + Writes the single character @var{@1@} in stream mode to unit 6 + (by-passing normal formatted output) using @code{putc(3)}. + Returns in + @var{@2@} 0 on success, the error code from @code{ferror(3)} otherwise. + " IOWARN) + + DEFDOC (FSEEK, "Position file (low-level).", "\ + Attempts to move Fortran unit @var{@1@} to the specified + @var{Offset}: absolute offset if @var{@2@}=0; relative to the + current offset if @var{@2@}=1; relative to the end of the file if + @var{@2@}=2. + It branches to label @var{@3@} if @var{@1@} is + not open or if the call otherwise fails. + ") + + DEFDOC (FTELL_func, "Get file position (low-level).", "\ + Returns the current offset of Fortran unit @var{@1@} + (or @minus{}1 if @var{@1@} is not open). + ") + + DEFDOC (FTELL_subr, "Get file position (low-level).", "\ + Sets @var{@2@} to the current offset of Fortran unit @var{@1@} + (or to @minus{}1 if @var{@1@} is not open). + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine. + ") + + DEFDOC (ISATTY, "Is unit connected to a terminal?", "\ + Returns @code{.TRUE.} if and only if the Fortran I/O unit + specified by @var{@1@} is connected + to a terminal device. + See @code{isatty(3)}. + ") + + DEFDOC (TTYNAM_func, "Get name of terminal device for unit.", "\ + Returns the name of the terminal device open on logical unit + @var{@1@} or a blank string if @var{@1@} is not connected to a + terminal. + ") + + DEFDOC (TTYNAM_subr, "Get name of terminal device for unit.", "\ + Sets @var{@1@} to the name of the terminal device open on logical unit + @var{@2@} or a blank string if @var{@2@} is not connected to a + terminal. + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine. + ") + + DEFDOC (SIGNAL_subr, "Muck with signal handling.", "\ + If @var{@2@} is a an @code{EXTERNAL} routine, arranges for it to be + invoked with a single integer argument (of system-dependent length) + when signal @var{@1@} occurs. + If @var{@1@} is an integer, it can be + used to turn off handling of signal @var{@2@} or revert to its default + action. + See @code{signal(2)}. + + Note that @var{@2@} will be called using C conventions, so its value in + Fortran terms is obtained by applying @code{%LOC()} (or @var{LOC()}) to it. + + The value returned by @code{signal(2)} is written to @var{@3@}, if + that argument is supplied. + Otherwise the return value is ignored. + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine, or do not support the + (optional) @var{@3@} argument. + ") + + DEFDOC (SIGNAL_func, "Muck with signal handling.", "\ + If @var{@2@} is a an @code{EXTERNAL} routine, arranges for it to be + invoked with a single integer argument (of system-dependent length) + when signal @var{@1@} occurs. + If @var{@1@} is an integer, it can be + used to turn off handling of signal @var{@2@} or revert to its default + action. + See @code{signal(2)}. + + Note that @var{@2@} will be called using C conventions, so its value in + Fortran terms is obtained by applying @code{%LOC()} (or @var{LOC()}) to it. + + The value returned by @code{signal(2)} is returned. + + Due to the side effects performed by this intrinsic, the function + form is not recommended. + ") + + DEFDOC (KILL_func, "Signal a process.", "\ + Sends the signal specified by @var{@2@} to the process @var{@1@}. + Returns 0 on success or a non-zero error code. + See @code{kill(2)}. + + Due to the side effects performed by this intrinsic, the function + form is not recommended. + ") + + DEFDOC (KILL_subr, "Signal a process.", "\ + Sends the signal specified by @var{@2@} to the process @var{@1@}. + If the @var{@3@} argument is supplied, it contains + 0 on success or a non-zero error code upon return. + See @code{kill(2)}. + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine, or do not support the + (optional) @var{@3@} argument. + ") + + DEFDOC (LNBLNK, "Get last non-blank character in string.", "\ + Returns the index of the last non-blank character in @var{@1@}. + @code{LNBLNK} and @code{LEN_TRIM} are equivalent. + ") + + DEFDOC (SLEEP, "Sleep for a specified time.", "\ + Causes the process to pause for @var{@1@} seconds. + See @code{sleep(2)}. + ") + + DEFDOC (SYSTEM_subr, "Invoke shell (system) command.", "\ + Passes the command @var{@1@} to a shell (see @code{system(3)}). + If argument @var{@2@} is present, it contains the value returned by + @code{system(3)}, presumably 0 if the shell command succeeded. + Note that which shell is used to invoke the command is system-dependent + and environment-dependent. + + Some non-GNU implementations of Fortran provide this intrinsic as + only a function, not as a subroutine, or do not support the + (optional) @var{@2@} argument. + ") + + DEFDOC (SYSTEM_func, "Invoke shell (system) command.", "\ + Passes the command @var{@1@} to a shell (see @code{system(3)}). + Returns the value returned by + @code{system(3)}, presumably 0 if the shell command succeeded. + Note that which shell is used to invoke the command is system-dependent + and environment-dependent. + + Due to the side effects performed by this intrinsic, the function + form is not recommended. + However, the function form can be valid in cases where the + actual side effects performed by the call are unimportant to + the application. + + For example, on a UNIX system, @samp{SAME = SYSTEM('cmp a b')} + does not perform any side effects likely to be important to the + program, so the programmer would not care if the actual system + call (and invocation of @code{cmp}) was optimized away in a situation + where the return value could be determined otherwise, or was not + actually needed (@samp{SAME} not actually referenced after the + sample assignment statement). + ") + + DEFDOC (TIME_vxt, "Get the time as a character value.", "\ + Returns in @var{@1@} a character representation of the current time as + obtained from @code{ctime(3)}. + + @xref{Fdate Intrinsic (subroutine)} for an equivalent routine. + ") + + DEFDOC (IBCLR, "Clear a bit.", "\ + Returns the value of @var{@1@} with bit @var{@2@} cleared (set to + zero). + @xref{BTest Intrinsic} for information on bit positions. + ") + + DEFDOC (IBSET, "Set a bit.", "\ + Returns the value of @var{@1@} with bit @var{@2@} set (to one). + @xref{BTest Intrinsic} for information on bit positions. + ") + + DEFDOC (IBITS, "Extract a bit subfield of a variable.", "\ + Extracts a subfield of length @var{@3@} from @var{@1@}, starting from + bit position @var{@2@} and extending left for @var{@3@} bits. + The result is right-justified and the remaining bits are zeroed. + The value + of @samp{@var{@2@}+@var{@3@}} must be less than or equal to the value + @samp{BIT_SIZE(@var{@1@})}. + @xref{Bit_Size Intrinsic}. + ") + + DEFDOC (ISHFT, "Logical bit shift.", "\ + All bits representing @var{@1@} are shifted @var{@2@} places. + @samp{@var{@2@}.GT.0} indicates a left shift, @samp{@var{@2@}.EQ.0} + indicates no shift and @samp{@var{@2@}.LT.0} indicates a right shift. + If the absolute value of the shift count is greater than + @samp{BIT_SIZE(@var{@1@})}, the result is undefined. + Bits shifted out from the left end or the right end, as the case may be, + are lost. + Zeros are shifted in from the opposite end. + + @xref{IShftC Intrinsic} for the circular-shift equivalent. + ") + + DEFDOC (ISHFTC, "Circular bit shift.", "\ + The rightmost @var{@3@} bits of the argument @var{@1@} + are shifted circularly @var{@2@} + places, i.e.@ the bits shifted out of one end are shifted into + the opposite end. + No bits are lost. + The unshifted bits of the result are the same as + the unshifted bits of @var{@1@}. + The absolute value of the argument @var{@2@} + must be less than or equal to @var{@3@}. + The value of @var{@3@} must be greater than or equal to one and less than + or equal to @samp{BIT_SIZE(@var{@1@})}. + + @xref{IShft Intrinsic} for the logical shift equivalent. + ") + + DEFDOC (MVBITS, "Moving a bit field.", "\ + Moves @var{@3@} bits from positions @var{@2@} through + @samp{@var{@2@}+@var{@3@}-1} of @var{@1@} to positions @var{@5@} through + @samp{@var{@2@}+@var{@3@}-1} of @var{@4@}. The portion of argument + @var{@4@} not affected by the movement of bits is unchanged. Arguments + @var{@1@} and @var{@4@} are permitted to be the same numeric storage + unit. The values of @samp{@var{@2@}+@var{@3@}} and + @samp{@var{@5@}+@var{@3@}} must be less than or equal to + @samp{BIT_SIZE(@var{@1@})}. + ") + + DEFDOC (INDEX, "Locate a CHARACTER substring.", "\ + Returns the position of the start of the first occurrence of string + @var{@2@} as a substring in @var{@1@}, counting from one. + If @var{@2@} doesn't occur in @var{@1@}, zero is returned. + ") + + DEFDOC (ALARM, "Execute a routine after a given delay.", "\ + Causes external subroutine @var{@2@} to be executed after a delay of + @var{@1@} seconds by using @code{alarm(1)} to set up a signal and + @code{signal(2)} to catch it. + If @var{@3@} is supplied, it will be + returned with the the number of seconds remaining until any previously + scheduled alarm was due to be delivered, or zero if there was no + previously scheduled alarm. + @xref{Signal Intrinsic (subroutine)}. + ") diff -rcp2N g77-0.5.20/f/intrin.c g77-0.5.21/f/intrin.c *** g77-0.5.20/f/intrin.c Fri Feb 28 06:54:54 1997 --- g77-0.5.21/f/intrin.c Fri Aug 8 04:34:55 1997 *************** the Free Software Foundation, 59 Temple *** 28,31 **** --- 28,32 ---- #include "info.h" #include "src.h" + #include "symbol.h" #include "target.h" #include "top.h" *************** struct _ffeintrin_imp_ *** 59,65 **** { char *name; /* Name of implementation. */ - ffeintrinImp cg_imp; /* Unique code-generation code. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! ffecomGfrt gfrt; /* gfrt index in library. */ #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ char *control; --- 60,67 ---- { char *name; /* Name of implementation. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ! ffecomGfrt gfrt_direct; /* library routine, direct-callable form. */ ! ffecomGfrt gfrt_f2c; /* library routine, f2c-callable form. */ ! ffecomGfrt gfrt_gnu; /* library routine, gnu-callable form. */ #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ char *control; *************** static struct _ffeintrin_name_ ffeintrin *** 83,88 **** #define DEFGEN(CODE,NAME,SPEC1,SPEC2) #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) ! #define DEFIMP(CODE,NAME,GFRT,CONTROL) ! #define DEFIMQ(CODE,NAME,GFRT,CONTROL,CGIMP) #include "intrin.def" #undef DEFNAME --- 85,89 ---- #define DEFGEN(CODE,NAME,SPEC1,SPEC2) #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) ! #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) #include "intrin.def" #undef DEFNAME *************** static struct _ffeintrin_name_ ffeintrin *** 90,94 **** #undef DEFSPEC #undef DEFIMP - #undef DEFIMQ }; --- 91,94 ---- *************** static struct _ffeintrin_gen_ ffeintrin_ *** 100,105 **** { NAME, { SPEC1, SPEC2, }, }, #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) ! #define DEFIMP(CODE,NAME,GFRT,CONTROL) ! #define DEFIMQ(CODE,NAME,GFRT,CONTROL,CGIMP) #include "intrin.def" #undef DEFNAME --- 100,104 ---- { NAME, { SPEC1, SPEC2, }, }, #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) ! #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) #include "intrin.def" #undef DEFNAME *************** static struct _ffeintrin_gen_ ffeintrin_ *** 107,111 **** #undef DEFSPEC #undef DEFIMP - #undef DEFIMQ }; --- 106,109 ---- *************** static struct _ffeintrin_imp_ ffeintrin_ *** 117,129 **** #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #define DEFIMP(CODE,NAME,GFRT,CONTROL) \ ! { NAME, FFEINTRIN_imp ## CODE, FFECOM_gfrt ## GFRT, CONTROL }, ! #define DEFIMQ(CODE,NAME,GFRT,CONTROL,CGIMP) \ ! { NAME, FFEINTRIN_imp ## CGIMP, FFECOM_gfrt ## GFRT, CONTROL }, #elif FFECOM_targetCURRENT == FFECOM_targetFFE ! #define DEFIMP(CODE,NAME,GFRT,CONTROL) \ ! { NAME, CODE, CONTROL }, ! #define DEFIMQ(CODE,NAME,GFRT,CONTROL,CGIMP) \ ! { NAME, CGIMP, CONTROL }, #else #error --- 115,124 ---- #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) #if FFECOM_targetCURRENT == FFECOM_targetGCC ! #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \ ! { NAME, FFECOM_gfrt ## GFRTDIRECT, FFECOM_gfrt ## GFRTF2C, \ ! FFECOM_gfrt ## GFRTGNU, CONTROL }, #elif FFECOM_targetCURRENT == FFECOM_targetFFE ! #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \ ! { NAME, CONTROL }, #else #error *************** static struct _ffeintrin_imp_ ffeintrin_ *** 134,138 **** #undef DEFSPEC #undef DEFIMP - #undef DEFIMQ }; --- 129,132 ---- *************** static struct _ffeintrin_spec_ ffeintrin *** 144,154 **** #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) \ { NAME, CALLABLE, FAMILY, IMP, }, ! #define DEFIMP(CODE,NAME,GFRT,CONTROL) ! #define DEFIMQ(CODE,NAME,GFRT,CONTROL,CGIMP) #include "intrin.def" #undef DEFGEN #undef DEFSPEC #undef DEFIMP - #undef DEFIMQ }; --- 138,146 ---- #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) \ { NAME, CALLABLE, FAMILY, IMP, }, ! #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) #include "intrin.def" #undef DEFGEN #undef DEFSPEC #undef DEFIMP }; *************** ffeintrin_cmp_name_ (const void *name, c *** 1166,1205 **** } ! /* Return basic type of intrinsic implementation. */ ffeinfoBasictype ffeintrin_basictype (ffeintrinSpec spec) { assert (spec < FFEINTRIN_spec); ! return FFEINTRIN_specNONE; ! } ! /* Return code-generation implementation of intrinsic. ! The idea is that an intrinsic might have its own implementation ! (defined by the DEFIMP macro) or might defer to the implementation ! of another intrinsic (defined by the DEFIMQ macro), and this is ! what points to that other implementation. ! ! The reason for this extra level of indirection, rather than ! just adding "case" statements to the big switch in com.c's ! ffecom_expr_intrinsic_ function, is so that generic disambiguation ! can ensure that it doesn't have an ambiguity on its hands. ! E.g. Both ABS and DABS might cope with a DOUBLE PRECISION, ! etc. Previously, the implementation itself was used to allow ! multiple specific intrinsics to "accept" the argument list ! if they all agreed on implementation. But, since implementation ! includes type signature and run-time-library function, another ! level was needed to say "maybe two intrinsics would be handled ! as two _different_ library references or involve different types ! in general, but the specific code involved to implement them is ! the same, so it is okay if a generic function reference can be ! satisfied by either intrinsic". */ ! ffeintrinImp ! ffeintrin_codegen_imp (ffeintrinImp imp) ! { ! assert (imp < FFEINTRIN_imp); ! return ffeintrin_imps_[imp].cg_imp; } --- 1158,1190 ---- } ! /* Return basic type of intrinsic implementation, based on its ! run-time implementation *only*. (This is used only when ! the type of an intrinsic name is needed without having a ! list of arguments, i.e. an interface signature, such as when ! passing the intrinsic itself, or really the run-time-library ! function, as an argument.) ! ! If there's no eligible intrinsic implementation, there must be ! a bug somewhere else; no such reference should have been permitted ! to go this far. (Well, this might be wrong.) */ ffeinfoBasictype ffeintrin_basictype (ffeintrinSpec spec) { + ffeintrinImp imp; + ffecomGfrt gfrt; + assert (spec < FFEINTRIN_spec); ! imp = ffeintrin_specs_[spec].implementation; ! assert (imp < FFEINTRIN_imp); ! if (ffe_is_f2c ()) ! gfrt = ffeintrin_imps_[imp].gfrt_f2c; ! else ! gfrt = ffeintrin_imps_[imp].gfrt_gnu; ! assert (gfrt != FFECOM_gfrt); ! return ffecom_gfrt_basictype (gfrt); } *************** ffeintrin_fulfill_generic (ffebld *expr, *** 1241,1245 **** bool any = FALSE; bool highly_specific = FALSE; - char *name = NULL; int i; --- 1226,1229 ---- *************** ffeintrin_fulfill_generic (ffebld *expr, *** 1269,1279 **** = ffeintrin_state_family (ffeintrin_specs_[tspec].family); ffebad terror; - char *tname; if (state == FFE_intrinsicstateDELETED) continue; - tname = ffeintrin_specs_[tspec].name; - if (timp != FFEINTRIN_impNONE) { --- 1253,1260 ---- *************** ffeintrin_fulfill_generic (ffebld *expr, *** 1296,1326 **** if (imp != FFEINTRIN_impNONE) { ! if (ffeintrin_imps_[timp].cg_imp ! == ffeintrin_imps_[imp].cg_imp) ! { ! if (ffebld_symter_specific (ffebld_left (*expr)) ! == tspec) ! { ! highly_specific = TRUE; ! imp = timp; ! spec = tspec; ! bt = tbt; ! kt = tkt; ! sz = tkt; ! error = terror; ! } ! else if (nimp == FFEINTRIN_impNONE) ! nimp = timp; ! } ! else ! { ! ffebad_start (FFEBAD_INTRINSIC_AMBIG); ! ffebad_here (0, ffelex_token_where_line (t), ! ffelex_token_where_column (t)); ! ffebad_string (ffeintrin_gens_[gen].name); ! ffebad_string (ffeintrin_specs_[spec].name); ! ffebad_string (ffeintrin_specs_[tspec].name); ! ffebad_finish (); ! } } else --- 1277,1287 ---- if (imp != FFEINTRIN_impNONE) { ! ffebad_start (FFEBAD_INTRINSIC_AMBIG); ! ffebad_here (0, ffelex_token_where_line (t), ! ffelex_token_where_column (t)); ! ffebad_string (ffeintrin_gens_[gen].name); ! ffebad_string (ffeintrin_specs_[spec].name); ! ffebad_string (ffeintrin_specs_[tspec].name); ! ffebad_finish (); } else *************** ffeintrin_fulfill_generic (ffebld *expr, *** 1346,1353 **** if (error == FFEBAD) ! { ! error = terror; ! name = tname; ! } } --- 1307,1311 ---- if (error == FFEBAD) ! error = terror; } *************** ffeintrin_fulfill_generic (ffebld *expr, *** 1358,1367 **** if (error == FFEBAD) error = FFEBAD_INTRINSIC_REF; - if (name == NULL) - name = ffeintrin_gens_[gen].name; ffebad_start (error); ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); ! ffebad_string (name); ffebad_finish (); } --- 1316,1323 ---- if (error == FFEBAD) error = FFEBAD_INTRINSIC_REF; ffebad_start (error); ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); ! ffebad_string (ffeintrin_gens_[gen].name); ffebad_finish (); } *************** ffeintrin_fulfill_generic (ffebld *expr, *** 1404,1407 **** --- 1360,1375 ---- FFEINFO_whereINTRINSIC, sz)); + + if ((ffesymbol_attrs (ffebld_symter (symter)) & FFESYMBOL_attrsTYPE) + && (((bt != ffesymbol_basictype (ffebld_symter (symter))) + || (kt != ffesymbol_kindtype (ffebld_symter (symter))) + || (sz != ffesymbol_size (ffebld_symter (symter)))))) + { + ffebad_start (FFEBAD_INTRINSIC_TYPE); + ffebad_here (0, ffelex_token_where_line (t), + ffelex_token_where_column (t)); + ffebad_string (ffeintrin_gens_[gen].name); + ffebad_finish (); + } } } *************** ffeintrin_fulfill_specific (ffebld *expr *** 1429,1432 **** --- 1397,1401 ---- ffebld symter; ffebldOp op; + ffeintrinGen gen; ffeintrinSpec spec; ffeintrinImp imp; *************** ffeintrin_fulfill_specific (ffebld *expr *** 1437,1440 **** --- 1406,1410 ---- ffebad error; bool any = FALSE; + char *name; op = ffebld_op (*expr); *************** ffeintrin_fulfill_specific (ffebld *expr *** 1442,1448 **** --- 1412,1424 ---- assert (ffebld_op (ffebld_left (*expr)) == FFEBLD_opSYMTER); + gen = ffebld_symter_generic (ffebld_left (*expr)); spec = ffebld_symter_specific (ffebld_left (*expr)); assert (spec != FFEINTRIN_specNONE); + if (gen != FFEINTRIN_genNONE) + name = ffeintrin_gens_[gen].name; + else + name = ffeintrin_specs_[spec].name; + state = ffeintrin_state_family (ffeintrin_specs_[spec].family); *************** ffeintrin_fulfill_specific (ffebld *expr *** 1470,1482 **** if (!any) { - char *name; ffebad_start (error); ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); - if (spec != FFEINTRIN_specNONE) - name = ffeintrin_specs_[spec].name; - else - name = ffeintrin_imps_[imp].name; ffebad_string (name); ffebad_finish (); --- 1446,1453 ---- *************** ffeintrin_fulfill_specific (ffebld *expr *** 1504,1521 **** FFEINFO_whereINTRINSIC, sz)); } } ! /* Return run-time index of intrinsic implementation as arg. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ffecomGfrt ! ffeintrin_gfrt (ffeintrinImp imp) { assert (imp < FFEINTRIN_imp); ! return ffeintrin_imps_[imp].gfrt; } #endif void ffeintrin_init_0 () --- 1475,1519 ---- FFEINFO_whereINTRINSIC, sz)); + + if ((ffesymbol_attrs (ffebld_symter (symter)) & FFESYMBOL_attrsTYPE) + && (((bt != ffesymbol_basictype (ffebld_symter (symter))) + || (kt != ffesymbol_kindtype (ffebld_symter (symter))) + || (sz != ffesymbol_size (ffebld_symter (symter)))))) + { + ffebad_start (FFEBAD_INTRINSIC_TYPE); + ffebad_here (0, ffelex_token_where_line (t), + ffelex_token_where_column (t)); + ffebad_string (name); + ffebad_finish (); + } } } ! /* Return run-time index of intrinsic implementation as direct call. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC ffecomGfrt ! ffeintrin_gfrt_direct (ffeintrinImp imp) { assert (imp < FFEINTRIN_imp); ! ! return ffeintrin_imps_[imp].gfrt_direct; } + #endif + + /* Return run-time index of intrinsic implementation as actual argument. */ + + #if FFECOM_targetCURRENT == FFECOM_targetGCC + ffecomGfrt + ffeintrin_gfrt_indirect (ffeintrinImp imp) + { + assert (imp < FFEINTRIN_imp); + if (! ffe_is_f2c ()) + return ffeintrin_imps_[imp].gfrt_gnu; + return ffeintrin_imps_[imp].gfrt_f2c; + } #endif + void ffeintrin_init_0 () *************** ffeintrin_init_0 () *** 1714,1718 **** } ! /* Determine whether intrinsic ok as actual arg. */ bool --- 1712,1716 ---- } ! /* Determine whether intrinsic is okay as an actual argument. */ bool *************** ffeintrin_is_actualarg (ffeintrinSpec sp *** 1728,1733 **** return (!ffe_is_pedantic () || ffeintrin_specs_[spec].is_actualarg) #if FFECOM_targetCURRENT == FFECOM_targetGCC ! && (ffeintrin_imps_[ffeintrin_specs_[spec].implementation].gfrt ! != FFECOM_gfrt) #endif && ((state == FFE_intrinsicstateENABLED) --- 1726,1734 ---- return (!ffe_is_pedantic () || ffeintrin_specs_[spec].is_actualarg) #if FFECOM_targetCURRENT == FFECOM_targetGCC ! && (ffe_is_f2c () ! ? (ffeintrin_imps_[ffeintrin_specs_[spec].implementation].gfrt_f2c ! != FFECOM_gfrt) ! : (ffeintrin_imps_[ffeintrin_specs_[spec].implementation].gfrt_gnu ! != FFECOM_gfrt)) #endif && ((state == FFE_intrinsicstateENABLED) *************** ffeintrin_is_intrinsic (char *name, ffel *** 1823,1827 **** if (spec != FFEINTRIN_specNONE) { ! name = ffeintrin_specs_[spec].name; if (((state = ffeintrin_state_family (ffeintrin_specs_[spec].family)) --- 1824,1831 ---- if (spec != FFEINTRIN_specNONE) { ! if (gen != FFEINTRIN_genNONE) ! name = ffeintrin_gens_[gen].name; ! else ! name = ffeintrin_specs_[spec].name; if (((state = ffeintrin_state_family (ffeintrin_specs_[spec].family)) *************** ffeintrin_is_intrinsic (char *name, ffel *** 1908,1918 **** } ! /* Return kind type of intrinsic implementation. */ ffeinfoKindtype ffeintrin_kindtype (ffeintrinSpec spec) { assert (spec < FFEINTRIN_spec); ! return FFEINFO_kindtypeNONE; } --- 1912,1960 ---- } ! /* Return TRUE if intrinsic is standard F77 (or, if -ff90, F90). */ ! ! bool ! ffeintrin_is_standard (ffeintrinGen gen, ffeintrinSpec spec) ! { ! if (spec == FFEINTRIN_specNONE) ! { ! if (gen == FFEINTRIN_genNONE) ! return FALSE; ! ! spec = ffeintrin_gens_[gen].specs[0]; ! if (spec == FFEINTRIN_specNONE) ! return FALSE; ! } ! ! if ((ffeintrin_specs_[spec].family == FFEINTRIN_familyF77) ! || (ffe_is_90 () ! && ((ffeintrin_specs_[spec].family == FFEINTRIN_familyF90) ! || (ffeintrin_specs_[spec].family == FFEINTRIN_familyMIL) ! || (ffeintrin_specs_[spec].family == FFEINTRIN_familyASC)))) ! return TRUE; ! return FALSE; ! } ! ! /* Return kind type of intrinsic implementation. See ffeintrin_basictype, ! its sibling. */ ffeinfoKindtype ffeintrin_kindtype (ffeintrinSpec spec) { + ffeintrinImp imp; + ffecomGfrt gfrt; + assert (spec < FFEINTRIN_spec); ! imp = ffeintrin_specs_[spec].implementation; ! assert (imp < FFEINTRIN_imp); ! ! if (ffe_is_f2c ()) ! gfrt = ffeintrin_imps_[imp].gfrt_f2c; ! else ! gfrt = ffeintrin_imps_[imp].gfrt_gnu; ! ! assert (gfrt != FFECOM_gfrt); ! ! return ffecom_gfrt_kindtype (gfrt); } *************** ffeintrin_state_family (ffeintrinFamily *** 1993,1996 **** --- 2035,2042 ---- case FFEINTRIN_familyF2U: state = ffe_intrinsic_state_unix (); + return state; + + case FFEINTRIN_familyBADU77: + state = ffe_intrinsic_state_badu77 (); return state; diff -rcp2N g77-0.5.20/f/intrin.def g77-0.5.21/f/intrin.def *** g77-0.5.20/f/intrin.def Fri Feb 28 06:54:55 1997 --- g77-0.5.21/f/intrin.def Mon Aug 11 05:58:07 1997 *************** *** 13,20 **** DEFNAME ("ABORT", "abort", "Abort", genNONE, specABORT) /* UNIX */ ! DEFNAME ("ABS", "abs", "Abs", genNONE, specABS) DEFNAME ("ACCESS", "access", "Access", genNONE, specACCESS) /* UNIX */ DEFNAME ("ACHAR", "achar", "AChar", genNONE, specACHAR) /* F90, F2C */ ! DEFNAME ("ACOS", "acos", "ACos", genNONE, specACOS) DEFNAME ("ACOSD", "acosd", "ACosD", genNONE, specACOSD) /* VXT */ DEFNAME ("ADJUSTL", "adjustl", "AdjustL", genNONE, specADJUSTL) /* F90 */ --- 13,20 ---- DEFNAME ("ABORT", "abort", "Abort", genNONE, specABORT) /* UNIX */ ! DEFNAME ("ABS", "abs", "Abs", genNONE, specABS) DEFNAME ("ACCESS", "access", "Access", genNONE, specACCESS) /* UNIX */ DEFNAME ("ACHAR", "achar", "AChar", genNONE, specACHAR) /* F90, F2C */ ! DEFNAME ("ACOS", "acos", "ACos", genNONE, specACOS) DEFNAME ("ACOSD", "acosd", "ACosD", genNONE, specACOSD) /* VXT */ DEFNAME ("ADJUSTL", "adjustl", "AdjustL", genNONE, specADJUSTL) /* F90 */ *************** DEFNAME ("AIMAG", "aimag", "AImag", genN *** 23,32 **** DEFNAME ("AIMAX0", "aimax0", "AIMax0", genNONE, specAIMAX0) /* VXT */ DEFNAME ("AIMIN0", "aimin0", "AIMin0", genNONE, specAIMIN0) /* VXT */ ! DEFNAME ("AINT", "aint", "AInt", genNONE, specAINT) DEFNAME ("AJMAX0", "ajmax0", "AJMax0", genNONE, specAJMAX0) /* VXT */ DEFNAME ("AJMIN0", "ajmin0", "AJMin0", genNONE, specAJMIN0) /* VXT */ ! DEFNAME ("ALL", "all", "All", genNONE, specALL) /* F90 */ DEFNAME ("ALLOCATED", "allocated", "Allocated", genNONE, specALLOCATED) /* F90 */ ! DEFNAME ("ALOG", "alog", "ALog", genNONE, specALOG) DEFNAME ("ALOG10", "alog10", "ALog10", genNONE, specALOG10) DEFNAME ("AMAX0", "amax0", "AMax0", genNONE, specAMAX0) --- 23,33 ---- DEFNAME ("AIMAX0", "aimax0", "AIMax0", genNONE, specAIMAX0) /* VXT */ DEFNAME ("AIMIN0", "aimin0", "AIMin0", genNONE, specAIMIN0) /* VXT */ ! DEFNAME ("AINT", "aint", "AInt", genNONE, specAINT) DEFNAME ("AJMAX0", "ajmax0", "AJMax0", genNONE, specAJMAX0) /* VXT */ DEFNAME ("AJMIN0", "ajmin0", "AJMin0", genNONE, specAJMIN0) /* VXT */ ! DEFNAME ("ALARM", "alarm", "Alarm", genNONE, specALARM) /* UNIX */ ! DEFNAME ("ALL", "all", "All", genNONE, specALL) /* F90 */ DEFNAME ("ALLOCATED", "allocated", "Allocated", genNONE, specALLOCATED) /* F90 */ ! DEFNAME ("ALOG", "alog", "ALog", genNONE, specALOG) DEFNAME ("ALOG10", "alog10", "ALog10", genNONE, specALOG10) DEFNAME ("AMAX0", "amax0", "AMax0", genNONE, specAMAX0) *************** DEFNAME ("AMAX1", "amax1", "AMax1", genN *** 34,45 **** DEFNAME ("AMIN0", "amin0", "AMin0", genNONE, specAMIN0) DEFNAME ("AMIN1", "amin1", "AMin1", genNONE, specAMIN1) ! DEFNAME ("AMOD", "amod", "AMod", genNONE, specAMOD) ! DEFNAME ("AND", "and", "And", genNONE, specAND) /* F2C */ DEFNAME ("ANINT", "anint", "ANInt", genNONE, specANINT) ! DEFNAME ("ANY", "any", "Any", genNONE, specANY) /* F90 */ ! DEFNAME ("ASIN", "asin", "ASin", genNONE, specASIN) DEFNAME ("ASIND", "asind", "ASinD", genNONE, specASIND) /* VXT */ DEFNAME ("ASSOCIATED", "associated", "Associated", genNONE, specASSOCIATED) /* F90 */ ! DEFNAME ("ATAN", "atan", "ATan", genNONE, specATAN) DEFNAME ("ATAN2", "atan2", "ATan2", genNONE, specATAN2) DEFNAME ("ATAN2D", "atan2d", "ATan2D", genNONE, specATAN2D) /* VXT */ --- 35,46 ---- DEFNAME ("AMIN0", "amin0", "AMin0", genNONE, specAMIN0) DEFNAME ("AMIN1", "amin1", "AMin1", genNONE, specAMIN1) ! DEFNAME ("AMOD", "amod", "AMod", genNONE, specAMOD) ! DEFNAME ("AND", "and", "And", genNONE, specAND) /* F2C */ DEFNAME ("ANINT", "anint", "ANInt", genNONE, specANINT) ! DEFNAME ("ANY", "any", "Any", genNONE, specANY) /* F90 */ ! DEFNAME ("ASIN", "asin", "ASin", genNONE, specASIN) DEFNAME ("ASIND", "asind", "ASinD", genNONE, specASIND) /* VXT */ DEFNAME ("ASSOCIATED", "associated", "Associated", genNONE, specASSOCIATED) /* F90 */ ! DEFNAME ("ATAN", "atan", "ATan", genNONE, specATAN) DEFNAME ("ATAN2", "atan2", "ATan2", genNONE, specATAN2) DEFNAME ("ATAN2D", "atan2d", "ATan2D", genNONE, specATAN2D) /* VXT */ *************** DEFNAME ("BIT_SIZE", "bit_size", "Bit_Si *** 55,60 **** DEFNAME ("BJTEST", "bjtest", "BJTest", genNONE, specBJTEST) /* VXT */ DEFNAME ("BTEST", "btest", "BTest", genNONE, specBTEST) /* F90, VXT */ ! DEFNAME ("CABS", "cabs", "CAbs", genNONE, specCABS) ! DEFNAME ("CCOS", "ccos", "CCos", genNONE, specCCOS) DEFNAME ("CDABS", "cdabs", "CDAbs", genNONE, specCDABS) /* VXT */ DEFNAME ("CDCOS", "cdcos", "CDCos", genNONE, specCDCOS) /* VXT */ --- 56,61 ---- DEFNAME ("BJTEST", "bjtest", "BJTest", genNONE, specBJTEST) /* VXT */ DEFNAME ("BTEST", "btest", "BTest", genNONE, specBTEST) /* F90, VXT */ ! DEFNAME ("CABS", "cabs", "CAbs", genNONE, specCABS) ! DEFNAME ("CCOS", "ccos", "CCos", genNONE, specCCOS) DEFNAME ("CDABS", "cdabs", "CDAbs", genNONE, specCDABS) /* VXT */ DEFNAME ("CDCOS", "cdcos", "CDCos", genNONE, specCDCOS) /* VXT */ *************** DEFNAME ("CDSIN", "cdsin", "CDSin", genN *** 64,84 **** DEFNAME ("CDSQRT", "cdsqrt", "CDSqRt", genNONE, specCDSQRT) /* VXT */ DEFNAME ("CEILING", "ceiling", "Ceiling", genNONE, specCEILING) /* F90 */ ! DEFNAME ("CEXP", "cexp", "CExp", genNONE, specCEXP) ! DEFNAME ("CHAR", "char", "Char", genNONE, specCHAR) ! DEFNAME ("CHDIR", "chdir", "ChDir", genNONE, specCHDIR) /* UNIX */ ! DEFNAME ("CHMOD", "chmod", "ChMod", genNONE, specCHMOD) /* UNIX */ ! DEFNAME ("CLOG", "clog", "CLog", genNONE, specCLOG) DEFNAME ("CMPLX", "cmplx", "Cmplx", genNONE, specCMPLX) DEFNAME ("COMPLEX", "complex", "Complex", genNONE, specCOMPLEX) DEFNAME ("CONJG", "conjg", "Conjg", genNONE, specCONJG) ! DEFNAME ("COS", "cos", "Cos", genNONE, specCOS) ! DEFNAME ("COSD", "cosd", "CosD", genNONE, specCOSD) /* VXT */ ! DEFNAME ("COSH", "cosh", "CosH", genNONE, specCOSH) DEFNAME ("COUNT", "count", "Count", genNONE, specCOUNT) /* F90 */ DEFNAME ("CSHIFT", "cshift", "CShift", genNONE, specCSHIFT) /* F90 */ ! DEFNAME ("CSIN", "csin", "CSin", genNONE, specCSIN) DEFNAME ("CSQRT", "csqrt", "CSqRt", genNONE, specCSQRT) ! DEFNAME ("CTIME", "ctime", "CTime", genNONE, specCTIME) /* UNIX */ ! DEFNAME ("DABS", "dabs", "DAbs", genNONE, specDABS) DEFNAME ("DACOS", "dacos", "DACos", genNONE, specDACOS) DEFNAME ("DACOSD", "dacosd", "DACosD", genNONE, specDACOSD) /* VXT */ --- 65,86 ---- DEFNAME ("CDSQRT", "cdsqrt", "CDSqRt", genNONE, specCDSQRT) /* VXT */ DEFNAME ("CEILING", "ceiling", "Ceiling", genNONE, specCEILING) /* F90 */ ! DEFNAME ("CEXP", "cexp", "CExp", genNONE, specCEXP) ! DEFNAME ("CHAR", "char", "Char", genNONE, specCHAR) ! DEFNAME ("CHDIR", "chdir", "ChDir", genCHDIR, specNONE) /* UNIX */ ! DEFNAME ("CHMOD", "chmod", "ChMod", genCHMOD, specNONE) /* UNIX */ ! DEFNAME ("CLOG", "clog", "CLog", genNONE, specCLOG) DEFNAME ("CMPLX", "cmplx", "Cmplx", genNONE, specCMPLX) DEFNAME ("COMPLEX", "complex", "Complex", genNONE, specCOMPLEX) DEFNAME ("CONJG", "conjg", "Conjg", genNONE, specCONJG) ! DEFNAME ("COS", "cos", "Cos", genNONE, specCOS) ! DEFNAME ("COSD", "cosd", "CosD", genNONE, specCOSD) /* VXT */ ! DEFNAME ("COSH", "cosh", "CosH", genNONE, specCOSH) DEFNAME ("COUNT", "count", "Count", genNONE, specCOUNT) /* F90 */ + DEFNAME ("CPU_TIME", "cpu_time", "Cpu_Time", genNONE, specCPU_TIME) /* F95 */ DEFNAME ("CSHIFT", "cshift", "CShift", genNONE, specCSHIFT) /* F90 */ ! DEFNAME ("CSIN", "csin", "CSin", genNONE, specCSIN) DEFNAME ("CSQRT", "csqrt", "CSqRt", genNONE, specCSQRT) ! DEFNAME ("CTIME", "ctime", "CTime", genCTIME, specNONE) /* UNIX */ ! DEFNAME ("DABS", "dabs", "DAbs", genNONE, specDABS) DEFNAME ("DACOS", "dacos", "DACos", genNONE, specDACOS) DEFNAME ("DACOSD", "dacosd", "DACosD", genNONE, specDACOSD) /* VXT */ *************** DEFNAME ("DBESY0", "dbesy0", "DbesY0", g *** 97,123 **** DEFNAME ("DBESY1", "dbesy1", "DbesY1", genNONE, specDBESY1) /* UNIX */ DEFNAME ("DBESYN", "dbesyn", "DbesYN", genNONE, specDBESYN) /* UNIX */ ! DEFNAME ("DBLE", "dble", "Dble", genNONE, specDBLE) DEFNAME ("DBLEQ", "dbleq", "DbleQ", genNONE, specDBLEQ) /* VXT */ DEFNAME ("DCMPLX", "dcmplx", "DCmplx", genNONE, specDCMPLX) /* F2C, VXT */ DEFNAME ("DCONJG", "dconjg", "DConjg", genNONE, specDCONJG) /* F2C, VXT */ ! DEFNAME ("DCOS", "dcos", "DCos", genNONE, specDCOS) DEFNAME ("DCOSD", "dcosd", "DCosD", genNONE, specDCOSD) /* VXT */ DEFNAME ("DCOSH", "dcosh", "DCosH", genNONE, specDCOSH) ! DEFNAME ("DDIM", "ddim", "DDiM", genNONE, specDDIM) ! DEFNAME ("DERF", "derf", "DErF", genNONE, specDERF) /* UNIX */ DEFNAME ("DERFC", "derfc", "DErFC", genNONE, specDERFC) /* UNIX */ ! DEFNAME ("DEXP", "dexp", "DExp", genNONE, specDEXP) DEFNAME ("DFLOAT", "dfloat", "DFloat", genNONE, specDFLOAT) /* F2C, VXT */ DEFNAME ("DFLOTI", "dfloti", "DFlotI", genNONE, specDFLOTI) /* VXT */ DEFNAME ("DFLOTJ", "dflotj", "DFlotJ", genNONE, specDFLOTJ) /* VXT */ DEFNAME ("DIGITS", "digits", "Digits", genNONE, specDIGITS) /* F90 */ ! DEFNAME ("DIM", "dim", "DiM", genNONE, specDIM) DEFNAME ("DIMAG", "dimag", "DImag", genNONE, specDIMAG) /* F2C, VXT */ ! DEFNAME ("DINT", "dint", "DInt", genNONE, specDINT) ! DEFNAME ("DLOG", "dlog", "DLog", genNONE, specDLOG) DEFNAME ("DLOG10", "dlog10", "DLog10", genNONE, specDLOG10) DEFNAME ("DMAX1", "dmax1", "DMax1", genNONE, specDMAX1) DEFNAME ("DMIN1", "dmin1", "DMin1", genNONE, specDMIN1) ! DEFNAME ("DMOD", "dmod", "DMod", genNONE, specDMOD) DEFNAME ("DNINT", "dnint", "DNInt", genNONE, specDNINT) DEFNAME ("DOT_PRODUCT", "dot_product", "Dot_Product", genNONE, specDOT_PRODUCT) /* F90 */ --- 99,125 ---- DEFNAME ("DBESY1", "dbesy1", "DbesY1", genNONE, specDBESY1) /* UNIX */ DEFNAME ("DBESYN", "dbesyn", "DbesYN", genNONE, specDBESYN) /* UNIX */ ! DEFNAME ("DBLE", "dble", "Dble", genNONE, specDBLE) DEFNAME ("DBLEQ", "dbleq", "DbleQ", genNONE, specDBLEQ) /* VXT */ DEFNAME ("DCMPLX", "dcmplx", "DCmplx", genNONE, specDCMPLX) /* F2C, VXT */ DEFNAME ("DCONJG", "dconjg", "DConjg", genNONE, specDCONJG) /* F2C, VXT */ ! DEFNAME ("DCOS", "dcos", "DCos", genNONE, specDCOS) DEFNAME ("DCOSD", "dcosd", "DCosD", genNONE, specDCOSD) /* VXT */ DEFNAME ("DCOSH", "dcosh", "DCosH", genNONE, specDCOSH) ! DEFNAME ("DDIM", "ddim", "DDiM", genNONE, specDDIM) ! DEFNAME ("DERF", "derf", "DErF", genNONE, specDERF) /* UNIX */ DEFNAME ("DERFC", "derfc", "DErFC", genNONE, specDERFC) /* UNIX */ ! DEFNAME ("DEXP", "dexp", "DExp", genNONE, specDEXP) DEFNAME ("DFLOAT", "dfloat", "DFloat", genNONE, specDFLOAT) /* F2C, VXT */ DEFNAME ("DFLOTI", "dfloti", "DFlotI", genNONE, specDFLOTI) /* VXT */ DEFNAME ("DFLOTJ", "dflotj", "DFlotJ", genNONE, specDFLOTJ) /* VXT */ DEFNAME ("DIGITS", "digits", "Digits", genNONE, specDIGITS) /* F90 */ ! DEFNAME ("DIM", "dim", "DiM", genNONE, specDIM) DEFNAME ("DIMAG", "dimag", "DImag", genNONE, specDIMAG) /* F2C, VXT */ ! DEFNAME ("DINT", "dint", "DInt", genNONE, specDINT) ! DEFNAME ("DLOG", "dlog", "DLog", genNONE, specDLOG) DEFNAME ("DLOG10", "dlog10", "DLog10", genNONE, specDLOG10) DEFNAME ("DMAX1", "dmax1", "DMax1", genNONE, specDMAX1) DEFNAME ("DMIN1", "dmin1", "DMin1", genNONE, specDMIN1) ! DEFNAME ("DMOD", "dmod", "DMod", genNONE, specDMOD) DEFNAME ("DNINT", "dnint", "DNInt", genNONE, specDNINT) DEFNAME ("DOT_PRODUCT", "dot_product", "Dot_Product", genNONE, specDOT_PRODUCT) /* F90 */ *************** DEFNAME ("DPROD", "dprod", "DProd", genN *** 125,146 **** DEFNAME ("DREAL", "dreal", "DReal", genNONE, specDREAL) /* VXT */ DEFNAME ("DSIGN", "dsign", "DSign", genNONE, specDSIGN) ! DEFNAME ("DSIN", "dsin", "DSin", genNONE, specDSIN) DEFNAME ("DSIND", "dsind", "DSinD", genNONE, specDSIND) /* VXT */ DEFNAME ("DSINH", "dsinh", "DSinH", genNONE, specDSINH) DEFNAME ("DSQRT", "dsqrt", "DSqRt", genNONE, specDSQRT) ! DEFNAME ("DTAN", "dtan", "DTan", genNONE, specDTAN) DEFNAME ("DTAND", "dtand", "DTanD", genNONE, specDTAND) /* VXT */ DEFNAME ("DTANH", "dtanh", "DTanH", genNONE, specDTANH) ! DEFNAME ("DTIME", "dtime", "Dtime", genNONE, specDTIME) /* UNIX */ DEFNAME ("EOSHIFT", "eoshift", "EOShift", genNONE, specEOSHIFT) /* F90 */ DEFNAME ("EPSILON", "epsilon", "Epsilon", genNONE, specEPSILON) /* F90 */ ! DEFNAME ("ERF", "erf", "ErF", genNONE, specERF) /* UNIX */ ! DEFNAME ("ERFC", "erfc", "ErFC", genNONE, specERFC) /* UNIX */ ! DEFNAME ("ETIME", "etime", "ETime", genNONE, specETIME) /* UNIX */ ! DEFNAME ("EXIT", "exit", "Exit", genNONE, specEXIT) /* UNIX */ ! DEFNAME ("EXP", "exp", "Exp", genNONE, specEXP) DEFNAME ("EXPONENT", "exponent", "Exponent", genNONE, specEXPONENT) /* F90 */ ! DEFNAME ("FDATE", "fdate", "Fdate", genNONE, specFDATE) /* UNIX */ ! DEFNAME ("FGETC", "fgetc", "FGetC", genNONE, specFGETC) /* UNIX */ DEFNAME ("FLOAT", "float", "Float", genNONE, specFLOAT) DEFNAME ("FLOATI", "floati", "FloatI", genNONE, specFLOATI) /* VXT */ --- 127,149 ---- DEFNAME ("DREAL", "dreal", "DReal", genNONE, specDREAL) /* VXT */ DEFNAME ("DSIGN", "dsign", "DSign", genNONE, specDSIGN) ! DEFNAME ("DSIN", "dsin", "DSin", genNONE, specDSIN) DEFNAME ("DSIND", "dsind", "DSinD", genNONE, specDSIND) /* VXT */ DEFNAME ("DSINH", "dsinh", "DSinH", genNONE, specDSINH) DEFNAME ("DSQRT", "dsqrt", "DSqRt", genNONE, specDSQRT) ! DEFNAME ("DTAN", "dtan", "DTan", genNONE, specDTAN) DEFNAME ("DTAND", "dtand", "DTanD", genNONE, specDTAND) /* VXT */ DEFNAME ("DTANH", "dtanh", "DTanH", genNONE, specDTANH) ! DEFNAME ("DTIME", "dtime", "Dtime", genDTIME, specNONE) /* UNIX */ DEFNAME ("EOSHIFT", "eoshift", "EOShift", genNONE, specEOSHIFT) /* F90 */ DEFNAME ("EPSILON", "epsilon", "Epsilon", genNONE, specEPSILON) /* F90 */ ! DEFNAME ("ERF", "erf", "ErF", genNONE, specERF) /* UNIX */ ! DEFNAME ("ERFC", "erfc", "ErFC", genNONE, specERFC) /* UNIX */ ! DEFNAME ("ETIME", "etime", "ETime", genETIME, specNONE) /* UNIX */ ! DEFNAME ("EXIT", "exit", "Exit", genNONE, specEXIT) /* UNIX */ ! DEFNAME ("EXP", "exp", "Exp", genNONE, specEXP) DEFNAME ("EXPONENT", "exponent", "Exponent", genNONE, specEXPONENT) /* F90 */ ! DEFNAME ("FDATE", "fdate", "Fdate", genFDATE, specNONE) /* UNIX */ ! DEFNAME ("FGET", "fget", "FGet", genFGET, specNONE) /* UNIX */ ! DEFNAME ("FGETC", "fgetc", "FGetC", genFGETC, specNONE) /* UNIX */ DEFNAME ("FLOAT", "float", "Float", genNONE, specFLOAT) DEFNAME ("FLOATI", "floati", "FloatI", genNONE, specFLOATI) /* VXT */ *************** DEFNAME ("FLOATJ", "floatj", "FloatJ", g *** 148,152 **** DEFNAME ("FLOOR", "floor", "Floor", genNONE, specFLOOR) /* F90 */ DEFNAME ("FLUSH", "flush", "Flush", genNONE, specFLUSH) /* UNIX */ ! DEFNAME ("FNUM", "fnum", "FNum", genNONE, specFNUM) /* UNIX */ DEFNAME ("FPABSP", "fpabsp", "FPAbsP", genFPABSP, specNONE) /* F2C */ DEFNAME ("FPEXPN", "fpexpn", "FPExpn", genFPEXPN, specNONE) /* F2C */ --- 151,155 ---- DEFNAME ("FLOOR", "floor", "Floor", genNONE, specFLOOR) /* F90 */ DEFNAME ("FLUSH", "flush", "Flush", genNONE, specFLUSH) /* UNIX */ ! DEFNAME ("FNUM", "fnum", "FNum", genNONE, specFNUM) /* UNIX */ DEFNAME ("FPABSP", "fpabsp", "FPAbsP", genFPABSP, specNONE) /* F2C */ DEFNAME ("FPEXPN", "fpexpn", "FPExpn", genFPEXPN, specNONE) /* F2C */ *************** DEFNAME ("FPMAKE", "fpmake", "FPMake", g *** 155,166 **** DEFNAME ("FPRRSP", "fprrsp", "FPRRSp", genFPRRSP, specNONE) /* F2C */ DEFNAME ("FPSCAL", "fpscal", "FPScal", genFPSCAL, specNONE) /* F2C */ ! DEFNAME ("FPUTC", "fputc", "FPutC", genNONE, specFPUTC) /* UNIX */ DEFNAME ("FRACTION", "fraction", "Fraction", genNONE, specFRACTION) /* F90 */ DEFNAME ("FSEEK", "fseek", "FSeek", genNONE, specFSEEK) /* UNIX */ ! DEFNAME ("FSTAT", "fstat", "FStat", genNONE, specFSTAT) /* UNIX */ ! DEFNAME ("FTELL", "ftell", "FTell", genNONE, specFTELL) /* UNIX */ DEFNAME ("GERROR", "gerror", "GError", genNONE, specGERROR) /* UNIX */ DEFNAME ("GETARG", "getarg", "GetArg", genNONE, specGETARG) /* UNIX */ ! DEFNAME ("GETCWD", "getcwd", "GetCWD", genNONE, specGETCWD) /* UNIX */ DEFNAME ("GETENV", "getenv", "GetEnv", genNONE, specGETENV) /* UNIX */ DEFNAME ("GETGID", "getgid", "GetGId", genNONE, specGETGID) /* UNIX */ --- 158,170 ---- DEFNAME ("FPRRSP", "fprrsp", "FPRRSp", genFPRRSP, specNONE) /* F2C */ DEFNAME ("FPSCAL", "fpscal", "FPScal", genFPSCAL, specNONE) /* F2C */ ! DEFNAME ("FPUT", "fput", "FPut", genFPUT, specNONE) /* UNIX */ ! DEFNAME ("FPUTC", "fputc", "FPutC", genFPUTC, specNONE) /* UNIX */ DEFNAME ("FRACTION", "fraction", "Fraction", genNONE, specFRACTION) /* F90 */ DEFNAME ("FSEEK", "fseek", "FSeek", genNONE, specFSEEK) /* UNIX */ ! DEFNAME ("FSTAT", "fstat", "FStat", genFSTAT, specNONE) /* UNIX */ ! DEFNAME ("FTELL", "ftell", "FTell", genFTELL, specNONE) /* UNIX */ DEFNAME ("GERROR", "gerror", "GError", genNONE, specGERROR) /* UNIX */ DEFNAME ("GETARG", "getarg", "GetArg", genNONE, specGETARG) /* UNIX */ ! DEFNAME ("GETCWD", "getcwd", "GetCWD", genGETCWD, specNONE) /* UNIX */ DEFNAME ("GETENV", "getenv", "GetEnv", genNONE, specGETENV) /* UNIX */ DEFNAME ("GETGID", "getgid", "GetGId", genNONE, specGETGID) /* UNIX */ *************** DEFNAME ("GETPID", "getpid", "GetPId", g *** 169,177 **** DEFNAME ("GETUID", "getuid", "GetUId", genNONE, specGETUID) /* UNIX */ DEFNAME ("GMTIME", "gmtime", "GMTime", genNONE, specGMTIME) /* UNIX */ ! DEFNAME ("HOSTNM", "hostnm", "HostNm", genNONE, specHOSTNM) /* UNIX */ ! DEFNAME ("HUGE", "huge", "Huge", genNONE, specHUGE) /* F90 */ ! DEFNAME ("IABS", "iabs", "IAbs", genNONE, specIABS) DEFNAME ("IACHAR", "iachar", "IAChar", genNONE, specIACHAR) /* F90, F2C */ ! DEFNAME ("IAND", "iand", "IAnd", genNONE, specIAND) /* F90, VXT */ DEFNAME ("IARGC", "iargc", "IArgC", genNONE, specIARGC) /* UNIX */ DEFNAME ("IBCLR", "ibclr", "IBClr", genNONE, specIBCLR) /* F90, VXT */ --- 173,181 ---- DEFNAME ("GETUID", "getuid", "GetUId", genNONE, specGETUID) /* UNIX */ DEFNAME ("GMTIME", "gmtime", "GMTime", genNONE, specGMTIME) /* UNIX */ ! DEFNAME ("HOSTNM", "hostnm", "HostNm", genHOSTNM, specNONE) /* UNIX */ ! DEFNAME ("HUGE", "huge", "Huge", genNONE, specHUGE) /* F90 */ ! DEFNAME ("IABS", "iabs", "IAbs", genNONE, specIABS) DEFNAME ("IACHAR", "iachar", "IAChar", genNONE, specIACHAR) /* F90, F2C */ ! DEFNAME ("IAND", "iand", "IAnd", genNONE, specIAND) /* F90, VXT */ DEFNAME ("IARGC", "iargc", "IArgC", genNONE, specIARGC) /* UNIX */ DEFNAME ("IBCLR", "ibclr", "IBClr", genNONE, specIBCLR) /* F90, VXT */ *************** DEFNAME ("IBSET", "ibset", "IBSet", genN *** 180,189 **** DEFNAME ("ICHAR", "ichar", "IChar", genNONE, specICHAR) DEFNAME ("IDATE", "idate", "IDate", genIDATE, specNONE) /* UNIX, VXT */ ! DEFNAME ("IDIM", "idim", "IDiM", genNONE, specIDIM) DEFNAME ("IDINT", "idint", "IDInt", genNONE, specIDINT) DEFNAME ("IDNINT", "idnint", "IDNInt", genNONE, specIDNINT) ! DEFNAME ("IEOR", "ieor", "IEOr", genNONE, specIEOR) /* F90, VXT */ DEFNAME ("IERRNO", "ierrno", "IErrNo", genNONE, specIERRNO) /* UNIX */ ! DEFNAME ("IFIX", "ifix", "IFix", genNONE, specIFIX) DEFNAME ("IIABS", "iiabs", "IIAbs", genNONE, specIIABS) /* VXT */ DEFNAME ("IIAND", "iiand", "IIAnd", genNONE, specIIAND) /* VXT */ --- 184,193 ---- DEFNAME ("ICHAR", "ichar", "IChar", genNONE, specICHAR) DEFNAME ("IDATE", "idate", "IDate", genIDATE, specNONE) /* UNIX, VXT */ ! DEFNAME ("IDIM", "idim", "IDiM", genNONE, specIDIM) DEFNAME ("IDINT", "idint", "IDInt", genNONE, specIDINT) DEFNAME ("IDNINT", "idnint", "IDNInt", genNONE, specIDNINT) ! DEFNAME ("IEOR", "ieor", "IEOr", genNONE, specIEOR) /* F90, VXT */ DEFNAME ("IERRNO", "ierrno", "IErrNo", genNONE, specIERRNO) /* UNIX */ ! DEFNAME ("IFIX", "ifix", "IFix", genNONE, specIFIX) DEFNAME ("IIABS", "iiabs", "IIAbs", genNONE, specIIABS) /* VXT */ DEFNAME ("IIAND", "iiand", "IIAnd", genNONE, specIIAND) /* VXT */ *************** DEFNAME ("IIDNNT", "iidnnt", "IIDNnt", g *** 196,201 **** DEFNAME ("IIEOR", "iieor", "IIEOr", genNONE, specIIEOR) /* VXT */ DEFNAME ("IIFIX", "iifix", "IIFix", genNONE, specIIFIX) /* VXT */ ! DEFNAME ("IINT", "iint", "IInt", genNONE, specIINT) /* VXT */ ! DEFNAME ("IIOR", "iior", "IIOr", genNONE, specIIOR) /* VXT */ DEFNAME ("IIQINT", "iiqint", "IIQint", genNONE, specIIQINT) /* VXT */ DEFNAME ("IIQNNT", "iiqnnt", "IIQNnt", genNONE, specIIQNNT) /* VXT */ --- 200,205 ---- DEFNAME ("IIEOR", "iieor", "IIEOr", genNONE, specIIEOR) /* VXT */ DEFNAME ("IIFIX", "iifix", "IIFix", genNONE, specIIFIX) /* VXT */ ! DEFNAME ("IINT", "iint", "IInt", genNONE, specIINT) /* VXT */ ! DEFNAME ("IIOR", "iior", "IIOr", genNONE, specIIOR) /* VXT */ DEFNAME ("IIQINT", "iiqint", "IIQint", genNONE, specIIQINT) /* VXT */ DEFNAME ("IIQNNT", "iiqnnt", "IIQNnt", genNONE, specIIQNNT) /* VXT */ *************** DEFNAME ("IMAX1", "imax1", "IMax1", genN *** 209,218 **** DEFNAME ("IMIN0", "imin0", "IMin0", genNONE, specIMIN0) /* VXT */ DEFNAME ("IMIN1", "imin1", "IMin1", genNONE, specIMIN1) /* VXT */ ! DEFNAME ("IMOD", "imod", "IMod", genNONE, specIMOD) /* VXT */ DEFNAME ("INDEX", "index", "Index", genNONE, specINDEX) DEFNAME ("ININT", "inint", "INInt", genNONE, specININT) /* VXT */ ! DEFNAME ("INOT", "inot", "INot", genNONE, specINOT) /* VXT */ ! DEFNAME ("INT", "int", "Int", genNONE, specINT) ! DEFNAME ("IOR", "ior", "IOr", genNONE, specIOR) /* F90, VXT */ DEFNAME ("IRAND", "irand", "IRand", genNONE, specIRAND) /* UNIX */ DEFNAME ("ISATTY", "isatty", "IsaTty", genNONE, specISATTY) /* UNIX */ --- 213,224 ---- DEFNAME ("IMIN0", "imin0", "IMin0", genNONE, specIMIN0) /* VXT */ DEFNAME ("IMIN1", "imin1", "IMin1", genNONE, specIMIN1) /* VXT */ ! DEFNAME ("IMOD", "imod", "IMod", genNONE, specIMOD) /* VXT */ DEFNAME ("INDEX", "index", "Index", genNONE, specINDEX) DEFNAME ("ININT", "inint", "INInt", genNONE, specININT) /* VXT */ ! DEFNAME ("INOT", "inot", "INot", genNONE, specINOT) /* VXT */ ! DEFNAME ("INT", "int", "Int", genNONE, specINT) ! DEFNAME ("INT2", "int2", "Int2", genNONE, specINT2) /* MS */ ! DEFNAME ("INT8", "int8", "Int8", genNONE, specINT8) /* GNU */ ! DEFNAME ("IOR", "ior", "IOr", genNONE, specIOR) /* F90, VXT */ DEFNAME ("IRAND", "irand", "IRand", genNONE, specIRAND) /* UNIX */ DEFNAME ("ISATTY", "isatty", "IsaTty", genNONE, specISATTY) /* UNIX */ *************** DEFNAME ("JIDNNT", "jidnnt", "JIDNnt", g *** 232,237 **** DEFNAME ("JIEOR", "jieor", "JIEOr", genNONE, specJIEOR) /* VXT */ DEFNAME ("JIFIX", "jifix", "JIFix", genNONE, specJIFIX) /* VXT */ ! DEFNAME ("JINT", "jint", "JInt", genNONE, specJINT) /* VXT */ ! DEFNAME ("JIOR", "jior", "JIOr", genNONE, specJIOR) /* VXT */ DEFNAME ("JIQINT", "jiqint", "JIQint", genNONE, specJIQINT) /* VXT */ DEFNAME ("JIQNNT", "jiqnnt", "JIQNnt", genNONE, specJIQNNT) /* VXT */ --- 238,243 ---- DEFNAME ("JIEOR", "jieor", "JIEOr", genNONE, specJIEOR) /* VXT */ DEFNAME ("JIFIX", "jifix", "JIFix", genNONE, specJIFIX) /* VXT */ ! DEFNAME ("JINT", "jint", "JInt", genNONE, specJINT) /* VXT */ ! DEFNAME ("JIOR", "jior", "JIOr", genNONE, specJIOR) /* VXT */ DEFNAME ("JIQINT", "jiqint", "JIQint", genNONE, specJIQINT) /* VXT */ DEFNAME ("JIQNNT", "jiqnnt", "JIQNnt", genNONE, specJIQNNT) /* VXT */ *************** DEFNAME ("JMAX1", "jmax1", "JMax1", genN *** 243,297 **** DEFNAME ("JMIN0", "jmin0", "JMin0", genNONE, specJMIN0) /* VXT */ DEFNAME ("JMIN1", "jmin1", "JMin1", genNONE, specJMIN1) /* VXT */ ! DEFNAME ("JMOD", "jmod", "JMod", genNONE, specJMOD) /* VXT */ DEFNAME ("JNINT", "jnint", "JNInt", genNONE, specJNINT) /* VXT */ ! DEFNAME ("JNOT", "jnot", "JNot", genNONE, specJNOT) /* VXT */ DEFNAME ("JZEXT", "jzext", "JZExt", genNONE, specJZEXT) /* VXT */ ! DEFNAME ("KILL", "kill", "Kill", genNONE, specKILL) /* UNIX */ ! DEFNAME ("KIND", "kind", "Kind", genNONE, specKIND) /* F90 */ DEFNAME ("LBOUND", "lbound", "LBound", genNONE, specLBOUND) /* F90 */ ! DEFNAME ("LEN", "len", "Len", genNONE, specLEN) DEFNAME ("LEN_TRIM", "len_trim", "Len_Trim", genNONE, specLEN_TRIM) /* F90 */ ! DEFNAME ("LGE", "lge", "LGe", genNONE, specLGE) ! DEFNAME ("LGT", "lgt", "LGt", genNONE, specLGT) ! DEFNAME ("LINK", "link", "Link", genNONE, specLINK) /* UNIX */ ! DEFNAME ("LLE", "lle", "LLe", genNONE, specLLE) ! DEFNAME ("LLT", "llt", "LLt", genNONE, specLLT) DEFNAME ("LNBLNK", "lnblnk", "LnBlnk", genNONE, specLNBLNK) /* UNIX */ ! DEFNAME ("LOC", "loc", "Loc", genNONE, specLOC) /* VXT */ ! DEFNAME ("LOG", "log", "Log", genNONE, specLOG) DEFNAME ("LOG10", "log10", "Log10", genNONE, specLOG10) DEFNAME ("LOGICAL", "logical", "Logical", genNONE, specLOGICAL) /* F90 */ ! DEFNAME ("LONG", "long", "Long", genNONE, specLONG) /* UNIX */ DEFNAME ("LSHIFT", "lshift", "LShift", genNONE, specLSHIFT) /* F2C */ ! DEFNAME ("LSTAT", "lstat", "LStat", genNONE, specLSTAT) /* UNIX */ DEFNAME ("LTIME", "ltime", "LTime", genNONE, specLTIME) /* UNIX */ DEFNAME ("MATMUL", "matmul", "MatMul", genNONE, specMATMUL) /* F90 */ ! DEFNAME ("MAX", "max", "Max", genNONE, specMAX) ! DEFNAME ("MAX0", "max0", "Max0", genNONE, specMAX0) ! DEFNAME ("MAX1", "max1", "Max1", genNONE, specMAX1) DEFNAME ("MAXEXPONENT", "maxexponent", "MaxExponent", genNONE, specMAXEXPONENT) /* F90 */ DEFNAME ("MAXLOC", "maxloc", "MaxLoc", genNONE, specMAXLOC) /* F90 */ DEFNAME ("MAXVAL", "maxval", "MaxVal", genNONE, specMAXVAL) /* F90 */ DEFNAME ("MCLOCK", "mclock", "MClock", genNONE, specMCLOCK) /* UNIX */ DEFNAME ("MERGE", "merge", "Merge", genNONE, specMERGE) /* F90 */ ! DEFNAME ("MIN", "min", "Min", genNONE, specMIN) ! DEFNAME ("MIN0", "min0", "Min0", genNONE, specMIN0) ! DEFNAME ("MIN1", "min1", "Min1", genNONE, specMIN1) DEFNAME ("MINEXPONENT", "minexponent", "MinExponent", genNONE, specMINEXPONENT) /* F90 */ DEFNAME ("MINLOC", "minloc", "MinLoc", genNONE, specMINLOC) /* F90 */ DEFNAME ("MINVAL", "minval", "MinVal", genNONE, specMINVAL) /* F90 */ ! DEFNAME ("MOD", "mod", "Mod", genNONE, specMOD) DEFNAME ("MODULO", "modulo", "Modulo", genNONE, specMODULO) /* F90 */ DEFNAME ("MVBITS", "mvbits", "MvBits", genNONE, specMVBITS) /* F90 */ DEFNAME ("NEAREST", "nearest", "Nearest", genNONE, specNEAREST) /* F90 */ ! DEFNAME ("NINT", "nint", "NInt", genNONE, specNINT) ! DEFNAME ("NOT", "not", "Not", genNONE, specNOT) /* F2C, F90, VXT */ ! DEFNAME ("OR", "or", "Or", genNONE, specOR) /* F2C */ ! DEFNAME ("PACK", "pack", "Pack", genNONE, specPACK) /* F90 */ DEFNAME ("PERROR", "perror", "PError", genNONE, specPERROR) /* UNIX */ DEFNAME ("PRECISION", "precision", "Precision", genNONE, specPRECISION) /* F90 */ DEFNAME ("PRESENT", "present", "Present", genNONE, specPRESENT) /* F90 */ DEFNAME ("PRODUCT", "product", "Product", genNONE, specPRODUCT) /* F90 */ ! DEFNAME ("QABS", "qabs", "QAbs", genNONE, specQABS) /* VXT */ DEFNAME ("QACOS", "qacos", "QACos", genNONE, specQACOS) /* VXT */ DEFNAME ("QACOSD", "qacosd", "QACosD", genNONE, specQACOSD) /* VXT */ --- 249,304 ---- DEFNAME ("JMIN0", "jmin0", "JMin0", genNONE, specJMIN0) /* VXT */ DEFNAME ("JMIN1", "jmin1", "JMin1", genNONE, specJMIN1) /* VXT */ ! DEFNAME ("JMOD", "jmod", "JMod", genNONE, specJMOD) /* VXT */ DEFNAME ("JNINT", "jnint", "JNInt", genNONE, specJNINT) /* VXT */ ! DEFNAME ("JNOT", "jnot", "JNot", genNONE, specJNOT) /* VXT */ DEFNAME ("JZEXT", "jzext", "JZExt", genNONE, specJZEXT) /* VXT */ ! DEFNAME ("KILL", "kill", "Kill", genKILL, specNONE) /* UNIX */ ! DEFNAME ("KIND", "kind", "Kind", genNONE, specKIND) /* F90 */ DEFNAME ("LBOUND", "lbound", "LBound", genNONE, specLBOUND) /* F90 */ ! DEFNAME ("LEN", "len", "Len", genNONE, specLEN) DEFNAME ("LEN_TRIM", "len_trim", "Len_Trim", genNONE, specLEN_TRIM) /* F90 */ ! DEFNAME ("LGE", "lge", "LGe", genNONE, specLGE) ! DEFNAME ("LGT", "lgt", "LGt", genNONE, specLGT) ! DEFNAME ("LINK", "link", "Link", genLINK, specNONE) /* UNIX */ ! DEFNAME ("LLE", "lle", "LLe", genNONE, specLLE) ! DEFNAME ("LLT", "llt", "LLt", genNONE, specLLT) DEFNAME ("LNBLNK", "lnblnk", "LnBlnk", genNONE, specLNBLNK) /* UNIX */ ! DEFNAME ("LOC", "loc", "Loc", genNONE, specLOC) /* VXT */ ! DEFNAME ("LOG", "log", "Log", genNONE, specLOG) DEFNAME ("LOG10", "log10", "Log10", genNONE, specLOG10) DEFNAME ("LOGICAL", "logical", "Logical", genNONE, specLOGICAL) /* F90 */ ! DEFNAME ("LONG", "long", "Long", genNONE, specLONG) /* UNIX */ DEFNAME ("LSHIFT", "lshift", "LShift", genNONE, specLSHIFT) /* F2C */ ! DEFNAME ("LSTAT", "lstat", "LStat", genLSTAT, specNONE) /* UNIX */ DEFNAME ("LTIME", "ltime", "LTime", genNONE, specLTIME) /* UNIX */ DEFNAME ("MATMUL", "matmul", "MatMul", genNONE, specMATMUL) /* F90 */ ! DEFNAME ("MAX", "max", "Max", genNONE, specMAX) ! DEFNAME ("MAX0", "max0", "Max0", genNONE, specMAX0) ! DEFNAME ("MAX1", "max1", "Max1", genNONE, specMAX1) DEFNAME ("MAXEXPONENT", "maxexponent", "MaxExponent", genNONE, specMAXEXPONENT) /* F90 */ DEFNAME ("MAXLOC", "maxloc", "MaxLoc", genNONE, specMAXLOC) /* F90 */ DEFNAME ("MAXVAL", "maxval", "MaxVal", genNONE, specMAXVAL) /* F90 */ DEFNAME ("MCLOCK", "mclock", "MClock", genNONE, specMCLOCK) /* UNIX */ + DEFNAME ("MCLOCK8", "mclock8", "MClock8", genNONE, specMCLOCK8) /* UNIX */ DEFNAME ("MERGE", "merge", "Merge", genNONE, specMERGE) /* F90 */ ! DEFNAME ("MIN", "min", "Min", genNONE, specMIN) ! DEFNAME ("MIN0", "min0", "Min0", genNONE, specMIN0) ! DEFNAME ("MIN1", "min1", "Min1", genNONE, specMIN1) DEFNAME ("MINEXPONENT", "minexponent", "MinExponent", genNONE, specMINEXPONENT) /* F90 */ DEFNAME ("MINLOC", "minloc", "MinLoc", genNONE, specMINLOC) /* F90 */ DEFNAME ("MINVAL", "minval", "MinVal", genNONE, specMINVAL) /* F90 */ ! DEFNAME ("MOD", "mod", "Mod", genNONE, specMOD) DEFNAME ("MODULO", "modulo", "Modulo", genNONE, specMODULO) /* F90 */ DEFNAME ("MVBITS", "mvbits", "MvBits", genNONE, specMVBITS) /* F90 */ DEFNAME ("NEAREST", "nearest", "Nearest", genNONE, specNEAREST) /* F90 */ ! DEFNAME ("NINT", "nint", "NInt", genNONE, specNINT) ! DEFNAME ("NOT", "not", "Not", genNONE, specNOT) /* F2C, F90, VXT */ ! DEFNAME ("OR", "or", "Or", genNONE, specOR) /* F2C */ ! DEFNAME ("PACK", "pack", "Pack", genNONE, specPACK) /* F90 */ DEFNAME ("PERROR", "perror", "PError", genNONE, specPERROR) /* UNIX */ DEFNAME ("PRECISION", "precision", "Precision", genNONE, specPRECISION) /* F90 */ DEFNAME ("PRESENT", "present", "Present", genNONE, specPRESENT) /* F90 */ DEFNAME ("PRODUCT", "product", "Product", genNONE, specPRODUCT) /* F90 */ ! DEFNAME ("QABS", "qabs", "QAbs", genNONE, specQABS) /* VXT */ DEFNAME ("QACOS", "qacos", "QACos", genNONE, specQACOS) /* VXT */ DEFNAME ("QACOSD", "qacosd", "QACosD", genNONE, specQACOSD) /* VXT */ *************** DEFNAME ("QATAN2", "qatan2", "QATan2", g *** 302,335 **** DEFNAME ("QATAN2D", "qatan2d", "QATan2D", genNONE, specQATAN2D) /* VXT */ DEFNAME ("QATAND", "qatand", "QATanD", genNONE, specQATAND) /* VXT */ ! DEFNAME ("QCOS", "qcos", "QCos", genNONE, specQCOS) /* VXT */ DEFNAME ("QCOSD", "qcosd", "QCosD", genNONE, specQCOSD) /* VXT */ DEFNAME ("QCOSH", "qcosh", "QCosH", genNONE, specQCOSH) /* VXT */ ! DEFNAME ("QDIM", "qdim", "QDiM", genNONE, specQDIM) /* VXT */ ! DEFNAME ("QEXP", "qexp", "QExp", genNONE, specQEXP) /* VXT */ ! DEFNAME ("QEXT", "qext", "QExt", genNONE, specQEXT) /* VXT */ DEFNAME ("QEXTD", "qextd", "QExtD", genNONE, specQEXTD) /* VXT */ DEFNAME ("QFLOAT", "qfloat", "QFloat", genNONE, specQFLOAT) /* VXT */ ! DEFNAME ("QINT", "qint", "QInt", genNONE, specQINT) /* VXT */ ! DEFNAME ("QLOG", "qlog", "QLog", genNONE, specQLOG) /* VXT */ DEFNAME ("QLOG10", "qlog10", "QLog10", genNONE, specQLOG10) /* VXT */ DEFNAME ("QMAX1", "qmax1", "QMax1", genNONE, specQMAX1) /* VXT */ DEFNAME ("QMIN1", "qmin1", "QMin1", genNONE, specQMIN1) /* VXT */ ! DEFNAME ("QMOD", "qmod", "QMod", genNONE, specQMOD) /* VXT */ DEFNAME ("QNINT", "qnint", "QNInt", genNONE, specQNINT) /* VXT */ ! DEFNAME ("QSIN", "qsin", "QSin", genNONE, specQSIN) /* VXT */ DEFNAME ("QSIND", "qsind", "QSinD", genNONE, specQSIND) /* VXT */ DEFNAME ("QSINH", "qsinh", "QSinH", genNONE, specQSINH) /* VXT */ DEFNAME ("QSQRT", "qsqrt", "QSqRt", genNONE, specQSQRT) /* VXT */ ! DEFNAME ("QTAN", "qtan", "QTan", genNONE, specQTAN) /* VXT */ DEFNAME ("QTAND", "qtand", "QTanD", genNONE, specQTAND) /* VXT */ DEFNAME ("QTANH", "qtanh", "QTanH", genNONE, specQTANH) /* VXT */ DEFNAME ("RADIX", "radix", "Radix", genNONE, specRADIX) /* F90 */ ! DEFNAME ("RAND", "rand", "Rand", genNONE, specRAND) /* UNIX */ DEFNAME ("RANDOM_NUMBER", "random_number", "Random_Number", genNONE, specRANDOM_NUMBER) /* F90 */ DEFNAME ("RANDOM_SEED", "random_seed", "Random_Seed", genNONE, specRANDOM_SEED) /* F90 */ DEFNAME ("RANGE", "range", "Range", genNONE, specRANGE) /* F90 */ ! DEFNAME ("REAL", "real", "Real", genNONE, specREAL) DEFNAME ("REALPART", "realpart", "RealPart", genNONE, specREALPART) /* GNU */ ! DEFNAME ("RENAME", "rename", "Rename", genNONE, specRENAME) /* UNIX */ DEFNAME ("REPEAT", "repeat", "Repeat", genNONE, specREPEAT) /* F90 */ DEFNAME ("RESHAPE", "reshape", "Reshape", genNONE, specRESHAPE) /* F90 */ --- 309,342 ---- DEFNAME ("QATAN2D", "qatan2d", "QATan2D", genNONE, specQATAN2D) /* VXT */ DEFNAME ("QATAND", "qatand", "QATanD", genNONE, specQATAND) /* VXT */ ! DEFNAME ("QCOS", "qcos", "QCos", genNONE, specQCOS) /* VXT */ DEFNAME ("QCOSD", "qcosd", "QCosD", genNONE, specQCOSD) /* VXT */ DEFNAME ("QCOSH", "qcosh", "QCosH", genNONE, specQCOSH) /* VXT */ ! DEFNAME ("QDIM", "qdim", "QDiM", genNONE, specQDIM) /* VXT */ ! DEFNAME ("QEXP", "qexp", "QExp", genNONE, specQEXP) /* VXT */ ! DEFNAME ("QEXT", "qext", "QExt", genNONE, specQEXT) /* VXT */ DEFNAME ("QEXTD", "qextd", "QExtD", genNONE, specQEXTD) /* VXT */ DEFNAME ("QFLOAT", "qfloat", "QFloat", genNONE, specQFLOAT) /* VXT */ ! DEFNAME ("QINT", "qint", "QInt", genNONE, specQINT) /* VXT */ ! DEFNAME ("QLOG", "qlog", "QLog", genNONE, specQLOG) /* VXT */ DEFNAME ("QLOG10", "qlog10", "QLog10", genNONE, specQLOG10) /* VXT */ DEFNAME ("QMAX1", "qmax1", "QMax1", genNONE, specQMAX1) /* VXT */ DEFNAME ("QMIN1", "qmin1", "QMin1", genNONE, specQMIN1) /* VXT */ ! DEFNAME ("QMOD", "qmod", "QMod", genNONE, specQMOD) /* VXT */ DEFNAME ("QNINT", "qnint", "QNInt", genNONE, specQNINT) /* VXT */ ! DEFNAME ("QSIN", "qsin", "QSin", genNONE, specQSIN) /* VXT */ DEFNAME ("QSIND", "qsind", "QSinD", genNONE, specQSIND) /* VXT */ DEFNAME ("QSINH", "qsinh", "QSinH", genNONE, specQSINH) /* VXT */ DEFNAME ("QSQRT", "qsqrt", "QSqRt", genNONE, specQSQRT) /* VXT */ ! DEFNAME ("QTAN", "qtan", "QTan", genNONE, specQTAN) /* VXT */ DEFNAME ("QTAND", "qtand", "QTanD", genNONE, specQTAND) /* VXT */ DEFNAME ("QTANH", "qtanh", "QTanH", genNONE, specQTANH) /* VXT */ DEFNAME ("RADIX", "radix", "Radix", genNONE, specRADIX) /* F90 */ ! DEFNAME ("RAND", "rand", "Rand", genNONE, specRAND) /* UNIX */ DEFNAME ("RANDOM_NUMBER", "random_number", "Random_Number", genNONE, specRANDOM_NUMBER) /* F90 */ DEFNAME ("RANDOM_SEED", "random_seed", "Random_Seed", genNONE, specRANDOM_SEED) /* F90 */ DEFNAME ("RANGE", "range", "Range", genNONE, specRANGE) /* F90 */ ! DEFNAME ("REAL", "real", "Real", genNONE, specREAL) DEFNAME ("REALPART", "realpart", "RealPart", genNONE, specREALPART) /* GNU */ ! DEFNAME ("RENAME", "rename", "Rename", genRENAME, specNONE) /* UNIX */ DEFNAME ("REPEAT", "repeat", "Repeat", genNONE, specREPEAT) /* F90 */ DEFNAME ("RESHAPE", "reshape", "Reshape", genNONE, specRESHAPE) /* F90 */ *************** DEFNAME ("RRSPACING", "rrspacing", "RRSp *** 337,341 **** DEFNAME ("RSHIFT", "rshift", "RShift", genNONE, specRSHIFT) /* F2C */ DEFNAME ("SCALE", "scale", "Scale", genNONE, specSCALE) /* F90 */ ! DEFNAME ("SCAN", "scan", "Scan", genNONE, specSCAN) /* F90 */ DEFNAME ("SECNDS", "secnds", "Secnds", genNONE, specSECNDS) /* VXT */ DEFNAME ("SECOND", "second", "Second", genSECOND, specNONE) /* UNIX */ --- 344,348 ---- DEFNAME ("RSHIFT", "rshift", "RShift", genNONE, specRSHIFT) /* F2C */ DEFNAME ("SCALE", "scale", "Scale", genNONE, specSCALE) /* F90 */ ! DEFNAME ("SCAN", "scan", "Scan", genNONE, specSCAN) /* F90 */ DEFNAME ("SECNDS", "secnds", "Secnds", genNONE, specSECNDS) /* VXT */ DEFNAME ("SECOND", "second", "Second", genSECOND, specNONE) /* UNIX */ *************** DEFNAME ("SET_EXPONENT", "set_exponent", *** 345,386 **** DEFNAME ("SHAPE", "shape", "Shape", genNONE, specSHAPE) /* F90 */ DEFNAME ("SHORT", "short", "Short", genNONE, specSHORT) /* UNIX */ ! DEFNAME ("SIGN", "sign", "Sign", genNONE, specSIGN) ! DEFNAME ("SIGNAL", "signal", "Signal", genNONE, specSIGNAL) /* UNIX */ ! DEFNAME ("SIN", "sin", "Sin", genNONE, specSIN) ! DEFNAME ("SIND", "sind", "SinD", genNONE, specSIND) /* VXT */ ! DEFNAME ("SINH", "sinh", "SinH", genNONE, specSINH) DEFNAME ("SLEEP", "sleep", "Sleep", genNONE, specSLEEP) /* UNIX */ ! DEFNAME ("SNGL", "sngl", "Sngl", genNONE, specSNGL) DEFNAME ("SNGLQ", "snglq", "SnglQ", genNONE, specSNGLQ) /* VXT */ DEFNAME ("SPACING", "spacing", "Spacing", genNONE, specSPACING) /* F90 */ DEFNAME ("SPREAD", "spread", "Spread", genNONE, specSPREAD) /* F90 */ ! DEFNAME ("SQRT", "sqrt", "SqRt", genNONE, specSQRT) DEFNAME ("SRAND", "srand", "SRand", genNONE, specSRAND) /* UNIX */ ! DEFNAME ("STAT", "stat", "Stat", genNONE, specSTAT) /* UNIX */ ! DEFNAME ("SUM", "sum", "Sum", genNONE, specSUM) /* F90 */ ! DEFNAME ("SYMLNK", "symlnk", "SymLnk", genNONE, specSYMLNK) /* UNIX */ ! DEFNAME ("SYSTEM", "system", "System", genNONE, specSYSTEM) /* UNIX */ DEFNAME ("SYSTEM_CLOCK", "system_clock", "System_Clock", genNONE, specSYSTEM_CLOCK) /* F90 */ ! DEFNAME ("TAN", "tan", "Tan", genNONE, specTAN) ! DEFNAME ("TAND", "tand", "TanD", genNONE, specTAND) /* VXT */ ! DEFNAME ("TANH", "tanh", "TanH", genNONE, specTANH) ! DEFNAME ("TIME", "time", "Time", genTIME, specNONE) /* UNIX, VXT */ ! DEFNAME ("TINY", "tiny", "Tiny", genNONE, specTINY) /* F90 */ DEFNAME ("TRANSFER", "transfer", "Transfer", genNONE, specTRANSFER) /* F90 */ DEFNAME ("TRANSPOSE", "transpose", "Transpose", genNONE, specTRANSPOSE) /* F90 */ ! DEFNAME ("TRIM", "trim", "Trim", genNONE, specTRIM) /* F90 */ ! DEFNAME ("TTYNAM", "ttynam", "TtyNam", genNONE, specTTYNAM) /* UNIX */ DEFNAME ("UBOUND", "ubound", "UBound", genNONE, specUBOUND) /* F90 */ ! DEFNAME ("UMASK", "umask", "UMask", genNONE, specUMASK) /* UNIX */ ! DEFNAME ("UNLINK", "unlink", "Unlink", genNONE, specUNLINK) /* UNIX */ DEFNAME ("UNPACK", "unpack", "Unpack", genNONE, specUNPACK) /* F90 */ DEFNAME ("VERIFY", "verify", "Verify", genNONE, specVERIFY) /* F90 */ ! DEFNAME ("XOR", "xor", "XOr", genNONE, specXOR) /* F2C */ ! DEFNAME ("ZABS", "zabs", "ZAbs", genNONE, specZABS) /* F2C */ ! DEFNAME ("ZCOS", "zcos", "ZCos", genNONE, specZCOS) /* F2C */ ! DEFNAME ("ZEXP", "zexp", "ZExp", genNONE, specZEXP) /* F2C */ ! DEFNAME ("ZEXT", "zext", "ZExt", genNONE, specZEXT) /* VXT */ ! DEFNAME ("ZLOG", "zlog", "ZLog", genNONE, specZLOG) /* F2C */ ! DEFNAME ("ZSIN", "zsin", "ZSin", genNONE, specZSIN) /* F2C */ DEFNAME ("ZSQRT", "zsqrt", "ZSqRt", genNONE, specZSQRT) /* F2C */ --- 352,394 ---- DEFNAME ("SHAPE", "shape", "Shape", genNONE, specSHAPE) /* F90 */ DEFNAME ("SHORT", "short", "Short", genNONE, specSHORT) /* UNIX */ ! DEFNAME ("SIGN", "sign", "Sign", genNONE, specSIGN) ! DEFNAME ("SIGNAL", "signal", "Signal", genSIGNAL, specNONE) /* UNIX */ ! DEFNAME ("SIN", "sin", "Sin", genNONE, specSIN) ! DEFNAME ("SIND", "sind", "SinD", genNONE, specSIND) /* VXT */ ! DEFNAME ("SINH", "sinh", "SinH", genNONE, specSINH) DEFNAME ("SLEEP", "sleep", "Sleep", genNONE, specSLEEP) /* UNIX */ ! DEFNAME ("SNGL", "sngl", "Sngl", genNONE, specSNGL) DEFNAME ("SNGLQ", "snglq", "SnglQ", genNONE, specSNGLQ) /* VXT */ DEFNAME ("SPACING", "spacing", "Spacing", genNONE, specSPACING) /* F90 */ DEFNAME ("SPREAD", "spread", "Spread", genNONE, specSPREAD) /* F90 */ ! DEFNAME ("SQRT", "sqrt", "SqRt", genNONE, specSQRT) DEFNAME ("SRAND", "srand", "SRand", genNONE, specSRAND) /* UNIX */ ! DEFNAME ("STAT", "stat", "Stat", genSTAT, specNONE) /* UNIX */ ! DEFNAME ("SUM", "sum", "Sum", genNONE, specSUM) /* F90 */ ! DEFNAME ("SYMLNK", "symlnk", "SymLnk", genSYMLNK, specNONE) /* UNIX */ ! DEFNAME ("SYSTEM", "system", "System", genSYSTEM, specNONE) /* UNIX */ DEFNAME ("SYSTEM_CLOCK", "system_clock", "System_Clock", genNONE, specSYSTEM_CLOCK) /* F90 */ ! DEFNAME ("TAN", "tan", "Tan", genNONE, specTAN) ! DEFNAME ("TAND", "tand", "TanD", genNONE, specTAND) /* VXT */ ! DEFNAME ("TANH", "tanh", "TanH", genNONE, specTANH) ! DEFNAME ("TIME", "time", "Time", genTIME, specNONE) /* UNIX, VXT */ ! DEFNAME ("TIME8", "time8", "Time8", genNONE, specTIME8) /* UNIX */ ! DEFNAME ("TINY", "tiny", "Tiny", genNONE, specTINY) /* F90 */ DEFNAME ("TRANSFER", "transfer", "Transfer", genNONE, specTRANSFER) /* F90 */ DEFNAME ("TRANSPOSE", "transpose", "Transpose", genNONE, specTRANSPOSE) /* F90 */ ! DEFNAME ("TRIM", "trim", "Trim", genNONE, specTRIM) /* F90 */ ! DEFNAME ("TTYNAM", "ttynam", "TtyNam", genTTYNAM, specNONE) /* UNIX */ DEFNAME ("UBOUND", "ubound", "UBound", genNONE, specUBOUND) /* F90 */ ! DEFNAME ("UMASK", "umask", "UMask", genUMASK, specNONE) /* UNIX */ ! DEFNAME ("UNLINK", "unlink", "Unlink", genUNLINK, specNONE) /* UNIX */ DEFNAME ("UNPACK", "unpack", "Unpack", genNONE, specUNPACK) /* F90 */ DEFNAME ("VERIFY", "verify", "Verify", genNONE, specVERIFY) /* F90 */ ! DEFNAME ("XOR", "xor", "XOr", genNONE, specXOR) /* F2C */ ! DEFNAME ("ZABS", "zabs", "ZAbs", genNONE, specZABS) /* F2C */ ! DEFNAME ("ZCOS", "zcos", "ZCos", genNONE, specZCOS) /* F2C */ ! DEFNAME ("ZEXP", "zexp", "ZExp", genNONE, specZEXP) /* F2C */ ! DEFNAME ("ZEXT", "zext", "ZExt", genNONE, specZEXT) /* VXT */ ! DEFNAME ("ZLOG", "zlog", "ZLog", genNONE, specZLOG) /* F2C */ ! DEFNAME ("ZSIN", "zsin", "ZSin", genNONE, specZSIN) /* F2C */ DEFNAME ("ZSQRT", "zsqrt", "ZSqRt", genNONE, specZSQRT) /* F2C */ *************** DEFNAME ("ZSQRT", "zsqrt", "ZSqRt", genN *** 393,396 **** --- 401,436 ---- have no specific versions, but we want to reserve the names for now. */ + DEFGEN (CTIME, "CTIME", /* UNIX */ + FFEINTRIN_specCTIME_subr, + FFEINTRIN_specCTIME_func + ) + DEFGEN (CHDIR, "CHDIR", /* UNIX */ + FFEINTRIN_specCHDIR_subr, + FFEINTRIN_specCHDIR_func + ) + DEFGEN (CHMOD, "CHMOD", /* UNIX */ + FFEINTRIN_specCHMOD_subr, + FFEINTRIN_specCHMOD_func + ) + DEFGEN (DTIME, "DTIME", /* UNIX */ + FFEINTRIN_specDTIME_subr, + FFEINTRIN_specDTIME_func + ) + DEFGEN (ETIME, "ETIME", /* UNIX */ + FFEINTRIN_specETIME_subr, + FFEINTRIN_specETIME_func + ) + DEFGEN (FDATE, "FDATE", /* UNIX */ + FFEINTRIN_specFDATE_subr, + FFEINTRIN_specFDATE_func + ) + DEFGEN (FGET, "FGET", /* UNIX */ + FFEINTRIN_specFGET_subr, + FFEINTRIN_specFGET_func + ) + DEFGEN (FGETC, "FGETC", /* UNIX */ + FFEINTRIN_specFGETC_subr, + FFEINTRIN_specFGETC_func + ) DEFGEN (FPABSP, "FPABSP", /* F2C */ FFEINTRIN_specNONE, *************** DEFGEN (FPSCAL, "FPSCAL", /* F2C */ *** 417,431 **** FFEINTRIN_specNONE ) ! DEFGEN (IDATE, "IDATE (UNIX or VXT)", /* UNIX/VXT */ ! FFEINTRIN_specIDATE, ! FFEINTRIN_specIDATEVXT ! ) ! DEFGEN (SECOND, "SECOND (function or subroutine)", /* UNIX/CRAY */ ! FFEINTRIN_specSECONDFUNC, ! FFEINTRIN_specSECONDSUBR ! ) ! DEFGEN (TIME, "TIME (UNIX or VXT)", /* UNIX/VXT */ ! FFEINTRIN_specTIME, ! FFEINTRIN_specTIMEVXT ) DEFGEN (NONE, "none", --- 457,539 ---- FFEINTRIN_specNONE ) ! DEFGEN (FPUT, "FPUT", /* UNIX */ ! FFEINTRIN_specFPUT_subr, ! FFEINTRIN_specFPUT_func ! ) ! DEFGEN (FPUTC, "FPUTC", /* UNIX */ ! FFEINTRIN_specFPUTC_subr, ! FFEINTRIN_specFPUTC_func ! ) ! DEFGEN (FSTAT, "FSTAT", /* UNIX */ ! FFEINTRIN_specFSTAT_subr, ! FFEINTRIN_specFSTAT_func ! ) ! DEFGEN (FTELL, "FTELL", /* UNIX */ ! FFEINTRIN_specFTELL_subr, ! FFEINTRIN_specFTELL_func ! ) ! DEFGEN (GETCWD, "GETCWD", /* UNIX */ ! FFEINTRIN_specGETCWD_subr, ! FFEINTRIN_specGETCWD_func ! ) ! DEFGEN (HOSTNM, "HOSTNM", /* UNIX */ ! FFEINTRIN_specHOSTNM_subr, ! FFEINTRIN_specHOSTNM_func ! ) ! DEFGEN (IDATE, "IDATE", /* UNIX/VXT */ ! FFEINTRIN_specIDATE_unix, ! FFEINTRIN_specIDATE_vxt ! ) ! DEFGEN (KILL, "KILL", /* UNIX */ ! FFEINTRIN_specKILL_subr, ! FFEINTRIN_specKILL_func ! ) ! DEFGEN (LINK, "LINK", /* UNIX */ ! FFEINTRIN_specLINK_subr, ! FFEINTRIN_specLINK_func ! ) ! DEFGEN (LSTAT, "LSTAT", /* UNIX */ ! FFEINTRIN_specLSTAT_subr, ! FFEINTRIN_specLSTAT_func ! ) ! DEFGEN (RENAME, "RENAME", /* UNIX */ ! FFEINTRIN_specRENAME_subr, ! FFEINTRIN_specRENAME_func ! ) ! DEFGEN (SECOND, "SECOND", /* UNIX/CRAY */ ! FFEINTRIN_specSECOND_func, ! FFEINTRIN_specSECOND_subr ! ) ! DEFGEN (SIGNAL, "SIGNAL", /* UNIX */ ! FFEINTRIN_specSIGNAL_subr, ! FFEINTRIN_specSIGNAL_func ! ) ! DEFGEN (STAT, "STAT", /* UNIX */ ! FFEINTRIN_specSTAT_subr, ! FFEINTRIN_specSTAT_func ! ) ! DEFGEN (SYMLNK, "SYMLNK", /* UNIX */ ! FFEINTRIN_specSYMLNK_subr, ! FFEINTRIN_specSYMLNK_func ! ) ! DEFGEN (SYSTEM, "SYSTEM", /* UNIX */ ! FFEINTRIN_specSYSTEM_subr, ! FFEINTRIN_specSYSTEM_func ! ) ! DEFGEN (TIME, "TIME", /* UNIX/VXT */ ! FFEINTRIN_specTIME_unix, ! FFEINTRIN_specTIME_vxt ! ) ! DEFGEN (TTYNAM, "TTYNAM", /* UNIX/VXT */ ! FFEINTRIN_specTTYNAM_subr, ! FFEINTRIN_specTTYNAM_func ! ) ! DEFGEN (UMASK, "UMASK", /* UNIX */ ! FFEINTRIN_specUMASK_subr, ! FFEINTRIN_specUMASK_func ! ) ! DEFGEN (UNLINK, "UNLINK", /* UNIX */ ! FFEINTRIN_specUNLINK_subr, ! FFEINTRIN_specUNLINK_func ) DEFGEN (NONE, "none", *************** DEFSPEC (IFIX, *** 795,799 **** FALSE, FFEINTRIN_familyF77, ! FFEINTRIN_impINT ) DEFSPEC (INDEX, --- 903,907 ---- FALSE, FFEINTRIN_familyF77, ! FFEINTRIN_impIFIX ) DEFSPEC (INDEX, *************** DEFSPEC (AJMIN0, *** 1014,1017 **** --- 1122,1131 ---- FFEINTRIN_impNONE ) + DEFSPEC (ALARM, + "ALARM", + FALSE, + FFEINTRIN_familyF2U, + FFEINTRIN_impALARM + ) DEFSPEC (ALL, "ALL", *************** DEFSPEC (CEILING, *** 1164,1178 **** FFEINTRIN_impNONE ) ! DEFSPEC (CHDIR, ! "CHDIR", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impCHDIR ) ! DEFSPEC (CHMOD, ! "CHMOD", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impCHMOD ) DEFSPEC (COMPLEX, --- 1278,1304 ---- FFEINTRIN_impNONE ) ! DEFSPEC (CHDIR_func, ! "function", ! FALSE, ! FFEINTRIN_familyBADU77, ! FFEINTRIN_impCHDIR_func ! ) ! DEFSPEC (CHDIR_subr, ! "subroutine", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impCHDIR_subr ! ) ! DEFSPEC (CHMOD_func, ! "function", ! FALSE, ! FFEINTRIN_familyBADU77, ! FFEINTRIN_impCHMOD_func ) ! DEFSPEC (CHMOD_subr, ! "subroutine", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impCHMOD_subr ) DEFSPEC (COMPLEX, *************** DEFSPEC (CSHIFT, *** 1200,1208 **** FFEINTRIN_impNONE ) ! DEFSPEC (CTIME, ! "CTIME", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impCTIME ) DEFSPEC (DACOSD, --- 1326,1346 ---- FFEINTRIN_impNONE ) ! DEFSPEC (CPU_TIME, ! "CPU_TIME", ! FALSE, ! FFEINTRIN_familyF95, ! FFEINTRIN_impCPU_TIME ! ) ! DEFSPEC (CTIME_func, ! "function", ! FALSE, ! FFEINTRIN_familyF2U, ! FFEINTRIN_impCTIME_func ! ) ! DEFSPEC (CTIME_subr, ! "subroutine", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impCTIME_subr ) DEFSPEC (DACOSD, *************** DEFSPEC (DTAND, *** 1368,1376 **** FFEINTRIN_impNONE ) ! DEFSPEC (DTIME, ! "DTIME", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impDTIME ) DEFSPEC (EOSHIFT, --- 1506,1520 ---- FFEINTRIN_impNONE ) ! DEFSPEC (DTIME_func, ! "function", ! FALSE, ! FFEINTRIN_familyBADU77, ! FFEINTRIN_impDTIME_func ! ) ! DEFSPEC (DTIME_subr, ! "subroutine", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impDTIME_subr ) DEFSPEC (EOSHIFT, *************** DEFSPEC (ERFC, *** 1398,1406 **** FFEINTRIN_impERFC ) ! DEFSPEC (ETIME, ! "ETIME", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impETIME ) DEFSPEC (EXIT, --- 1542,1556 ---- FFEINTRIN_impERFC ) ! DEFSPEC (ETIME_func, ! "function", ! FALSE, ! FFEINTRIN_familyF2U, ! FFEINTRIN_impETIME_func ! ) ! DEFSPEC (ETIME_subr, ! "subroutine", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impETIME_subr ) DEFSPEC (EXIT, *************** DEFSPEC (EXPONENT, *** 1416,1430 **** FFEINTRIN_impNONE ) ! DEFSPEC (FDATE, ! "FDATE", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impFDATE ) ! DEFSPEC (FGETC, ! "FGETC", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impFGETC ) DEFSPEC (FLOATI, --- 1566,1604 ---- FFEINTRIN_impNONE ) ! DEFSPEC (FDATE_func, ! "function", ! FALSE, ! FFEINTRIN_familyF2U, ! FFEINTRIN_impFDATE_func ! ) ! DEFSPEC (FDATE_subr, ! "subroutine", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impFDATE_subr ! ) ! DEFSPEC (FGET_func, ! "function", ! FALSE, ! FFEINTRIN_familyBADU77, ! FFEINTRIN_impFGET_func ) ! DEFSPEC (FGET_subr, ! "subroutine", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impFGET_subr ! ) ! DEFSPEC (FGETC_func, ! "function", ! FALSE, ! FFEINTRIN_familyBADU77, ! FFEINTRIN_impFGETC_func ! ) ! DEFSPEC (FGETC_subr, ! "subroutine", ! FALSE, ! FFEINTRIN_familyF2U, ! FFEINTRIN_impFGETC_subr ) DEFSPEC (FLOATI, *************** DEFSPEC (FNUM, *** 1458,1466 **** FFEINTRIN_impFNUM ) ! DEFSPEC (FPUTC, ! "FPUTC", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impFPUTC ) DEFSPEC (FRACTION, --- 1632,1658 ---- FFEINTRIN_impFNUM ) ! DEFSPEC (FPUT_func, ! "function", ! FALSE, ! FFEINTRIN_familyBADU77, ! FFEINTRIN_impFPUT_func ! ) ! DEFSPEC (FPUT_subr, ! "subroutine", ! FALSE, ! FFEINTRIN_familyF2U, ! FFEINTRIN_impFPUT_subr ! ) ! DEFSPEC (FPUTC_func, ! "function", ! FALSE, ! FFEINTRIN_familyBADU77, ! FFEINTRIN_impFPUTC_func ! ) ! DEFSPEC (FPUTC_subr, ! "subroutine", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impFPUTC_subr ) DEFSPEC (FRACTION, *************** DEFSPEC (FSEEK, *** 1476,1490 **** FFEINTRIN_impFSEEK ) ! DEFSPEC (FSTAT, ! "FSTAT", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impFSTAT ) ! DEFSPEC (FTELL, ! "FTELL", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impFTELL ) DEFSPEC (GERROR, --- 1668,1694 ---- FFEINTRIN_impFSEEK ) ! DEFSPEC (FSTAT_func, ! "function", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impFSTAT_func ) ! DEFSPEC (FSTAT_subr, ! "subroutine", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impFSTAT_subr ! ) ! DEFSPEC (FTELL_func, ! "function", ! FALSE, ! FFEINTRIN_familyF2U, ! FFEINTRIN_impFTELL_func ! ) ! DEFSPEC (FTELL_subr, ! "subroutine", ! FALSE, ! FFEINTRIN_familyF2U, ! FFEINTRIN_impFTELL_subr ) DEFSPEC (GERROR, *************** DEFSPEC (GETARG, *** 1500,1508 **** FFEINTRIN_impGETARG ) ! DEFSPEC (GETCWD, ! "GETCWD", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impGETCWD ) DEFSPEC (GETENV, --- 1704,1718 ---- FFEINTRIN_impGETARG ) ! DEFSPEC (GETCWD_func, ! "function", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impGETCWD_func ! ) ! DEFSPEC (GETCWD_subr, ! "subroutine", ! FALSE, ! FFEINTRIN_familyF2U, ! FFEINTRIN_impGETCWD_subr ) DEFSPEC (GETENV, *************** DEFSPEC (GMTIME, *** 1542,1550 **** FFEINTRIN_impGMTIME ) ! DEFSPEC (HOSTNM, ! "HOSTNM", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impHOSTNM ) DEFSPEC (HUGE, --- 1752,1766 ---- FFEINTRIN_impGMTIME ) ! DEFSPEC (HOSTNM_func, ! "function", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impHOSTNM_func ! ) ! DEFSPEC (HOSTNM_subr, ! "subroutine", ! FALSE, ! FFEINTRIN_familyF2U, ! FFEINTRIN_impHOSTNM_subr ) DEFSPEC (HUGE, *************** DEFSPEC (IBSET, *** 1590,1604 **** FFEINTRIN_impIBSET ) ! DEFSPEC (IDATE, ! "IDATE (UNIX)", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impIDATE ) ! DEFSPEC (IDATEVXT, ! "IDATE (VXT)", FALSE, FFEINTRIN_familyVXT, ! FFEINTRIN_impIDATEVXT ) DEFSPEC (IEOR, --- 1806,1820 ---- FFEINTRIN_impIBSET ) ! DEFSPEC (IDATE_unix, ! "UNIX", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impIDATE_unix ) ! DEFSPEC (IDATE_vxt, ! "VXT", FALSE, FFEINTRIN_familyVXT, ! FFEINTRIN_impIDATE_vxt ) DEFSPEC (IEOR, *************** DEFSPEC (INOT, *** 1770,1773 **** --- 1986,2001 ---- FFEINTRIN_impNONE ) + DEFSPEC (INT2, + "INT2", + FALSE, + FFEINTRIN_familyGNU, + FFEINTRIN_impINT2 + ) + DEFSPEC (INT8, + "INT8", + FALSE, + FFEINTRIN_familyGNU, + FFEINTRIN_impINT8 + ) DEFSPEC (IOR, "IOR", *************** DEFSPEC (JZEXT, *** 1962,1970 **** FFEINTRIN_impNONE ) ! DEFSPEC (KILL, ! "KILL", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impKILL ) DEFSPEC (KIND, --- 2190,2204 ---- FFEINTRIN_impNONE ) ! DEFSPEC (KILL_func, ! "function", ! FALSE, ! FFEINTRIN_familyBADU77, ! FFEINTRIN_impKILL_func ! ) ! DEFSPEC (KILL_subr, ! "subroutine", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impKILL_subr ) DEFSPEC (KIND, *************** DEFSPEC (LBOUND, *** 1980,1988 **** FFEINTRIN_impNONE ) ! DEFSPEC (LINK, ! "LINK", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impLINK ) DEFSPEC (LEN_TRIM, --- 2214,2228 ---- FFEINTRIN_impNONE ) ! DEFSPEC (LINK_func, ! "function", ! FALSE, ! FFEINTRIN_familyBADU77, ! FFEINTRIN_impLINK_func ! ) ! DEFSPEC (LINK_subr, ! "subroutine", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impLINK_subr ) DEFSPEC (LEN_TRIM, *************** DEFSPEC (LSHIFT, *** 2022,2030 **** FFEINTRIN_impLSHIFT ) ! DEFSPEC (LSTAT, ! "LSTAT", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impLSTAT ) DEFSPEC (LTIME, --- 2262,2276 ---- FFEINTRIN_impLSHIFT ) ! DEFSPEC (LSTAT_func, ! "function", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impLSTAT_func ! ) ! DEFSPEC (LSTAT_subr, ! "subroutine", ! FALSE, ! FFEINTRIN_familyF2U, ! FFEINTRIN_impLSTAT_subr ) DEFSPEC (LTIME, *************** DEFSPEC (MCLOCK, *** 2064,2067 **** --- 2310,2319 ---- FFEINTRIN_impMCLOCK ) + DEFSPEC (MCLOCK8, + "MCLOCK8", + FALSE, + FFEINTRIN_familyF2U, + FFEINTRIN_impMCLOCK8 + ) DEFSPEC (MERGE, "MERGE", *************** DEFSPEC (REALPART, *** 2376,2384 **** FFEINTRIN_impREALPART ) ! DEFSPEC (RENAME, ! "RENAME", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impRENAME ) DEFSPEC (REPEAT, --- 2628,2642 ---- FFEINTRIN_impREALPART ) ! DEFSPEC (RENAME_func, ! "function", ! FALSE, ! FFEINTRIN_familyBADU77, ! FFEINTRIN_impRENAME_func ! ) ! DEFSPEC (RENAME_subr, ! "subroutine", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impRENAME_subr ) DEFSPEC (REPEAT, *************** DEFSPEC (SECNDS, *** 2424,2438 **** FFEINTRIN_impSECNDS ) ! DEFSPEC (SECONDFUNC, ! "SECOND (function)", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impSECONDFUNC ) ! DEFSPEC (SECONDSUBR, ! "SECOND (subroutine)", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impSECONDSUBR ) DEFSPEC (SEL_INT_KIND, --- 2682,2696 ---- FFEINTRIN_impSECNDS ) ! DEFSPEC (SECOND_func, ! "function", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impSECOND_func ) ! DEFSPEC (SECOND_subr, ! "subroutine", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impSECOND_subr ) DEFSPEC (SEL_INT_KIND, *************** DEFSPEC (SHORT, *** 2466,2474 **** FFEINTRIN_impSHORT ) ! DEFSPEC (SIGNAL, ! "SIGNAL", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impSIGNAL ) DEFSPEC (SIND, --- 2724,2738 ---- FFEINTRIN_impSHORT ) ! DEFSPEC (SIGNAL_func, ! "function", ! FALSE, ! FFEINTRIN_familyBADU77, ! FFEINTRIN_impSIGNAL_func ! ) ! DEFSPEC (SIGNAL_subr, ! "subroutine", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impSIGNAL_subr ) DEFSPEC (SIND, *************** DEFSPEC (SRAND, *** 2508,2516 **** FFEINTRIN_impSRAND ) ! DEFSPEC (STAT, ! "STAT", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impSTAT ) DEFSPEC (SUM, --- 2772,2786 ---- FFEINTRIN_impSRAND ) ! DEFSPEC (STAT_func, ! "function", ! FALSE, ! FFEINTRIN_familyF2U, ! FFEINTRIN_impSTAT_func ! ) ! DEFSPEC (STAT_subr, ! "subroutine", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impSTAT_subr ) DEFSPEC (SUM, *************** DEFSPEC (SUM, *** 2520,2534 **** FFEINTRIN_impNONE ) ! DEFSPEC (SYMLNK, ! "SYMLNK", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impSYMLNK ) ! DEFSPEC (SYSTEM, ! "SYSTEM", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impSYSTEM ) DEFSPEC (SYSTEM_CLOCK, --- 2790,2816 ---- FFEINTRIN_impNONE ) ! DEFSPEC (SYMLNK_func, ! "function", ! FALSE, ! FFEINTRIN_familyBADU77, ! FFEINTRIN_impSYMLNK_func ! ) ! DEFSPEC (SYMLNK_subr, ! "subroutine", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impSYMLNK_subr ) ! DEFSPEC (SYSTEM_func, ! "function", ! FALSE, ! FFEINTRIN_familyBADU77, ! FFEINTRIN_impSYSTEM_func ! ) ! DEFSPEC (SYSTEM_subr, ! "subroutine", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impSYSTEM_subr ) DEFSPEC (SYSTEM_CLOCK, *************** DEFSPEC (TAND, *** 2544,2558 **** FFEINTRIN_impNONE ) ! DEFSPEC (TIME, ! "TIME (UNIX)", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impTIME ) ! DEFSPEC (TIMEVXT, ! "TIME (VXT)", FALSE, FFEINTRIN_familyVXT, ! FFEINTRIN_impTIMEVXT ) DEFSPEC (TINY, --- 2826,2846 ---- FFEINTRIN_impNONE ) ! DEFSPEC (TIME8, ! "UNIX", ! FALSE, ! FFEINTRIN_familyF2U, ! FFEINTRIN_impTIME8 ! ) ! DEFSPEC (TIME_unix, ! "UNIX", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impTIME_unix ) ! DEFSPEC (TIME_vxt, ! "VXT", FALSE, FFEINTRIN_familyVXT, ! FFEINTRIN_impTIME_vxt ) DEFSPEC (TINY, *************** DEFSPEC (TRIM, *** 2580,2588 **** FFEINTRIN_impNONE ) ! DEFSPEC (TTYNAM, ! "TTYNAM", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impTTYNAM ) DEFSPEC (UBOUND, --- 2868,2882 ---- FFEINTRIN_impNONE ) ! DEFSPEC (TTYNAM_func, ! "function", ! FALSE, ! FFEINTRIN_familyF2U, ! FFEINTRIN_impTTYNAM_func ! ) ! DEFSPEC (TTYNAM_subr, ! "subroutine", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impTTYNAM_subr ) DEFSPEC (UBOUND, *************** DEFSPEC (UBOUND, *** 2592,2606 **** FFEINTRIN_impNONE ) ! DEFSPEC (UMASK, ! "UMASK", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impUMASK ) ! DEFSPEC (UNLINK, ! "UNLINK", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impUNLINK ) DEFSPEC (UNPACK, --- 2886,2912 ---- FFEINTRIN_impNONE ) ! DEFSPEC (UMASK_func, ! "function", ! FALSE, ! FFEINTRIN_familyBADU77, ! FFEINTRIN_impUMASK_func ! ) ! DEFSPEC (UMASK_subr, ! "subroutine", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impUMASK_subr ! ) ! DEFSPEC (UNLINK_func, ! "function", ! FALSE, ! FFEINTRIN_familyBADU77, ! FFEINTRIN_impUNLINK_func ) ! DEFSPEC (UNLINK_subr, ! "subroutine", FALSE, FFEINTRIN_familyF2U, ! FFEINTRIN_impUNLINK_subr ) DEFSPEC (UNPACK, *************** DEFSPEC (NONE, *** 2673,2700 **** /* Intrinsic implementations ordered in two sections: F77, then extensions; secondarily, alphabetical ! ordering. ! This list corresponds to actual implementations ! of specific intrinsics, so there is no redundancy -- e.g. instead ! of FLOAT and REAL, there is only _REAL_I. We use this non- ! redundancy when determining which specific intrinsic is meant ! by a generic -- REAL(I) can match either specific REAL or FLOAT, ! but rather than complain about that, we see that the implementations ! are the same. This approach should allow lots of extensions in ! the form of possibly conflicting intrinsic sets with complaints ! arising only when those sets are enabled and the potentially ! conflicting intrinsics are actually referenced. ! ! DEFIMQ defines an implementation that, while it might be implemented ! differently at run time, is implemented by the same code at compile ! time, and that code handles checking various possible inputs. So, ! no need to complain about ambiguity if two different-typed intrinsic ! run-time implementations have the same compile-time implementation, ! as long as there's a straightforward way of determining which was ! meant (done by ffeintrin_fulfill_generic). (Here `the same code at ! compile time' may be the default dispatch defined by the ! DEFIMP/DEFIMQ signatures -- see com.c.) Fixme: Note that ! currently, DEFIMQs have to be a subroutine or function to match ! what the corresponding DEFIMP of the same name is. */ /* The control string has the following format: --- 2979,3011 ---- /* Intrinsic implementations ordered in two sections: F77, then extensions; secondarily, alphabetical ! ordering. */ ! ! /* The DEFIMP macro specifies the following fields for an intrinsic: ! ! CODE -- The internal name for this intrinsic; `FFEINTRIN_imp' ! prepends this to form the `enum' name. ! ! NAME -- The textual name to use when printing information on ! this intrinsic. ! GFRTDIRECT -- The run-time library routine that is suitable for ! a call to implement a *direct* invocation of the ! intrinsic (e.g. `ABS(10)'). ! ! GFRTF2C -- The run-time library routine that is suitable for ! passing as an argument to a procedure that will ! invoke the argument as an EXTERNAL procedure, when ! f2c calling conventions will be used (e.g. ! `CALL FOO(ABS)', when FOO compiled with -ff2c). ! ! GFRTGNU -- The run-time library routine that is suitable for ! passing as an argument to a procedure that will ! invoke the argument as an EXTERNAL procedure, when ! GNU calling conventions will be used (e.g. ! `CALL FOO(ABS)', when FOO compiled with -fno-f2c). ! ! CONTROL -- A control string, described below. ! ! */ /* The control string has the following format: *************** DEFSPEC (NONE, *** 2808,3073 **** */ ! DEFIMP (ABS, "ABS", ABS, "S=:0:A=N*") ! DEFIMP (ACOS, "ACOS", ACOS, "R=:0:X=R*") ! DEFIMP (AIMAG, "AIMAG", AIMAG, "RC:0:Z=C*") ! DEFIMP (AINT, "AINT", AINT, "R=:0:A=R*") ! DEFIMQ (ALOG, "ALOG", ALOG, "R1:-:X=R1", ! LOG) ! DEFIMQ (ALOG10, "ALOG10", ALOG10, "R1:-:X=R1", ! LOG10) ! DEFIMQ (AMAX0, "AMAX0", , "R1:*:A=pI1", ! MAX) ! DEFIMQ (AMAX1, "AMAX1", , "R1:*:A=pR1", ! MAX) ! DEFIMQ (AMIN0, "AMIN0", , "R1:*:A=pI1", ! MIN) ! DEFIMQ (AMIN1, "AMIN1", , "R1:*:A=pR1", ! MIN) ! DEFIMQ (AMOD, "AMOD", AMOD, "R1:*:A=R1,P=R1", ! MOD) ! DEFIMP (ANINT, "ANINT", ANINT, "R=:0:A=R*") ! DEFIMP (ASIN, "ASIN", ASIN, "R=:0:X=R*") ! DEFIMP (ATAN, "ATAN", ATAN, "R=:0:X=R*") ! DEFIMP (ATAN2, "ATAN2", ATAN2, "R=:*:Y=R*,X=R*") ! DEFIMQ (CABS, "CABS", CABS, "R1:-:A=C1", ! ABS) ! DEFIMQ (CCOS, "CCOS", CCOS, "C1:-:X=C1", ! COS) ! DEFIMQ (CEXP, "CEXP", CEXP, "C1:-:X=C1", ! EXP) ! DEFIMP (CHAR, "CHAR", , "A1:-:I=I*") ! DEFIMQ (CLOG, "CLOG", CLOG, "C1:-:X=C1", ! LOG) ! DEFIMP (CMPLX, "CMPLX", , "C1:*:X=N*,Y=!S*") ! DEFIMP (CONJG, "CONJG", CONJG, "C=:0:Z=C*") ! DEFIMP (COS, "COS", COS, "F=:0:X=F*") ! DEFIMP (COSH, "COSH", COSH, "R=:0:X=R*") ! DEFIMQ (CSIN, "CSIN", CSIN, "C1:-:X=C1", ! SIN) ! DEFIMQ (CSQRT, "CSQRT", CSQRT, "C1:-:X=C1", ! SQRT) ! DEFIMQ (DABS, "DABS", DABS, "R2:-:A=R2", ! ABS) ! DEFIMQ (DACOS, "DACOS", DACOS, "R2:-:X=R2", ! ACOS) ! DEFIMQ (DASIN, "DASIN", DASIN, "R2:-:X=R2", ! ASIN) ! DEFIMQ (DATAN, "DATAN", DATAN, "R2:-:X=R2", ! ATAN) ! DEFIMQ (DATAN2, "DATAN2", DATAN2, "R2:*:Y=R2,X=R2", ! ATAN2) ! DEFIMP (DBLE, "DBLE", , "R2:-:A=N*") ! DEFIMQ (DCMPLX, "DCMPLX", , "C2:*:X=N*,Y=!S*", ! CMPLX) ! DEFIMQ (DCOS, "DCOS", DCOS, "R2:-:X=R2", ! COS) ! DEFIMQ (DCOSH, "DCOSH", DCOSH, "R2:-:X=R2", ! COSH) ! DEFIMQ (DDIM, "DDIM", DDIM, "R2:*:X=R2,Y=R2", ! DIM) ! DEFIMQ (DEXP, "DEXP", DEXP, "R2:-:X=R2", ! EXP) ! DEFIMP (DIM, "DIM", DIM, "S=:*:X=S*,Y=S*") ! DEFIMQ (DINT, "DINT", DINT, "R2:-:A=R2", ! AINT) ! DEFIMQ (DLOG, "DLOG", DLOG, "R2:-:X=R2", ! LOG) ! DEFIMQ (DLOG10, "DLOG10", DLOG10, "R2:-:X=R2", ! LOG10) ! DEFIMQ (DMAX1, "DMAX1", , "R2:*:A=pR2", ! MAX) ! DEFIMQ (DMIN1, "DMIN1", , "R2:*:A=pR2", ! MIN) ! DEFIMQ (DMOD, "DMOD", DMOD, "R2:*:A=R2,P=R2", ! MOD) ! DEFIMQ (DNINT, "DNINT", DNINT, "R2:-:A=R2", ! ANINT) ! DEFIMP (DPROD, "DPROD", DPROD, "R2:*:X=R1,Y=R1") ! DEFIMQ (DSIGN, "DSIGN", DSIGN, "R2:*:A=R2,B=R2", ! SIGN) ! DEFIMQ (DSIN, "DSIN", DSIN, "R2:-:X=R2", ! SIN) ! DEFIMQ (DSINH, "DSINH", DSINH, "R2:-:X=R2", ! SINH) ! DEFIMQ (DSQRT, "DSQRT", DSQRT, "R2:-:X=R2", ! SQRT) ! DEFIMQ (DTAN, "DTAN", DTAN, "R2:-:X=R2", ! TAN) ! DEFIMQ (DTANH, "DTANH", DTANH, "R2:-:X=R2", ! TANH) ! DEFIMP (EXP, "EXP", EXP, "F=:0:X=F*") ! DEFIMQ (FLOAT, "FLOAT", , "R1:-:A=I*", ! REAL) ! DEFIMQ (IABS, "IABS", IABS, "I1:-:A=I1", ! ABS) ! DEFIMP (ICHAR, "ICHAR", , "I1:-:C=A*") ! DEFIMQ (IDIM, "IDIM", IDIM, "I1:*:X=I1,Y=I1", ! DIM) ! DEFIMQ (IDINT, "IDINT", , "I1:-:A=R2", ! INT) ! DEFIMQ (IDNINT, "IDNINT", IDNINT, "I1:-:A=R2", ! NINT) ! DEFIMP (INDEX, "INDEX", INDEX, "I1:*:String=A*,Substring=A*") ! DEFIMP (INT, "INT", , "I1:-:A=N*") ! DEFIMQ (ISIGN, "ISIGN", ISIGN, "I1:*:A=I1,B=I1", ! SIGN) ! DEFIMP (LEN, "LEN", LEN, "I1:-:String=A*i") ! DEFIMP (LGE, "LGE", LGE, "L1:*:String_A=A1,String_B=A1") ! DEFIMP (LGT, "LGT", LGT, "L1:*:String_A=A1,String_B=A1") ! DEFIMP (LLE, "LLE", LLE, "L1:*:String_A=A1,String_B=A1") ! DEFIMP (LLT, "LLT", LLT, "L1:*:String_A=A1,String_B=A1") ! DEFIMP (LOG, "LOG", , "F=:0:X=F*") ! DEFIMP (LOG10, "LOG10", , "R=:0:X=R*") ! DEFIMP (LONG, "LONG", , "I1:-:A=I*") ! DEFIMP (MAX, "MAX", , "S=:*:A=pS*") ! DEFIMP (MIN, "MIN", , "S=:*:A=pS*") ! DEFIMQ (MAX0, "MAX0", , "I1:*:A=pI1", ! MAX) ! DEFIMQ (MAX1, "MAX1", , "I1:*:A=pR1", ! MAX) ! DEFIMQ (MIN0, "MIN0", , "I1:*:A=pI1", ! MIN) ! DEFIMQ (MIN1, "MIN1", , "I1:*:A=pR1", ! MIN) ! DEFIMP (MOD, "MOD", MOD, "S=:*:A=S*,P=S*") ! DEFIMP (NINT, "NINT", NINT, "I1:-:A=R*") ! DEFIMP (REAL, "REAL", , "RC:0:A=N*") ! DEFIMP (SIGN, "SIGN", SIGN, "S=:*:A=S*,B=S*") ! DEFIMP (SIN, "SIN", SIN, "F=:0:X=F*") ! DEFIMP (SINH, "SINH", SINH, "R=:0:X=R*") ! DEFIMQ (SNGL, "SNGL", , "R1:-:A=R2", ! REAL) ! DEFIMP (SQRT, "SQRT", SQRT, "F=:0:X=F*") ! DEFIMP (TAN, "TAN", TAN, "R=:0:X=R*") ! DEFIMP (TANH, "TANH", TANH, "R=:0:X=R*") ! ! DEFIMP (ABORT, "ABORT", ABORT, "--:-:") ! DEFIMP (ACCESS, "ACCESS", ACCESS, "I1:-:Name=A1,Mode=A1") ! DEFIMP (ACHAR, "ACHAR", , "A1:-:I=I*") ! DEFIMP (AND, "AND", , "B=:*:I=B*,J=B*") ! DEFIMP (BESJ0, "BESJ0", BESJ0, "R=:0:X=R*") ! DEFIMP (BESJ1, "BESJ1", BESJ1, "R=:0:X=R*") ! DEFIMP (BESJN, "BESJN", BESJN, "R=:1:N=I*,X=R*") ! DEFIMP (BESY0, "BESY0", BESY0, "R=:0:X=R*") ! DEFIMP (BESY1, "BESY1", BESY1, "R=:0:X=R*") ! DEFIMP (BESYN, "BESYN", BESYN, "R=:1:N=I*,X=R*") ! DEFIMP (BIT_SIZE, "BIT_SIZE", , "I=:0:I=I*i") ! DEFIMP (BTEST, "BTEST", , "L1:*:I=I*,Pos=I*") ! DEFIMQ (CDABS, "CDABS", CDABS, "R2:-:A=C2", ! ABS) ! DEFIMQ (CDCOS, "CDCOS", CDCOS, "C2:-:X=C2", ! COS) ! DEFIMQ (CDEXP, "CDEXP", CDEXP, "C2:-:X=C2", ! EXP) ! DEFIMQ (CDLOG, "CDLOG", CDLOG, "C2:-:X=C2", ! LOG) ! DEFIMQ (CDSIN, "CDSIN", CDSIN, "C2:-:X=C2", ! SIN) ! DEFIMQ (CDSQRT, "CDSQRT", CDSQRT, "C2:-:X=C2", ! SQRT) ! DEFIMP (CHDIR, "CHDIR", CHDIR, "--:-:Dir=A1,Status=?I1w") ! DEFIMP (CHMOD, "CHMOD", CHMOD, "--:-:Name=A1,Mode=A1,Status=?I*w") ! DEFIMP (COMPLEX, "COMPLEX", , "C=:*:Real=S*,Imag=S*") ! DEFIMP (CTIME, "CTIME", CTIME, "A1*:-:STime=I2") ! DEFIMP (DATE, "DATE", DATE, "--:-:Date=A1w") ! DEFIMQ (DBESJ0, "DBESJ0", DBESJ0, "R2:-:X=R2", ! BESJ0) ! DEFIMQ (DBESJ1, "DBESJ1", DBESJ1, "R2:-:X=R2", ! BESJ1) ! DEFIMQ (DBESJN, "DBESJN", DBESJN, "R2:-:N=I*,X=R2", ! BESJN) ! DEFIMQ (DBESY0, "DBESY0", DBESY0, "R2:-:X=R2", ! BESY0) ! DEFIMQ (DBESY1, "DBESY1", DBESY1, "R2:-:X=R2", ! BESY1) ! DEFIMQ (DBESYN, "DBESYN", DBESYN, "R2:-:N=I*,X=R2", ! BESYN) ! DEFIMQ (DCONJG, "DCONJG", DCONJG, "C2:-:Z=C2", ! CONJG) ! DEFIMQ (DERF, "DERF", DERF, "R2:-:X=R2", ! ERF) ! DEFIMQ (DERFC, "DERFC", DERFC, "R2:-:X=R2", ! ERFC) ! DEFIMQ (DFLOAT, "DFLOAT", , "R2:-:A=I*", ! REAL) ! DEFIMQ (DIMAG, "DIMAG", DIMAG, "R2:-:Z=C2", ! AIMAG) ! DEFIMQ (DREAL, "DREAL", , "R2:-:A=N*", ! REAL) ! DEFIMP (DTIME, "DTIME", DTIME, "R1:-:TArray=R1(2)w") ! DEFIMP (ERF, "ERF", ERF, "R=:0:X=R*") ! DEFIMP (ERFC, "ERFC", ERFC, "R=:0:X=R*") ! DEFIMP (ETIME, "ETIME", ETIME, "R1:-:TArray=R1(2)w") ! DEFIMP (EXIT, "EXIT", EXIT, "--:-:Status=?I*") ! DEFIMP (FDATE, "FDATE", FDATE, "A1*:-:") ! DEFIMP (FGET, "FGET", FGET, "--:-:C=A1w,Status=?I*w") ! DEFIMP (FGETC, "FGETC", FGETC, "--:-:Unit=I*,C=A1w,Status=I*w") ! DEFIMP (FLUSH, "FLUSH", FLUSH, "--:-:Unit=?I*") ! DEFIMP (FNUM, "FNUM", FNUM, "I1:-:Unit=I*") ! DEFIMP (FPUT, "FPUT", FPUT, "--:-:C=A1,Status=?I*w") ! DEFIMP (FPUTC, "FPUTC", FPUTC, "--:-:Unit=I*,C=A1,Status=I*w") ! DEFIMP (FSEEK, "FSEEK", FSEEK, "--:-:Unit=I*,Offset=I*,Whence=I*,ErrLab=?g*") ! DEFIMP (FSTAT, "FSTAT", FSTAT, "I1:-:Unit=I*,SArray=I1(13)w") ! DEFIMP (FTELL, "FTELL", FTELL, "I1:-:Unit=I*") ! DEFIMP (GERROR, "GERROR", GERROR, "--:-:Message=A1w") ! DEFIMP (GETARG, "GETARG", GETARG, "--:-:Pos=I*,Value=A1w") ! DEFIMP (GETCWD, "GETCWD", GETCWD, "I1:-:Name=A1w") ! DEFIMP (GETGID, "GETGID", GETGID, "I1:-:") ! DEFIMP (GETLOG, "GETLOG", GETLOG, "--:-:Login=A1w") ! DEFIMP (GETPID, "GETPID", GETPID, "I1:-:") ! DEFIMP (GETUID, "GETUID", GETUID, "I1:-:") ! DEFIMP (GETENV, "GETENV", GETENV, "--:-:Name=A1,Value=A1w") ! DEFIMP (GMTIME, "GMTIME", GMTIME, "--:-:STime=I1,TArray=I1(9)w") ! DEFIMP (HOSTNM, "HOSTNM", HOSTNM, "I1:-:Name=A1w") ! DEFIMP (IACHAR, "IACHAR", , "I1:-:C=A*") ! DEFIMP (IAND, "IAND", , "I=:*:I=I*,J=I*") ! DEFIMP (IARGC, "IARGC", IARGC, "I1:-:") ! DEFIMP (IBCLR, "IBCLR", , "I=:0:I=I*,Pos=I*") ! DEFIMP (IBITS, "IBITS", , "I=:0:I=I*,Pos=I*,Len=I*") ! DEFIMP (IBSET, "IBSET", , "I=:0:I=I*,Pos=I*") ! DEFIMP (IDATE, "IDATE (UNIX)", IDATE, "--:-:TArray=I1(3)w") ! DEFIMP (IDATEVXT, "IDATE (VXT)", VXTIDATE, "--:-:D=I1w,M=I1w,Y=I1w") ! DEFIMP (IEOR, "IEOR", , "I=:*:I=I*,J=I*") ! DEFIMP (IOR, "IOR", , "I=:*:I=I*,J=I*") ! DEFIMP (IERRNO, "IERRNO", IERRNO, "I1:-:") ! DEFIMQ (IMAGPART, "IMAGPART", , "R=:0:Z=C*", ! AIMAG) ! DEFIMP (IRAND, "IRAND", IRAND, "I1:-:Flag=?I*") ! DEFIMP (ISATTY, "ISATTY", ISATTY, "L1:-:Unit=I*") ! DEFIMP (ISHFT, "ISHFT", , "I=:0:I=I*,Shift=I*") ! DEFIMP (ISHFTC, "ISHFTC", , "I=:0:I=I*,Shift=I*,Size=I*") ! DEFIMP (ITIME, "ITIME", ITIME, "--:-:TArray=I1(3)w") ! DEFIMP (KILL, "KILL", KILL, "--:-:Pid=I*,Signal=I*,Status=?I*w") ! DEFIMP (LINK, "LINK", LINK, "--:-:Path1=A1,Path2=A1,Status=?I*w") ! DEFIMP (LNBLNK, "LNBLNK", LNBLNK, "I1:-:String=A1") ! DEFIMP (LSTAT, "LSTAT", LSTAT, "I1:-:File=A1,SArray=I1(13)w") ! DEFIMP (LTIME, "LTIME", LTIME, "--:-:STime=I1,TArray=I1(9)w") ! DEFIMP (LOC, "LOC", , "Ip:-:Entity=-*&&") ! DEFIMP (LSHIFT, "LSHIFT", , "I=:0:I=I*,Shift=I*") ! DEFIMP (MCLOCK, "MCLOCK", MCLOCK, "I2:-:") ! DEFIMP (MVBITS, "MVBITS", , "--:-:From=I*,FromPos=I*,Len=I*,TO=IAx,ToPos=I*") ! DEFIMP (NOT, "NOT", , "I=:0:I=I*") ! DEFIMP (OR, "OR", , "B=:*:I=B*,J=B*") ! DEFIMP (PERROR, "PERROR", PERROR, "--:-:String=A1") ! DEFIMP (RAND, "RAND", RAND, "R1:-:Flag=?I*") ! DEFIMP (REALPART, "REALPART", , "R=:0:Z=C*") ! DEFIMP (RENAME, "RENAME", RENAME, "--:-:Path1=A1,Path2=A1,Status=?I*w") ! DEFIMP (RSHIFT, "RSHIFT", , "I=:0:I=I*,Shift=I*") ! DEFIMP (SECNDS, "SECNDS", SECNDS, "R1:-:T=R1") ! DEFIMP (SECONDFUNC, "SECOND (function)", SECOND, "R1:-:") ! DEFIMP (SECONDSUBR, "SECOND (subroutine)", SECOND, "--:-:Seconds=R1w") ! DEFIMP (SHORT, "SHORT", , "I6:-:A=I*") ! DEFIMP (SIGNAL, "SIGNAL", , "--:-:Number=I*,Handler=s*") ! DEFIMP (SLEEP, "SLEEP", SLEEP, "--:-:Seconds=I1") ! DEFIMP (SRAND, "SRAND", SRAND, "--:-:Seed=I*") ! DEFIMP (STAT, "STAT", STAT, "I1:-:File=A1,SArray=I1(13)w") ! DEFIMP (SYMLNK, "SYMLNK", SYMLNK, "--:-:Path1=A1,Path2=A1,Status=?I*w") ! DEFIMP (SYSTEM, "SYSTEM", SYSTEM, "--:-:Command=A1,Status=?I1") ! DEFIMP (SYSTEM_CLOCK, "SYSTEM_CLOCK", SYSTEM_CLOCK, "--:-:Count=I1w,Rate=I1w,Max=I1w") ! DEFIMP (TIME, "TIME (UNIX)", TIME, "I2:-:") ! DEFIMP (TIMEVXT, "TIME (VXT)", VXTTIME, "--:-:Time=A1[8]w") ! DEFIMP (TTYNAM, "TTYNAM", TTYNAM, "A1*:-:Unit=I*") ! DEFIMP (UMASK, "UMASK", UMASK, "--:-:Mask=I*,Old=?I*w") ! DEFIMP (UNLINK, "UNLINK", UNLINK, "--:-:File=A1,Status=?I1w") ! DEFIMP (XOR, "XOR", , "B=:*:I=B*,J=B*") ! DEFIMP (NONE, "none", , "") --- 3119,3350 ---- */ ! DEFIMP (ABS, "ABS", ,ABS,, "S=:0:A=N*") ! DEFIMP (ACOS, "ACOS", L_ACOS,ACOS,, "R=:0:X=R*") ! DEFIMP (AIMAG, "AIMAG", ,AIMAG,, "RC:0:Z=C*") ! DEFIMP (AINT, "AINT", ,AINT,, "R=:0:A=R*") ! DEFIMP (ALOG, "ALOG", L_LOG,ALOG,, "R1:-:X=R1") ! DEFIMP (ALOG10, "ALOG10", ,ALOG10,, "R1:-:X=R1") ! DEFIMP (AMAX0, "AMAX0", ,,, "R1:*:A=pI1") ! DEFIMP (AMAX1, "AMAX1", ,,, "R1:*:A=pR1") ! DEFIMP (AMIN0, "AMIN0", ,,, "R1:*:A=pI1") ! DEFIMP (AMIN1, "AMIN1", ,,, "R1:*:A=pR1") ! DEFIMP (AMOD, "AMOD", ,AMOD,, "R1:*:A=R1,P=R1") ! DEFIMP (ANINT, "ANINT", ,ANINT,, "R=:0:A=R*") ! DEFIMP (ASIN, "ASIN", L_ASIN,ASIN,, "R=:0:X=R*") ! DEFIMP (ATAN, "ATAN", L_ATAN,ATAN,, "R=:0:X=R*") ! DEFIMP (ATAN2, "ATAN2", L_ATAN2,ATAN2,, "R=:*:Y=R*,X=R*") ! DEFIMP (CABS, "CABS", ,CABS,, "R1:-:A=C1") ! DEFIMP (CCOS, "CCOS", ,CCOS,, "C1:-:X=C1") ! DEFIMP (CEXP, "CEXP", ,CEXP,, "C1:-:X=C1") ! DEFIMP (CHAR, "CHAR", ,,, "A1:-:I=I*") ! DEFIMP (CLOG, "CLOG", ,CLOG,, "C1:-:X=C1") ! DEFIMP (CMPLX, "CMPLX", ,,, "C1:*:X=N*,Y=!S*") ! DEFIMP (CONJG, "CONJG", ,CONJG,, "C=:0:Z=C*") ! DEFIMP (COS, "COS", L_COS,COS,, "F=:0:X=F*") ! DEFIMP (COSH, "COSH", L_COSH,COSH,, "R=:0:X=R*") ! DEFIMP (CSIN, "CSIN", ,CSIN,, "C1:-:X=C1") ! DEFIMP (CSQRT, "CSQRT", ,CSQRT,, "C1:-:X=C1") ! DEFIMP (DABS, "DABS", ,DABS,, "R2:-:A=R2") ! DEFIMP (DACOS, "DACOS", L_ACOS,DACOS,, "R2:-:X=R2") ! DEFIMP (DASIN, "DASIN", L_ASIN,DASIN,, "R2:-:X=R2") ! DEFIMP (DATAN, "DATAN", L_ATAN,DATAN,, "R2:-:X=R2") ! DEFIMP (DATAN2, "DATAN2", L_ATAN2,DATAN2,,"R2:*:Y=R2,X=R2") ! DEFIMP (DBLE, "DBLE", ,,, "R2:-:A=N*") ! DEFIMP (DCMPLX, "DCMPLX", ,,, "C2:*:X=N*,Y=!S*") ! DEFIMP (DCOS, "DCOS", L_COS,DCOS,, "R2:-:X=R2") ! DEFIMP (DCOSH, "DCOSH", L_COSH,DCOSH,, "R2:-:X=R2") ! DEFIMP (DDIM, "DDIM", ,DDIM,, "R2:*:X=R2,Y=R2") ! DEFIMP (DEXP, "DEXP", L_EXP,DEXP,, "R2:-:X=R2") ! DEFIMP (DIM, "DIM", ,DIM,, "S=:*:X=S*,Y=S*") ! DEFIMP (DINT, "DINT", ,DINT,, "R2:-:A=R2") ! DEFIMP (DLOG, "DLOG", L_LOG,DLOG,, "R2:-:X=R2") ! DEFIMP (DLOG10, "DLOG10", ,DLOG10,, "R2:-:X=R2") ! DEFIMP (DMAX1, "DMAX1", ,,, "R2:*:A=pR2") ! DEFIMP (DMIN1, "DMIN1", ,,, "R2:*:A=pR2") ! DEFIMP (DMOD, "DMOD", ,DMOD,, "R2:*:A=R2,P=R2") ! DEFIMP (DNINT, "DNINT", ,DNINT,, "R2:-:A=R2") ! DEFIMP (DPROD, "DPROD", ,DPROD,, "R2:*:X=R1,Y=R1") ! DEFIMP (DSIGN, "DSIGN", ,DSIGN,, "R2:*:A=R2,B=R2") ! DEFIMP (DSIN, "DSIN", L_SIN,DSIN,, "R2:-:X=R2") ! DEFIMP (DSINH, "DSINH", L_SINH,DSINH,, "R2:-:X=R2") ! DEFIMP (DSQRT, "DSQRT", L_SQRT,DSQRT,, "R2:-:X=R2") ! DEFIMP (DTAN, "DTAN", L_TAN,DTAN,, "R2:-:X=R2") ! DEFIMP (DTANH, "DTANH", L_TANH,DTANH,, "R2:-:X=R2") ! DEFIMP (EXP, "EXP", L_EXP,EXP,, "F=:0:X=F*") ! DEFIMP (FLOAT, "FLOAT", ,,, "R1:-:A=I*") ! DEFIMP (IABS, "IABS", ,IABS,IABS, "I1:-:A=I1") ! DEFIMP (ICHAR, "ICHAR", ,,, "I1:-:C=A*") ! DEFIMP (IDIM, "IDIM", ,IDIM,IDIM, "I1:*:X=I1,Y=I1") ! DEFIMP (IDINT, "IDINT", ,,, "I1:-:A=R2") ! DEFIMP (IDNINT, "IDNINT", ,IDNINT,IDNINT, "I1:-:A=R2") ! DEFIMP (IFIX, "IFIX", ,,, "I1:-:A=R1") ! DEFIMP (INDEX, "INDEX", ,INDEX,INDEX, "I1:*:String=A*,Substring=A*") ! DEFIMP (INT, "INT", ,,, "I1:-:A=N*") ! DEFIMP (ISIGN, "ISIGN", ,ISIGN,ISIGN, "I1:*:A=I1,B=I1") ! DEFIMP (LEN, "LEN", ,LEN,LEN, "I1:-:String=A*i") ! DEFIMP (LGE, "LGE", ,LGE,LGE, "L1:*:String_A=A1,String_B=A1") ! DEFIMP (LGT, "LGT", ,LGT,LGT, "L1:*:String_A=A1,String_B=A1") ! DEFIMP (LLE, "LLE", ,LLE,LLE, "L1:*:String_A=A1,String_B=A1") ! DEFIMP (LLT, "LLT", ,LLT,LLT, "L1:*:String_A=A1,String_B=A1") ! DEFIMP (LOG, "LOG", L_LOG,ALOG,, "F=:0:X=F*") ! DEFIMP (LOG10, "LOG10", ,,, "R=:0:X=R*") ! DEFIMP (MAX, "MAX", ,,, "S=:*:A=pS*") ! DEFIMP (MIN, "MIN", ,,, "S=:*:A=pS*") ! DEFIMP (MAX0, "MAX0", ,,, "I1:*:A=pI1") ! DEFIMP (MAX1, "MAX1", ,,, "I1:*:A=pR1") ! DEFIMP (MIN0, "MIN0", ,,, "I1:*:A=pI1") ! DEFIMP (MIN1, "MIN1", ,,, "I1:*:A=pR1") ! DEFIMP (MOD, "MOD", ,MOD,MOD, "S=:*:A=S*,P=S*") ! DEFIMP (NINT, "NINT", ,NINT,NINT, "I1:-:A=R*") ! DEFIMP (REAL, "REAL", ,,, "RC:0:A=N*") ! DEFIMP (SIGN, "SIGN", ,SIGN,, "S=:*:A=S*,B=S*") ! DEFIMP (SIN, "SIN", L_SIN,SIN,, "F=:0:X=F*") ! DEFIMP (SINH, "SINH", L_SINH,SINH,, "R=:0:X=R*") ! DEFIMP (SNGL, "SNGL", ,,, "R1:-:A=R2") ! DEFIMP (SQRT, "SQRT", L_SQRT,SQRT,, "F=:0:X=F*") ! DEFIMP (TAN, "TAN", L_TAN,TAN,, "R=:0:X=R*") ! DEFIMP (TANH, "TANH", L_TANH,TANH,, "R=:0:X=R*") ! ! DEFIMP (ABORT, "ABORT", ABORT,,, "--:-:") ! DEFIMP (ACCESS, "ACCESS", ACCESS,,, "I1:-:Name=A1,Mode=A1") ! DEFIMP (ACHAR, "ACHAR", ,,, "A1:-:I=I*") ! DEFIMP (ALARM, "ALARM", ALARM,,, "--:-:Seconds=I*,Handler=s*,Status=?I1w") ! DEFIMP (AND, "AND", ,,, "B=:*:I=B*,J=B*") ! DEFIMP (BESJ0, "BESJ0", L_BESJ0,,, "R=:0:X=R*") ! DEFIMP (BESJ1, "BESJ1", L_BESJ1,,, "R=:0:X=R*") ! DEFIMP (BESJN, "BESJN", L_BESJN,,, "R=:1:N=I*,X=R*") ! DEFIMP (BESY0, "BESY0", L_BESY0,,, "R=:0:X=R*") ! DEFIMP (BESY1, "BESY1", L_BESY1,,, "R=:0:X=R*") ! DEFIMP (BESYN, "BESYN", L_BESYN,,, "R=:1:N=I*,X=R*") ! DEFIMP (BIT_SIZE, "BIT_SIZE", ,,, "I=:0:I=I*i") ! DEFIMP (BTEST, "BTEST", ,,, "L1:*:I=I*,Pos=I*") ! DEFIMP (CDABS, "CDABS", ,CDABS,, "R2:-:A=C2") ! DEFIMP (CDCOS, "CDCOS", ,CDCOS,, "C2:-:X=C2") ! DEFIMP (CDEXP, "CDEXP", ,CDEXP,, "C2:-:X=C2") ! DEFIMP (CDLOG, "CDLOG", ,CDLOG,, "C2:-:X=C2") ! DEFIMP (CDSIN, "CDSIN", ,CDSIN,, "C2:-:X=C2") ! DEFIMP (CDSQRT, "CDSQRT", ,CDSQRT,, "C2:-:X=C2") ! DEFIMP (CHDIR_func, "CHDIR_func", CHDIR,,, "I1:-:Dir=A1") ! DEFIMP (CHDIR_subr, "CHDIR_subr", CHDIR,,, "--:-:Dir=A1,Status=?I1w") ! DEFIMP (CHMOD_func, "CHMOD_func", CHMOD,,, "I1:-:Name=A1,Mode=A1") ! DEFIMP (CHMOD_subr, "CHMOD_subr", CHMOD,,, "--:-:Name=A1,Mode=A1,Status=?I1w") ! DEFIMP (COMPLEX, "COMPLEX", ,,, "C=:*:Real=S*,Imag=S*") ! DEFIMP (CPU_TIME, "CPU_TIME", ,,, "--:-:Seconds=R1w") ! DEFIMP (CTIME_func, "CTIME_func", CTIME,,, "A1*:-:STime=I*") ! DEFIMP (CTIME_subr, "CTIME_subr", CTIME,,, "--:-:Result=A1w,STime=I*") ! DEFIMP (DATE, "DATE", DATE,,, "--:-:Date=A1w") ! DEFIMP (DBESJ0, "DBESJ0", L_BESJ0,,, "R2:-:X=R2") ! DEFIMP (DBESJ1, "DBESJ1", L_BESJ1,,, "R2:-:X=R2") ! DEFIMP (DBESJN, "DBESJN", L_BESJN,,, "R2:-:N=I*,X=R2") ! DEFIMP (DBESY0, "DBESY0", L_BESY0,,, "R2:-:X=R2") ! DEFIMP (DBESY1, "DBESY1", L_BESY1,,, "R2:-:X=R2") ! DEFIMP (DBESYN, "DBESYN", L_BESYN,,, "R2:-:N=I*,X=R2") ! DEFIMP (DCONJG, "DCONJG", ,DCONJG,, "C2:-:Z=C2") ! DEFIMP (DERF, "DERF", L_ERF,DERF,, "R2:-:X=R2") ! DEFIMP (DERFC, "DERFC", L_ERFC,DERFC,, "R2:-:X=R2") ! DEFIMP (DFLOAT, "DFLOAT", ,,, "R2:-:A=I*") ! DEFIMP (DIMAG, "DIMAG", ,DIMAG,, "R2:-:Z=C2") ! DEFIMP (DREAL, "DREAL", ,,, "R2:-:A=N*") ! DEFIMP (DTIME_func, "DTIME_func", DTIME,,, "R1:-:TArray=R1(2)w") ! DEFIMP (DTIME_subr, "DTIME_subr", DTIME,,, "--:-:Result=R1w,TArray=R1(2)w") ! DEFIMP (ERF, "ERF", L_ERF,ERF,, "R=:0:X=R*") ! DEFIMP (ERFC, "ERFC", L_ERFC,ERFC,, "R=:0:X=R*") ! DEFIMP (ETIME_func, "ETIME_func", ETIME,,, "R1:-:TArray=R1(2)w") ! DEFIMP (ETIME_subr, "ETIME_subr", ETIME,,, "--:-:Result=R1w,TArray=R1(2)w") ! DEFIMP (EXIT, "EXIT", EXIT,,, "--:-:Status=?I*") ! DEFIMP (FDATE_func, "FDATE_func", FDATE,,, "A1*:-:") ! DEFIMP (FDATE_subr, "FDATE_subr", FDATE,,, "--:-:Date=A1w") ! DEFIMP (FGET_func, "FGET_func", FGET,,, "I1:-:C=A1w") ! DEFIMP (FGET_subr, "FGET_subr", FGET,,, "--:-:C=A1w,Status=?I1w") ! DEFIMP (FGETC_func, "FGETC_func", FGETC,,, "I1:-:Unit=I*,C=A1w") ! DEFIMP (FGETC_subr, "FGETC_subr", FGETC,,, "--:-:Unit=I*,C=A1w,Status=?I1w") ! DEFIMP (FLUSH, "FLUSH", ,,, "--:-:Unit=?I*") ! DEFIMP (FNUM, "FNUM", FNUM,,, "I1:-:Unit=I*") ! DEFIMP (FPUT_func, "FPUT_func", FPUT,,, "I1:-:C=A1") ! DEFIMP (FPUT_subr, "FPUT_subr", FPUT,,, "--:-:C=A1,Status=?I1w") ! DEFIMP (FPUTC_func, "FPUTC_func", FPUTC,,, "I1:-:Unit=I*,C=A1") ! DEFIMP (FPUTC_subr, "FPUTC_subr", FPUTC,,, "--:-:Unit=I*,C=A1,Status=?I1w") ! DEFIMP (FSEEK, "FSEEK", FSEEK,,, "--:-:Unit=I*,Offset=I*,Whence=I*,ErrLab=?g*") ! DEFIMP (FSTAT_func, "FSTAT_func", FSTAT,,, "I1:-:Unit=I*,SArray=I1(13)w") ! DEFIMP (FSTAT_subr, "FSTAT_subr", FSTAT,,, "--:-:Unit=I*,SArray=I1(13)w,Status=?I1w") ! DEFIMP (FTELL_func, "FTELL_func", FTELL,,, "I1:-:Unit=I*") ! DEFIMP (FTELL_subr, "FTELL_subr", FTELL,,, "--:-:Unit=I*,Offset=I1w") ! DEFIMP (GERROR, "GERROR", GERROR,,, "--:-:Message=A1w") ! DEFIMP (GETARG, "GETARG", GETARG,,, "--:-:Pos=I*,Value=A1w") ! DEFIMP (GETCWD_func, "GETCWD_func", GETCWD,,, "I1:-:Name=A1w") ! DEFIMP (GETCWD_subr, "GETCWD_subr", GETCWD,,, "--:-:Name=A1w,Status=?I1w") ! DEFIMP (GETGID, "GETGID", GETGID,,, "I1:-:") ! DEFIMP (GETLOG, "GETLOG", GETLOG,,, "--:-:Login=A1w") ! DEFIMP (GETPID, "GETPID", GETPID,,, "I1:-:") ! DEFIMP (GETUID, "GETUID", GETUID,,, "I1:-:") ! DEFIMP (GETENV, "GETENV", GETENV,,, "--:-:Name=A1,Value=A1w") ! DEFIMP (GMTIME, "GMTIME", GMTIME,,, "--:-:STime=I1,TArray=I1(9)w") ! DEFIMP (HOSTNM_func, "HOSTNM_func", HOSTNM,,, "I1:-:Name=A1w") ! DEFIMP (HOSTNM_subr, "HOSTNM_subr", HOSTNM,,, "--:-:Name=A1w,Status=?I1w") ! DEFIMP (IACHAR, "IACHAR", ,,, "I1:-:C=A*") ! DEFIMP (IAND, "IAND", ,,, "I=:*:I=I*,J=I*") ! DEFIMP (IARGC, "IARGC", IARGC,,, "I1:-:") ! DEFIMP (IBCLR, "IBCLR", ,,, "I=:0:I=I*,Pos=I*") ! DEFIMP (IBITS, "IBITS", ,,, "I=:0:I=I*,Pos=I*,Len=I*") ! DEFIMP (IBSET, "IBSET", ,,, "I=:0:I=I*,Pos=I*") ! DEFIMP (IDATE_unix, "IDATE_unix", IDATE,,, "--:-:TArray=I1(3)w") ! DEFIMP (IDATE_vxt, "IDATE_vxt", VXTIDATE,,, "--:-:M=I1w,D=I1w,Y=I1w") ! DEFIMP (IEOR, "IEOR", ,,, "I=:*:I=I*,J=I*") ! DEFIMP (IOR, "IOR", ,,, "I=:*:I=I*,J=I*") ! DEFIMP (IERRNO, "IERRNO", IERRNO,,, "I1:-:") ! DEFIMP (IMAGPART, "IMAGPART", ,,, "R=:0:Z=C*") ! DEFIMP (INT2, "INT2", ,,, "I6:-:A=I*") ! DEFIMP (INT8, "INT8", ,,, "I2:-:A=I*") ! DEFIMP (IRAND, "IRAND", IRAND,,, "I1:-:Flag=?I*") ! DEFIMP (ISATTY, "ISATTY", ISATTY,,, "L1:-:Unit=I*") ! DEFIMP (ISHFT, "ISHFT", ,,, "I=:0:I=I*,Shift=I*") ! DEFIMP (ISHFTC, "ISHFTC", ,,, "I=:0:I=I*,Shift=I*,Size=I*") ! DEFIMP (ITIME, "ITIME", ITIME,,, "--:-:TArray=I1(3)w") ! DEFIMP (KILL_func, "KILL_func", KILL,,, "I1:-:Pid=I*,Signal=I*") ! DEFIMP (KILL_subr, "KILL_subr", KILL,,, "--:-:Pid=I*,Signal=I*,Status=?I1w") ! DEFIMP (LINK_func, "LINK_func", LINK,,, "I1:-:Path1=A1,Path2=A1") ! DEFIMP (LINK_subr, "LINK_subr", LINK,,, "--:-:Path1=A1,Path2=A1,Status=?I1w") ! DEFIMP (LNBLNK, "LNBLNK", LNBLNK,,, "I1:-:String=A1") ! DEFIMP (LONG, "LONG", ,,, "I1:-:A=I6") ! DEFIMP (LSTAT_func, "LSTAT_func", LSTAT,,, "I1:-:File=A1,SArray=I1(13)w") ! DEFIMP (LSTAT_subr, "LSTAT_subr", LSTAT,,, "--:-:File=A1,SArray=I1(13)w,Status=?I1w") ! DEFIMP (LTIME, "LTIME", LTIME,,, "--:-:STime=I1,TArray=I1(9)w") ! DEFIMP (LOC, "LOC", ,,, "Ip:-:Entity=-*&&") ! DEFIMP (LSHIFT, "LSHIFT", ,,, "I=:0:I=I*,Shift=I*") ! DEFIMP (MCLOCK, "MCLOCK", MCLOCK,,, "I1:-:") ! DEFIMP (MCLOCK8, "MCLOCK8", MCLOCK,,, "I2:-:") ! DEFIMP (MVBITS, "MVBITS", ,,, "--:-:From=I*,FromPos=I*,Len=I*,TO=IAx,ToPos=I*") ! DEFIMP (NOT, "NOT", ,,, "I=:0:I=I*") ! DEFIMP (OR, "OR", ,,, "B=:*:I=B*,J=B*") ! DEFIMP (PERROR, "PERROR", PERROR,,, "--:-:String=A1") ! DEFIMP (RAND, "RAND", RAND,,, "R1:-:Flag=?I*") ! DEFIMP (REALPART, "REALPART", ,,, "R=:0:Z=C*") ! DEFIMP (RENAME_func, "RENAME_func", RENAME,,, "I1:-:Path1=A1,Path2=A1") ! DEFIMP (RENAME_subr, "RENAME_subr", RENAME,,, "--:-:Path1=A1,Path2=A1,Status=?I1w") ! DEFIMP (RSHIFT, "RSHIFT", ,,, "I=:0:I=I*,Shift=I*") ! DEFIMP (SECNDS, "SECNDS", SECNDS,,, "R1:-:T=R1") ! DEFIMP (SECOND_func, "SECOND_func", SECOND,SECOND,, "R1:-:") ! DEFIMP (SECOND_subr, "SECOND_subr", SECOND,,, "--:-:Seconds=R1w") ! DEFIMP (SHORT, "SHORT", ,,, "I6:-:A=I*") ! DEFIMP (SIGNAL_func, "SIGNAL_func", L_SIGNAL,,, "I1:-:Number=I*,Handler=s*") ! DEFIMP (SIGNAL_subr, "SIGNAL_subr", L_SIGNAL,,, "--:-:Number=I*,Handler=s*,Status=?I1w") ! DEFIMP (SLEEP, "SLEEP", SLEEP,,, "--:-:Seconds=I1") ! DEFIMP (SRAND, "SRAND", SRAND,,, "--:-:Seed=I*") ! DEFIMP (STAT_func, "STAT_func", STAT,,, "I1:-:File=A1,SArray=I1(13)w") ! DEFIMP (STAT_subr, "STAT_subr", STAT,,, "--:-:File=A1,SArray=I1(13)w,Status=?I1w") ! DEFIMP (SYMLNK_func, "SYMLNK_func", SYMLNK,,, "I1:-:Path1=A1,Path2=A1") ! DEFIMP (SYMLNK_subr, "SYMLNK_subr", SYMLNK,,, "--:-:Path1=A1,Path2=A1,Status=?I1w") ! DEFIMP (SYSTEM_func, "SYSTEM_func", SYSTEM,SYSTEM,SYSTEM,"I1:-:Command=A1") ! DEFIMP (SYSTEM_subr, "SYSTEM_subr", SYSTEM,,, "--:-:Command=A1,Status=?I1w") ! DEFIMP (SYSTEM_CLOCK, "SYSTEM_CLOCK", SYSTEM_CLOCK,,, "--:-:Count=I1w,Rate=I1w,Max=I1w") ! DEFIMP (TIME8, "TIME8", TIME,,, "I2:-:") ! DEFIMP (TIME_unix, "TIME_unix", TIME,,, "I1:-:") ! DEFIMP (TIME_vxt, "TIME_vxt", VXTTIME,,, "--:-:Time=A1[8]w") ! DEFIMP (TTYNAM_func, "TTYNAM_func", TTYNAM,,, "A1*:-:Unit=I*") ! DEFIMP (TTYNAM_subr, "TTYNAM_subr", TTYNAM,,, "--:-:Name=A1w,Unit=I*") ! DEFIMP (UMASK_func, "UMASK_func", UMASK,,, "I1:-:Mask=I*") ! DEFIMP (UMASK_subr, "UMASK_subr", UMASK,,, "--:-:Mask=I*,Old=?I1w") ! DEFIMP (UNLINK_func, "UNLINK_func", UNLINK,,, "I1:-:File=A1") ! DEFIMP (UNLINK_subr, "UNLINK_subr", UNLINK,,, "--:-:File=A1,Status=?I1w") ! DEFIMP (XOR, "XOR", ,,, "B=:*:I=B*,J=B*") ! DEFIMP (NONE, "none", ,,, "") diff -rcp2N g77-0.5.20/f/intrin.h g77-0.5.21/f/intrin.h *** g77-0.5.20/f/intrin.h Sat Mar 1 04:25:08 1997 --- g77-0.5.21/f/intrin.h Tue Sep 9 06:11:37 1997 *************** *** 1,4 **** /* intrin.h -- Public interface for intrin.c ! Copyright (C) 1995, 1996 Free Software Foundation, Inc. Contributed by James Craig Burley (burley@gnu.ai.mit.edu). --- 1,4 ---- /* intrin.h -- Public interface for intrin.c ! Copyright (C) 1995-1997 Free Software Foundation, Inc. Contributed by James Craig Burley (burley@gnu.ai.mit.edu). *************** typedef enum *** 36,39 **** --- 36,40 ---- FFEINTRIN_familyF2C, /* f2c intrinsics. */ FFEINTRIN_familyF90, /* Fortran 90. */ + FFEINTRIN_familyF95 = FFEINTRIN_familyF90, FFEINTRIN_familyVXT, /* VAX/VMS FORTRAN. */ FFEINTRIN_familyMIL, /* MIL STD 1753 (MVBITS, etc), in mil, vxt, and f90. */ *************** typedef enum *** 41,45 **** FFEINTRIN_familyFVZ, /* in both f2c and VAX/VMS FORTRAN. */ FFEINTRIN_familyF2U, /* libf2c/libU77 UNIX system intrinsics. */ ! FFEINTRIN_family, } ffeintrinFamily; --- 42,47 ---- FFEINTRIN_familyFVZ, /* in both f2c and VAX/VMS FORTRAN. */ FFEINTRIN_familyF2U, /* libf2c/libU77 UNIX system intrinsics. */ ! FFEINTRIN_familyBADU77, /* libU77 UNIX system intrinsics with bad form. */ ! FFEINTRIN_family } ffeintrinFamily; *************** typedef enum *** 49,54 **** #define DEFGEN(CODE,NAME,SPEC1,SPEC2) FFEINTRIN_gen ## CODE, #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) ! #define DEFIMP(CODE,NAME,GFRT,CONTROL) ! #define DEFIMQ(CODE,NAME,GFRT,CONTROL,CGIMP) #include "intrin.def" #undef DEFNAME --- 51,55 ---- #define DEFGEN(CODE,NAME,SPEC1,SPEC2) FFEINTRIN_gen ## CODE, #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) ! #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) #include "intrin.def" #undef DEFNAME *************** typedef enum *** 56,60 **** #undef DEFSPEC #undef DEFIMP - #undef DEFIMQ FFEINTRIN_gen } ffeintrinGen; --- 57,60 ---- *************** typedef enum *** 65,70 **** #define DEFGEN(CODE,NAME,SPEC1,SPEC2) #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) FFEINTRIN_spec ## CODE, ! #define DEFIMP(CODE,NAME,GFRT,CONTROL) ! #define DEFIMQ(CODE,NAME,GFRT,CONTROL,CGIMP) #include "intrin.def" #undef DEFNAME --- 65,69 ---- #define DEFGEN(CODE,NAME,SPEC1,SPEC2) #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) FFEINTRIN_spec ## CODE, ! #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) #include "intrin.def" #undef DEFNAME *************** typedef enum *** 72,76 **** #undef DEFSPEC #undef DEFIMP - #undef DEFIMQ FFEINTRIN_spec } ffeintrinSpec; --- 71,74 ---- *************** typedef enum *** 81,86 **** #define DEFGEN(CODE,NAME,SPEC1,SPEC2) #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) ! #define DEFIMP(CODE,NAME,GFRT,CONTROL) FFEINTRIN_imp ## CODE, ! #define DEFIMQ(CODE,NAME,GFRT,CONTROL,CGIMP) FFEINTRIN_imp ## CODE, #include "intrin.def" #undef DEFNAME --- 79,84 ---- #define DEFGEN(CODE,NAME,SPEC1,SPEC2) #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) ! #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \ ! FFEINTRIN_imp ## CODE, #include "intrin.def" #undef DEFNAME *************** typedef enum *** 88,92 **** #undef DEFSPEC #undef DEFIMP - #undef DEFIMQ FFEINTRIN_imp } ffeintrinImp; --- 86,89 ---- *************** typedef enum *** 98,102 **** ffeinfoBasictype ffeintrin_basictype (ffeintrinSpec spec); - ffeintrinImp ffeintrin_codegen_imp (ffeintrinImp imp); ffeintrinFamily ffeintrin_family (ffeintrinSpec spec); void ffeintrin_fulfill_generic (ffebld *expr, ffeinfo *info, ffelexToken t); --- 95,98 ---- *************** void ffeintrin_fulfill_specific (ffebld *** 104,108 **** bool *check_intrin, ffelexToken t); #if FFECOM_targetCURRENT == FFECOM_targetGCC ! ffecomGfrt ffeintrin_gfrt (ffeintrinImp imp); #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ void ffeintrin_init_0 (void); --- 100,105 ---- bool *check_intrin, ffelexToken t); #if FFECOM_targetCURRENT == FFECOM_targetGCC ! ffecomGfrt ffeintrin_gfrt_direct (ffeintrinImp imp); ! ffecomGfrt ffeintrin_gfrt_indirect (ffeintrinImp imp); #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ void ffeintrin_init_0 (void); *************** bool ffeintrin_is_intrinsic (char *name, *** 115,118 **** --- 112,116 ---- ffeintrinGen *gen, ffeintrinSpec *spec, ffeintrinImp *imp); + bool ffeintrin_is_standard (ffeintrinGen gen, ffeintrinSpec spec); ffeinfoKindtype ffeintrin_kindtype (ffeintrinSpec spec); char *ffeintrin_name_generic (ffeintrinGen gen); diff -rcp2N g77-0.5.20/f/lang-options.h g77-0.5.21/f/lang-options.h *** g77-0.5.20/f/lang-options.h Sun Feb 23 22:00:52 1997 --- g77-0.5.21/f/lang-options.h Fri Jul 11 00:11:13 1997 *************** the Free Software Foundation, 59 Temple *** 71,76 **** "-fugly-logint", "-fno-ugly-logint", ! "-fdebug", ! "-fno-debug", "-finit-local-zero", "-fno-init-local-zero", --- 71,76 ---- "-fugly-logint", "-fno-ugly-logint", ! "-fxyzzy", ! "-fno-xyzzy", "-finit-local-zero", "-fno-init-local-zero", *************** the Free Software Foundation, 59 Temple *** 136,141 **** --- 136,145 ---- "-fsilent", "-fno-silent", + "-fglobals", + "-fno-globals", "-ftypeless-boz", "-fno-typeless-boz", + "-Wglobals", + "-Wno-globals", /*"-Wimplicit",*/ /*"-Wno-implicit",*/ diff -rcp2N g77-0.5.20/f/lang-specs.h g77-0.5.21/f/lang-specs.h *** g77-0.5.20/f/lang-specs.h Wed Feb 5 05:57:10 1997 --- g77-0.5.21/f/lang-specs.h Tue Sep 9 06:11:37 1997 *************** *** 1,4 **** /* lang-specs.h file for Fortran ! Copyright (C) 1995, 1996 Free Software Foundation, Inc. Contributed by James Craig Burley (burley@gnu.ai.mit.edu). --- 1,4 ---- /* lang-specs.h file for Fortran ! Copyright (C) 1995-1997 Free Software Foundation, Inc. Contributed by James Craig Burley (burley@gnu.ai.mit.edu). *************** the Free Software Foundation, 59 Temple *** 53,57 **** %{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} -fset-g77-defaults \ %{!Q:-quiet} -dumpbase %b.F %{d*} %{m*} %{a}\ %{g*} %{O*} %{W*} %{w} %{pedantic*} \ --- 53,57 ---- %{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} -fset-g77-defaults %(f771) \ %{!Q:-quiet} -dumpbase %b.F %{d*} %{m*} %{a}\ %{g*} %{O*} %{W*} %{w} %{pedantic*} \ *************** the Free Software Foundation, 59 Temple *** 63,70 **** %{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 -fset-g77-defaults \ %{!Q:-quiet} -dumpbase %b.f %{d*} %{m*} %{a}\ %{g*} %{O*} %{W*} %{w} %{pedantic*}\ --- 63,85 ---- %{c:%W{o*}%{!o*:-o %w%b" OO "}}%{!c:-o %d%w%u" OO "}\ %{!pipe:%g.s} %A\n }}}}"}, + {".r", "@ratfor"}, + {"@ratfor", + "ratfor %{C} %{v}\ + %{C:%{!E:%eGNU C does not support -C without using -E}}\ + %{!E:%{!pipe:-o %g.f}}%{E:%W{o*}} %i |\n", + "%{!E:f771 %{!pipe:%g.f} -fset-g77-defaults %(f771) \ + %{!Q:-quiet} -dumpbase %b.r %{d*} %{m*} %{a}\ + %{g*} %{O*} %{W*} %{w} %{pedantic*} \ + %{v:-version -fversion} %{pg:-p} %{p} %{f*} %{I*}\ + %{aux-info*}\ + %{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\ + %{S:%W{o*}%{!o*:-o %b.s}}%{!S:-o %{|!pipe:%g.s}} |\n\ + %{!S:as %a %Y\ + %{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 -fset-g77-defaults %(f771) \ %{!Q:-quiet} -dumpbase %b.f %{d*} %{m*} %{a}\ %{g*} %{O*} %{W*} %{w} %{pedantic*}\ diff -rcp2N g77-0.5.20/f/lex.c g77-0.5.21/f/lex.c *** g77-0.5.20/f/lex.c Mon Feb 10 22:39:15 1997 --- g77-0.5.21/f/lex.c Sun Jul 13 20:42:39 1997 *************** ffelex_prepare_eos_ () *** 944,947 **** --- 944,952 ---- ffebad_string (num); ffebad_finish (); + /* Make sure the token has some text, might as well fill up with spaces. */ + do + { + ffelex_append_to_token_ (' '); + } while (--ffelex_raw_mode_ > 0); break; } *************** static ffewhereColumnNumber *** 1416,1419 **** --- 1421,1426 ---- ffelex_image_char_ (int c, ffewhereColumnNumber column) { + ffewhereColumnNumber old_column = column; + if (column >= ffelex_card_size_) { *************** ffelex_image_char_ (int c, ffewhereColum *** 1425,1434 **** if ((newmax >> 1) != ffelex_card_size_) { /* Overflowed column number. */ ffelex_bad_line_ = TRUE; ! strcpy (&ffelex_card_image_[column], "..."); ! ffelex_card_length_ = column + 3; ffelex_bad_1_ (FFEBAD_LINE_TOO_LONG, ffelex_linecount_current_, column + 1); - column += 3; return column; } --- 1432,1442 ---- if ((newmax >> 1) != ffelex_card_size_) { /* Overflowed column number. */ + overflow: /* :::::::::::::::::::: */ + ffelex_bad_line_ = TRUE; ! strcpy (&ffelex_card_image_[column - 3], "..."); ! ffelex_card_length_ = column; ffelex_bad_1_ (FFEBAD_LINE_TOO_LONG, ffelex_linecount_current_, column + 1); return column; } *************** ffelex_image_char_ (int c, ffewhereColum *** 1473,1476 **** --- 1481,1490 ---- } + if (column < old_column) + { + column = old_column; + goto overflow; /* :::::::::::::::::::: */ + } + return column; } *************** ffelex_splice_tokens (ffelexHandler firs *** 4292,4297 **** i += ffelex_token_length (t); } ! else if ((*p == '$') ! && !ffe_is_dollar_ok ()) { t = ffelex_token_dollar_from_names (master, i); --- 4306,4310 ---- i += ffelex_token_length (t); } ! else if (*p == '$') { t = ffelex_token_dollar_from_names (master, i); diff -rcp2N g77-0.5.20/f/malloc.c g77-0.5.21/f/malloc.c *** g77-0.5.20/f/malloc.c Sun Dec 10 05:57:39 1995 --- g77-0.5.21/f/malloc.c Tue Sep 2 21:25:48 1997 *************** the Free Software Foundation, 59 Temple *** 34,41 **** #include "malloc.h" ! /* For systems where is missing: */ ! ! void *malloc (size_t size); ! void *realloc (void *ptr, size_t size); /* Externals defined here. */ --- 34,40 ---- #include "malloc.h" ! /* Assume gcc/toplev.o is linked in. */ ! void *xmalloc (unsigned size); ! void *xrealloc (void *ptr, int size); /* Externals defined here. */ *************** malloc_new_ (mallocSize s) *** 365,381 **** { void *ptr; ! size_t ss = s; ! #if MALLOC_DEBUG assert (s == (mallocSize) ss);/* Else alloc is too big for this library/sys. */ #endif ! ptr = malloc (ss); ! if (ptr == NULL) ! { ! free (malloc_reserve_); ! assert (ptr != NULL); ! } #if MALLOC_DEBUG memset (ptr, 126, ss); /* Catch some kinds of errors more --- 364,375 ---- { void *ptr; ! unsigned ss = s; ! #if MALLOC_DEBUG && 0 assert (s == (mallocSize) ss);/* Else alloc is too big for this library/sys. */ #endif ! ptr = xmalloc (ss); #if MALLOC_DEBUG memset (ptr, 126, ss); /* Catch some kinds of errors more *************** void * *** 524,539 **** malloc_resize_ (void *ptr, mallocSize s) { ! size_t ss = s; ! #if MALLOC_DEBUG assert (s == (mallocSize) ss);/* Too big if failure here. */ #endif ! ptr = realloc (ptr, ss); ! if (ptr == NULL) ! { ! free (malloc_reserve_); ! assert (ptr != NULL); ! } return ptr; } --- 518,528 ---- malloc_resize_ (void *ptr, mallocSize s) { ! int ss = s; ! #if MALLOC_DEBUG && 0 assert (s == (mallocSize) ss);/* Too big if failure here. */ #endif ! ptr = xrealloc (ptr, ss); return ptr; } diff -rcp2N g77-0.5.20/f/news.texi g77-0.5.21/f/news.texi *** g77-0.5.20/f/news.texi Thu Feb 27 04:52:16 1997 --- g77-0.5.21/f/news.texi Tue Sep 9 06:11:37 1997 *************** *** 6,10 **** @c in the G77 distribution, as well as in the G77 manual. ! @c 1997-02-25 @ifclear NEWSONLY --- 6,10 ---- @c in the G77 distribution, as well as in the G77 manual. ! @c 1997-09-09 @ifclear NEWSONLY *************** *** 14,17 **** --- 14,346 ---- @cindex versions, recent @cindex recent versions + + Changes made to recent versions of GNU Fortran are listed + below, with the most recent version first. + + The changes are generally listed with code-generation + bugs first, followed by compiler crashes involving valid + code, new features, fixes to existing features, new + diagnostics, internal improvements, and miscellany. + This order is not strict---for example, some items + involve a combination of these elements. + + @heading In 0.5.21: + @itemize @bullet + @item + Fix a code-generation bug introduced by 0.5.20 + caused by loop unrolling (by specifying + @samp{-funroll-loops} or similar). + This bug afflicted all code compiled by + version 2.7.2.2.f.2 of @code{gcc} (C, C++, + Fortran, and so on). + + @item + Fix a code-generation bug manifested when + combining local @code{EQUIVALENCE} with a + @code{DATA} statement that follows + the first executable statement (or is + treated as an executable-context statement + as a result of using the @samp{-fpedantic} + option). + + @item + Fix a compiler crash that occured when an + integer division by a constant zero is detected. + Instead, when the @samp{-W} option is specified, + the @code{gcc} back end issues a warning about such a case. + This bug afflicted all code compiled by + version 2.7.2.2.f.2 of @code{gcc} (C, C++, + Fortran, and so on). + + @item + Fix a compiler crash that occurred in some cases + of procedure inlining. + (Such cases became more frequent in 0.5.20.) + + @item + Fix a compiler crash resulting from using @code{DATA} + or similar to initialize a @code{COMPLEX} variable or + array to zero. + + @item + Fix compiler crashes involving use of @code{AND}, @code{OR}, + or @code{XOR} intrinsics. + + @item + Fix compiler bug triggered when using a @code{COMMON} + or @code{EQUIVALENCE} variable + as the target of an @code{ASSIGN} + or assigned-@code{GOTO} statement. + + @item + Fix compiler crashes due to using the name of a some + non-standard intrinsics (such as @samp{FTELL} or + @samp{FPUTC}) as such and as the name of a procedure + or common block. + Such dual use of a name in a program is allowed by + the standard. + + @c @code{g77}'s version of @code{libf2c} has been modified + @c so that the external names of library's procedures do not + @c conflict with names used for Fortran procedures compiled + @c by @code{g77}. + @c An additional layer of jacket procedures has been added + @c to @code{libf2c} to map the old names to the new names, + @c for automatic use by programs that interface to the + @c library procedures via the external-procedure mechanism. + @c + @c For example, the intrinsic @code{FPUTC} previously was + @c implemented by @code{g77} as a call to the @code{libf2c} + @c routine @samp{fputc_}. + @c This would conflict with a Fortran procedure named @code{FPUTC} + @c (using default compiler options), and this conflict + @c would cause a crash under certain circumstances. + @c + @c Now, the intrinsic @code{FPUTC} calls @samp{G77_fputc_0}, + @c which does not conflict with the @samp{fputc_} external + @c that implements a Fortran procedure named @code{FPUTC}. + @c + @c Programs that refer to @code{FPUTC} as an external procedure + @c without supplying their own implementation will link to + @c the new @code{libf2c} routine @samp{fputc_}, which is + @c simply a jacket routine that calls @samp{G77_fputc_0}. + + @item + Place automatic arrays on the stack, even if + @code{SAVE} or the @samp{-fno-automatic} option + is in effect. + This avoids a compiler crash in some cases. + + @item + The @samp{-malign-double} option now reliably aligns + @code{DOUBLE PRECISION} optimally on Pentium and + Pentium Pro architectures (586 and 686 in @code{gcc}). + + @item + New option @samp{-Wno-globals} disables warnings + about ``suspicious'' use of a name both as a global + name and as the implicit name of an intrinsic, and + warnings about disagreements over the number or natures of + arguments passed to global procedures, or the + natures of the procedures themselves. + + The default is to issue such warnings, which are + new as of this version of @code{g77}. + + @item + New option @samp{-fno-globals} disables diagnostics + about potentially fatal disagreements + analysis problems, such as disagreements over the + number or natures of arguments passed to global + procedures, or the natures of those procedures themselves. + + The default is to issue such diagnostics and flag + the compilation as unsuccessful. + With this option, the diagnostics are issued as + warnings, or, if @samp{-Wno-globals} is specified, + are not issued at all. + + This option also disables inlining of global procedures, + to avoid compiler crashes resulting from coding errors + that these diagnostics normally would identify. + + @item + Diagnose cases where a reference to a procedure + disagrees with the type of that procedure, or + where disagreements about the number or nature + of arguments exist. + This avoids a compiler crash. + + @item + Fix parsing bug whereby @code{g77} rejected a + second initialization specification immediately + following the first's closing @samp{/} without + an intervening comma in a @code{DATA} statement, + and the second specification was an implied-DO list. + + @item + Improve performance of the @code{gcc} back end so + certain complicated expressions involving @code{COMPLEX} + arithmetic (especially multiplication) don't appear to + take forever to compile. + + @item + Fix a couple of profiling-related bugs in @code{gcc} + back end. + + @item + Integrate GNU Ada's (GNAT's) changes to the back end, + which consist almost entirely of bug fixes. + These fixes are circa version 3.10p of GNAT. + + @item + Include some other @code{gcc} fixes that seem useful in + @code{g77}'s version of @code{gcc}. + (See @file{gcc/ChangeLog} for details---compare it + to that file in the vanilla @code{gcc-2.7.2.3.tar.gz} + distribution.) + + @item + Fix @code{libU77} routines that accept file and other names + to strip trailing blanks from them, for consistency + with other implementations. + Blanks may be forcibly appended to such names by + appending a single null character (@samp{CHAR(0)}) + to the significant trailing blanks. + + @item + Fix @code{CHMOD} intrinsic to work with file names + that have embedded blanks, commas, and so on. + + @item + Fix @code{SIGNAL} intrinsic so it accepts an + optional third @samp{Status} argument. + + @item + Fix @code{IDATE()} intrinsic subroutine (VXT form) + so it accepts arguments in the correct order. + Documentation fixed accordingly, and for + @code{GMTIME()} and @code{LTIME()} as well. + + @item + Make many changes to @code{libU77} intrinsics to + support existing code more directly. + + Such changes include allowing both subroutine and + function forms of many routines, changing @code{MCLOCK()} + and @code{TIME()} to return @code{INTEGER(KIND=1)} values, + introducing @code{MCLOCK8()} and @code{TIME8()} to + return @code{INTEGER(KIND=2)} values, + and placing functions that are intended to perform + side effects in a new intrinsic group, @code{badu77}. + + @item + Improve @code{libU77} so it is more portable. + + @item + Add options @samp{-fbadu77-intrinsics-delete}, + @samp{-fbadu77-intrinsics-hide}, and so on. + + @item + Fix crashes involving diagnosed or invalid code. + + @item + @code{g77} and @code{gcc} now do a somewhat better + job detecting and diagnosing arrays that are too + large to handle before these cause diagnostics + during the assembler or linker phase, a compiler + crash, or generation of incorrect code. + + @item + Make some fixes to alias analysis code. + + @item + Add support for @code{restrict} keyword in @code{gcc} + front end. + + @item + Support @code{gcc} version 2.7.2.3 + (modified by @code{g77} into version 2.7.2.3.f.1), + and remove + support for prior versions of @code{gcc}. + + @item + Incorporate GNAT's patches to the @code{gcc} back + end into @code{g77}'s, so GNAT users do not need + to apply GNAT's patches to build both GNAT and @code{g77} + from the same source tree. + + @item + Modify @code{make} rules and related code so that + generation of Info documentation doesn't require + compilation using @code{gcc}. + Now, any ANSI C compiler should be adequate to + produce the @code{g77} documentation (in particular, + the tables of intrinsics) from scratch. + + @item + Add @code{INT2} and @code{INT8} intrinsics. + + @item + Add @code{CPU_TIME} intrinsic. + + @item + Add @code{ALARM} intrinsic. + + @item + @code{CTIME} intrinsic now accepts any @code{INTEGER} + argument, not just @code{INTEGER(KIND=2)}. + + @item + Warn when explicit type declaration disagrees with + the type of an intrinsic invocation. + + @item + Support @samp{*f771} entry in @code{gcc} @file{specs} file. + + @item + Fix typo in @code{make} rule @samp{g77-cross}, used only for + cross-compiling. + + @item + Fix @code{libf2c} build procedure to re-archive library + if previous attempt to archive was interrupted. + + @item + Change @code{gcc} to unroll loops only during the last + invocation (of as many as two invocations) of loop + optimization. + + @item + Improve handling of @samp{-fno-f2c} so that code that + attempts to pass an intrinsic as an actual argument, + such as @samp{CALL FOO(ABS)}, is rejected due to the fact + that the run-time-library routine is, effectively, + compiled with @samp{-ff2c} in effect. + + @item + Fix @code{g77} driver to recognize @samp{-fsyntax-only} + as an option that inhibits linking, just like @samp{-c} or + @samp{-S}, and to recognize and properly handle the + @samp{-nostdlib}, @samp{-M}, @samp{-MM}, @samp{-nodefaultlibs}, + and @samp{-Xlinker} options. + + @item + Upgrade to @code{libf2c} as of 1997-08-16. + + @item + Modify @code{libf2c} to consistently and clearly diagnose + recursive I/O (at run time). + + @item + @code{g77} driver now prints version information (such as produced + by @kbd{g77 -v}) to @code{stderr} instead of @code{stdout}. + + @item + The @samp{.r} suffix now designates a Ratfor source file, + to be preprocessed via the @code{ratfor} command, available + separately. + + @item + Fix some aspects of how @code{gcc} determines what kind of + system is being configured and what kinds are supported. + For example, GNU Linux/Alpha ELF systems now are directly + supported. + + @item + Improve diagnostics. + + @item + Improve documentation and indexing. + + @item + Include all pertinent files for @code{libf2c} that come + from @code{netlib.bell-labs.com}; give any such files + that aren't quite accurate in @code{g77}'s version of + @code{libf2c} the suffix @samp{.netlib}. + + @item + Reserve @code{INTEGER(KIND=0)} for future use. + @end itemize @heading In 0.5.20: diff -rcp2N g77-0.5.20/f/proj.h g77-0.5.21/f/proj.h *** g77-0.5.20/f/proj.h Sat Mar 1 04:26:18 1997 --- g77-0.5.21/f/proj.h Tue Sep 2 21:25:48 1997 *************** the Free Software Foundation, 59 Temple *** 65,68 **** --- 65,69 ---- /* Include files everyone gets. */ + #include "config.j" /* Must come before any other #includes in gcc. */ #include "assert.j" /* Use gcc's assert.h. */ #include diff -rcp2N g77-0.5.20/f/runtime/ChangeLog g77-0.5.21/f/runtime/ChangeLog *** g77-0.5.20/f/runtime/ChangeLog Sat Mar 1 04:06:54 1997 --- g77-0.5.21/f/runtime/ChangeLog Tue Sep 9 06:10:54 1997 *************** *** 1,2 **** --- 1,266 ---- + Tue Sep 9 00:33:24 1997 Craig Burley + + * Version 0.5.21 released. + + Mon Sep 8 19:39:01 1997 Craig Burley + + * libI77/close.c (f_exit): Fix thinko, inverted test + of whether initialization done, so exiting now closes + open units again. + + Tue Aug 26 01:42:21 1997 Craig Burley + + From Jim Wilson: + * configure.in: Make sure RANLIB_TEST is set also. + + From Robert Lipe : + * libU77/getcwd_.c, libU77/hostnm_.c, libU77/lstat_.c: + Also #include , to define ENOSYS. + + Tue Aug 26 01:25:58 1997 Craig Burley + + * Makefile.in (stamp-lib): Put all f2cext.c objects in + a temp directory named libE77, then `ar' them all at + once into libf2c.a, to get the job done a bit faster. + Still remove the objects (and libE77 directory) afterward. + + Sun Aug 24 05:04:35 1997 Craig Burley + + * libU77/rand_.c (G77_rand_0), libU77/dtime_.c (G77_dtime_0), + libU77/etime_.c (G77_etime_0), libU77/secnds_.c (G77_secnds_0), + libU77/second_.c (G77_second_0): Really return `double', not + `doublereal', since the result is cast to `float'. + * f2cext.c: (rand_, dtime_, etime_, secnds_, second_): Ditto. + (erf_, erfc_, besj0_, besj1_, besjn_, besy0_, besy1_, + besyn_, dbesj0_, dbesj1_, dbesjn_, dbesy0_, dbesy1_, + dbesyn_): All of these return `double', not `doublereal', + as they either have `float' or `double' results. + * libU77/bes.c (besj0_, besj1_, besjn_, besy0_, besy1_, + besyn_): Ditto. + * libU77/dbes.c (dbesj0_, dbesj1_, dbesjn_, dbesy0_, dbesy1_, + dbesyn_): Ditto. + + Update to Netlib version of 1997-08-16: + * libI77/iio.c: Fix bug in internal writes to an array + of character strings. + + * Makefile.in (UOBJ): Restore fixes made by Dan Pettet I + lost, which included the addition of mclock_.o already noted + below, plus adding symlnk_.o. + + Thu Aug 21 03:58:34 1997 Craig Burley + + * Makefile.in (UOBJ): Add mclock_.o, thanks to Mumit Khan! + + 1997-08-21 Dave Love + + * libU77/alarm_.c: Fix return type: `integer'. + + Mon Aug 11 20:12:42 1997 Craig Burley + + * Makefile.in ($(lib), stamp-lib): Ensure that library + gets fully updated even if updating was aborted earlier. + + * libU77/hostnm_.c (G77_hostnm_0): Return ENOSYS and stuff + in errno if system has no gethostname() function. + + * libU77/lstat_.c (G77_lstat_0): Return ENOSYS and stuff + in errno if system has no lstat() function. + + * libU77/getcwd_.c (G77_getcwd_0): Return ENOSYS and stuff + in errno if system has no getcwd() or getwd() function. + Test HAVE_GETCWD properly. + + * libU77/symlnk_.c (G77_symlink_0): Return ENOSYS and stuff + in errno if system has no symlink() function. + + * libU77/mclock_.c (G77_mclock_0): Return -1 if system + has no clock() function. + + Mon Aug 11 01:55:36 1997 Craig Burley + + * Makefile.in (F2CEXT): Add `alarm' to this list. + + * f2cext.c (alarm_): Fix some typos in this function. + Delete third `status' argument. + + * libU77/alarm_.c: Delete third `status' argument, + as caller gets this from function result; return + status value as function result for caller. + + * configure.in: Rename `ac_cv_struct_FILE' to + `g77_cv_struct_FILE' according to 1997-06-26 change. + + 1997-08-06 Dave Love + + * libU77/vxtidate_.c: Correct day/month argument order. + * f2cext.c: Likewise. + + 1997-07-07 Dave Love + + * f2cext.c: Add alarm_. + + * Makefile.in, libU77/Makefile.in: Add alarm_. + + * libU77/alarm_.c: New file. + + 1997-06-26 Dave Love + + * configure.in: Generally use prefix `g77_' for cached values + we've invented, not `ac_'. + + Tue Jun 24 18:50:06 1997 Craig Burley + + * libI77/ilnw.c (s_wsni): Call f_init() here. + (s_wsli): Ditto. + (e_wsli): Turn off "doing I/O" flag here. + + 1997-06-20 Dave Love + + * runtime/configure.in: Check for cygwin32 after Mumit Khan (but + differently); if cygwin32 define NON_UNIX_STDIO and don't define + NON_ANSI_RW_MODES. + + Tue Jun 01 06:26:29 1997 Craig Burley + + * libI77/rsne.c (nl_init): Don't call f_init() here, + since s_rsne() already does. + (c_lir): Call f_init() here instead. + * libI77/rsli.c (e_rsli): Turn off "doing I/O" flag here. + * libI77/sue.c (e_rsue): Ditto. + + Sun Jun 22 23:27:22 1997 Craig Burley + + * libI77/fio.h (err): Mark I/O as no longer in progress + before returning a non-zero error indicator (since + that tells the caller to jump over the remaining I/O + calls, including the corresponding `e_whatever' call). + * libI77/err.c (endif): Ditto. + * libI77/sfe.c (e_wsfe): Ditto. + * libI77/lread.c (ERR): Ditto. + * libI77/lread.c (l_read): Ditto by having quad case + use ERR, not return, to return non-zero error code. + + Sat Jun 21 12:31:28 1997 Craig Burley + + * libI77/open.c (fk_open): Temporarily turn off + "doing I/O" flag during f_open() call to avoid recursive + I/O error. + + Tue Jun 17 22:40:47 1997 Craig Burley + + * err.c, close.c, rewind.c, inquire.c, backspace.c, endfile.c, + iio.c, open.c, Version.c, sfe.c, wsle.c, rsne.c, sue.c, rsfe.c, + lread.c, wsfe.c, fio.h, due.c, dfe.c: Change f__init from + `flag' to `int' and to signal not just whether initialization + has happened (bit 0), but also whether I/O is in progress + already (bit 1). Consistently produce a clear diagnostic + in cases of recursive I/O. Avoid infinite recursion in + f__fatal, in case sig_die triggers another error. Don't + output info on internals if not initialized in f__fatal. Don't + bother closing units in f_exit if initialization hasn't + happened. + + Tue Jun 10 12:57:44 1997 Craig Burley + + Update to Netlib version of 1997-06-09: + * libI77/err.c, libI77/lread.c, libI77/rdfmt.c, + libI77/wref.c: Move some #include's around. + + Mon Jun 9 18:11:56 1997 Craig Burley + + * libU77/kill_.c (kill_): KR_headers version needed + `*' in front of args in decls. + + Sun May 25 03:16:53 1997 Craig Burley + + Update to Netlib version of 1997-05-24: + * libF77/README, libF77/Version.c, libF77/main.c, + libF77/makefile, libF77/s_paus.c, libF77/signal1.h, + libF77/signal_.c, libF77/z_div.c, libI77/Notice, + libI77/README, libI77/Version.c, libI77/dfe.c, + libI77/err.c, libI77/fmt.c, libI77/makefile, + libI77/rawio.h: Apply many, but not all, of the changes + made to libf2c since last update. + * libF77/Makefile.in (MISC), Makefile.in (MISC): Rename + exit.o to exit_.o to go along with Netlib. + * libF77/signal.c: Make the prologue much simpler than + Netlib has it. + + Sun May 18 20:56:02 1997 Craig Burley + + * libU77/unlink_.c, libU77/stat_.c, libU77/symlnk_.c, + libU77/chmod_.c: g_char first arg is const. + + * libU77/chmod_.c: s_cat expects ftnlen[], not int[] or + integer[], change types of array and variables + accordingly. + + May 7 1997 Daniel Pettet + + * libU77/dbes_.c: Commented out the code in the + same way the bes* routines are commented out. This + was done because corresponding C routines are referenced + directly in com-rt.def. + + Mon May 5 13:56:02 1997 Craig Burley + + * libU77/stat_.c: Reverse KR/ANSI decls of g_char(). + + Apr 18 1997 Daniel Pettet + + * libF77/F77_aloc.c, libF77/abort_.c, libF77/derf_.c, + libF77/derfc_.c, libF77/ef1asc_.c, libF77/ef1cmc_.c, + libF77/erf_.c, libF77/erfc_.c, libF77/exit.c, + libF77/getarg_.c, libF77/getenv_.c, libF77/iargc_.c, + libF77/s_cat.c, libF77/signal_.c, libF77/system_.c, + libI77/close.c, libI77/ftell_.c, libU77/access_.c, + libU77/bes.c, libU77/chdir_.c, libU77/chmod_.c, libU77/ctime_.c, + libU77/date_.c, libU77/dbes.c, libU77/dtime_.c, libU77/etime_.c, + libU77/fdate_.c, libU77/fgetc_.c, libU77/flush1_.c, + libU77/fnum_.c, libU77/fputc_.c, libU77/fstat_.c, + libU77/gerror_.c, libU77/getcwd_.c, libU77/getgid_.c, + libU77/getlog_.c, libU77/getpid_.c, libU77/getuid_.c, + libU77/gmtime_.c, libU77/hostnm_.c, libU77/idate_.c, + libU77/ierrno_.c, libU77/irand_.c, libU77/isatty_.c, + libU77/itime_.c, libU77/kill_.c, libU77/link_.c, + libU77/lnblnk_.c, libU77/ltime_.c, libU77/mclock_.c, + libU77/perror_.c, libU77/rand_.c, libU77/rename_.c, + libU77/secnds_.c, libU77/second_.c, libU77/sleep_.c, + libU77/srand_.c, libU77/stat_.c, libU77/symlnk_.c, + libU77/system_clock_.c, libU77/time_.c, libU77/ttynam_.c, + libU77/umask_.c, libU77/unlink_.c, libU77/vxtidate_.c, + libU77/vxttime_.c: Completed renaming routines that are directly + callable from g77 to internal names of the form + G77_xxxx_0 that are known as intrinsics by g77. + + Apr 8 1997 Daniel Pettet + + * Makefile.in: Add libU77/mclock_.o and libU77/symlnk_.o to UOBJ. + * libU77/Makefile.in: Add mclock_.c to SRCS. + Add mclock_.o and symlnk_.o to OBJS. + Add mclock_.o dependency. + + Apr 8 1997 Daniel Pettet + + * libU77/symlnk_.c: Added a couple of (char*) casts to malloc + to silence the compiler. + + 1997-03-17 Dave Love + + * libU77/access_.c, libU77/chdir_.c, libU77/chmod_.c, + libU77/link_.c, libU77/lstat_.c, libU77/rename_.c, libU77/stat_.c, + libU77/symlnk_.c, libU77/u77-test.f, libU77/unlink_.c: Strip + trailing blanks from file names for consistency with other + implementations (notably Sun's). + + * libU77/chmod_.c: Quote the file name given to the shell. + + Mon Mar 10 00:19:17 1997 Craig Burley + + * libI77/uio.c (do_ud) [PAD_UDread]: Add semicolon to err() + invocation when macro not defined (from Mumit Khan + ). + Fri Feb 28 13:16:50 1997 Craig Burley diff -rcp2N g77-0.5.20/f/runtime/Makefile.in g77-0.5.21/f/runtime/Makefile.in *** g77-0.5.20/f/runtime/Makefile.in Thu Feb 27 04:52:16 1997 --- g77-0.5.21/f/runtime/Makefile.in Tue Sep 2 21:25:48 1997 *************** CPPFLAGS = @CPPFLAGS@ @DEFS@ *** 40,43 **** --- 40,44 ---- LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ + CGFLAGS = -g0 GCC_FOR_TARGET = @CC@ *************** CC = $(GCC_FOR_TARGET) *** 46,49 **** --- 47,52 ---- CROSS = @CROSS@ + objext = .o + transform=@program_transform_name@ *************** MISC = libF77/F77_aloc.o libF77/VersionF *** 75,79 **** libF77/signal_.o libF77/s_stop.o libF77/s_paus.o libF77/system_.o \ libF77/cabs.o libF77/derf_.o libF77/derfc_.o libF77/erf_.o \ ! libF77/erfc_.o libF77/sig_die.o libF77/exit.o POW = libF77/pow_ci.o libF77/pow_dd.o libF77/pow_di.o libF77/pow_hh.o \ libF77/pow_ii.o libF77/pow_ri.o libF77/pow_zi.o libF77/pow_zz.o \ --- 78,82 ---- libF77/signal_.o libF77/s_stop.o libF77/s_paus.o libF77/system_.o \ libF77/cabs.o libF77/derf_.o libF77/derfc_.o libF77/erf_.o \ ! libF77/erfc_.o libF77/sig_die.o libF77/exit_.o POW = libF77/pow_ci.o libF77/pow_dd.o libF77/pow_di.o libF77/pow_hh.o \ libF77/pow_ii.o libF77/pow_ri.o libF77/pow_zi.o libF77/pow_zz.o \ *************** UOBJ = libU77/VersionU.o libU77/gerror_ *** 130,134 **** libU77/lnblnk_.o libU77/hostnm_.o libU77/rename_.o libU77/fgetc_.o \ libU77/fputc_.o libU77/umask_.o libU77/system_clock_.o libU77/date_.o \ ! libU77/second_.o libU77/flush1_.o # flags_to_pass to recursive makes & configure (hence the quoting style) --- 133,147 ---- libU77/lnblnk_.o libU77/hostnm_.o libU77/rename_.o libU77/fgetc_.o \ libU77/fputc_.o libU77/umask_.o libU77/system_clock_.o libU77/date_.o \ ! libU77/second_.o libU77/flush1_.o libU77/alarm_.o libU77/mclock_.o \ ! libU77/symlnk_.o ! ! F2CEXT = abort derf derfc ef1asc ef1cmc erf erfc exit getarg getenv iargc \ ! signal system flush ftell fseek access besj0 besj1 besjn besy0 besy1 \ ! besyn chdir chmod ctime date dbesj0 dbesj1 dbesjn dbesy0 dbesy1 dbesyn \ ! dtime etime fdate fgetc fget flush1 fnum fputc fput fstat gerror \ ! getcwd getgid getlog getpid getuid gmtime hostnm idate ierrno irand \ ! isatty itime kill link lnblnk lstat ltime mclock perror rand rename \ ! secnds second sleep srand stat symlnk sclock time ttynam umask unlink \ ! vxtidt vxttim alarm # flags_to_pass to recursive makes & configure (hence the quoting style) *************** CROSS_FLAGS_TO_PASS = \ *** 159,166 **** all: ../../include/f2c.h libi77 libf77 libu77 $(lib) ! $(lib): $(FOBJ) $(IOBJ) $(UOBJ) ! -$(AR) $(AR_FLAGS) $(lib) $? if $(RANLIB_TEST); then $(RANLIB) $(lib); \ else true; fi libi77: libI77/Makefile --- 172,193 ---- all: ../../include/f2c.h libi77 libf77 libu77 $(lib) ! $(lib): stamp-lib ; @true ! stamp-lib: $(FOBJ) $(IOBJ) $(UOBJ) ! rm -f stamp-lib ! $(AR) $(AR_FLAGS) $(lib) $? ! rm -fr libE77 ! mkdir libE77 ! for name in $(F2CEXT); \ ! do \ ! echo $${name}; \ ! $(GCC_FOR_TARGET) -c -I. -I$(srcdir) -I../../include $(CPPFLAGS) $(CFLAGS) $(CGFLAGS) \ ! -DL$${name} $(srcdir)/f2cext.c -o libE77/L$${name}$(objext); \ ! if [ $$? -eq 0 ] ; then true; else exit 1; fi; \ ! done ! $(AR) $(AR_FLAGS) $(lib) libE77/*$(object) ! rm -fr libE77 if $(RANLIB_TEST); then $(RANLIB) $(lib); \ else true; fi + touch stamp-lib libi77: libI77/Makefile diff -rcp2N g77-0.5.20/f/runtime/README g77-0.5.21/f/runtime/README *** g77-0.5.20/f/runtime/README Wed Feb 5 05:48:36 1997 --- g77-0.5.21/f/runtime/README Tue Aug 12 02:08:47 1997 *************** *** 1,3 **** ! 970205 This directory contains the f2c library packaged for use with g77 to configure --- 1,3 ---- ! 970811 This directory contains the f2c library packaged for use with g77 to configure *************** and build automatically (in principle!) *** 5,19 **** make steps. This depends on the makefile and configure fragments in ../f. ! Some small changes have been made to the f2c distributions of lib[IF]77 which ! come from ftp@bell-labs.com:netlib/f2c and are maintained (excellently) by David M. Gay . See the Notice files for copyright information. I'll try to get the changes rolled into the f2c distribution. ! WARNING WARNING WARNING!!! We have left the README files in libF77 and ! libI77 intact, because they are part of the libf2c sources and might ! prove useful to you, but AS DISTRIBUTED WITH GNU FORTRAN, you should ! not do anything suggested by gcc/f/libf77/README or gcc/f/libi77/README, ! because the configuration stuff added for the g77 distribution should ! handle everything. The packaging for auto-configuration was done by Dave Love . --- 5,28 ---- make steps. This depends on the makefile and configure fragments in ../f. ! Some small changes have been made to the f2c distributions of lib[FI]77 which ! come from and are maintained (excellently) by David M. Gay . See the Notice files for copyright information. I'll try to get the changes rolled into the f2c distribution. ! Files that come directly from netlib are either maintained in the ! gcc/f/runtime/ directory under their original names or, if they ! are not pertinent for g77's version of libf2c, under their original ! names with `.netlib' appended. For example, gcc/f/runtime/permissions.netlib ! is a copy of f2c's top-level`permissions' file in the netlib distribution. ! In this case, it applies only to the relevant portions of the libF77/ and ! libI77/ directories; it does not apply to the libU77/ directory, which is ! distributed under different licensing arrangements. Similarly, ! the `makefile.netlib' files in libF77/ and libI77/ are copies of ! the respective `makefile' files in the netlib distribution, but ! are not used when building g77's version of libf2c. ! ! The `README.netlib' files in libF77/ and libI77/ thus might be ! interesting, but should not be taken as guidelines for how to ! configure and build libf2c in g77's distribution. The packaging for auto-configuration was done by Dave Love . *************** Minor changes have been made by James Cr *** 21,25 **** who probably broke things Dave had working. :-) ! Some key changes made by Burley: - f2c.h configured to default to padding unformatted direct reads --- 30,35 ---- who probably broke things Dave had working. :-) ! Among the user-visible changes (choices) g77 makes in its ! version of libf2c: - f2c.h configured to default to padding unformatted direct reads *************** Some key changes made by Burley: *** 32,33 **** --- 42,46 ---- standard-conforming, however, and you should try to avoid writing code that assumes one format or another. + + - dtime_() and etime_() are from Dave Love's libU77, not from + netlib's libF77. diff -rcp2N g77-0.5.20/f/runtime/TODO g77-0.5.21/f/runtime/TODO *** g77-0.5.20/f/runtime/TODO Wed Feb 5 05:49:03 1997 --- g77-0.5.21/f/runtime/TODO Tue Aug 12 02:09:31 1997 *************** *** 1,3 **** ! 970205 TODO list for the g77 library --- 1,3 ---- ! 970811 TODO list for the g77 library *************** TODO list for the g77 library *** 6,10 **** have a complete set of targets at present. ! * Investigate building shared libraries on systems we know about. * Test cases. --- 6,12 ---- have a complete set of targets at present. ! * Investigate building shared libraries on systems we know about ! (probably in 0.5.22, using libtool-1.0 from the FSF, which looks ! quite useful). * Test cases. *************** TODO list for the g77 library *** 14,17 **** * An interface to IEEE maths functions from libc where this makes sense. - - * TeXinfo Documentation of the user-callable routines. --- 16,17 ---- diff -rcp2N g77-0.5.20/f/runtime/changes.netlib g77-0.5.21/f/runtime/changes.netlib *** g77-0.5.20/f/runtime/changes.netlib Thu Jan 1 00:00:00 1970 --- g77-0.5.21/f/runtime/changes.netlib Tue Sep 2 21:25:49 1997 *************** *** 0 **** --- 1,2841 ---- + 31 Aug. 1989: + 1. A(min(i,j)) now is translated correctly (where A is an array). + 2. 7 and 8 character variable names are allowed (but elicit a + complaint under -ext). + 3. LOGICAL*1 is treated as LOGICAL, with just one error message + per LOGICAL*1 statement (rather than one per variable declared + in that statement). [Note that LOGICAL*1 is not in Fortran 77.] + Like f77, f2c now allows the format in a read or write statement + to be an integer array. + + 5 Sept. 1989: + Fixed botch in argument passing of substrings of equivalenced + variables. + + 15 Sept. 1989: + Warn about incorrect code generated when a character-valued + function is not declared external and is passed as a parameter + (in violation of the Fortran 77 standard) before it is invoked. + Example: + + subroutine foo(a,b) + character*10 a,b + call goo(a,b) + b = a(3) + end + + 18 Sept. 1989: + Complain about overlapping initializations. + + 20 Sept. 1989: + Warn about names declared EXTERNAL but never referenced; + include such names as externs in the generated C (even + though most C compilers will discard them). + + 24 Sept. 1989: + New option -w8 to suppress complaint when COMMON or EQUIVALENCE + forces word alignment of a double. + Under -A (for ANSI C), ensure that floating constants (terminated + by 'f') contain either a decimal point or an exponent field. + Repair bugs sometimes encountered with CHAR and ICHAR intrinsic + functions. + Restore f77's optimizations for copying and comparing character + strings of length 1. + Always assume floating-point valued routines in libF77 return + doubles, even under -R. + Repair occasional omission of arguments in routines having multiple + entry points. + Repair bugs in computing offsets of character strings involved + in EQUIVALENCE. + Don't omit structure qualification when COMMON variables are used + as FORMATs or internal files. + + 2 Oct. 1989: + Warn about variables that appear only in data stmts; don't emit them. + Fix bugs in character DATA for noncharacter variables + involved in EQUIVALENCE. + Treat noncharacter variables initialized (at least partly) with + character data as though they were equivalenced -- put out a struct + and #define the variables. This eliminates the hideous and nonportable + numeric values that were used to initialize such variables. + Treat IMPLICIT NONE as IMPLICIT UNDEFINED(A-Z) . + Quit when given invalid options. + + 8 Oct. 1989: + Modified naming scheme for generated intermediate variables; + more are recycled, fewer distinct ones used. + New option -W nn specifies nn characters/word for Hollerith + data initializing non-character variables. + Bug fix: x(i:min(i+10,j)) used to elicit "Can't handle opcode 31 yet". + Integer expressions of the form (i+const1) - (i+const2), where + i is a scalar integer variable, are now simplified to (const1-const2); + this leads to simpler translation of some substring expressions. + Initialize uninitialized portions of character string arrays to 0 + rather than to blanks. + + 9 Oct. 1989: + New option -c to insert comments showing original Fortran source. + New option -g to insert line numbers of original Fortran source. + + 10 Oct. 1989: + ! recognized as in-line comment delimiter (a la Fortran 88). + + 24 Oct. 1989: + New options to ease coping with systems that want the structs + that result from COMMON blocks to be defined just once: + -E causes uninitialized COMMON blocks to be declared Extern; + if Extern is undefined, f2c.h #defines it to be extern. + -ec causes a separate .c file to be emitted for each + uninitialized COMMON block: COMMON /ABC/ yields abc_com.c; + thus one can compile *_com.c into a library to ensure + precisely one definition. + -e1c is similar to -ec, except that everything goes into + one file, along with comments that give a sed script for + splitting the file into the pieces that -ec would give. + This is for use with netlib's "execute f2c" service (for which + -ec is coerced into -e1c, and the sed script will put everything + but the COMMON definitions into f2c_out.c ). + + 28 Oct. 1989: + Convert "i = i op ..." into "i op= ...;" even when i is a + dummy argument. + + 13 Nov. 1989: + Name integer constants (passed as arguments) c__... rather + than c_... so + common /c/stuff + call foo(1) + ... + is translated correctly. + + 19 Nov. 1989: + Floating-point constants are now kept as strings unless they + are involved in constant expressions that get simplified. The + floating-point constants kept as strings can have arbitrarily + many significant figures and a very large exponent field (as + large as long int allows on the machine on which f2c runs). + Thus, for example, the body of + + subroutine zot(x) + double precision x(6), pi + parameter (pi=3.1415926535897932384626433832795028841972) + x(1) = pi + x(2) = pi+1 + x(3) = 9287349823749272.7429874923740978492734D-298374 + x(4) = .89 + x(5) = 4.0005 + x(6) = 10D7 + end + + now gets translated into + + x[1] = 3.1415926535897932384626433832795028841972; + x[2] = 4.1415926535897931; + x[3] = 9.2873498237492727429874923740978492734e-298359; + x[4] = (float).89; + x[5] = (float)4.0005; + x[6] = 1e8; + + rather than the former + + x[1] = 3.1415926535897931; + x[2] = 4.1415926535897931; + x[3] = 0.; + x[4] = (float)0.89000000000000003; + x[5] = (float)4.0004999999999997; + x[6] = 100000000.; + + Recognition of f77 machine-constant intrinsics deleted, i.e., + epbase, epprec, epemin, epemax, eptiny, ephuge, epmrsp. + + 22 Nov. 1989: + Workarounds for glitches on some Sun systems... + libf77: libF77/makefile modified to point out possible need + to compile libF77/main.c with -Donexit=on_exit . + libi77: libI77/wref.c (and libI77/README) modified so non-ANSI + systems can compile with USE_STRLEN defined, which will cause + sprintf(b = buf, "%#.*f", d, x); + n = strlen(b) + d1; + rather than + n = sprintf(b = buf, "%#.*f", d, x) + d1; + to be compiled. + + 26 Nov. 1989: + Longer names are now accepted (up to 50 characters); names may + contain underscores (in which case they will have two underscores + appended, to avoid clashes with library names). + + 28 Nov. 1989: + libi77 updated: + 1. Allow 3 (or, on Crays, 4) digit exponents under format Ew.d . + 2. Try to get things right on machines where ints have 16 bits. + + 29 Nov. 1989: + Supplied missing semicolon in parameterless subroutines that + have multiple entry points (all of them parameterless). + + 30 Nov. 1989: + libf77 and libi77 revised to use types from f2c.h. + f2c now types floating-point valued C library routines as "double" + rather than "doublereal" (for use with nonstandard C compilers for + which "double" is IEEE double extended). + + 1 Dec. 1989: + f2c.h updated to eliminate #defines rendered unnecessary (and, + indeed, dangerous) by change of 26 Nov. to long names possibly + containing underscores. + libi77 further revised: yesterday's change omitted two tweaks to fmt.h + (tweaks which only matter if float and real or double and doublereal are + different types). + + 2 Dec. 1989: + Better error message (than "bad tag") for NAMELIST, which no longer + inhibits C output. + + 4 Dec. 1989: + Allow capital letters in hex constants (f77 extension; e.g., + x'a012BCd', X'A012BCD' and x'a012bcd' are all treated as the integer + 167848909). + libi77 further revised: lio.c lio.h lread.c wref.c wrtfmt.c tweaked + again to allow float and real or double and doublereal to be different. + + 6 Dec. 1989: + Revised f2c.h -- required for the following... + Simpler looking translations for abs, min, max, using #defines in + revised f2c.h . + libi77: more corrections to types; additions for NAMELIST. + Corrected casts in some I/O calls. + Translation of NAMELIST; libi77 must still be revised. Currently + libi77 gives you a run-time error message if you attempt NAMELIST I/O. + + 7 Dec. 1989: + Fixed bug that prevented local integer variables that appear in DATA + stmts from being ASSIGNed statement labels. + Fillers (for DATA statements initializing EQUIVALENCEd variables and + variables in COMMON) typed integer rather than doublereal (for slightly + more portability, e.g. to Crays). + libi77: missing return values supplied in a few places; some tests + reordered for better working on the Cray. + libf77: better accuracy for complex divide, complex square root, + real mod function (casts to double; double temporaries). + + 9 Dec. 1989: + Fixed bug that caused needless (albeit harmless) empty lines to be + inserted in the C output when a comment line contained trailing blanks. + Further tweak to type of fillers: allow doublereal fillers if the + struct has doublereal data. + + 11 Dec. 1989: + Alteration of rule for producing external (C) names from names that + contain underscores. Now the external name is always obtained by + appending a pair of underscores. + + 12 Dec. 1989: + C production inhibited after most errors. + + 15 Dec. 1989: + Fixed bug in headers for subroutines having two or more character + strings arguments: the length arguments were reversed. + + 19 Dec. 1989: + f2c.h libf77 libi77: adjusted so #undefs in f2c.h should not foil + compilation of libF77 and libI77. + libf77: getenv_ adjusted to work with unsorted environments. + libi77: the iostat= specifier should now work right with internal I/O. + + 20 Dec. 1989: + f2c bugs fixed: In the absence of an err= specifier, the iostat= + specifier was generally set wrong. Character strings containing + explicit nulls (\0) were truncated at the first null. + Unlabeled DO loops recognized; must be terminated by ENDDO. + (Don't ask for CYCLE, EXIT, named DO loops, or DO WHILE.) + + 29 Dec. 1989: + Nested unlabeled DO loops now handled properly; new warning for + extraneous text at end of FORMAT. + + 30 Dec. 1989: + Fixed bug in translating dble(real(...)), dble(sngl(...)), and + dble(float(...)), where ... is either of type double complex or + is an expression requiring assignment to intermediate variables (e.g., + dble(real(foo(x+1))), where foo is a function and x is a variable). + Regard nonblank label fields on continuation lines as an error. + + 3 Jan. 1990: + New option -C++ yields output that should be understood + by C++ compilers. + + 6 Jan. 1989: + -a now excludes variables that appear in a namelist from those + that it makes automatic. (As before, it also excludes variables + that appear in a common, data, equivalence, or save statement.) + The syntactically correct Fortran + read(*,i) x + end + now yields syntactically correct C (even though both the Fortran + and C are buggy -- no FORMAT has not been ASSIGNed to i). + + 7 Jan. 1990: + libi77: routines supporting NAMELIST added. Surrounding quotes + made optional when no ambiguity arises in a list or namelist READ + of a character-string value. + + 9 Jan. 1990: + f2c.src made available. + + 16 Jan. 1990: + New options -P to produce ANSI C or C++ prototypes for procedures + defined. Change to -A and -C++: f2c tries to infer prototypes for + invoked procedures unless the new -!P option is given. New warning + messages for inconsistent calling sequences among procedures within + a single file. Most of f2c/src is affected. + f2c.h: typedefs for procedure arguments added; netlib's f2c service + will insert appropriate typedefs for use with older versions of f2c.h. + + 17 Jan. 1990: + f2c/src: defs.h exec.c format.c proc.c putpcc.c version.c xsum0.out + updated. Castargs and protofile made extern in defs.h; exec.c + modified so superfluous else clauses are diagnosed; unused variables + omitted from declarations in format.c proc.c putpcc.c . + + 21 Jan. 1990: + No C emitted for procedures declared external but not referenced. + f2c.h: more new types added for use with -P. + New feature: f2c accepts as arguments files ending in .p or .P; + such files are assumed to be prototype files, such as produced by + the -P option. All prototype files are read before any Fortran files + and apply globally to all Fortran files. Suitable prototypes help f2c + warn about calling-sequence errors and can tell f2c how to type + procedures declared external but not explicitly typed; the latter is + mainly of interest for users of the -A and -C++ options. (Prototype + arguments are not available to netlib's "execute f2c" service.) + New option -it tells f2c to try to infer types of untyped external + arguments from their use as parameters to prototyped or previously + defined procedures. + f2c/src: many minor cleanups; most modules changed. Individual + files in f2c/src are now in "bundle" format. The former f2c.1 is + now f2c.1t; "f2c.1t from f2c" and "f2c.1t from f2c/src" are now the + same, as are "f2c.1 from f2c" and "f2c.1 from f2c/src". People who + do not obtain a new copy of "all from f2c/src" should at least add + fclose(sortfp); + after the call on do_init_data(outfile, sortfp) in format_data.c . + + 22 Jan. 1990: + Cleaner man page wording (thanks to Doug McIlroy). + -it now also applies to all untyped EXTERNAL procedures, not just + arguments. + + 23 Jan. 01:34:00 EST 1990: + Bug fixes: under -A and -C++, incorrect C was generated for + subroutines having multiple entries but no arguments. + Under -A -P, subroutines of no arguments were given prototype + calling sequence () rather than (void). + Character-valued functions elicited erroneous warning messages + about inconsistent calling sequences when referenced by another + procedure in the same file. + f2c.1t: omit first appearance of libF77.a in FILES section; + load order of libraries is -lF77 -lI77, not vice versa (bug + introduced in yesterday's edits); define .F macro for those whose + -man lacks it. (For a while after yesterday's fixes were posted, + f2c.1t was out of date. Sorry!) + + 23 Jan. 9:53:24 EST 1990: + Character substring expressions involving function calls having + character arguments (including the intrinsic len function) yielded + incorrect C. + Procedures defined after invocation (in the same file) with + conflicting argument types also got an erroneous message about + the wrong number of arguments. + + 24 Jan. 11:44:00 EST 1990: + Bug fixes: -p omitted #undefs; COMMON block names containing + underscores had their C names incorrectly computed; a COMMON block + having the name of a previously defined procedure wreaked havoc; + if all arguments were .P files, f2c tried reading the second as a + Fortran file. + New feature: -P emits comments showing COMMON block lengths, so one + can get warnings of incompatible COMMON block lengths by having f2c + read .P (or .p) files. Now by running f2c twice, first with -P -!c + (or -P!c), then with *.P among the arguments, you can be warned of + inconsistent COMMON usage, and COMMON blocks having inconsistent + lengths will be given the maximum length. (The latter always did + happen within each input file; now -P lets you extend this behavior + across files.) + + 26 Jan. 16:44:00 EST 1990: + Option -it made less aggressive: untyped external procedures that + are invoked are now typed by the rules of Fortran, rather than by + previous use of procedures to which they are passed as arguments + before being invoked. + Option -P now includes information about references, i.e., called + procedures, in the prototype files (in the form of special comments). + This allows iterative invocations of f2c to infer more about untyped + external names, particularly when multiple Fortran files are involved. + As usual, there are some obscure bug fixes: + 1. Repair of erroneous warning messages about inconsistent number of + arguments that arose when a character dummy parameter was discovered + to be a function or when multiple entry points involved character + variables appearing in a previous entry point. + 2. Repair of memory fault after error msg about "adjustable character + function". + 3. Under -U, allow MAIN_ as a subroutine name (in the same file as a + main program). + 4. Change for consistency: a known function invoked as a subroutine, + then as a function elicits a warning rather than an error. + + 26 Jan. 22:32:00 EST 1990: + Fixed two bugs that resulted in incorrect C for substrings, within + the body of a character-valued function, of the function's name, when + those substrings were arguments to another function (even implicitly, + as in character-string assignment). + + 28 Jan. 18:32:00 EST 1990: + libf77, libi77: checksum files added; "make check" looks for + transmission errors. NAMELIST read modified to allow $ rather than & + to precede a namelist name, to allow $ rather than / to terminate + input where the name of another variable would otherwise be expected, + and to regard all nonprinting ASCII characters <= ' ' as spaces. + + 29 Jan. 02:11:00 EST 1990: + "fc from f2c" added. + -it option made the default; -!it turns it off. Type information is + now updated in a previously missed case. + -P option tweaked again; message about when rerunning f2c may change + prototypes or declarations made more accurate. + New option -Ps implies -P and returns exit status 4 if rerunning + f2c -P with prototype inputs might change prototypes or declarations. + Now you can execute a crude script like + + cat *.f >zap.F + rm -f zap.P + while :; do + f2c -Ps -!c zap.[FP] + case $? in 4) ;; *) break;; esac + done + + to get a file zap.P of the best prototypes f2c can determine for *.f . + + Jan. 29 07:30:21 EST 1990: + Forgot to check for error status when setting return code 4 under -Ps; + error status (1, 2, 3, or, for caught signal, 126) now takes precedence. + + Jan 29 14:17:00 EST 1990: + Incorrect handling of + open(n,'filename') + repaired -- now treated as + open(n,file='filename') + (and, under -ext, given an error message). + New optional source file memset.c for people whose systems don't + provide memset, memcmp, and memcpy; #include in mem.c + changed to #include "string.h" so BSD people can create a local + string.h that simply says #include . + + Jan 30 10:34:00 EST 1990: + Fix erroneous warning at end of definition of a procedure with + character arguments when the procedure had previously been called with + a numeric argument instead of a character argument. (There were two + warnings, the second one incorrectly complaining of a wrong number of + arguments.) + + Jan 30 16:29:41 EST 1990: + Fix case where -P and -Ps erroneously reported another iteration + necessary. (Only harm is the extra iteration.) + + Feb 3 01:40:00 EST 1990: + Supply semicolon occasionally omitted under -c . + Try to force correct alignment when numeric variables are initialized + with character data (a non-standard and non-portable practice). You + must use the -W option if your code has such data statements and is + meant to run on a machine with other than 4 characters/word; e.g., for + code meant to run on a Cray, you would specify -W8 . + Allow parentheses around expressions in output lists (in write and + print statements). + Rename source files so their names are <= 12 characters long + (so there's room to append .Z and still have <= 14 characters); + renamed files: formatdata.c niceprintf.c niceprintf.h safstrncpy.c . + f2c material made available by anonymous ftp from research.att.com + (look in dist/f2c ). + + Feb 3 03:49:00 EST 1990: + Repair memory fault that arose from use (in an assignment or + call) of a non-argument variable declared CHARACTER*(*). + + Feb 9 01:35:43 EST 1990: + Fix erroneous error msg about bad types in + subroutine foo(a,adim) + dimension a(adim) + integer adim + Fix improper passing of character args (and possible memory fault) + in the expression part of a computed goto. + Fix botched calling sequences in array references involving + functions having character args. + Fix memory fault caused by invocation of character-valued functions + of no arguments. + Fix botched calling sequence of a character*1-valued function + assigned to a character*1 variable. + Fix bug in error msg for inconsistent number of args in prototypes. + Allow generation of C output despite inconsistencies in prototypes, + but give exit code 8. + Simplify include logic (by removing some bogus logic); never + prepend "/usr/include/" to file names. + Minor cleanups (that should produce no visible change in f2c's + behavior) in intr.c parse.h main.c defs.h formatdata.c p1output.c . + + Feb 10 00:19:38 EST 1990: + Insert (integer) casts when floating-point expressions are used + as subscripts. + Make SAVE stmt (with no variable list) override -a . + Minor cleanups: change field to Field in struct Addrblock (for the + benefit of buggy C compilers); omit system("/bin/cp ...") in misc.c . + + Feb 13 00:39:00 EST 1990: + Error msg fix in gram.dcl: change "cannot make %s parameter" + to "cannot make into parameter". + + Feb 14 14:02:00 EST 1990: + Various cleanups (invisible on systems with 4-byte ints), thanks + to Dave Regan: vaxx.c eliminated; %d changed to %ld various places; + external names adjusted for the benefit of stupid systems (that ignore + case and recognize only 6 significant characters in external names); + buffer shortened in xsum.c (e.g. for MS-DOS); fopen modes distinguish + text and binary files; several unused functions eliminated; missing + arg supplied to an unlikely fatalstr invocation. + + Thu Feb 15 19:15:53 EST 1990: + More cleanups (invisible on systems with 4 byte ints); casts inserted + so most complaints from cyntax(1) and lint(1) go away; a few (int) + versus (long) casts corrected. + + Fri Feb 16 19:55:00 EST 1990: + Recognize and translate unnamed Fortran 8x do while statements. + Fix bug that occasionally caused improper breaking of character + strings. + New error message for attempts to provide DATA in a type-declaration + statement. + + Sat Feb 17 11:43:00 EST 1990: + Fix infinite loop clf -> Fatal -> done -> clf after I/O error. + Change "if (addrp->vclass = CLPROC)" to "if (addrp->vclass == CLPROC)" + in p1_addr (in p1output.c); this was probably harmless. + Move a misplaced } in lex.c (which slowed initkey()). + Thanks to Gary Word for pointing these things out. + + Sun Feb 18 18:07:00 EST 1990: + Detect overlapping initializations of arrays and scalar variables + in previously missed cases. + Treat logical*2 as logical (after issuing a warning). + Don't pass string literals to p1_comment(). + Correct a cast (introduced 16 Feb.) in gram.expr; this matters e.g. + on a Cray. + Attempt to isolate UNIX-specific things in sysdep.c (a new source + file). Unless sysdep.c is compiled with SYSTEM_SORT defined, the + intermediate files created for DATA statements are now sorted in-core + without invoking system(). + + Tue Feb 20 16:10:35 EST 1990: + Move definition of binread and binwrite from init.c to sysdep.c . + Recognize Fortran 8x tokens < <= == >= > <> as synonyms for + .LT. .LE. .EQ. .GE. .GT. .NE. + Minor cleanup in putpcc.c: fully remove simoffset(). + More discussion of system dependencies added to libI77/README. + + Tue Feb 20 21:44:07 EST 1990: + Minor cleanups for the benefit of EBCDIC machines -- try to remove + the assumption that 'a' through 'z' are contiguous. (Thanks again to + Gary Word.) Also, change log2 to log_2 (shouldn't be necessary). + + Wed Feb 21 06:24:56 EST 1990: + Fix botch in init.c introduced in previous change; only matters + to non-ASCII machines. + + Thu Feb 22 17:29:12 EST 1990: + Allow several entry points to mention the same array. Protect + parameter adjustments with if's (for the case that an array is not + an argument to all entrypoints). + Under -u, allow + subroutine foo(x,n) + real x(n) + integer n + Compute intermediate variables used to evaluate dimension expressions + at the right time. Example previously mistranslated: + subroutine foo(x,k,m,n) + real x(min(k,m,n)) + ... + write(*,*) x + Detect duplicate arguments. (The error msg points to the first + executable stmt -- not wonderful, but not worth fixing.) + Minor cleanup of min/max computation (sometimes slightly simpler). + + Sun Feb 25 09:39:01 EST 1990: + Minor tweak to multiple entry points: protect parameter adjustments + with if's only for (array) args that do not appear in all entry points. + Minor tweaks to format.c and io.c (invisible unless your compiler + complained at the duplicate #defines of IOSUNIT and IOSFMT or at + comparisons of p1gets(...) with NULL). + + Sun Feb 25 18:40:10 EST 1990: + Fix bug introduced Feb. 22: if a subprogram contained DATA and the + first executable statement was labeled, then the label got lost. + (Just change INEXEC to INDATA in p1output.c; it occurs just once.) + + Mon Feb 26 17:45:10 EST 1990: + Fix bug in handling of " and ' in comments. + + Wed Mar 28 01:43:06 EST 1990: + libI77: + 1. Repair nasty I/O bug: opening two files and closing the first + (after possibly reading or writing it), then writing the second caused + the last buffer of the second to be lost. + 2. Formatted reads of logical values treated all letters other than + t or T as f (false). + libI77 files changed: err.c rdfmt.c Version.c + (Request "libi77 from f2c" -- you can't get these files individually.) + + f2c itself: + Repair nasty bug in translation of + ELSE IF (condition involving complicated abs, min, or max) + -- auxiliary statements were emitted at the wrong place. + Supply semicolon previously omitted from the translation of a label + (of a CONTINUE) immediately preceding an ELSE IF or an ELSE. This + bug made f2c produce invalid C. + Correct a memory fault that occurred (on some machines) when the + error message "adjustable dimension on non-argument" should be given. + Minor tweaks to remove some harmless warnings by overly chatty C + compilers. + Argument arays having constant dimensions but a variable lower bound + (e.g., x(n+1:n+3)) had a * omitted from scalar arguments involved in + the array offset computation. + + Wed Mar 28 18:47:59 EST 1990: + libf77: add exit(0) to end of main [return(0) encounters a Cray bug] + + Sun Apr 1 16:20:58 EDT 1990: + Avoid dereferencing null when processing equivalences after an error. + + Fri Apr 6 08:29:49 EDT 1990: + Calls involving alternate return specifiers omitted processing + needed for things like min, max, abs, and // (concatenation). + INTEGER*2 PARAMETERs were treated as INTEGER*4. + Convert some O(n^2) parsing to O(n). + + Tue Apr 10 20:07:02 EDT 1990: + When inconsistent calling sequences involve differing numbers of + arguments, report the first differing argument rather than the numbers + of arguments. + Fix bug under -a: formatted I/O in which either the unit or the + format was a local character variable sometimes resulted in invalid C + (a static struct initialized with an automatic component). + Improve error message for invalid flag after elided -. + Complain when literal table overflows, rather than infinitely + looping. (The complaint mentions the new and otherwise undocumented + -NL option for specifying a larger literal table.) + New option -h for forcing strings to word (or, with -hd, double-word) + boundaries where possible. + Repair a bug that could cause improper splitting of strings. + Fix bug (cast of c to doublereal) in + subroutine foo(c,r) + double complex c + double precision r + c = cmplx(r,real(c)) + end + New include file "sysdep.h" has some things from defs.h (and + elsewhere) that one may need to modify on some systems. + Some large arrays that were previously statically allocated are now + dynamically allocated when f2c starts running. + f2c/src files changed: + README cds.c defs.h f2c.1 f2c.1t format.c formatdata.c init.c + io.c lex.c main.c makefile mem.c misc.c names.c niceprintf.c + output.c parse_args.c pread.c put.c putpcc.c sysdep.h + version.c xsum0.out + + Wed Apr 11 18:27:12 EDT 1990: + Fix bug in argument consistency checking of character, complex, and + double complex valued functions. If the same source file contained a + definition of such a function with arguments not explicitly typed, + then subsequent references to the function might get erroneous + warnings of inconsistent calling sequences. + Tweaks to sysdep.h for partially ANSI systems. + New options -kr and -krd cause f2c to use temporary variables to + enforce Fortran evaluation-order rules with pernicious, old-style C + compilers that apply the associative law to floating-point operations. + + Sat Apr 14 15:50:15 EDT 1990: + libi77: libI77 adjusted to allow list-directed and namelist I/O + of internal files; bug in namelist I/O of logical and character arrays + fixed; list input of complex numbers adjusted to permit d or D to + denote the start of the exponent field of a component. + f2c itself: fix bug in handling complicated lower-bound + expressions for character substrings; e.g., min and max did not work + right, nor did function invocations involving character arguments. + Switch to octal notation, rather than hexadecimal, for nonprinting + characters in character and string constants. + Fix bug (when neither -A nor -C++ was specified) in typing of + external arguments of type complex, double complex, or character: + subroutine foo(c) + external c + complex c + now results in + /* Complex */ int (*c) (); + (as, indeed, it once did) rather than + complex (*c) (); + + Sat Apr 14 22:50:39 EDT 1990: + libI77/makefile: updated "make check" to omit lio.c + lib[FI]77/makefile: trivial change: define CC = cc, reference $(CC). + (Request, e.g., "libi77 from f2c" -- you can't ask for individual + files from lib[FI]77.) + + Wed Apr 18 00:56:37 EDT 1990: + Move declaration of atof() from defs.h to sysdep.h, where it is + now not declared if stdlib.h is included. (NeXT's stdlib.h has a + #define atof that otherwise wreaks havoc.) + Under -u, provide a more intelligible error message (than "bad tag") + for an attempt to define a function without specifying its type. + + Wed Apr 18 17:26:27 EDT 1990: + Recognize \v (vertical tab) in Hollerith as well as quoted strings; + add recognition of \r (carriage return). + New option -!bs turns off recognition of escapes in character strings + (\0, \\, \b, \f, \n, \r, \t, \v). + Move to sysdep.c initialization of some arrays whose initialization + assumed ASCII; #define Table_size in sysdep.h rather than using + hard-coded 256 in allocating arrays of size 1 << (bits/byte). + + Thu Apr 19 08:13:21 EDT 1990: + Warn when escapes would make Hollerith extend beyond statement end. + Omit max() definition from misc.c (should be invisible except on + systems that erroneously #define max in stdlib.h). + + Mon Apr 23 22:24:51 EDT 1990: + When producing default-style C (no -A or -C++), cast switch + expressions to (int). + Move "-lF77 -lI77 -lm -lc" to link_msg, defined in sysdep.c . + Add #define scrub(x) to sysdep.h, with invocations in format.c and + formatdata.c, so that people who have systems like VMS that would + otherwise create multiple versions of intermediate files can + #define scrub(x) unlink(x) + + Tue Apr 24 18:28:36 EDT 1990: + Pass string lengths once rather than twice to a function of character + arguments involved in comparison of character strings of length 1. + + Fri Apr 27 13:11:52 EDT 1990: + Fix bug that made f2c gag on concatenations involving char(...) on + some systems. + + Sat Apr 28 23:20:16 EDT 1990: + Fix control-stack bug in + if(...) then + else if (complicated condition) + else + endif + (where the complicated condition causes assignment to an auxiliary + variable, e.g., max(a*b,c)). + + Mon Apr 30 13:30:10 EDT 1990: + Change fillers for DATA with holes from substructures to arrays + (in an attempt to make things work right with C compilers that have + funny padding rules for substructures, e.g., Sun C compilers). + Minor cleanup of exec.c (should not affect generated C). + + Mon Apr 30 23:13:51 EDT 1990: + Fix bug in handling return values of functions having multiple + entry points of differing return types. + + Sat May 5 01:45:18 EDT 1990: + Fix type inference bug in + subroutine foo(x) + call goo(x) + end + subroutine goo(i) + i = 3 + end + Instead of warning of inconsistent calling sequences for goo, + f2c was simply making i a real variable; now i is correctly + typed as an integer variable, and f2c issues an error message. + Adjust error messages issued at end of declarations so they + don't blame the first executable statement. + + Sun May 6 01:29:07 EDT 1990: + Fix bug in -P and -Ps: warn when the definition of a subprogram adds + information that would change prototypes or previous declarations. + + Thu May 10 18:09:15 EDT 1990: + Fix further obscure bug with (default) -it: inconsistent calling + sequences and I/O statements could interact to cause a memory fault. + Example: + SUBROUTINE FOO + CALL GOO(' Something') ! Forgot integer first arg + END + SUBROUTINE GOO(IUNIT,MSG) + CHARACTER*(*)MSG + WRITE(IUNIT,'(1X,A)') MSG + END + + Fri May 11 16:49:11 EDT 1990: + Under -!c, do not delete any .c files (when there are errors). + Avoid dereferencing 0 when a fatal error occurs while reading + Fortran on stdin. + + Wed May 16 18:24:42 EDT 1990: + f2c.ps made available. + + Mon Jun 4 12:53:08 EDT 1990: + Diagnose I/O units of invalid type. + Add specific error msg about dummy arguments in common. + + Wed Jun 13 12:43:17 EDT 1990: + Under -A, supply a missing "[1]" for CHARACTER*1 variables that appear + both in a DATA statement and in either COMMON or EQUIVALENCE. + + Mon Jun 18 16:58:31 EDT 1990: + Trivial updates to f2c.ps . ("Fortran 8x" --> "Fortran 90"; omit + "(draft)" from "(draft) ANSI C".) + + Tue Jun 19 07:36:32 EDT 1990: + Fix incorrect code generated for ELSE IF(expression involving + function call passing non-constant substring). + Under -h, preserve the property that strings are null-terminated + where possible. + Remove spaces between # and define in lex.c output.c parse.h . + + Mon Jun 25 07:22:59 EDT 1990: + Minor tweak to makefile to reduce unnecessary recompilations. + + Tue Jun 26 11:49:53 EDT 1990: + Fix unintended truncation of some integer constants on machines + where casting a long to (int) may change the value. E.g., when f2c + ran on machines with 16-bit ints, "i = 99999" was being translated + to "i = -31073;". + + Wed Jun 27 11:05:32 EDT 1990: + Arrange for CHARACTER-valued PARAMETERs to honor their length + specifications. Allow CHAR(nn) in expressions defining such PARAMETERs. + + Fri Jul 20 09:17:30 EDT 1990: + Avoid dereferencing 0 when a FORMAT statement has no label. + + Thu Jul 26 11:09:39 EDT 1990: + Remarks about VOID and binread,binwrite added to README. + Tweaks to parse_args: should be invisible unless your compiler + complained at (short)*store. + + Thu Aug 2 02:07:58 EDT 1990: + f2c.ps: change the first line of page 5 from + include stuff + to + include 'stuff' + + Tue Aug 14 13:21:24 EDT 1990: + libi77: libI77 adjusted to treat tabs as spaces in list input. + + Fri Aug 17 07:24:53 EDT 1990: + libi77: libI77 adjusted so a blank='ZERO' clause (upper case Z) + in an open of a currently open file works right. + + Tue Aug 28 01:56:44 EDT 1990: + Fix bug in warnings of inconsistent calling sequences: if an + argument to a subprogram was never referenced, then a previous + invocation of the subprogram (in the same source file) that + passed something of the wrong type for that argument did not + elicit a warning message. + + Thu Aug 30 09:46:12 EDT 1990: + libi77: prevent embedded blanks in list output of complex values; + omit exponent field in list output of values of magnitude between + 10 and 1e8; prevent writing stdin and reading stdout or stderr; + don't close stdin, stdout, or stderr when reopening units 5, 6, 0. + + Tue Sep 4 12:30:57 EDT 1990: + Fix bug in C emitted under -I2 or -i2 for INTEGER*4 FUNCTION. + Warn of missing final END even if there are previous errors. + + Fri Sep 7 13:55:34 EDT 1990: + Remark about "make xsum.out" and "make f2c" added to README. + + Tue Sep 18 23:50:01 EDT 1990: + Fix null dereference (and, on some systems, writing of bogus *_com.c + files) under -ec or -e1c when a prototype file (*.p or *.P) describes + COMMON blocks that do not appear in the Fortran source. + libi77: + Add some #ifdef lines (#ifdef MSDOS, #ifndef MSDOS) to avoid + references to stat and fstat on non-UNIX systems. + On UNIX systems, add component udev to unit; decide that old + and new files are the same iff both the uinode and udev components + of unit agree. + When an open stmt specifies STATUS='OLD', use stat rather than + access (on UNIX systems) to check the existence of the file (in case + directories leading to the file have funny permissions and this is + a setuid or setgid program). + + Thu Sep 27 16:04:09 EDT 1990: + Supply missing entry for Impldoblock in blksize array of cpexpr + (in expr.c). No examples are known where this omission caused trouble. + + Tue Oct 2 22:58:09 EDT 1990: + libf77: test signal(...) == SIG_IGN rather than & 01 in main(). + libi77: adjust rewind.c so two successive rewinds after a write + don't clobber the file. + + Thu Oct 11 18:00:14 EDT 1990: + libi77: minor cleanups: add #include "fcntl.h" to endfile.c, err.c, + open.c; adjust g_char in util.c for segmented memories; in f_inqu + (inquire.c), define x appropriately when MSDOS is defined. + + Mon Oct 15 20:02:11 EDT 1990: + Add #ifdef MSDOS pointer adjustments to mem.c; treat NAME= as a + synonym for FILE= in OPEN statements. + + Wed Oct 17 16:40:37 EDT 1990: + libf77, libi77: minor cleanups: _cleanup() and abort() invocations + replaced by invocations of sig_die in main.c; some error messages + previously lost in buffers will now appear. + + Mon Oct 22 16:11:27 EDT 1990: + libf77: separate sig_die from main (for folks who don't want to use + the main in libF77). + libi77: minor tweak to comments in README. + + Fri Nov 2 13:49:35 EST 1990: + Use two underscores rather than one in generated temporary variable + names to avoid conflict with COMMON names. f2c.ps updated to reflect + this change and the NAME= extension introduced 15 Oct. + Repair a rare memory fault in io.c . + + Mon Nov 5 16:43:55 EST 1990: + libi77: changes to open.c (and err.c): complain if an open stmt + specifies new= and the file already exists (as specified by Fortrans 77 + and 90); allow file= to be omitted in open stmts and allow + status='replace' (Fortran 90 extensions). + + Fri Nov 30 10:10:14 EST 1990: + Adjust malloc.c for unusual systems whose sbrk() can return values + not properly aligned for doubles. + Arrange for slightly more helpful and less repetitive warnings for + non-character variables initialized with character data; these warnings + are (still) suppressed by -w66. + + Fri Nov 30 15:57:59 EST 1990: + Minor tweak to README (about changing VOID in f2c.h). + + Mon Dec 3 07:36:20 EST 1990: + Fix spelling of "character" in f2c.1t. + + Tue Dec 4 09:48:56 EST 1990: + Remark about link_msg and libf2c added to f2c/README. + + Thu Dec 6 08:33:24 EST 1990: + Under -U, render label nnn as L_nnn rather than Lnnn. + + Fri Dec 7 18:05:00 EST 1990: + Add more names from f2c.h (e.g. integer, real) to the c_keywords + list of names to which an underscore is appended to avoid confusion. + + Mon Dec 10 19:11:15 EST 1990: + Minor tweaks to makefile (./xsum) and README (binread/binwrite). + libi77: a few modifications for POSIX systems; meant to be invisible + elsewhere. + + Sun Dec 16 23:03:16 EST 1990: + Fix null dereference caused by unusual erroneous input, e.g. + call foo('abc') + end + subroutine foo(msg) + data n/3/ + character*(*) msg + end + (Subroutine foo is illegal because the character statement comes after a + data statement.) + Use decimal rather than hex constants in xsum.c (to prevent + erroneous warning messages about constant overflow). + + Mon Dec 17 12:26:40 EST 1990: + Fix rare extra underscore in character length parameters passed + for multiple entry points. + + Wed Dec 19 17:19:26 EST 1990: + Allow generation of C despite error messages about bad alignment + forced by equivalence. + Allow variable-length concatenations in I/O statements, such as + open(3, file=bletch(1:n) // '.xyz') + + Fri Dec 28 17:08:30 EST 1990: + Fix bug under -p with formats and internal I/O "units" in COMMON, + as in + COMMON /FIGLEA/F + CHARACTER*20 F + F = '(A)' + WRITE (*,FMT=F) 'Hello, world!' + END + + Tue Jan 15 12:00:24 EST 1991: + Fix bug when two equivalence groups are merged, the second with + nonzero offset, and the result is then merged into a common block. + Example: + INTEGER W(3), X(3), Y(3), Z(3) + COMMON /ZOT/ Z + EQUIVALENCE (W(1),X(1)), (X(2),Y(1)), (Z(3),X(1)) + ***** W WAS GIVEN THE WRONG OFFSET + Recognize Fortran 90's optional NML= in NAMELIST READs and WRITEs. + (Currently NML= and FMT= are treated as synonyms -- there's no + error message if, e.g., NML= specifies a format.) + libi77: minor adjustment to allow internal READs from character + string constants in read-only memory. + + Fri Jan 18 22:56:15 EST 1991: + Add comment to README about needing to comment out the typedef of + size_t in sysdep.h on some systems, e.g. Sun 4.1. + Fix misspelling of "statement" in an error message in lex.c + + Wed Jan 23 00:38:48 EST 1991: + Allow hex, octal, and binary constants to have the qualifying letter + (z, x, o, or b) either before or after the quoted string containing the + digits. For now this change will not be reflected in f2c.ps . + + Tue Jan 29 16:23:45 EST 1991: + Arrange for character-valued statement functions to give results of + the right length (that of the statement function's name). + + Wed Jan 30 07:05:32 EST 1991: + More tweaks for character-valued statement functions: an error + check and an adjustment so a right-hand side of nonconstant length + (e.g., a substring) is handled right. + + Wed Jan 30 09:49:36 EST 1991: + Fix p1_head to avoid printing (char *)0 with %s. + + Thu Jan 31 13:53:44 EST 1991: + Add a test after the cleanup call generated for I/O statements with + ERR= or END= clauses to catch the unlikely event that the cleanup + routine encounters an error. + + Mon Feb 4 08:00:58 EST 1991: + Minor cleanup: omit unneeded jumps and labels from code generated for + some NAMELIST READs and WRITEs with IOSTAT=, ERR=, and/or END=. + + Tue Feb 5 01:39:36 EST 1991: + Change Mktemp to mktmp (for the benefit of systems so brain-damaged + that they do not distinguish case in external names -- and that for + some reason want to load mktemp). Try to get xsum0.out right this + time (it somehow didn't get updated on 4 Feb. 1991). + Add note to libi77/README about adjusting the interpretation of + RECL= specifiers in OPENs for direct unformatted I/O. + + Thu Feb 7 17:24:42 EST 1991: + New option -r casts values of REAL functions, including intrinsics, + to REAL. This only matters for unportable code like + real r + r = asin(1.) + if (r .eq. asin(1.)) ... + [The behavior of such code varies with the Fortran compiler used -- + and sometimes is affected by compiler options.] For now, the man page + at the end of f2c.ps is the only part of f2c.ps that reflects this new + option. + + Fri Feb 8 18:12:51 EST 1991: + Cast pointer differences passed as arguments to the appropriate type. + This matters, e.g., with MSDOS compilers that yield a long pointer + difference but have int == short. + Disallow nonpositive dimensions. + + Fri Feb 15 12:24:15 EST 1991: + Change %d to %ld in sprintf call in putpower in putpcc.c. + Free more memory (e.g. allowing translation of larger Fortran + files under MS-DOS). + Recognize READ (character expression) and WRITE (character expression) + as formatted I/O with the format given by the character expression. + Update year in Notice. + + Sat Feb 16 00:42:32 EST 1991: + Recant recognizing WRITE(character expression) as formatted output + -- Fortran 77 is not symmetric in its syntax for READ and WRITE. + + Mon Mar 4 15:19:42 EST 1991: + Fix bug in passing the real part of a complex argument to an intrinsic + function. Omit unneeded parentheses in nested calls to intrinsics. + Example: + subroutine foo(x, y) + complex y + x = exp(sin(real(y))) + exp(imag(y)) + end + + Fri Mar 8 15:05:42 EST 1991: + Fix a comment in expr.c; omit safstrncpy.c (which had bugs in + cases not used by f2c). + + Wed Mar 13 02:27:23 EST 1991: + Initialize firstmemblock->next in mem_init in mem.c . [On most + systems it was fortuituously 0, but with System V, -lmalloc could + trip on this missed initialization.] + + Wed Mar 13 11:47:42 EST 1991: + Fix a reference to freed memory. + + Wed Mar 27 00:42:19 EST 1991: + Fix a memory fault caused by such illegal Fortran as + function foo + x = 3 + logical foo ! declaration among executables + foo=.false. ! used to suffer memory fault + end + + Fri Apr 5 08:30:31 EST 1991: + Fix loss of % in some format expressions, e.g. + write(*,'(1h%)') + Fix botch introduced 27 March 1991 that caused subroutines with + multiple entry points to have extraneous declarations of ret_val. + + Fri Apr 5 12:44:02 EST 1991 + Try again to omit extraneous ret_val declarations -- this morning's + fix was sometimes wrong. + + Mon Apr 8 13:47:06 EDT 1991: + Arrange for s_rnge to have the right prototype under -A -C . + + Wed Apr 17 13:36:03 EDT 1991: + New fatal error message for apparent invocation of a recursive + statement function. + + Thu Apr 25 15:13:37 EDT 1991: + F2c and libi77 adjusted so NAMELIST works with -i2. (I forgot + about -i2 when adding NAMELIST.) This required a change to f2c.h + (that only affects NAMELIST I/O under -i2.) Man-page description of + -i2 adjusted to reflect that -i2 stores array lengths in short ints. + + Fri Apr 26 02:54:41 EDT 1991: + Libi77: fix some bugs in NAMELIST reading of multi-dimensional arrays + (file rsne.c). + + Thu May 9 02:13:51 EDT 1991: + Omit a trailing space in expr.c (could cause a false xsum value if + a mailer drops the trailing blank). + + Thu May 16 13:14:59 EDT 1991: + Libi77: increase LEFBL in lio.h to overcome a NeXT bug. + Tweak for compilers that recognize "nested" comments: inside comments, + turn /* into /+ (as well as */ into +/). + + Sat May 25 11:44:25 EDT 1991: + libf77: s_rnge: declare line long int rather than int. + + Fri May 31 07:51:50 EDT 1991: + libf77: system_: officially return status. + + Mon Jun 17 16:52:53 EDT 1991: + Minor tweaks: omit unnecessary declaration of strcmp (that caused + trouble on a system where strcmp was a macro) from misc.c; add + SHELL = /bin/sh to makefiles. + Fix a dereference of null when a CHARACTER*(*) declaration appears + (illegally) after DATA. Complain only once per subroutine about + declarations appearing after DATA. + + Mon Jul 1 00:28:13 EDT 1991: + Add test and error message for illegal use of subroutine names, e.g. + SUBROUTINE ZAP(A) + ZAP = A + END + + Mon Jul 8 21:49:20 EDT 1991: + Issue a warning about things like + integer i + i = 'abc' + (which is treated as i = ichar('a')). [It might be nice to treat 'abc' + as an integer initialized (in a DATA statement) with 'abc', but + other matters have higher priority.] + Render + i = ichar('A') + as + i = 'A'; + rather than + i = 65; + (which assumes ASCII). + + Fri Jul 12 07:41:30 EDT 1991: + Note added to README about erroneous definitions of __STDC__ . + + Sat Jul 13 13:38:54 EDT 1991: + Fix bugs in double type convesions of complex values, e.g. + sngl(real(...)) or dble(real(...)) (where ... is complex). + + Mon Jul 15 13:21:42 EDT 1991: + Fix bug introduced 8 July 1991 that caused erroneous warnings + "ichar([first char. of] char. string) assumed for conversion to numeric" + when a subroutine had an array of character strings as an argument. + + Wed Aug 28 01:12:17 EDT 1991: + Omit an unused function in format.c, an unused variable in proc.c . + Under -r8, promote complex to double complex (as the man page claims). + + Fri Aug 30 17:19:17 EDT 1991: + f2c.ps updated: slightly expand description of intrinsics and,or,xor, + not; add mention of intrinsics lshift, rshift; add note about f2c + accepting Fortran 90 inline comments (starting with !); update Cobalt + Blue address. + + Tue Sep 17 07:17:33 EDT 1991: + libI77: err.c and open.c modified to use modes "rb" and "wb" + when (f)opening unformatted files; README updated to point out + that it may be necessary to change these modes to "r" and "w" + on some non-ANSI systems. + + Tue Oct 15 10:25:49 EDT 1991: + Minor tweaks that make some PC compilers happier: insert some + casts, add args to signal functions. + Change -g to emit uncommented #line lines -- and to emit more of them; + update fc, f2c.1, f2c.1t, f2c.ps to reflect this. + Change uchar to Uchar in xsum.c . + Bring gram.c up to date. + + Thu Oct 17 09:22:05 EDT 1991: + libi77: README, fio.h, sue.c, uio.c changed so the length field + in unformatted sequential records has type long rather than int + (unless UIOLEN_int is #defined). This is for systems where sizeof(int) + can vary, depending on the compiler or compiler options. + + Thu Oct 17 13:42:59 EDT 1991: + libi77: inquire.c: when MSDOS is defined, don't strcmp units[i].ufnm + when it is NULL. + + Fri Oct 18 15:16:00 EDT 1991: + Correct xsum0.out in "all from f2c/src" (somehow botched on 15 Oct.). + + Tue Oct 22 18:12:56 EDT 1991: + Fix memory fault when a character*(*) argument is used (illegally) + as a dummy variable in the definition of a statement function. (The + memory fault occurred when the statement function was invoked.) + Complain about implicit character*(*). + + Thu Nov 14 08:50:42 EST 1991: + libi77: change uint to Uint in fmt.h, rdfmt.c, wrtfmt.c; this change + should be invisible unless you're running a brain-damaged system. + + Mon Nov 25 19:04:40 EST 1991: + libi77: correct botches introduced 17 Oct. 1991 and 14 Nov. 1991 + (change uint to Uint in lwrite.c; other changes that only matter if + sizeof(int) != sizeof(long)). + Add a more meaningful error message when bailing out due to an attempt + to invoke a COMMON variable as a function. + + Sun Dec 1 19:29:24 EST 1991: + libi77: uio.c: add test for read failure (seq. unformatted reads); + adjust an error return from EOF to off end of record. + + Tue Dec 10 17:42:28 EST 1991: + Add tests to prevent memory faults with bad uses of character*(*). + + Thu Dec 12 11:24:41 EST 1991: + libi77: fix bug with internal list input that caused the last + character of each record to be ignored; adjust error message in + internal formatted input from "end-of-file" to "off end of record" + if the format specifies more characters than the record contains. + + Wed Dec 18 17:48:11 EST 1991: + Fix bug in translating nonsensical ichar invocations involving + concatenations. + Fix bug in passing intrinsics lle, llt, lge, lgt as arguments; + hl_le was being passed rather than l_le, etc. + libf77: adjust length parameters from long to ftnlen, for + compiling with f2c_i2 defined. + + Sat Dec 21 15:30:57 EST 1991: + Allow DO nnn ... to end with an END DO statement labelled nnn. + + Tue Dec 31 13:53:47 EST 1991: + Fix bug in handling dimension a(n**3,2) -- pow_ii was called + incorrectly. + Fix bug in translating + subroutine x(abc,n) + character abc(n) + write(abc,'(i10)') 123 + end + (omitted declaration and initialiation of abc_dim1). + Complain about dimension expressions of such invalid types + as complex and logical. + + Fri Jan 17 11:54:20 EST 1992: + Diagnose some illegal uses of main program name (rather than + memory faulting). + libi77: (1) In list and namelist input, treat "r* ," and "r*," + alike (where r is a positive integer constant), and fix a bug in + handling null values following items with repeat counts (e.g., + 2*1,,3). (2) For namelist reading of a numeric array, allow a new + name-value subsequence to terminate the current one (as though the + current one ended with the right number of null values). + (3) [lio.h, lwrite.c]: omit insignificant zeros in list and namelist + output. (Compile with -DOld_list_output to get the old behavior.) + + Sat Jan 18 15:58:01 EST 1992: + libi77: make list output consistent with F format by printing .1 + rather than 0.1 (introduced yesterday). + + Wed Jan 22 08:32:43 EST 1992: + libi77: add comment to README pointing out preconnection of + Fortran units 5, 6, 0 to stdin, stdout, stderr (respectively). + + Mon Feb 3 11:57:53 EST 1992: + libi77: fix namelist read bug that caused the character following + a comma to be ignored. + + Fri Feb 28 01:04:26 EST 1992: + libf77: fix buggy z_sqrt.c (double precision square root), which + misbehaved for arguments in the southwest quadrant. + + Thu Mar 19 15:05:18 EST 1992: + Fix bug (introduced 17 Jan 1992) in handling multiple entry points + of differing types (with implicitly typed entries appearing after + the first executable statement). + Fix memory fault in the following illegal Fortran: + double precision foo(i) + * illegal: above should be "double precision function foo(i)" + foo = i * 3.2 + entry moo(i) + end + Note about ANSI_Libraries (relevant, e.g., to IRIX 4.0.1 and AIX) + added to README. + Abort zero divides during constant simplification. + + Sat Mar 21 01:27:09 EST 1992: + Tweak ckalloc (misc.c) for systems where malloc(0) = 0; this matters + for subroutines with multiple entry points but no arguments. + Add "struct memblock;" to init.c (irrelevant to most compilers). + + Wed Mar 25 13:31:05 EST 1992: + Fix bug with IMPLICIT INTEGER*4(...): under -i2 or -I2, the *4 was + ignored. + + Tue May 5 09:53:55 EDT 1992: + Tweaks to README; e.g., ANSI_LIbraries changed to ANSI_Libraries . + + Wed May 6 23:49:07 EDT 1992 + Under -A and -C++, have subroutines return 0 (even if they have + no * arguments). + Adjust libi77 (rsne.c and lread.c) for systems where ungetc is + a macro. Tweak lib[FI]77/makefile to use unique intermediate file + names (for parallel makes). + + Tue May 19 09:03:05 EDT 1992: + Adjust libI77 to make err= work with internal list and formatted I/O. + + Sat May 23 18:17:42 EDT 1992: + Under -A and -C++, supply "return 0;" after the code generated for + a STOP statement -- the C compiler doesn't know that s_stop won't + return. + New (mutually exclusive) options: + -f treats all input lines as free-format lines, + honoring text that appears after column 72 + and not padding lines shorter than 72 characters + with blanks (which matters if a character string + is continued across 2 or more lines). + -72 treats text appearing after column 72 as an error. + + Sun May 24 09:45:37 EDT 1992: + Tweak description of -f in f2c.1 and f2c.1t; update f2c.ps . + + Fri May 29 01:17:15 EDT 1992: + Complain about externals used as variables. Example + subroutine foo(a,b) + external b + a = a*b ! illegal use of b; perhaps should be b() + end + + Mon Jun 15 11:15:27 EDT 1992: + Fix bug in handling namelists with names that have underscores. + + Sat Jun 27 17:30:59 EDT 1992: + Under -A and -C++, end Main program aliases with "return 0;". + Under -A and -C++, use .P files and usage in previous subprograms + in the current file to give prototypes for functions declared EXTERNAL + but not invoked. + Fix memory fault under -d1 -P . + Under -A and -C++, cast arguments to the right types in calling + a function that has been defined in the current file or in a .P file. + Fix bug in handling multi-dimensional arrays with array references + in their leading dimensions. + Fix bug in the intrinsic cmplx function when the first argument + involves an expression for which f2c generates temporary variables, + e.g. cmplx(abs(real(a)),1.) . + + Sat Jul 18 07:36:58 EDT 1992: + Fix buglet with -e1c (invisible on most systems) temporary file + f2c_functions was unlinked before being closed. + libf77: fix bugs in evaluating m**n for integer n < 0 and m an + integer different from 1 or a real or double precision 0. + Catch SIGTRAP (to print "Trace trap" before aborting). Programs + that previously erroneously computed 1 for 0**-1 may now fault. + Relevant routines: main.c pow_di.c pow_hh.c pow_ii.c pow_ri.c . + + Sat Jul 18 08:40:10 EDT 1992: + libi77: allow namelist input to end with & (e.g. &end). + + Thu Jul 23 00:14:43 EDT 1992 + Append two underscores rather than one to C keywords used as + local variables to avoid conflicts with similarly named COMMON blocks. + + Thu Jul 23 11:20:55 EDT 1992: + libf77, libi77 updated to assume ANSI prototypes unless KR_headers + is #defined. + libi77 now recognizes a Z format item as in Fortran 90; + the implementation assumes 8-bit bytes and botches character strings + on little-endian machines (by printing their bytes from right to + left): expect this bug to persist; fixing it would require a + change to the I/O calling sequences. + + Tue Jul 28 15:18:33 EDT 1992: + libi77: insert missed "#ifdef KR_headers" lines around getnum + header in rsne.c. Version not updated. + + NOTE: "index from f2c" now ends with current timestamps of files in + "all from f2c/src", sorted by time. To bring your source up to date, + obtain source files with a timestamp later than the time shown in your + version.c. + + Fri Aug 14 08:07:09 EDT 1992: + libi77: tweak wrt_E in wref.c to avoid signing NaNs. + + Sun Aug 23 19:05:22 EDT 1992: + fc: supply : after O in getopt invocation (for -O1 -O2 -O3). + + Mon Aug 24 18:37:59 EDT 1992: + Recant above tweak to fc: getopt is dumber than I thought; + it's necessary to say -O 1 (etc.). + libF77/README: add comments about ABORT, ERF, DERF, ERFC, DERFC, + GETARG, GETENV, IARGC, SIGNAL, and SYSTEM. + + Tue Oct 27 01:57:42 EST 1992: + libf77, libi77: + 1. Fix botched indirection in signal_.c. + 2. Supply missing l_eof = 0 assignment to s_rsne() in rsne.c (so + end-of-file on other files won't confuse namelist reads of external + files). + 3. Prepend f__ to external names that are only of internal + interest to lib[FI]77. + + Thu Oct 29 12:37:18 EST 1992: + libf77: Fix botch in signal_.c when KR_headers is #defined; + add CFLAGS to makefile. + libi77: trivial change to makefile for consistency with + libF77/makefile. + + Wed Feb 3 02:05:16 EST 1993: + Recognize types INTEGER*1, LOGICAL*1, LOGICAL*2, INTEGER*8. + INTEGER*8 is not well tested and will only work reasonably on + systems where int = 4 bytes, long = 8 bytes; on such systems, + you'll have to modify f2c.h appropriately, changing integer + from long to int and adding typedef long longint. You'll also + have to compile libI77 with Allow_TYQUAD #defined and adjust + libF77/makefile to compile pow_qq.c. In the f2c source, changes + for INTEGER*8 are delimited by #ifdef TYQUAD ... #endif. You + can omit the INTEGER*8 changes by compiling with NO_TYQUAD + #defined. Otherwise, the new command-line option -!i8 + disables recognition of INTEGER*8. + libf77: add pow_qq.c + libi77: add #ifdef Allow_TYQUAD stuff. Changes for INTEGER*1, + LOGICAL*1, and LOGICAL*2 came last 23 July 1992. Fix bug in + backspace (that only bit when the last character of the second + or subsequent buffer read was the previous newline). Guard + against L_tmpnam being too small in endfile.c. For MSDOS, + close and reopen files when copying to truncate. Lengthen + LINTW (buffer size in lwrite.c). + Add \ to the end of #define lines that get broken. + Fix bug in handling NAMELIST of items in EQUIVALENCE. + Under -h (or -hd), convert Hollerith to integer in general expressions + (e.g., assignments), not just when they're passed as arguments, and + blank-pad rather than 0-pad the Hollerith to a multiple of + sizeof(integer) or sizeof(doublereal). + Add command-line option -s, which instructs f2c preserve multi- + dimensional subscripts (by emitting and using appropriate #defines). + Fix glitch (with default type inferences) in examples like + call foo('abc') + end + subroutine foo(goo) + end + This gave two warning messages: + Warning on line 4 of y.f: inconsistent calling sequences for foo: + here 1, previously 2 args and string lengths. + Warning on line 4 of y.f: inconsistent calling sequences for foo: + here 2, previously 1 args and string lengths. + Now the second Warning is suppressed. + Complain about all inconsistent arguments, not just the first. + Switch to automatic creation of "all from f2c/src". For folks + getting f2c source via ftp, this means f2c/src/all.Z is now an + empty file rather than a bundle. + Separate -P and -A: -P no longer implies -A. + + Thu Feb 4 00:32:20 EST 1993: + Fix some glitches (introduced yesterday) with -h . + + Fri Feb 5 01:40:38 EST 1993: + Fix bug in types conveyed for namelists (introduced 3 Feb. 1993). + + Fri Feb 5 21:26:43 EST 1993: + libi77: tweaks to NAMELIST and open (after comments by Harold + Youngren): + 1. Reading a ? instead of &name (the start of a namelist) causes + the namelist being sought to be written to stdout (unit 6); + to omit this feature, compile rsne.c with -DNo_Namelist_Questions. + 2. Reading the wrong namelist name now leads to an error message + and an attempt to skip input until the right namelist name is found; + to omit this feature, compile rsne.c with -DNo_Bad_Namelist_Skip. + 3. Namelist writes now insert newlines before each variable; to omit + this feature, compile xwsne.c with -DNo_Extra_Namelist_Newlines. + 4. For OPEN of sequential files, ACCESS='APPEND' (or + access='anything else starting with "A" or "a"') causes the file to + be positioned at end-of-file, so a write will append to the file. + (This is nonstandard, but does not require modifying data + structures.) + + Mon Feb 8 14:40:37 EST 1993: + Increase number of continuation lines allowed from 19 to 99, + and allow changing this limit with -NC (e.g. -NC200 for 200 lines). + Treat control-Z (at the beginning of a line) as end-of-file: see + the new penultimate paragraph of README. + Fix a rarely seen glitch that could make an error messages to say + "line 0". + + Tue Feb 9 02:05:40 EST 1993 + libi77: change some #ifdef MSDOS lines to #ifdef NON_UNIX_STDIO, + and, in err.c under NON_UNIX_STDIO, avoid close(creat(name,0666)) + when the unit has another file descriptor for name. + + Tue Feb 9 17:12:49 EST 1993 + libi77: more tweaks for NON_UNIX_STDIO: use stdio routines + rather than open, close, creat, seek, fdopen (except for f__isdev). + + Fri Feb 12 15:49:33 EST 1993 + Update src/gram.c (which was forgotten in the recent updates). + Most folks regenerate it anyway (wity yacc or bison). + + Thu Mar 4 17:07:38 EST 1993 + Increase default max labels in computed gotos and alternate returns + to 257, and allow -Nl1234 to specify this number. + Tweak put.c to check p->tag == TADDR in realpart() and imagpart(). + Adjust fc script to allow .r (RATFOR) files and -C (check subscripts). + Avoid declaring strchr in niceprintf.c under -DANSI_Libraries . + gram.c updated again. + libi77: err.c, open.c: take declaration of fdopen from rawio.h. + + Sat Mar 6 07:09:11 EST 1993 + libi77: uio.c: adjust off-end-of-record test for sequential + unformatted reads to respond to err= rather than end= . + + Sat Mar 6 16:12:47 EST 1993 + Treat scalar arguments of the form (v) and v+0, where v is a variable, + as expressions: assign to a temporary variable, and pass the latter. + gram.c updated. + + Mon Mar 8 09:35:38 EST 1993 + "f2c.h from f2c" updated to add types logical1 and integer1 for + LOGICAL*1 and INTEGER*1. ("f2c.h from f2c" is supposed to be the + same as "f2c.h from f2c/src", which was updated 3 Feb. 1993.) + + Mon Mar 8 17:57:55 EST 1993 + Fix rarely seen bug that could cause strange casts in function + invocations (revealed by an example with msdos/f2c.exe). + msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only). + + Fri Mar 12 12:37:01 EST 1993 + Fix bug with -s in handling subscripts involving min, max, and + complicated expressions requiring temporaries. + Fix bug in handling COMMONs that need padding by a char array. + msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only). + + Fri Mar 12 17:16:16 EST 1993 + libf77, libi77: updated for compiling under C++. + + Mon Mar 15 16:21:37 EST 1993 + libi77: more minor tweaks (for -DKR_headers); Version.c not changed. + + Thu Mar 18 12:37:30 EST 1993 + Flag -r (for discarding carriage-returns on systems that end lines + with carriage-return/newline pairs, e.g. PCs) added to xsum, and + xsum.c converted to ANSI/ISO syntax (with K&R syntax available with + -DKR_headers). [When time permits, the f2c source will undergo a + similar conversion.] + libi77: tweaks to #includes in endfile.c, err.c, open.c, rawio.h; + Version.c not changed. + f2c.ps updated (to pick up revision of 2 Feb. 1993 to f2c.1). + + Fri Mar 19 09:19:26 EST 1993 + libi77: add (char *) casts to malloc and realloc invocations + in err.c, open.c; Version.c not changed. + + Tue Mar 30 07:17:15 EST 1993 + Fix bug introduced 6 March 1993: possible memory corruption when + loops in data statements involve constant subscripts, as in + DATA (GUNIT(1,I),I=0,14)/15*-1/ + + Tue Mar 30 16:17:42 EST 1993 + Fix bug with -s: (floating-point array item)*(complex item) + generates an _subscr() reference for the floating-point array, + but a #define for the _subscr() was omitted. + + Tue Apr 6 12:11:22 EDT 1993 + libi77: adjust error returns for formatted inputs to flush the current + input line when err= is specified. To restore the old behavior (input + left mid-line), either adjust the #definition of errfl in fio.h or omit + the invocation of f__doend in err__fl (in err.c). + + Tue Apr 6 13:30:04 EDT 1993 + Fix bug revealed in + subroutine foo(i) + call goo(int(i)) + end + which now passes a copy of i, rather than i itself. + + Sat Apr 17 11:41:02 EDT 1993 + Adjust appending of underscores to conform with f2c.ps ("A Fortran + to C Converter"): names that conflict with C keywords or f2c type + names now have just one underscore appended (rather than two); add + "integer1", "logical1", "longint" to the keyword list. + Append underscores to names that appear in EQUIVALENCE and are + component names in a structure declared in f2c.h, thus avoiding a + problem caused by the #defines emitted for equivalences. Example: + complex a + equivalence (i,j) + a = 1 ! a.i went awry because of #define i + j = 2 + write(*,*) a, i + end + Adjust line-breaking logic to avoid splitting very long constants + (and names). Example: + ! The next line starts with tab and thus is a free-format line. + a=.012345689012345689012345689012345689012345689012345689012345689012345689 + end + Omit extraneous "return 0;" from entry stubs emitted for multiple + entry points of type character, complex, or double complex. + + Sat Apr 17 14:35:05 EDT 1993 + Fix bug (introduced 4 Feb.) in separating -P from -A that kept f2c + from re-reading a .P file written without -A or -C++ describing a + routine with an external argument. [See the just-added note about + separating -P from -A in the changes above for 3 Feb. 1993.] + Fix bug (type UNKNOWN for V in the example below) revealed by + subroutine a() + external c + call b(c) + end + subroutine b(v) + end + + Sun Apr 18 19:55:26 EDT 1993 + Fix wrong calling sequence for mem() in yesterday's addition to + equiv.c . + + Wed Apr 21 17:39:46 EDT 1993 + Fix bug revealed in + + ASSIGN 10 TO L1 + GO TO 20 + 10 ASSIGN 30 TO L2 + STOP 10 + + 20 ASSIGN 10 TO L2 ! Bug here because 10 had been assigned + ! to another label, then defined. + GO TO L2 + 30 END + + Fri Apr 23 18:38:50 EDT 1993 + Fix bug with -h revealed in + CHARACTER*9 FOO + WRITE(FOO,'(I6)') 1 + WRITE(FOO,'(I6)') 2 ! struct icilist io___3 botched + END + + Tue Apr 27 16:08:28 EDT 1993 + Tweak to makefile: remove "size f2c". + + Tue May 4 23:48:20 EDT 1993 + libf77: tweak signal_ line of f2ch.add . + + Tue Jun 1 13:47:13 EDT 1993 + Fix bug introduced 3 Feb. 1993 in handling multiple entry + points with differing return types -- the postfix array in proc.c + needed a new entry for integer*8 (which resulted in wrong + Multitype suffixes for non-integral types). + For (default) K&R C, generate VOID rather than int functions for + functions of Fortran type character, complex, and double complex. + msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only). + + Tue Jun 1 23:11:15 EDT 1993 + f2c.h: add Multitype component g and commented type longint. + proc.c: omit "return 0;" from stubs for complex and double complex + entries (when entries have multiple types); add test to avoid memory + fault with illegal combinations of entry types. + + Mon Jun 7 12:00:47 EDT 1993 + Fix memory fault in + common /c/ m + integer m(1) + data m(1)/1/, m(2)/2/ ! one too many initializers + end + msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only). + + Fri Jun 18 13:55:51 EDT 1993 + libi77: change type of signal_ in f2ch.add; change type of il in + union Uint from long to integer (for machines like the DEC Alpha, + where integer should be the same as int). Version.c not changed. + Tweak gram.dcl and gram.head: add semicolons after some rules that + lacked them, and remove an extraneous semicolon. These changes are + completely transparent to our local yacc programs, but apparently + matter on some VMS systems. + + Wed Jun 23 01:02:56 EDT 1993 + Update "fc" shell script, and bring f2c.1 and f2c.1t up to date: + they're meant to be linked with (i.e., the same as) src/f2c.1 and + src/f2c.1t . [In the last update of f2c.1* (2 Feb. 1993), only + src/f2c.1 and src/f2c.1t got changed -- a mistake.] + + Wed Jun 23 09:04:31 EDT 1993 + libi77: fix bug in format reversions for internal writes. + Example: + character*60 lines(2) + write(lines,"('n =',i3,2(' more text',i3))") 3, 4, 5, 6 + write(*,*) 'lines(1) = ', lines(1) + write(*,*) 'lines(2) = ', lines(2) + end + gave an error message that began "iio: off end of record", rather + than giving the correct output: + + lines(1) = n = 3 more text 4 more text 5 + lines(2) = more text 6 more text + + Thu Aug 5 11:31:14 EDT 1993 + libi77: lread.c: fix bug in handling repetition counts for logical + data (during list or namelist input). Change struct f__syl to + struct syl (for buggy compilers). + + Sat Aug 7 16:05:30 EDT 1993 + libi77: lread.c (again): fix bug in namelist reading of incomplete + logical arrays. + Fix minor calling-sequence errors in format.c, output.c, putpcc.c: + should be invisible. + + Mon Aug 9 09:12:38 EDT 1993 + Fix erroneous cast under -A in translating + character*(*) function getc() + getc(2:3)=' ' !wrong cast in first arg to s_copy + end + libi77: lread.c: fix bug in namelist reading of an incomplete array + of numeric data followed by another namelist item whose name starts + with 'd', 'D', 'e', or 'E'. + + Fri Aug 20 13:22:10 EDT 1993 + Fix bug in do while revealed by + subroutine skdig (line, i) + character line*(*), ch*1 + integer i + logical isdigit + isdigit(ch) = ch.ge.'0' .and. ch.le.'9' + do while (isdigit(line(i:i))) ! ch__1[0] was set before + ! "while(...) {...}" + i = i + 1 + enddo + end + + Fri Aug 27 08:22:54 EDT 1993 + Add #ifdefs to avoid declaring atol when it is a macro; version.c + not updated. + + Wed Sep 8 12:24:26 EDT 1993 + libi77: open.c: protect #include "sys/..." with + #ifndef NON_UNIX_STDIO; Version date not changed. + + Thu Sep 9 08:51:21 EDT 1993 + Adjust "include" to interpret file names relative to the directory + of the file that contains the "include". + + Fri Sep 24 00:56:12 EDT 1993 + Fix offset error resulting from repeating the same equivalence + statement twice. Example: + real a(2), b(2) + equivalence (a(2), b(2)) + equivalence (a(2), b(2)) + end + Increase MAXTOKENLEN (to roughly the largest allowed by ANSI C). + + Mon Sep 27 08:55:09 EDT 1993 + libi77: endfile.c: protect #include "sys/types.h" with + #ifndef NON_UNIX_STDIO; Version.c not changed. + + Fri Oct 15 15:37:26 EDT 1993 + Fix rarely seen parsing bug illustrated by + subroutine foo(xabcdefghij) + character*(*) xabcdefghij + IF (xabcdefghij.NE.'##') GOTO 40 + 40 end + in which the spacing in the IF line is crucial. + + Thu Oct 21 13:55:11 EDT 1993 + Give more meaningful error message (then "unexpected character in + cds") when constant simplification leads to Infinity or NaN. + + Wed Nov 10 15:01:05 EST 1993 + libi77: backspace.c: adjust, under -DMSDOS, to cope with MSDOS + text files, as handled by some popular PC C compilers. Beware: + the (defective) libraries associated with these compilers assume lines + end with \r\n (conventional MS-DOS text files) -- and ftell (and + hence the current implementation of backspace) screws up if lines with + just \n. + + Thu Nov 18 09:37:47 EST 1993 + Give a better error (than "control stack empty") for an extraneous + ENDDO. Example: + enddo + end + Update comments about ftp in "readme from f2c". + + Sun Nov 28 17:26:50 EST 1993 + Change format of time stamp in version.c to yyyymmdd. + Sort parameter adjustments (or complain of impossible dependencies) + so that dummy arguments are referenced only after being adjusted. + Example: + subroutine foo(a,b) + integer a(2) ! a must be adjusted before b + double precision b(a(1),a(2)) + call goo(b(3,4)) + end + Adjust structs for initialized common blocks and equivalence classes + to omit the trailing struct component added to force alignment when + padding already forces the desired alignment. Example: + PROGRAM TEST + COMMON /Z/ A, CC + CHARACTER*4 CC + DATA cc /'a'/ + END + now gives + struct { + integer fill_1[1]; + char e_2[4]; + } z_ = { {0}, {'a', ' ', ' ', ' '} }; + rather than + struct { + integer fill_1[1]; + char e_2[4]; + real e_3; + } z_ = { {0}, {'a', ' ', ' ', ' '}, (float)0. }; + + Wed Dec 8 16:24:43 EST 1993 + Adjust lex.c to recognize # nnn "filename" lines emitted by cpp; + this affects the file names and line numbers in error messages and + the #line lines emitted under -g. + Under -g, arrange for a file that starts with an executable + statement to have the first #line line indicate line 1, rather + than the line number of the END statement ending the main program. + Adjust fc script to run files ending in .F through /lib/cpp. + Fix bug ("Impossible tag 2") in + if (t .eq. (0,2)) write(*,*) 'Bug!' + end + libi77: iio.c: adjust internal formatted reads to treat short records + as though padded with blanks (rather than causing an "off end of record" + error). + + Wed Dec 15 15:19:15 EST 1993 + fc: adjusted for .F files to pass -D and -I options to cpp. + + Fri Dec 17 20:03:38 EST 1993 + Fix botch introduced 28 Nov. 1993 in vax.c; change "version of" + to "version". + + Tue Jan 4 15:39:52 EST 1994 + msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only). + + Wed Jan 19 08:55:19 EST 1994 + Arrange to accept + integer Nx, Ny, Nz + parameter (Nx = 10, Ny = 20) + parameter (Nz = max(Nx, Ny)) + integer c(Nz) + call foo(c) + end + rather than complaining "Declaration error for c: adjustable dimension + on non-argument". The necessary changes cause some hitherto unfolded + constant expressions to be folded. + Accept BYTE as a synonym for INTEGER*1. + + Thu Jan 27 08:57:40 EST 1994 + Fix botch in changes of 19 Jan. 1994 that broke entry points with + multi-dimensional array arguments that did not appear in the subprogram + argument list and whose leading dimensions depend on arguments. + + Mon Feb 7 09:24:30 EST 1994 + Remove artifact in "fc" script that caused -O to be ignored: + 87c87 + < # lcc ignores -O... + --- + > CFLAGS="$CFLAGS $O" + + Sun Feb 20 17:04:58 EST 1994 + Fix bugs reading .P files for routines with arguments of type + INTEGER*1, INTEGER*8, LOGICAL*2. + Fix glitch in reporting inconsistent arguments for routines involving + character arguments: "arg n" had n too large by the number of + character arguments. + + Tue Feb 22 20:50:08 EST 1994 + Trivial changes to data.c format.c main.c niceprintf.c output.h and + sysdep.h (consistency improvements). + libI77: lread.c: check for NULL return from realloc. + + Fri Feb 25 23:56:08 EST 1994 + output.c, sysdep.h: arrange for -DUSE_DTOA to use dtoa.c and g_fmt.c + for correctly rounded decimal values on IEEE-arithmetic machines + (plus machines with VAX and IBM-mainframe arithmetic). These + routines are available from netlib's fp directory. + msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only); the + former uses -DUSE_DTOA to keep 12 from printing as 12.000000000000001. + vax.c: fix wrong arguments to badtag and frchain introduced + 28 Nov. 1993. + Source for f2c converted to ANSI/ISO format, with the K&R format + available by compilation with -DKR_headers . + Arrange for (double precision expression) relop (single precision + constant) to retain the single-precision nature of the constant. + Example: + double precision t + if (t .eq. 0.3) ... + + Mon Feb 28 11:40:24 EST 1994 + README updated to reflect a modification just made to netlib's + "dtoa.c from fp": + 96a97,105 + > Also add the rule + > + > dtoa.o: dtoa.c + > $(CC) -c $(CFLAGS) -DMALLOC=ckalloc -DIEEE... dtoa.c + > + > (without the initial tab) to the makefile, where IEEE... is one of + > IEEE_MC68k, IEEE_8087, VAX, or IBM, depending on your machine's + > arithmetic. See the comments near the start of dtoa.c. + > + + Sat Mar 5 09:41:52 EST 1994 + Complain about functions with the name of a previously declared + common block (which is illegal). + New option -d specifies the directory for output .c and .P files; + f2c.1 and f2c.1t updated. The former undocumented debug option -dnnn + is now -Dnnn. + + Thu Mar 10 10:21:44 EST 1994 + libf77: add #undef min and #undef max lines to s_paus.c s_stop.c + and system_.c; Version.c not changed. + libi77: add -DPad_UDread lines to uio.c and explanation to README: + Some buggy Fortran programs use unformatted direct I/O to write + an incomplete record and later read more from that record than + they have written. For records other than the last, the unwritten + portion of the record reads as binary zeros. The last record is + a special case: attempting to read more from it than was written + gives end-of-file -- which may help one find a bug. Some other + Fortran I/O libraries treat the last record no differently than + others and thus give no help in finding the bug of reading more + than was written. If you wish to have this behavior, compile + uio.c with -DPad_UDread . + Version.c not changed. + + Tue Mar 29 17:27:54 EST 1994 + Adjust make_param so dimensions involving min, max, and other + complicated constant expressions do not provoke error messages + about adjustable dimensions on non-arguments. + Fix botch introduced 19 Jan 1994: "adjustable dimension on non- + argument" messages could cause some things to be freed twice. + + Tue May 10 07:55:12 EDT 1994 + Trivial changes to exec.c, p1output.c, parse_args.c, proc.c, + and putpcc.c: change arguments from + type foo[] + to + type *foo + for consistency with defs.h. For most compilers, this makes no + difference. + + Thu Jun 2 12:18:18 EDT 1994 + Fix bug in handling FORMAT statements that have adjacent character + (or Hollerith) strings: an extraneous \002 appeared between the + strings. + libf77: under -DNO_ONEXIT, arrange for f_exit to be called just + once; previously, upon abnormal termination (including stop statements), + it was called twice. + + Mon Jun 6 15:52:57 EDT 1994 + libf77: Avoid references to SIGABRT and SIGIOT if neither is defined; + Version.c not changed. + libi77: Add cast to definition of errfl() in fio.h; this only matters + on systems with sizeof(int) < sizeof(long). Under -DNON_UNIX_STDIO, + use binary mode for direct formatted files (to avoid any confusion + connected with \n characters). + + Fri Jun 10 16:47:31 EDT 1994 + Fix bug under -A in handling unreferenced (and undeclared) + external arguments in subroutines with multiple entry points. Example: + subroutine m(fcn,futil) + external fcn,futil + call fcn + entry mintio(i1) ! (D_fp)0 rather than (U_fp)0 for futil + end + + Wed Jun 15 10:38:14 EDT 1994 + Allow char(constant expression) function in parameter declarations. + (This was probably broken in the changes of 29 March 1994.) + + Fri Jul 1 23:54:00 EDT 1994 + Minor adjustments to makefile (rule for f2c.1 commented out) and + sysdep.h (#undef KR_headers if __STDC__ is #defined, and base test + for ANSI_Libraries and ANSI_Prototypes on KR_headers rather than + __STDC__); version.c touched but not changed. + libi77: adjust fp.h so local.h is only needed under -DV10; + Version.c not changed. + + Tue Jul 5 03:05:46 EDT 1994 + Fix segmentation fault in + subroutine foo(a,b,k) + data i/1/ + double precision a(k,1) ! sequence error: must precede data + b = a(i,1) + end + libi77: Fix bug (introduced 6 June 1994?) in reopening files under + NON_UNIX_STDIO. + Fix some error messages caused by illegal Fortran. Examples: + * 1. + x(i) = 0 !Missing declaration for array x + call f(x) !Said Impossible storage class 8 in routine mkaddr + end !Now says invalid use of statement function x + * 2. + f = g !No declaration for g; by default it's a real variable + call g !Said invalid class code 2 for function g + end !Now says g cannot be called + * 3. + intrinsic foo !Invalid intrinsic name + a = foo(b) !Said intrcall: bad intrgroup 0 + end !Now just complains about line 1 + + Tue Jul 5 11:14:26 EDT 1994 + Fix glitch in handling erroneous statement function declarations. + Example: + a(j(i) - i) = a(j(i) - i) + 1 ! bad statement function + call foo(a(3)) ! Said Impossible type 0 in routine mktmpn + end ! Now warns that i and j are not used + + Wed Jul 6 17:31:25 EDT 1994 + Tweak test for statement functions that (illegally) call themselves; + f2c will now proceed to check for other errors, rather than bailing + out at the first recursive statement function reference. + Warn about but retain divisions by 0 (instead of calling them + "compiler errors" and quiting). On IEEE machines, this permits + double precision nan, ninf, pinf + nan = 0.d0/0.d0 + pinf = 1.d0/0.d0 + ninf = -1.d0/0.d0 + write(*,*) 'nan, pinf, ninf = ', nan, pinf, ninf + end + to print + nan, pinf, ninf = NaN Infinity -Infinity + libi77: wref.c: protect with #ifdef GOOD_SPRINTF_EXPONENT an + optimization that requires exponents to have 2 digits when 2 digits + suffice. lwrite.c wsfe.c (list and formatted external output): + omit ' ' carriage-control when compiled with -DOMIT_BLANK_CC . + Off-by-one bug fixed in character count for list output of character + strings. Omit '.' in list-directed printing of Nan, Infinity. + + Mon Jul 11 13:05:33 EDT 1994 + src/gram.c updated. + + Tue Jul 12 10:24:42 EDT 1994 + libi77: wrtfmt.c: under G11.4, write 0. as " .0000 " rather + than " .0000E+00". + + Thu Jul 14 17:55:46 EDT 1994 + Fix glitch in changes of 6 July 1994 that could cause erroneous + "division by zero" warnings (or worse). Example: + subroutine foo(a,b) + y = b + a = a / y ! erroneous warning of division by zero + end + + Mon Aug 1 16:45:17 EDT 1994 + libi77: lread.c rsne.c: for benefit of systems with a buggy stdio.h, + declare ungetc when neither KR_headers nor ungetc is #defined. + Version.c not changed. + + Wed Aug 3 01:53:00 EDT 1994 + libi77: lwrite.c (list output): do not insert a newline when + appending an oversize item to an empty line. + + Mon Aug 8 00:51:01 EDT 1994 + Fix bug (introduced 3 Feb. 1993) that, under -i2, kept LOGICAL*2 + variables from appearing in INQUIRE statements. Under -I2, allow + LOGICAL*4 variables to appear in INQUIRE. Fix intrinsic function + LEN so it returns a short value under -i2, a long value otherwise. + exec.c: fix obscure memory fault possible with bizarre (and highly + erroneous) DO-loop syntax. + + Fri Aug 12 10:45:57 EDT 1994 + libi77: fix glitch that kept ERR= (in list- or format-directed input) + from working after a NAMELIST READ. + + Thu Aug 25 13:58:26 EDT 1994 + Suppress -s when -C is specified. + Give full pathname (netlib@research.att.com) for netlib in readme and + src/README. + + Wed Sep 7 22:13:20 EDT 1994 + libi77: typesize.c: adjust to allow types LOGICAL*1, LOGICAL*2, + INTEGER*1, and (under -DAllow_TYQUAD) INTEGER*8 in NAMELISTs. + + Fri Sep 16 17:50:18 EDT 1994 + Change name adjustment for reserved words: instead of just appending + "_" (a single underscore), append "_a_" to local variable names to avoid + trouble when a common block is named a reserved word and the same + reserved word is also a local variable name. Example: + common /const/ a,b,c + real const(3) + equivalence (const(1),a) + a = 1.234 + end + Arrange for ichar() to treat characters as unsigned. + libf77: s_cmp.c: treat characters as unsigned in comparisons. + These changes for unsignedness only matter for strings that contain + non-ASCII characters. Now ichar() should always be >= 0. + + Sat Sep 17 11:19:32 EDT 1994 + fc: set rc=$? before exit (to get exit code right in trap code). + + Mon Sep 19 17:49:43 EDT 1994 + libf77: s_paus.c: flush stderr after PAUSE; add #ifdef MSDOS stuff. + libi77: README: point out general need for -DMSDOS under MS-DOS. + + Tue Sep 20 11:42:30 EDT 1994 + Fix bug in comparing identically named common blocks, in which + all components have the same names and types, but at least one is + dimensioned (1) and the other is not dimensioned. Example: + subroutine foo + common /ab/ a + a=1. !!! translated correctly to ab_1.a = (float)1.; + end + subroutine goo + common /ab/ a(1) + a(1)=2. !!! translated erroneously to ab_1.a[0] = (float)2. + end + + Tue Sep 27 23:47:34 EDT 1994 + Fix bug introduced 16 Sept. 1994: don't add _a_ to C keywords + used as external names. In fact, return to earlier behavior of + appending __ to C keywords unless they are used as external names, + in which case they get just one underscore appended. + Adjust constant handling so integer and logical PARAMETERs retain + type information, particularly under -I2. Example: + SUBROUTINE FOO + INTEGER I + INTEGER*1 I1 + INTEGER*2 I2 + INTEGER*4 I4 + LOGICAL L + LOGICAL*1 L1 + LOGICAL*2 L2 + LOGICAL*4 L4 + PARAMETER (L=.FALSE., L1=.FALSE., L2=.FALSE., L4=.FALSE.) + PARAMETER (I=0,I1=0,I2=0,I4=0) + CALL DUMMY(I, I1, I2, I4, L, L1, L2, L4) + END + f2c.1t: Change f\^2c to f2c (omit half-narrow space) in line following + ".SH NAME" for benefit of systems that cannot cope with troff commands + in this context. + + Wed Sep 28 12:45:19 EDT 1994 + libf77: s_cmp.c fix glitch in -DKR_headers version introduced + 12 days ago. + + Thu Oct 6 09:46:53 EDT 1994 + libi77: util.c: omit f__mvgbt (which is never used). + f2c.h: change "long" to "long int" to facilitate the adjustments + by means of sed described above. Comment out unused typedef of Long. + + Fri Oct 21 18:02:24 EDT 1994 + libf77: add s_catow.c and adjust README to point out that changing + "s_cat.o" to "s_catow.o" in the makefile will permit the target of a + concatenation to appear on its right-hand side (contrary to the + Fortran 77 Standard and at the cost of some run-time efficiency). + + Wed Nov 2 00:03:58 EST 1994 + Adjust -g output to contain only one #line line per statement, + inserting \ before the \n ending lines broken because of their + length [this insertion was recanted 10 Dec. 1994]. This change + accommodates an idiocy in the ANSI/ISO C standard, which leaves + undefined the behavior of #line lines that occur within the arguments + to a macro call. + + Wed Nov 2 14:44:27 EST 1994 + libi77: under compilation with -DALWAYS_FLUSH, flush buffers at + the end of each write statement, and test (via the return from + fflush) for write failures, which can be caught with an ERR= + specifier in the write statement. This extra flushing slows + execution, but can abort execution or alter the flow of control + when a disk fills up. + f2c/src/io.c: Add ERR= test to e_wsle invocation (end of + list-directed external output) to catch write failures when libI77 + is compiled with -DALWAYS_FLUSH. + + Thu Nov 3 10:59:13 EST 1994 + Fix bug in handling dimensions involving certain intrinsic + functions of constant expressions: the expressions, rather than + pointers to them, were passed. Example: + subroutine subtest(n,x) + real x(2**n,n) ! pow_ii(2,n) was called; now it's pow_ii(&c__2,n) + x(2,2)=3. + end + + Tue Nov 8 23:56:30 EST 1994 + malloc.c: remove assumption that only malloc calls sbrk. This + appears to make malloc.c useful on RS6000 systems. + + Sun Nov 13 13:09:38 EST 1994 + Turn off constant folding of integers used in floating-point + expressions, so the assignment in + subroutine foo(x) + double precision x + x = x*1000000*500000 + end + is rendered as + *x = *x * 1000000 * 500000; + rather than as + *x *= 1783793664; + + Sat Dec 10 16:31:40 EST 1994 + Supply a better error message (than "Impossible type 14") for + subroutine foo + foo = 3 + end + Under -g, convey name of included files to #line lines. + Recant insertion of \ introduced (under -g) 2 Nov. 1994. + + Thu Dec 15 14:33:55 EST 1994 + New command-line option -Idir specifies directories in which to + look for non-absolute include files (after looking in the directory + of the current input file). There can be several -Idir options, each + specifying one directory. All -Idir options are considered, from + left to right, until a suitably named file is found. The -I2 and -I4 + command-line options have precedence, so directories named 2 or 4 + must be spelled by some circumlocation, such as -I./2 . + f2c.ps updated to mention the new -Idir option, correct a typo, + and bring the man page at the end up to date. + lex.c: fix bug in reading line numbers in #line lines. + fc updated to pass -Idir options to f2c. + + Thu Dec 29 09:48:03 EST 1994 + Fix bug (e.g., addressing fault) in diagnosing inconsistency in + the type of function eta in the following example: + function foo(c1,c2) + double complex foo,c1,c2 + double precision eta + foo = eta(c1,c2) + end + function eta(c1,c2) + double complex eta,c1,c2 + eta = c1*c2 + end + + Mon Jan 2 13:27:26 EST 1995 + Retain casts for SNGL (or FLOAT) that were erroneously optimized + away. Example: + subroutine foo(a,b) + double precision a,b + a = float(b) ! now rendered as *a = (real) (*b); + end + Use float (rather than double) temporaries in certain expressions + of type complex. Example: the temporary for sngl(b) in + complex a + double precision b + a = sngl(b) - (3.,4.) + is now of type float. + + Fri Jan 6 00:00:27 EST 1995 + Adjust intrinsic function cmplx to act as dcmplx (returning + double complex rather than complex) if either of its args is of + type double precision. The double temporaries used prior to 2 Jan. + 1995 previously gave it this same behavior. + + Thu Jan 12 12:31:35 EST 1995 + Adjust -krd to use double temporaries in some calculations of + type complex. + libf77: pow_[dhiqrz][hiq].c: adjust x**i to work on machines + that sign-extend right shifts when i is the most negative integer. + + Wed Jan 25 00:14:42 EST 1995 + Fix memory fault in handling overlapping initializations in + block data + common /zot/ d + double precision d(3) + character*6 v(4) + real r(2) + equivalence (d(3),r(1)), (d(1),v(1)) + data v/'abcdef', 'ghijkl', 'mnopqr', 'stuvwx'/ + data r/4.,5./ + end + names.c: add "far", "huge", "near" to c_keywords (causing them + to have __ appended when used as local variables). + libf77: add s_copyow.c, an alternative to s_copy.c for handling + (illegal) character assignments where the right- and left-hand + sides overlap, as in a(2:4) = a(1:3). + + Thu Jan 26 14:21:19 EST 1995 + libf77: roll s_catow.c and s_copyow.c into s_cat.c and s_copy.c, + respectively, allowing the left-hand side of a character assignment + to appear on its right-hand side unless s_cat.c and s_copy.c are + compiled with -DNO_OVERWRITE (which is a bit more efficient). + Fortran 77 forbids the left-hand side from participating in the + right-hand side (of a character assignment), but Fortran 90 allows it. + libi77: wref.c: fix glitch in printing the exponent of 0 when + GOOD_SPRINTF_EXPONENT is not #defined. + + Fri Jan 27 12:25:41 EST 1995 + Under -C++ -ec (or -C++ -e1c), surround struct declarations with + #ifdef __cplusplus + extern "C" { + #endif + and + #ifdef __cplusplus + } + #endif + (This isn't needed with cfront, but apparently is necessary with + some other C++ compilers.) + libf77: minor tweak to s_copy.c: copy forward whenever possible + (for better cache behavior). + + Wed Feb 1 10:26:12 EST 1995 + Complain about parameter statements that assign values to dummy + arguments, as in + subroutine foo(x) + parameter(x = 3.4) + end + + Sat Feb 4 20:22:02 EST 1995 + fc: omit "lib=/lib/num/lib.lo". + + Wed Feb 8 08:41:14 EST 1995 + Minor changes to exec.c, putpcc.c to avoid "bad tag" or "error + in frexpr" with certain invalid Fortran. + + Sat Feb 11 08:57:39 EST 1995 + Complain about integer overflows, both in simplifying integer + expressions, and in converting integers from decimal to binary. + Fix a memory fault in putcx1() associated with invalid input. + + Thu Feb 23 11:20:59 EST 1995 + Omit MAXTOKENLEN; realloc token if necessary (to handle very long + strings). + + Fri Feb 24 11:02:00 EST 1995 + libi77: iio.c: z_getc: insert (unsigned char *) to allow internal + reading of characters with high-bit set (on machines that sign-extend + characters). + + Tue Mar 14 18:22:42 EST 1995 + Fix glitch (in io.c) in handling 0-length strings in format + statements, as in + write(*,10) + 10 format(' ab','','cd') + libi77: lread.c and rsfe.c: adjust s_rsle and s_rsfe to check for + end-of-file (to prevent infinite loops with empty read statements). + + Wed Mar 22 10:01:46 EST 1995 + f2c.ps: adjust discussion of -P on p. 7 to reflect a change made + 3 Feb. 1993: -P no longer implies -A. + + Fri Apr 21 18:35:00 EDT 1995 + fc script: remove absolute paths (since PATH specifies only standard + places). On most systems, it's still necessary to adjust the PATH + assignment at the start of fc to fit the local conventions. + + Fri May 26 10:03:17 EDT 1995 + fc script: add recognition of -P and .P files. + libi77: iio.c: z_wnew: fix bug in handling T format items in internal + writes whose last item is written to an earlier position than some + previous item. + + Wed May 31 11:39:48 EDT 1995 + libf77: added subroutine exit(rc) (with integer return code rc), + which works like a stop statement but supplies rc as the program's + return code. + + Fri Jun 2 11:56:50 EDT 1995 + Fix memory fault in + parameter (x=2.) + data x /2./ + end + This now elicits two error messages; the second ("too many + initializers"), though not desirable, seems hard to eliminate + without considerable hassle. + + Mon Jul 17 23:24:20 EDT 1995 + Fix botch in simplifying constants in certain complex + expressions. Example: + subroutine foo(s,z) + double complex z + double precision s, M, P + parameter ( M = 100.d0, P = 2.d0 ) + z = M * M / s * dcmplx (1.d0, P/M) + *** The imaginary part of z was miscomputed *** + end + Under -ext, complain about nonintegral dimensions. + + Fri Jul 21 11:18:36 EDT 1995 + Fix glitch on line 159 of init.c: change + "(shortlogical *)0)", + to + "(shortlogical *)0", + This affects multiple entry points when some but not all have + arguments of type logical*2. + libi77: adjust lwrite.c, wref.c, wrtfmt.c so compiling with + -DWANT_LEAD_0 causes formatted writes of floating-point numbers of + magnitude < 1 to have an explicit 0 before the decimal point (if the + field-width permits it). Note that the Fortran 77 Standard leaves it + up to the implementation whether to supply these superfluous zeros. + + Tue Aug 1 09:25:56 EDT 1995 + Permit real (or double precision) parameters in dimension expressions. + + Mon Aug 7 08:04:00 EDT 1995 + Append "_eqv" rather than just "_" to names that that appear in + EQUIVALENCE statements as well as structs in f2c.h (to avoid a + conflict when these names also name common blocks). + + Tue Aug 8 12:49:02 EDT 1995 + Modify yesterday's change: merge st_fields with c_keywords, to + cope with equivalences introduced to permit initializing numeric + variables with character data. DATA statements causing these + equivalences can appear after executable statements, so the only + safe course is to rename all local variable with names in the + former st_fields list. This has the unfortunate side effect that + the common local variable "i" will henceforth be renamed "i__". + + Wed Aug 30 00:19:32 EDT 1995 + libf77: add F77_aloc, now used in s_cat and system_ (to allocate + memory and check for failure in so doing). + libi77: improve MSDOS logic in backspace.c. + + Wed Sep 6 09:06:19 EDT 1995 + libf77: Fix return type of system_ (integer) under -DKR_headers. + libi77: Move some f_init calls around for people who do not use + libF77's main(); now open and namelist read statements that are the + first I/O statements executed should work right in that context. + Adjust namelist input to treat a subscripted name whose subscripts do + not involve colons similarly to the name without a subscript: accept + several values, stored in successive elements starting at the + indicated subscript. Adjust namelist output to quote character + strings (avoiding confusion with arrays of character strings). + + Thu Sep 7 00:36:04 EDT 1995 + Fix glitch in integer*8 exponentiation function: it's pow_qq, not + pow_qi. + libi77: fix some bugs with -DAllow_TYQUAD (for integer*8); when + looking for the &name that starts NAMELIST input, treat lines whose + first nonblank character is something other than &, $, or ? as + comment lines (i.e., ignore them), unless rsne.c is compiled with + -DNo_Namelist_Comments. + + Thu Sep 7 09:05:40 EDT 1995 + libi77: rdfmt.c: one more tweak for -DAllow_TYQUAD. + + Tue Sep 19 00:03:02 EDT 1995 + Adjust handling of floating-point subscript bounds (a questionable + f2c extension) so subscripts in the generated C are of integral type. + Move #define of roundup to proc.c (where its use is commented out); + version.c left at 19950918. + + Wed Sep 20 17:24:19 EDT 1995 + Fix bug in handling ichar() under -h. + + Thu Oct 5 07:52:56 EDT 1995 + libi77: wrtfmt.c: fix bug with t editing (f__cursor was not always + zeroed in mv_cur). + + Tue Oct 10 10:47:54 EDT 1995 + Under -ext, warn about X**-Y and X**+Y. Following the original f77, + f2c treats these as X**(-Y) and X**(+Y), respectively. (They are not + allowed by the official Fortran 77 Standard.) Some Fortran compilers + give a bizarre interpretation to larger contexts, making multiplication + noncommutative: they treat X**-Y*Z as X**(-Y*Z) rather than X**(-Y)*Z, + which, following the rules of Fortran 77, is the same as (X**(-Y))*Z. + + Wed Oct 11 13:27:05 EDT 1995 + libi77: move defs of f__hiwater, f__svic, f__icptr from wrtfmt.c + to err.c. This should work around a problem with buggy loaders and + sometimes leads to smaller executable programs. + + Sat Oct 21 23:54:22 EDT 1995 + Under -h, fix bug in the treatment of ichar('0') in arithmetic + expressions. + Demote to -dneg (a new command-line option not mentioned in the + man page) imitation of the original f77's treatment of unary minus + applied to a REAL operand (yielding a DOUBLE PRECISION result). + Previously this imitation (which was present for debugging) occurred + under (the default) -!R. It is still suppressed by -R. + + Tue Nov 7 23:52:57 EST 1995 + Adjust assigned GOTOs to honor SAVE declarations. + Add comments about ranlib to lib[FI]77/README and makefile. + + Tue Dec 19 22:54:06 EST 1995 + libf77: s_cat.c: fix bug when 2nd or later arg overlaps lhs. + + Tue Jan 2 17:54:00 EST 1996 + libi77: rdfmt.c: move #include "ctype.h" up before "stdlib.h"; no + change to Version.c. + + Sun Feb 25 22:20:20 EST 1996 + Adjust expr.c to permit raising the integer constants 1 and -1 to + negative constant integral powers. + Avoid faulting when -T and -d are not followed by a directory name + (immediately, without intervening spaces). + + Wed Feb 28 12:49:01 EST 1996 + Fix a glitch in handling complex parameters assigned a "wrong" type. + Example: + complex d, z + parameter(z = (0d0,0d0)) + data d/z/ ! elicited "non-constant initializer" + call foo(d) + end + + Thu Feb 29 00:53:12 EST 1996 + Fix bug in handling character parameters assigned a char() value. + Example: + character*2 b,c + character*1 esc + parameter(esc = char(27)) + integer i + data (b(i:i),i=1,2)/esc,'a'/ + data (c(i:i),i=1,2)/esc,'b'/ ! memory fault + call foo(b,c) + end + + Fri Mar 1 23:44:51 EST 1996 + Fix glitch in evaluating .EQ. and .NE. when both operands are + logical constants (.TRUE. or .FALSE.). + + Fri Mar 15 17:29:54 EST 1996 + libi77: lread.c, rsfe.c: honor END= in READ stmts with empty iolist. + + Tue Mar 19 23:08:32 EST 1996 + lex.c: arrange for a "statement" consisting of a single short bogus + keyword to elicit an error message showing the whole keyword. The + error message formerly omitted the last letter of the bad keyword. + libf77: s_cat.c: supply missing break after overlap detection. + + Mon May 13 23:35:26 EDT 1996 + Recognize Fortran 90's /= as a synonym for .NE.. (<> remains a + synonym for .NE..) + Emit an empty int function of no arguments to supply an external + name to named block data subprograms (so they can be called somewhere + to force them to be loaded from a library). + Fix bug (memory fault) in handling the following illegal Fortran: + parameter(i=1) + equivalence(i,j) + end + Treat cdabs, cdcos, cdexp, cdlog, cdsin, and cdsqrt as synonyms for + the double complex intrinsics zabs, zcos, zexp, zlog, zsin, and zsqrt, + respectively, unless -cd is specified. + Recognize the Fortran 90 bit-manipulation intrinsics btest, iand, + ibclr, ibits, ibset, ieor, ior, ishft, and ishftc, unless -i90 is + specified. Note that iand, ieor, and ior are thus now synonyms for + "and", "xor", and "or", respectively. + Add three macros (bit_test, bit_clear, bit_set) to f2c.h for use + with btest, ibclr, and ibset, respectively. Add new functions + [lq]bit_bits, [lq]bit_shift, and [lq]_bit_cshift to libF77 for + use with ibits, ishft, and ishftc, respectively. + Add integer function ftell(unit) (returning -1 on error) and + subroutine fseek(unit, offset, whence, *) to libI77 (with branch to + label * on error). + + Tue May 14 23:21:12 EDT 1996 + Fix glitch (possible memory fault, or worse) in handling multiple + entry points with names over 28 characters long. + + Mon Jun 10 01:20:16 EDT 1996 + Update netlib E-mail and ftp addresses in f2c/readme and + f2c/src/readme (which are different files) -- to reflect the upcoming + breakup of AT&T. + libf77: trivial tweaks to F77_aloc.c and system_.c; Version.c not + changed. + libi77: Adjust rsli.c and lread.c so internal list input with too + few items in the input string will honor end= . + + Mon Jun 10 22:59:57 EDT 1996 + Add Bits_per_Byte to sysdep.h and adjust definition of Table_size + to depend on Bits_per_Byte (forcing Table_size to be a power of 2); in + lex.c, change "comstart[c & 0xfff]" to "comstart[c & (Table_size-1)]" + to avoid an out-of-range subscript on end-of-file. + + Wed Jun 12 00:24:28 EDT 1996 + Fix bug in output.c (dereferencing a freed pointer) revealed in + print * !np in out_call in output.c clobbered by free + end !during out_expr. + + Wed Jun 19 08:12:47 EDT 1996 + f2c.h: add types uinteger, ulongint (for libF77); add qbit_clear + and qbit_set macros (in a commented-out section) for integer*8. + For integer*8, use qbit_clear and qbit_set for ibclr and ibset. + libf77: add casts to unsigned in [lq]bitshft.c. + + Thu Jun 20 13:30:43 EDT 1996 + Complain at character*(*) in common (rather than faulting). + Fix bug in recognizing hex constants that start with "16#" (e.g., + 16#1234abcd, which is a synonym for z'1234abcd'). + Fix bugs in constant folding of expressions involving btest, ibclr, + and ibset. + Fix bug in constant folding of rshift(16#80000000, -31) (on a 32-bit + machine; more generally, the bug was in constant folding of + rshift(ibset(0,NBITS-1), 1-NBITS) when f2c runs on a machine with + long ints having NBITS bits. + + Mon Jun 24 07:58:53 EDT 1996 + Adjust struct Literal and newlabel() function to accommodate huge + source files (with more than 32767 newlabel() invocations). + Omit .c file when the .f file has a missing final end statement. + + Wed Jun 26 14:00:02 EDT 1996 + libi77: Add discussion of MXUNIT (highest allowed Fortran unit number) + to libI77/README. + + Fri Jun 28 14:16:11 EDT 1996 + Fix glitch with -onetrip: the temporary variable used for nonconstant + initial loop variable values was recycled too soon. Example: + do i = j+1, k + call foo(i+1) ! temp for j+1 was reused here + enddo + end + + Tue Jul 2 16:11:27 EDT 1996 + formatdata.c: add a 0 to the end of the basetype array (for TYBLANK) + (an omission that was harmless on most machines). + expr.c: fix a dereference of NULL that was only possible with buggy + input, such as + subroutine $sub(s) ! the '$' is erroneous + character s*(*) + s(1:) = ' ' + end + + Sat Jul 6 00:44:56 EDT 1996 + Fix glitch in the intrinsic "real" function when applied to a + complex (or double complex) variable and passed as an argument to + some intrinsic functions. Example: + complex a + b = sqrt(a) + end + Fix glitch (only visible if you do not use f2c's malloc and the + malloc you do use is defective in the sense that malloc(0) returns 0) + in handling include files that end with another include (perhaps + followed by comments). + Fix glitch with character*(*) arguments named "h" and "i" when + the body of the subroutine invokes the intrinsic LEN function. + Arrange that after a previous "f2c -P foo.f" has produced foo.P, + running "f2c foo.P foo.f" will produce valid C when foo.f contains + call sub('1234') + end + subroutine sub(msg) + end + Specifically, the length argument in "call sub" is now suppressed. + With or without foo.P, it is also now suppressed when the order of + subprograms in file foo.f is reversed: + subroutine sub(msg) + end + call sub('1234') + end + Adjust copyright notices to reflect AT&T breakup. + + Wed Jul 10 09:25:49 EDT 1996 + Fix bug (possible memory fault) in handling erroneously placed + and inconsistent declarations. Example that faulted: + character*1 w(8) + call foo(w) + end + subroutine foo(m) + data h /0.5/ + integer m(2) ! should be before data + end + Fix bug (possible fault) in handling illegal "if" constructions. + Example (that faulted): + subroutine foo(i,j) + if (i) then ! bug: i is integer, not logical + else if (j) then ! bug: j is integer, not logical + endif + end + Fix glitch with character*(*) argument named "ret_len" to a + character*(*) function. + + Wed Jul 10 23:04:16 EDT 1996 + Fix more glitches in the intrinsic "real" function when applied to a + complex (or double complex) variable and passed as an argument to + some intrinsic functions. Example: + complex a, b + r = sqrt(real(conjg(a))) + sqrt(real(a*b)) + end + + Thu Jul 11 17:27:16 EDT 1996 + Fix a memory fault associated with complicated, illegal input. + Example: + subroutine goo + character a + call foo(a) ! inconsistent with subsequent def and call + end + subroutine foo(a) + end + call foo(a) + end + + Wed Jul 17 19:18:28 EDT 1996 + Fix yet another case of intrinsic "real" applied to a complex + argument. Example: + complex a(3) + x = sqrt(real(a(2))) ! gave error message about bad tag + end + + Mon Aug 26 11:28:57 EDT 1996 + Tweak sysdep.c for non-Unix systems in which process ID's can be + over 5 digits long. + + Tue Aug 27 08:31:32 EDT 1996 + Adjust the ishft intrinsic to use unsigned right shifts. (Previously, + a negative constant second operand resulted in a possibly signed shift.) + + Thu Sep 12 14:04:07 EDT 1996 + equiv.c: fix glitch with -DKR_headers. + libi77: fmtlib.c: fix bug in printing the most negative integer. + + Fri Sep 13 08:54:40 EDT 1996 + Diagnose some illegal appearances of substring notation. + + Tue Sep 17 17:48:09 EDT 1996 + Fix fault in handling some complex parameters. Example: + subroutine foo(a) + double complex a, b + parameter(b = (0,1)) + a = b ! f2c faulted here + end + + Thu Sep 26 07:47:10 EDT 1996 + libi77: fmt.h: for formatted writes of negative integer*1 values, + make ic signed on ANSI systems. If formatted writes of integer*1 + values trouble you when using a K&R C compiler, switch to an ANSI + compiler or use a compiler flag that makes characters signed. + + Tue Oct 1 14:41:36 EDT 1996 + Give a better error message when dummy arguments appear in data + statements. + + Thu Oct 17 13:37:22 EDT 1996 + Fix bug in typechecking arguments to character and complex (or + double complex) functions; the bug could cause length arguments + for character arguments to be omitted on invocations appearing + textually after the first invocation. For example, in + subroutine foo + character c + complex zot + call goo(zot(c), zot(c)) + end + the length was omitted from the second invocation of zot, and + there was an erroneous error message about inconsistent calling + sequences. + + Wed Dec 4 13:59:14 EST 1996 + Fix bug revealed by + subroutine test(cdum,rdum) + complex cdum + rdum=cos(real(cdum)) ! "Unexpected tag 3 in opconv_fudge" + end + Fix glitch in parsing "DO 10 D0 = 1, 10". + Fix glitch in parsing + real*8 x + real*8 x ! erroneous "incompatible type" message + call foo(x) + end + + Mon Dec 9 23:15:02 EST 1996 + Fix glitch in parameter adjustments for arrays whose lower + bound depends on a scalar argument. Example: + subroutine bug(p,z,m,n) + integer z(*),m,n + double precision p(z(m):z(m) + n) ! p_offset botched + call foo(p(0), p(n)) + end + libi77: complain about non-positive rec= in direct read and write + statements. + libf77: trivial adjustments; Version.c not changed. + + Wed Feb 12 00:18:03 EST 1997 + output.c: fix (seldom problematic) glitch in out_call: put parens + around the ... in a test of the form "if (q->tag == TADDR && ...)". + vax.c: fix bug revealed in the "psi_offset =" assignment in the + following example: + subroutine foo(psi,m) + integer z(100),m + common /a/ z + double precision psi(z(m):z(m) + 10) + call foo(m+1, psi(0),psi(10)) + end + + Mon Feb 24 23:44:54 EST 1997 + For consistency with f2c's current treatment of adjacent character + strings in FORMAT statements, recognize a Hollerith string following + a string (and merge adjacent strings in FORMAT statements). + + Wed Feb 26 13:41:11 EST 1997 + New libf2c.zip, a combination of the libf77 and libi77 bundles (and + available only by ftp). + libf77: adjust functions with a complex output argument to permit + aliasing it with input arguments. (For now, at least, this is just + for possible benefit of g77.) + libi77: tweak to ftell_.c for systems with strange definitions of + SEEK_SET, etc. + + Tue Apr 8 20:57:08 EDT 1997 + libf77: [cz]_div.c: tweaks invisible on most systems (that may + improve things slightly with optimized compilation on systems that use + gratuitous extra precision). + libi77: fmt.c: adjust to complain at missing numbers in formats + (but still treat missing ".nnn" as ".0"). + + Fri Apr 11 14:05:57 EDT 1997 + libi77: err.c: attempt to make stderr line buffered rather than + fully buffered. (Buffering is needed for format items T and TR.) + + Thu Apr 17 22:42:43 EDT 1997 + libf77: add F77_aloc.o to makefile (and makefile.u in libf2c.zip). + + Fri Apr 25 19:32:09 EDT 1997 + libf77: add [de]time_.c (which may give trouble on some systems). + + Tue May 27 09:18:52 EDT 1997 + libi77: ftell_.c: fix typo that caused the third argument to be + treated as 2 on some systems. + + Mon Jun 9 00:04:37 EDT 1997 + libi77 (and libf2c.zip): adjust include order in err.c lread.c wref.c + rdfmt.c to include fmt.h (etc.) after system includes. Version.c not + changed. + + Mon Jul 21 16:04:54 EDT 1997 + proc.c: fix glitch in logic for "nonpositive dimension" message. + libi77: inquire.c: always include string.h (for possible use with + -DNON_UNIX_STDIO); Version.c not changed. + + Thu Jul 24 17:11:23 EDT 1997 + Tweak "Notice" to reflect the AT&T breakup -- we missed it when + updating the copyright notices in the source files last summer. + Adjust src/makefile so malloc.o is not used by default, but can + be specified with "make MALLOC=malloc.o". + Add comments to src/README about the "CRAY" T3E. + + Tue Aug 5 14:53:25 EDT 1997 + Add definition of calloc to malloc.c; this makes f2c's malloc + work on some systems where trouble hitherto arose because references + to calloc brought in the system's malloc. (On sensible systems, + calloc is defined separately from malloc. To avoid confusion on + other systems, f2c/malloc.c now defines calloc.) + libi77: lread.c: adjust to accord with a change to the Fortran 8X + draft (in 1990 or 1991) that rescinded permission to elide quote marks + in namelist input of character data; to get the old behavior, compile + with F8X_NML_ELIDE_QUOTES #defined. wrtfmt.o: wrt_G: tweak to print + the right number of 0's for zero under G format. + + Sat Aug 16 05:45:32 EDT 1997 + libI77: iio.c: fix bug in internal writes to an array of character + strings that sometimes caused one more array element than required by + the format to be blank-filled. Example: format(1x). diff -rcp2N g77-0.5.20/f/runtime/configure g77-0.5.21/f/runtime/configure *** g77-0.5.20/f/runtime/configure Sun Feb 23 22:22:00 1997 --- g77-0.5.21/f/runtime/configure Tue Sep 2 21:33:07 1997 *************** test "$AR" || AR=ar *** 704,707 **** --- 704,710 ---- if test "$RANLIB"; then : + if test -z "$RANLIB_TEST"; then + RANLIB_TEST=true + fi else RANLIB_TEST=true *************** else *** 709,713 **** set dummy ranlib; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:712: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 --- 712,716 ---- set dummy ranlib; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 ! echo "configure:715: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 *************** fi *** 742,746 **** # Sanity check for the cross-compilation case: echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 ! echo "configure:745: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then --- 745,749 ---- # Sanity check for the cross-compilation case: echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 ! echo "configure:748: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then *************** else *** 757,761 **** # not just through cpp. cat > conftest.$ac_ext < --- 760,764 ---- # not just through cpp. cat > conftest.$ac_ext < *************** Syntax Error *** 763,767 **** EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:766: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then --- 766,770 ---- EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:769: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then *************** else *** 774,778 **** CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext < --- 777,781 ---- CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext < *************** Syntax Error *** 780,784 **** EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:783: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then --- 783,787 ---- EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:786: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then *************** echo "$ac_t""$CPP" 1>&6 *** 804,818 **** ac_safe=`echo "stdio.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for stdio.h""... $ac_c" 1>&6 ! echo "configure:807: checking for stdio.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:817: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then --- 807,821 ---- ac_safe=`echo "stdio.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for stdio.h""... $ac_c" 1>&6 ! echo "configure:810: checking for stdio.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:820: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then *************** fi *** 842,851 **** echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 ! echo "configure:845: checking for ANSI C header files" >&5 if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < --- 845,854 ---- echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 ! echo "configure:848: checking for ANSI C header files" >&5 if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < *************** else *** 855,859 **** EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:858: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then --- 858,862 ---- EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:861: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then *************** if test $ac_cv_header_stdc = yes; then *** 872,876 **** # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext < --- 875,879 ---- # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext < *************** if test $ac_cv_header_stdc = yes; then *** 890,894 **** # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext < --- 893,897 ---- # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext < *************** if test "$cross_compiling" = yes; then *** 911,915 **** else cat > conftest.$ac_ext < --- 914,918 ---- else cat > conftest.$ac_ext < *************** exit (0); } *** 922,926 **** EOF ! if { (eval echo configure:925: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null then : --- 925,929 ---- EOF ! if { (eval echo configure:928: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null then : *************** fi *** 948,957 **** echo $ac_n "checking for posix""... $ac_c" 1>&6 ! echo "configure:951: checking for posix" >&5 ! if eval "test \"`echo '$''{'ac_cv_header_posix'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < --- 951,960 ---- echo $ac_n "checking for posix""... $ac_c" 1>&6 ! echo "configure:954: checking for posix" >&5 ! if eval "test \"`echo '$''{'g77_cv_header_posix'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < *************** if (eval "$ac_cpp conftest.$ac_ext") 2>& *** 965,972 **** egrep "yes" >/dev/null 2>&1; then rm -rf conftest* ! ac_cv_header_posix=yes else rm -rf conftest* ! ac_cv_header_posix=no fi rm -f conftest* --- 968,975 ---- egrep "yes" >/dev/null 2>&1; then rm -rf conftest* ! g77_cv_header_posix=yes else rm -rf conftest* ! g77_cv_header_posix=no fi rm -f conftest* *************** rm -f conftest* *** 974,988 **** fi ! echo "$ac_t""$ac_cv_header_posix" 1>&6 # We can rely on the GNU library being posix-ish. I guess checking the # header isn't actually like checking the functions, though... echo $ac_n "checking for GNU library""... $ac_c" 1>&6 ! echo "configure:982: checking for GNU library" >&5 ! if eval "test \"`echo '$''{'ac_cv_lib_gnu'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < --- 977,991 ---- fi ! echo "$ac_t""$g77_cv_header_posix" 1>&6 # We can rely on the GNU library being posix-ish. I guess checking the # header isn't actually like checking the functions, though... echo $ac_n "checking for GNU library""... $ac_c" 1>&6 ! echo "configure:985: checking for GNU library" >&5 ! if eval "test \"`echo '$''{'g77_cv_lib_gnu'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < *************** if (eval "$ac_cpp conftest.$ac_ext") 2>& *** 995,1002 **** egrep "yes" >/dev/null 2>&1; then rm -rf conftest* ! ac_cv_lib_gnu=yes else rm -rf conftest* ! ac_cv_lib_gnu=no fi rm -f conftest* --- 998,1005 ---- egrep "yes" >/dev/null 2>&1; then rm -rf conftest* ! g77_cv_lib_gnu=yes else rm -rf conftest* ! g77_cv_lib_gnu=no fi rm -f conftest* *************** rm -f conftest* *** 1004,1022 **** fi ! echo "$ac_t""$ac_cv_lib_gnu" 1>&6 ac_safe=`echo "fcntl.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for fcntl.h""... $ac_c" 1>&6 ! echo "configure:1011: checking for fcntl.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:1021: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then --- 1007,1053 ---- fi ! echo "$ac_t""$g77_cv_lib_gnu" 1>&6 ! ! # Apparently cygwin needs to be special-cased. ! echo $ac_n "checking for cyg\`win'32""... $ac_c" 1>&6 ! echo "configure:1014: checking for cyg\`win'32" >&5 ! if eval "test \"`echo '$''{'g77_cv_sys_cygwin32'+set}'`\" = set"; then ! echo $ac_n "(cached) $ac_c" 1>&6 ! else ! cat > conftest.$ac_ext <&5 | ! egrep "yes" >/dev/null 2>&1; then ! rm -rf conftest* ! g77_cv_sys_cygwin32=yes ! else ! rm -rf conftest* ! g77_cv_sys_cygwin32=no ! fi ! rm -f conftest* ! ! fi ! ! echo "$ac_t""$g77_cv_sys_cygwin32" 1>&6 ac_safe=`echo "fcntl.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for fcntl.h""... $ac_c" 1>&6 ! echo "configure:1042: checking for fcntl.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:1052: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then *************** fi *** 1034,1038 **** if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then echo "$ac_t""yes" 1>&6 ! test $ac_cv_header_posix = yes && cat >> confdefs.h <<\EOF #define _POSIX_SOURCE 1 EOF --- 1065,1069 ---- if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then echo "$ac_t""yes" 1>&6 ! test $g77_cv_header_posix = yes && cat >> confdefs.h <<\EOF #define _POSIX_SOURCE 1 EOF *************** fi *** 1051,1060 **** echo $ac_n "checking for working const""... $ac_c" 1>&6 ! echo "configure:1054: checking for working const" >&5 if eval "test \"`echo '$''{'ac_cv_c_const'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&6 ! echo "configure:1085: checking for working const" >&5 if eval "test \"`echo '$''{'ac_cv_c_const'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_const=yes --- 1136,1140 ---- ; return 0; } EOF ! if { (eval echo configure:1139: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_const=yes *************** fi *** 1126,1135 **** echo $ac_n "checking for size_t""... $ac_c" 1>&6 ! echo "configure:1129: checking for size_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < --- 1157,1166 ---- echo $ac_n "checking for size_t""... $ac_c" 1>&6 ! echo "configure:1160: checking for size_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < *************** fi *** 1160,1169 **** echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6 ! echo "configure:1163: checking return type of signal handlers" >&5 if eval "test \"`echo '$''{'ac_cv_type_signal'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < --- 1191,1200 ---- echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6 ! echo "configure:1194: checking return type of signal handlers" >&5 if eval "test \"`echo '$''{'ac_cv_type_signal'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < *************** int i; *** 1182,1186 **** ; return 0; } EOF ! if { (eval echo configure:1185: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_type_signal=void --- 1213,1217 ---- ; return 0; } EOF ! if { (eval echo configure:1216: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_type_signal=void *************** EOF *** 1203,1212 **** if test $ac_cv_header_stdc != yes; then echo $ac_n "checking for atexit""... $ac_c" 1>&6 ! echo "configure:1206: checking for atexit" >&5 if eval "test \"`echo '$''{'ac_cv_func_atexit'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&6 ! echo "configure:1237: checking for atexit" >&5 if eval "test \"`echo '$''{'ac_cv_func_atexit'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_atexit=yes" --- 1262,1266 ---- ; return 0; } EOF ! if { (eval echo configure:1265: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_atexit=yes" *************** EOF *** 1256,1265 **** echo $ac_n "checking for onexit""... $ac_c" 1>&6 ! echo "configure:1259: checking for onexit" >&5 if eval "test \"`echo '$''{'ac_cv_func_onexit'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&6 ! echo "configure:1290: checking for onexit" >&5 if eval "test \"`echo '$''{'ac_cv_func_onexit'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_onexit=yes" --- 1315,1319 ---- ; return 0; } EOF ! if { (eval echo configure:1318: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_onexit=yes" *************** else *** 1302,1311 **** echo "$ac_t""no" 1>&6 echo $ac_n "checking for on_exit""... $ac_c" 1>&6 ! echo "configure:1305: checking for on_exit" >&5 if eval "test \"`echo '$''{'ac_cv_func_on_exit'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&6 echo $ac_n "checking for on_exit""... $ac_c" 1>&6 ! echo "configure:1336: checking for on_exit" >&5 if eval "test \"`echo '$''{'ac_cv_func_on_exit'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_on_exit=yes" --- 1361,1365 ---- ; return 0; } EOF ! if { (eval echo configure:1364: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_on_exit=yes" *************** else true *** 1359,1370 **** fi ! # This should always succeed on unix: echo $ac_n "checking for fstat""... $ac_c" 1>&6 ! echo "configure:1364: checking for fstat" >&5 if eval "test \"`echo '$''{'ac_cv_func_fstat'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&6 ! echo "configure:1397: checking for fstat" >&5 if eval "test \"`echo '$''{'ac_cv_func_fstat'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_fstat=yes" --- 1422,1426 ---- ; return 0; } EOF ! if { (eval echo configure:1425: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_fstat=yes" *************** if eval "test \"`echo '$ac_cv_func_'fsta *** 1406,1423 **** else echo "$ac_t""no" 1>&6 ! cat >> confdefs.h <<\EOF #define NON_UNIX_STDIO 1 EOF fi # This is necessary for e.g. Linux: echo $ac_n "checking for necessary members of struct FILE""... $ac_c" 1>&6 ! echo "configure:1417: checking for necessary members of struct FILE" >&5 ! if eval "test \"`echo '$''{'ac_cv_struct_FILE'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < --- 1439,1464 ---- else echo "$ac_t""no" 1>&6 ! fi ! ! echo $ac_n "checking need for NON_UNIX_STDIO""... $ac_c" 1>&6 ! echo "configure:1445: checking need for NON_UNIX_STDIO" >&5 ! if test $g77_cv_sys_cygwin32 = yes || test $ac_cv_func_fstat = no; then ! echo "$ac_t""yes" 1>&6 ! cat >> confdefs.h <<\EOF #define NON_UNIX_STDIO 1 EOF + else + echo "$ac_t""no" 1>&6 fi # This is necessary for e.g. Linux: echo $ac_n "checking for necessary members of struct FILE""... $ac_c" 1>&6 ! echo "configure:1458: checking for necessary members of struct FILE" >&5 ! if eval "test \"`echo '$''{'g77_cv_struct_FILE'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < *************** FILE s; s._ptr; s._base; s._flag; *** 1426,1442 **** ; return 0; } EOF ! if { (eval echo configure:1429: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ! ac_cv_struct_FILE=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* ! ac_cv_struct_FILE=no fi rm -f conftest* fi ! echo "$ac_t""$ac_cv_struct_FILE" 1>&6 ! if test $ac_cv_struct_FILE = no; then cat >> confdefs.h <<\EOF #define MISSING_FILE_ELEMS 1 --- 1467,1483 ---- ; return 0; } EOF ! if { (eval echo configure:1470: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ! g77_cv_struct_FILE=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* ! g77_cv_struct_FILE=no fi rm -f conftest* fi ! echo "$ac_t""$g77_cv_struct_FILE" 1>&6 ! if test $g77_cv_struct_FILE = no; then cat >> confdefs.h <<\EOF #define MISSING_FILE_ELEMS 1 *************** fi *** 1446,1450 **** echo $ac_n "checking for drem in -lm""... $ac_c" 1>&6 ! echo "configure:1449: checking for drem in -lm" >&5 ac_lib_var=`echo m'_'drem | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then --- 1487,1491 ---- echo $ac_n "checking for drem in -lm""... $ac_c" 1>&6 ! echo "configure:1490: checking for drem in -lm" >&5 ac_lib_var=`echo m'_'drem | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then *************** else *** 1454,1458 **** LIBS="-lm $LIBS" cat > conftest.$ac_ext < conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" --- 1506,1510 ---- ; return 0; } EOF ! if { (eval echo configure:1509: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" *************** fi *** 1495,1504 **** # we're posix-conformant, so always do the test. echo $ac_n "checking for ansi/posix sprintf result""... $ac_c" 1>&6 ! echo "configure:1498: checking for ansi/posix sprintf result" >&5 if test "$cross_compiling" = yes; then ! ac_cv_sys_sprintf_ansi=no else cat > conftest.$ac_ext < --- 1536,1545 ---- # we're posix-conformant, so always do the test. echo $ac_n "checking for ansi/posix sprintf result""... $ac_c" 1>&6 ! echo "configure:1539: checking for ansi/posix sprintf result" >&5 if test "$cross_compiling" = yes; then ! g77_cv_sys_sprintf_ansi=no else cat > conftest.$ac_ext < *************** else *** 1507,1534 **** EOF ! if { (eval echo configure:1510: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null then ! ac_cv_sys_sprintf_ansi=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -fr conftest* ! ac_cv_sys_sprintf_ansi=no fi rm -fr conftest* fi ! if eval "test \"`echo '$''{'ac_cv_sys_sprintf_ansi'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ! ac_cv_sys_sprintf_ansi=$ac_cv_sys_sprintf_ansi fi if test $ac_cv_c_cross = no; then ! echo "$ac_t""$ac_cv_sys_sprintf_ansi" 1>&6 else echo "$ac_t""can't tell -- assuming no" 1>&6 fi ! if test $ac_cv_sys_sprintf_ansi != yes; then cat >> confdefs.h <<\EOF #define USE_STRLEN 1 --- 1548,1577 ---- EOF ! if { (eval echo configure:1551: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null then ! g77_cv_sys_sprintf_ansi=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -fr conftest* ! g77_cv_sys_sprintf_ansi=no fi rm -fr conftest* fi ! if eval "test \"`echo '$''{'g77_cv_sys_sprintf_ansi'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ! g77_cv_sys_sprintf_ansi=$g77_cv_sys_sprintf_ansi fi if test $ac_cv_c_cross = no; then ! echo "$ac_t""$g77_cv_sys_sprintf_ansi" 1>&6 else echo "$ac_t""can't tell -- assuming no" 1>&6 fi ! # The cygwin patch takes steps to avoid defining USE_STRLEN here -- I don't ! # understand why. ! if test $g77_cv_sys_sprintf_ansi != yes; then cat >> confdefs.h <<\EOF #define USE_STRLEN 1 *************** fi *** 1538,1543 **** # define NON_ANSI_RW_MODES on unix (can't hurt) cat > conftest.$ac_ext <&6 + echo "configure:1585: checking NON_ANSI_RW_MODES" >&5 cat > conftest.$ac_ext <> confdefs.h <<\EOF #define NON_ANSI_RW_MODES 1 EOF # We have to firkle with the info in hconfig.h to figure out suitable types --- 1607,1623 ---- rm -f conftest* ! if test $g77_cv_sys_cygwin32 = yes; then ! echo "$ac_t""no" 1>&6 ! else ! if test $is_unix = yes; then ! cat >> confdefs.h <<\EOF #define NON_ANSI_RW_MODES 1 EOF + echo "$ac_t""yes" 1>&6 + else + echo "$ac_t""no" 1>&6 + fi + fi # We have to firkle with the info in hconfig.h to figure out suitable types *************** EOF *** 1571,1582 **** # is in ../.. and the config files are in $srcdir/../../config. echo $ac_n "checking f2c integer type""... $ac_c" 1>&6 ! echo "configure:1574: checking f2c integer type" >&5 late_ac_cpp=$ac_cpp ac_cpp="$late_ac_cpp -I$srcdir/.. -I../.. -I$srcdir/../.. -I$srcdir/../../config" ! if eval "test \"`echo '$''{'ac_cv_sys_f2cinteger'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&6 ! echo "configure:1628: checking f2c integer type" >&5 late_ac_cpp=$ac_cpp ac_cpp="$late_ac_cpp -I$srcdir/.. -I../.. -I$srcdir/../.. -I$srcdir/../../config" ! if eval "test \"`echo '$''{'g77_cv_sys_f2cinteger'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <& *** 1595,1605 **** egrep "F2C_INTEGER=long int" >/dev/null 2>&1; then rm -rf conftest* ! ac_cv_sys_f2cinteger="long int" fi rm -f conftest* ! if test "$ac_cv_sys_f2cinteger" = ""; then cat > conftest.$ac_ext </dev/null 2>&1; then rm -rf conftest* ! g77_cv_sys_f2cinteger="long int" fi rm -f conftest* ! if test "$g77_cv_sys_f2cinteger" = ""; then cat > conftest.$ac_ext <& *** 1618,1627 **** egrep "F2C_INTEGER=int" >/dev/null 2>&1; then rm -rf conftest* ! ac_cv_sys_f2cinteger=int fi rm -f conftest* fi ! if test "$ac_cv_sys_f2cinteger" = ""; then echo "$ac_t""""" 1>&6 { echo "configure: error: Can't determine type for f2c integer; config.log may help." 1>&2; exit 1; } --- 1672,1681 ---- egrep "F2C_INTEGER=int" >/dev/null 2>&1; then rm -rf conftest* ! g77_cv_sys_f2cinteger=int fi rm -f conftest* fi ! if test "$g77_cv_sys_f2cinteger" = ""; then echo "$ac_t""""" 1>&6 { echo "configure: error: Can't determine type for f2c integer; config.log may help." 1>&2; exit 1; } *************** fi *** 1630,1647 **** fi ! echo "$ac_t""$ac_cv_sys_f2cinteger" 1>&6 ! F2C_INTEGER=$ac_cv_sys_f2cinteger ac_cpp=$late_ac_cpp echo $ac_n "checking f2c long int type""... $ac_c" 1>&6 ! echo "configure:1639: checking f2c long int type" >&5 late_ac_cpp=$ac_cpp ac_cpp="$late_ac_cpp -I$srcdir/.. -I../.. -I$srcdir/../.. -I$srcdir/../../config" ! if eval "test \"`echo '$''{'ac_cv_sys_f2clongint'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&6 ! F2C_INTEGER=$g77_cv_sys_f2cinteger ac_cpp=$late_ac_cpp echo $ac_n "checking f2c long int type""... $ac_c" 1>&6 ! echo "configure:1693: checking f2c long int type" >&5 late_ac_cpp=$ac_cpp ac_cpp="$late_ac_cpp -I$srcdir/.. -I../.. -I$srcdir/../.. -I$srcdir/../../config" ! if eval "test \"`echo '$''{'g77_cv_sys_f2clongint'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <& *** 1660,1670 **** egrep "F2C_LONGINT=long int" >/dev/null 2>&1; then rm -rf conftest* ! ac_cv_sys_f2clongint="long int" fi rm -f conftest* ! if test "$ac_cv_sys_f2clongint" = ""; then cat > conftest.$ac_ext </dev/null 2>&1; then rm -rf conftest* ! g77_cv_sys_f2clongint="long int" fi rm -f conftest* ! if test "$g77_cv_sys_f2clongint" = ""; then cat > conftest.$ac_ext <& *** 1683,1692 **** egrep "F2C_LONGINT=long long int" >/dev/null 2>&1; then rm -rf conftest* ! ac_cv_sys_f2clongint="long long int" fi rm -f conftest* fi ! if test "$ac_cv_sys_f2clongint" = ""; then echo "$ac_t""""" 1>&6 { echo "configure: error: Can't determine type for f2c long int; config.log may help." 1>&2; exit 1; } --- 1737,1746 ---- egrep "F2C_LONGINT=long long int" >/dev/null 2>&1; then rm -rf conftest* ! g77_cv_sys_f2clongint="long long int" fi rm -f conftest* fi ! if test "$g77_cv_sys_f2clongint" = ""; then echo "$ac_t""""" 1>&6 { echo "configure: error: Can't determine type for f2c long int; config.log may help." 1>&2; exit 1; } *************** fi *** 1695,1700 **** fi ! echo "$ac_t""$ac_cv_sys_f2clongint" 1>&6 ! F2C_LONGINT=$ac_cv_sys_f2clongint ac_cpp=$late_ac_cpp --- 1749,1754 ---- fi ! echo "$ac_t""$g77_cv_sys_f2clongint" 1>&6 ! F2C_LONGINT=$g77_cv_sys_f2clongint ac_cpp=$late_ac_cpp diff -rcp2N g77-0.5.20/f/runtime/configure.in g77-0.5.21/f/runtime/configure.in *** g77-0.5.20/f/runtime/configure.in Tue Feb 11 15:54:16 1997 --- g77-0.5.21/f/runtime/configure.in Tue Sep 2 21:28:08 1997 *************** AC_SUBST(AR) *** 42,45 **** --- 42,49 ---- if test "$RANLIB"; then : AC_SUBST(RANLIB) + dnl Make sure that RANLIB_TEST is set also. + if test -z "$RANLIB_TEST"; then + RANLIB_TEST=true + fi else RANLIB_TEST=true *************** AC_HEADER_STDC *** 65,76 **** dnl We could do this if we didn't know we were using gcc dnl AC_MSG_CHECKING(for prototype-savvy compiler) ! dnl AC_CACHE_VAL(ac_cv_sys_proto, dnl [AC_TRY_LINK(, dnl dnl looks screwy because TRY_LINK expects a function body dnl [return 0;} int foo (int * bar) {], ! dnl ac_cv_sys_proto=yes, ! dnl [ac_cv_sys_proto=no dnl AC_DEFINE(KR_headers)])]) ! dnl AC_MSG_RESULT($ac_cv_sys_proto) dnl for U77 --- 69,80 ---- dnl We could do this if we didn't know we were using gcc dnl AC_MSG_CHECKING(for prototype-savvy compiler) ! dnl AC_CACHE_VAL(g77_cv_sys_proto, dnl [AC_TRY_LINK(, dnl dnl looks screwy because TRY_LINK expects a function body dnl [return 0;} int foo (int * bar) {], ! dnl g77_cv_sys_proto=yes, ! dnl [g77_cv_sys_proto=no dnl AC_DEFINE(KR_headers)])]) ! dnl AC_MSG_RESULT($g77_cv_sys_proto) dnl for U77 *************** dnl AC_CHECK_HEADERS(unistd.h) *** 78,82 **** AC_MSG_CHECKING(for posix) ! AC_CACHE_VAL(ac_cv_header_posix, AC_EGREP_CPP(yes, [#include --- 82,86 ---- AC_MSG_CHECKING(for posix) ! AC_CACHE_VAL(g77_cv_header_posix, AC_EGREP_CPP(yes, [#include *************** AC_CACHE_VAL(ac_cv_header_posix, *** 86,97 **** #endif ], ! ac_cv_header_posix=yes, ! ac_cv_header_posix=no)) ! AC_MSG_RESULT($ac_cv_header_posix) # We can rely on the GNU library being posix-ish. I guess checking the # header isn't actually like checking the functions, though... AC_MSG_CHECKING(for GNU library) ! AC_CACHE_VAL(ac_cv_lib_gnu, AC_EGREP_CPP(yes, [#include --- 90,101 ---- #endif ], ! g77_cv_header_posix=yes, ! g77_cv_header_posix=no)) ! AC_MSG_RESULT($g77_cv_header_posix) # We can rely on the GNU library being posix-ish. I guess checking the # header isn't actually like checking the functions, though... AC_MSG_CHECKING(for GNU library) ! AC_CACHE_VAL(g77_cv_lib_gnu, AC_EGREP_CPP(yes, [#include *************** AC_CACHE_VAL(ac_cv_lib_gnu, *** 100,108 **** #endif ], ! ac_cv_lib_gnu=yes, ac_cv_lib_gnu=no)) ! AC_MSG_RESULT($ac_cv_lib_gnu) AC_CHECK_HEADER(fcntl.h, ! test $ac_cv_header_posix = yes && AC_DEFINE(_POSIX_SOURCE), AC_DEFINE(NO_FCNTL) AC_DEFINE(OPEN_DECL)) --- 104,124 ---- #endif ], ! g77_cv_lib_gnu=yes, g77_cv_lib_gnu=no)) ! AC_MSG_RESULT($g77_cv_lib_gnu) ! ! # Apparently cygwin needs to be special-cased. ! AC_MSG_CHECKING([for cyg\`win'32]) ! AC_CACHE_VAL(g77_cv_sys_cygwin32, ! AC_EGREP_CPP(yes, ! [#ifdef __CYGWIN32__ ! yes ! #endif ! ], ! g77_cv_sys_cygwin32=yes, ! g77_cv_sys_cygwin32=no)) ! AC_MSG_RESULT($g77_cv_sys_cygwin32) AC_CHECK_HEADER(fcntl.h, ! test $g77_cv_header_posix = yes && AC_DEFINE(_POSIX_SOURCE), AC_DEFINE(NO_FCNTL) AC_DEFINE(OPEN_DECL)) *************** else true *** 124,137 **** fi ! # This should always succeed on unix: ! AC_CHECK_FUNC(fstat,,AC_DEFINE(NON_UNIX_STDIO)) # This is necessary for e.g. Linux: AC_MSG_CHECKING([for necessary members of struct FILE]) ! AC_CACHE_VAL(ac_cv_struct_FILE, [AC_TRY_COMPILE([#include ], ! [FILE s; s._ptr; s._base; s._flag;],ac_cv_struct_FILE=yes, ! ac_cv_struct_FILE=no)])dnl ! AC_MSG_RESULT($ac_cv_struct_FILE) ! if test $ac_cv_struct_FILE = no; then AC_DEFINE(MISSING_FILE_ELEMS) fi --- 140,163 ---- fi ! # This should always succeed on unix. ! # Apparently positive result on cygwin loses re. NON_UNIX_STDIO ! # (as of cygwin b18). ! AC_CHECK_FUNC(fstat) ! AC_MSG_CHECKING([need for NON_UNIX_STDIO]) ! if test $g77_cv_sys_cygwin32 = yes || test $ac_cv_func_fstat = no; then ! AC_MSG_RESULT(yes) ! AC_DEFINE(NON_UNIX_STDIO) ! else ! AC_MSG_RESULT(no) ! fi ! # This is necessary for e.g. Linux: AC_MSG_CHECKING([for necessary members of struct FILE]) ! AC_CACHE_VAL(g77_cv_struct_FILE, [AC_TRY_COMPILE([#include ], ! [FILE s; s._ptr; s._base; s._flag;],g77_cv_struct_FILE=yes, ! g77_cv_struct_FILE=no)])dnl ! AC_MSG_RESULT($g77_cv_struct_FILE) ! if test $g77_cv_struct_FILE = no; then AC_DEFINE(MISSING_FILE_ELEMS) fi *************** AC_TRY_RUN(changequote(<<, >>)dnl *** 160,179 **** main () {char foo[2]; (sprintf(foo, "1") == 1) ? exit(0) : exit(1);} >>changequote([, ]), ! ac_cv_sys_sprintf_ansi=yes, ! ac_cv_sys_sprintf_ansi=no, ! ac_cv_sys_sprintf_ansi=no) ! AC_CACHE_VAL(ac_cv_sys_sprintf_ansi, ! ac_cv_sys_sprintf_ansi=$ac_cv_sys_sprintf_ansi) dnl We get a misleading `(cached)' message... if test $ac_cv_c_cross = no; then ! AC_MSG_RESULT($ac_cv_sys_sprintf_ansi) else AC_MSG_RESULT([can't tell -- assuming no]) fi ! if test $ac_cv_sys_sprintf_ansi != yes; then AC_DEFINE(USE_STRLEN) fi # define NON_ANSI_RW_MODES on unix (can't hurt) AC_EGREP_CPP(yes, [#ifdef unix --- 186,208 ---- main () {char foo[2]; (sprintf(foo, "1") == 1) ? exit(0) : exit(1);} >>changequote([, ]), ! g77_cv_sys_sprintf_ansi=yes, ! g77_cv_sys_sprintf_ansi=no, ! g77_cv_sys_sprintf_ansi=no) ! AC_CACHE_VAL(g77_cv_sys_sprintf_ansi, ! g77_cv_sys_sprintf_ansi=$g77_cv_sys_sprintf_ansi) dnl We get a misleading `(cached)' message... if test $ac_cv_c_cross = no; then ! AC_MSG_RESULT($g77_cv_sys_sprintf_ansi) else AC_MSG_RESULT([can't tell -- assuming no]) fi ! # The cygwin patch takes steps to avoid defining USE_STRLEN here -- I don't ! # understand why. ! if test $g77_cv_sys_sprintf_ansi != yes; then AC_DEFINE(USE_STRLEN) fi # define NON_ANSI_RW_MODES on unix (can't hurt) + AC_MSG_CHECKING(NON_ANSI_RW_MODES) AC_EGREP_CPP(yes, [#ifdef unix *************** AC_EGREP_CPP(yes, *** 187,191 **** #endif ], is_unix=yes, is_unix=no) ! test $is_unix = yes && AC_DEFINE(NON_ANSI_RW_MODES) # We have to firkle with the info in hconfig.h to figure out suitable types --- 216,229 ---- #endif ], is_unix=yes, is_unix=no) ! if test $g77_cv_sys_cygwin32 = yes; then ! AC_MSG_RESULT(no) ! else ! if test $is_unix = yes; then ! AC_DEFINE(NON_ANSI_RW_MODES) ! AC_MSG_RESULT(yes) ! else ! AC_MSG_RESULT(no) ! fi ! fi # We have to firkle with the info in hconfig.h to figure out suitable types *************** AC_MSG_CHECKING(f2c integer type) *** 195,199 **** late_ac_cpp=$ac_cpp ac_cpp="$late_ac_cpp -I$srcdir/.. -I../.. -I$srcdir/../.. -I$srcdir/../../config" ! AC_CACHE_VAL(ac_cv_sys_f2cinteger, AC_EGREP_CPP(F2C_INTEGER=long int, [#include "proj.h" --- 233,237 ---- late_ac_cpp=$ac_cpp ac_cpp="$late_ac_cpp -I$srcdir/.. -I../.. -I$srcdir/../.. -I$srcdir/../../config" ! AC_CACHE_VAL(g77_cv_sys_f2cinteger, AC_EGREP_CPP(F2C_INTEGER=long int, [#include "proj.h" *************** F2C_INTEGER=int *** 208,213 **** #endif ], ! ac_cv_sys_f2cinteger="long int",) ! if test "$ac_cv_sys_f2cinteger" = ""; then AC_EGREP_CPP(F2C_INTEGER=int, [#include "proj.h" --- 246,251 ---- #endif ], ! g77_cv_sys_f2cinteger="long int",) ! if test "$g77_cv_sys_f2cinteger" = ""; then AC_EGREP_CPP(F2C_INTEGER=int, [#include "proj.h" *************** F2C_INTEGER=int *** 222,234 **** #endif ], ! ac_cv_sys_f2cinteger=int,) fi ! if test "$ac_cv_sys_f2cinteger" = ""; then AC_MSG_RESULT("") AC_MSG_ERROR([Can't determine type for f2c integer; config.log may help.]) fi ) ! AC_MSG_RESULT($ac_cv_sys_f2cinteger) ! F2C_INTEGER=$ac_cv_sys_f2cinteger ac_cpp=$late_ac_cpp AC_SUBST(F2C_INTEGER) --- 260,272 ---- #endif ], ! g77_cv_sys_f2cinteger=int,) fi ! if test "$g77_cv_sys_f2cinteger" = ""; then AC_MSG_RESULT("") AC_MSG_ERROR([Can't determine type for f2c integer; config.log may help.]) fi ) ! AC_MSG_RESULT($g77_cv_sys_f2cinteger) ! F2C_INTEGER=$g77_cv_sys_f2cinteger ac_cpp=$late_ac_cpp AC_SUBST(F2C_INTEGER) *************** AC_MSG_CHECKING(f2c long int type) *** 237,241 **** late_ac_cpp=$ac_cpp ac_cpp="$late_ac_cpp -I$srcdir/.. -I../.. -I$srcdir/../.. -I$srcdir/../../config" ! AC_CACHE_VAL(ac_cv_sys_f2clongint, AC_EGREP_CPP(F2C_LONGINT=long int, [#include "proj.h" --- 275,279 ---- late_ac_cpp=$ac_cpp ac_cpp="$late_ac_cpp -I$srcdir/.. -I../.. -I$srcdir/../.. -I$srcdir/../../config" ! AC_CACHE_VAL(g77_cv_sys_f2clongint, AC_EGREP_CPP(F2C_LONGINT=long int, [#include "proj.h" *************** F2C_LONGINT=long long int *** 250,255 **** #endif ], ! ac_cv_sys_f2clongint="long int",) ! if test "$ac_cv_sys_f2clongint" = ""; then AC_EGREP_CPP(F2C_LONGINT=long long int, [#include "proj.h" --- 288,293 ---- #endif ], ! g77_cv_sys_f2clongint="long int",) ! if test "$g77_cv_sys_f2clongint" = ""; then AC_EGREP_CPP(F2C_LONGINT=long long int, [#include "proj.h" *************** F2C_LONGINT=long long int *** 264,276 **** #endif ], ! ac_cv_sys_f2clongint="long long int",) fi ! if test "$ac_cv_sys_f2clongint" = ""; then AC_MSG_RESULT("") AC_MSG_ERROR([Can't determine type for f2c long int; config.log may help.]) fi ) ! AC_MSG_RESULT($ac_cv_sys_f2clongint) ! F2C_LONGINT=$ac_cv_sys_f2clongint ac_cpp=$late_ac_cpp AC_SUBST(F2C_LONGINT) --- 302,314 ---- #endif ], ! g77_cv_sys_f2clongint="long long int",) fi ! if test "$g77_cv_sys_f2clongint" = ""; then AC_MSG_RESULT("") AC_MSG_ERROR([Can't determine type for f2c long int; config.log may help.]) fi ) ! AC_MSG_RESULT($g77_cv_sys_f2clongint) ! F2C_LONGINT=$g77_cv_sys_f2clongint ac_cpp=$late_ac_cpp AC_SUBST(F2C_LONGINT) diff -rcp2N g77-0.5.20/f/runtime/disclaimer.netlib g77-0.5.21/f/runtime/disclaimer.netlib *** g77-0.5.20/f/runtime/disclaimer.netlib Thu Jan 1 00:00:00 1970 --- g77-0.5.21/f/runtime/disclaimer.netlib Mon Aug 11 23:44:18 1997 *************** *** 0 **** --- 1,15 ---- + f2c is a Fortran to C converter under development since 1990 by + David M. Gay (then AT&T Bell Labs, now Bell Labs, Lucent Technologies) + Stu Feldman (then at Bellcore, now at IBM) + Mark Maimone (Carnegie-Mellon University) + Norm Schryer (then AT&T Bell Labs, now AT&T Labs) + Please send bug reports to dmg@research.bell-labs.com . + + AT&T, Bellcore and Lucent disclaim all warranties with regard to this + software, including all implied warranties of merchantability + and fitness. In no event shall AT&T, Bellcore or Lucent be liable for + any special, indirect or consequential damages or any damages + whatsoever resulting from loss of use, data or profits, whether + in an action of contract, negligence or other tortious action, + arising out of or in connection with the use or performance of + this software. diff -rcp2N g77-0.5.20/f/runtime/f2cext.c g77-0.5.21/f/runtime/f2cext.c *** g77-0.5.20/f/runtime/f2cext.c Thu Jan 1 00:00:00 1970 --- g77-0.5.21/f/runtime/f2cext.c Tue Sep 2 21:25:50 1997 *************** *** 0 **** --- 1,562 ---- + /* Copyright (C) 1997 Free Software Foundation, Inc. + This file is part of GNU Fortran run-time library. + + This library is free software; you can redistribute it and/or modify it + under the terms of the GNU Library General Public License as published + by the Free Software Foundation; either version 2 of the License, 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 + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with GNU Fortran; see the file COPYING.LIB. If + not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, + Boston, MA 02111-1307, USA. */ + + + #include + typedef int (*sig_proc)(int); + + #ifdef Labort + int abort_ (void) { + extern int G77_abort_0 (void); + return G77_abort_0 (); + } + #endif + + #ifdef Lderf + double derf_ (doublereal *x) { + extern double G77_derf_0 (doublereal *x); + return G77_derf_0 (x); + } + #endif + + #ifdef Lderfc + double derfc_ (doublereal *x) { + extern double G77_derfc_0 (doublereal *x); + return G77_derfc_0 (x); + } + #endif + + #ifdef Lef1asc + int ef1asc_ (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) { + extern int G77_ef1asc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb); + return G77_ef1asc_0 (a, la, b, lb); + } + #endif + + #ifdef Lef1cmc + integer ef1cmc_ (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) { + extern integer G77_ef1cmc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb); + return G77_ef1cmc_0 (a, la, b, lb); + } + #endif + + #ifdef Lerf + double erf_ (real *x) { + extern double G77_erf_0 (real *x); + return G77_erf_0 (x); + } + #endif + + #ifdef Lerfc + double erfc_ (real *x) { + extern double G77_erfc_0 (real *x); + return G77_erfc_0 (x); + } + #endif + + #ifdef Lexit + void exit_ (integer *rc) { + extern void G77_exit_0 (integer *rc); + G77_exit_0 (rc); + } + #endif + + #ifdef Lgetarg + void getarg_ (ftnint *n, char *s, ftnlen ls) { + extern void G77_getarg_0 (ftnint *n, char *s, ftnlen ls); + G77_getarg_0 (n, s, ls); + } + #endif + + #ifdef Lgetenv + void getenv_ (char *fname, char *value, ftnlen flen, ftnlen vlen) { + extern void G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen); + G77_getenv_0 (fname, value, flen, vlen); + } + #endif + + #ifdef Liargc + ftnint iargc_ (void) { + extern ftnint G77_iargc_0 (void); + return G77_iargc_0 (); + } + #endif + + #ifdef Lsignal + ftnint signal_ (integer *sigp, sig_proc proc) { + extern ftnint G77_signal_0 (integer *sigp, sig_proc proc); + return G77_signal_0 (sigp, proc); + } + #endif + + #ifdef Lsystem + integer system_ (char *s, ftnlen n) { + extern integer G77_system_0 (char *s, ftnlen n); + return G77_system_0 (s, n); + } + #endif + + #ifdef Lflush + int flush_ (void) { + extern int G77_flush_0 (void); + return G77_flush_0 (); + } + #endif + + #ifdef Lftell + integer ftell_ (integer *Unit) { + extern integer G77_ftell_0 (integer *Unit); + return G77_ftell_0 (Unit); + } + #endif + + #ifdef Lfseek + integer fseek_ (integer *Unit, integer *offset, integer *xwhence) { + extern integer G77_fseek_0 (integer *Unit, integer *offset, integer *xwhence); + return G77_fseek_0 (Unit, offset, xwhence); + } + #endif + + #ifdef Laccess + integer access_ (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode) { + extern integer G77_access_0 (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode); + return G77_access_0 (name, mode, Lname, Lmode); + } + #endif + + #ifdef Lalarm + integer alarm_ (integer *seconds, sig_proc proc, integer *status) { + extern integer G77_alarm_0 (integer *seconds, sig_proc proc); + return G77_alarm_0 (seconds, proc); + } + #endif + + #ifdef Lbesj0 + double besj0_ (const real *x) { + return j0 (*x); + } + #endif + + #ifdef Lbesj1 + double besj1_ (const real *x) { + return j1 (*x); + } + #endif + + #ifdef Lbesjn + double besjn_ (const integer *n, real *x) { + return jn (*n, *x); + } + #endif + + #ifdef Lbesy0 + double besy0_ (const real *x) { + return y0 (*x); + } + #endif + + #ifdef Lbesy1 + double besy1_ (const real *x) { + return y1 (*x); + } + #endif + + #ifdef Lbesyn + double besyn_ (const integer *n, real *x) { + return yn (*n, *x); + } + #endif + + #ifdef Lchdir + integer chdir_ (const char *name, const ftnlen Lname) { + extern integer G77_chdir_0 (const char *name, const ftnlen Lname); + return G77_chdir_0 (name, Lname); + } + #endif + + #ifdef Lchmod + integer chmod_ (const char *name, const char *mode, const ftnlen Lname, const ftnlen Lmode) { + extern integer G77_chmod_0 (const char *name, const char *mode, const ftnlen Lname, const ftnlen Lmode); + return G77_chmod_0 (name, mode, Lname, Lmode); + } + #endif + + #ifdef Lctime + void ctime_ (char *chtime, const ftnlen Lchtime, longint *xstime) { + extern void G77_ctime_0 (char *chtime, const ftnlen Lchtime, longint *xstime); + G77_ctime_0 (chtime, Lchtime, xstime); + } + #endif + + #ifdef Ldate + int date_ (char *buf, ftnlen buf_len) { + extern int G77_date_0 (char *buf, ftnlen buf_len); + return G77_date_0 (buf, buf_len); + } + #endif + + #ifdef Ldbesj0 + double dbesj0_ (const double *x) { + return j0 (*x); + } + #endif + + #ifdef Ldbesj1 + double dbesj1_ (const double *x) { + return j1 (*x); + } + #endif + + #ifdef Ldbesjn + double dbesjn_ (const integer *n, double *x) { + return jn (*n, *x); + } + #endif + + #ifdef Ldbesy0 + double dbesy0_ (const double *x) { + return y0 (*x); + } + #endif + + #ifdef Ldbesy1 + double dbesy1_ (const double *x) { + return y1 (*x); + } + #endif + + #ifdef Ldbesyn + double dbesyn_ (const integer *n, double *x) { + return yn (*n, *x); + } + #endif + + #ifdef Ldtime + double dtime_ (real tarray[2]) { + extern double G77_dtime_0 (real tarray[2]); + return G77_dtime_0 (tarray); + } + #endif + + #ifdef Letime + double etime_ (real tarray[2]) { + extern double G77_etime_0 (real tarray[2]); + return G77_etime_0 (tarray); + } + #endif + + #ifdef Lfdate + void fdate_ (char *ret_val, ftnlen ret_val_len) { + extern void G77_fdate_0 (char *ret_val, ftnlen ret_val_len); + G77_fdate_0 (ret_val, ret_val_len); + } + #endif + + #ifdef Lfgetc + integer fgetc_ (const integer *lunit, char *c, ftnlen Lc) { + extern integer G77_fgetc_0 (const integer *lunit, char *c, ftnlen Lc); + return G77_fgetc_0 (lunit, c, Lc); + } + #endif + + #ifdef Lfget + integer fget_ (char *c, const ftnlen Lc) { + extern integer G77_fget_0 (char *c, const ftnlen Lc); + return G77_fget_0 (c, Lc); + } + #endif + + #ifdef Lflush1 + int flush1_ (const integer *lunit) { + extern int G77_flush1_0 (const integer *lunit); + return G77_flush1_0 (lunit); + } + #endif + + #ifdef Lfnum + integer fnum_ (integer *lunit) { + extern integer G77_fnum_0 (integer *lunit); + return G77_fnum_0 (lunit); + } + #endif + + #ifdef Lfputc + integer fputc_ (const integer *lunit, const char *c, const ftnlen Lc) { + extern integer G77_fputc_0 (const integer *lunit, const char *c, const ftnlen Lc); + return G77_fputc_0 (lunit, c, Lc); + } + #endif + + #ifdef Lfput + integer fput_ (const char *c, const ftnlen Lc) { + extern integer G77_fput_0 (const char *c, const ftnlen Lc); + return G77_fput_0 (c, Lc); + } + #endif + + #ifdef Lfstat + integer fstat_ (const integer *lunit, integer statb[13]) { + extern integer G77_fstat_0 (const integer *lunit, integer statb[13]); + return G77_fstat_0 (lunit, statb); + } + #endif + + #ifdef Lgerror + int gerror_ (char *str, ftnlen Lstr) { + extern int G77_gerror_0 (char *str, ftnlen Lstr); + return G77_gerror_0 (str, Lstr); + } + #endif + + #ifdef Lgetcwd + integer getcwd_ (char *str, const ftnlen Lstr) { + extern integer G77_getcwd_0 (char *str, const ftnlen Lstr); + return G77_getcwd_0 (str, Lstr); + } + #endif + + #ifdef Lgetgid + integer getgid_ (void) { + extern integer G77_getgid_0 (void); + return G77_getgid_0 (); + } + #endif + + #ifdef Lgetlog + int getlog_ (char *str, const ftnlen Lstr) { + extern int G77_getlog_0 (char *str, const ftnlen Lstr); + return G77_getlog_0 (str, Lstr); + } + #endif + + #ifdef Lgetpid + integer getpid_ (void) { + extern integer G77_getpid_0 (void); + return G77_getpid_0 (); + } + #endif + + #ifdef Lgetuid + integer getuid_ (void) { + extern integer G77_getuid_0 (void); + return G77_getuid_0 (); + } + #endif + + #ifdef Lgmtime + int gmtime_ (const integer *stime, integer tarray[9]) { + extern int G77_gmtime_0 (const integer *stime, integer tarray[9]); + return G77_gmtime_0 (stime, tarray); + } + #endif + + #ifdef Lhostnm + integer hostnm_ (char *name, ftnlen Lname) { + extern integer G77_hostnm_0 (char *name, ftnlen Lname); + return G77_hostnm_0 (name, Lname); + } + #endif + + #ifdef Lidate + int idate_ (int iarray[3]) { + extern int G77_idate_0 (int iarray[3]); + return G77_idate_0 (iarray); + } + #endif + + #ifdef Lierrno + integer ierrno_ (void) { + extern integer G77_ierrno_0 (void); + return G77_ierrno_0 (); + } + #endif + + #ifdef Lirand + integer irand_ (integer *flag) { + extern integer G77_irand_0 (integer *flag); + return G77_irand_0 (flag); + } + #endif + + #ifdef Lisatty + logical isatty_ (integer *lunit) { + extern logical G77_isatty_0 (integer *lunit); + return G77_isatty_0 (lunit); + } + #endif + + #ifdef Litime + int itime_ (integer tarray[3]) { + extern int G77_itime_0 (integer tarray[3]); + return G77_itime_0 (tarray); + } + #endif + + #ifdef Lkill + integer kill_ (const integer *pid, const integer *signum) { + extern integer G77_kill_0 (const integer *pid, const integer *signum); + return G77_kill_0 (pid, signum); + } + #endif + + #ifdef Llink + integer link_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) { + extern integer G77_link_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2); + return G77_link_0 (path1, path2, Lpath1, Lpath2); + } + #endif + + #ifdef Llnblnk + integer lnblnk_ (char *str, ftnlen str_len) { + extern integer G77_lnblnk_0 (char *str, ftnlen str_len); + return G77_lnblnk_0 (str, str_len); + } + #endif + + #ifdef Llstat + integer lstat_ (const char *name, integer statb[13], const ftnlen Lname) { + extern integer G77_lstat_0 (const char *name, integer statb[13], const ftnlen Lname); + return G77_lstat_0 (name, statb, Lname); + } + #endif + + #ifdef Lltime + int ltime_ (const integer *stime, integer tarray[9]) { + extern int G77_ltime_0 (const integer *stime, integer tarray[9]); + return G77_ltime_0 (stime, tarray); + } + #endif + + #ifdef Lmclock + longint mclock_ (void) { + extern longint G77_mclock_0 (void); + return G77_mclock_0 (); + } + #endif + + #ifdef Lperror + int perror_ (const char *str, const ftnlen Lstr) { + extern int G77_perror_0 (const char *str, const ftnlen Lstr); + return G77_perror_0 (str, Lstr); + } + #endif + + #ifdef Lrand + double rand_ (integer *flag) { + extern double G77_rand_0 (integer *flag); + return G77_rand_0 (flag); + } + #endif + + #ifdef Lrename + integer rename_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) { + extern integer G77_rename_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2); + return G77_rename_0 (path1, path2, Lpath1, Lpath2); + } + #endif + + #ifdef Lsecnds + double secnds_ (real *r) { + extern double G77_secnds_0 (real *r); + return G77_secnds_0 (r); + } + #endif + + #ifdef Lsecond + double second_ () { + extern double G77_second_0 (); + return G77_second_0 (); + } + #endif + + #ifdef Lsleep + int sleep_ (const integer *seconds) { + extern int G77_sleep_0 (const integer *seconds); + return G77_sleep_0 (seconds); + } + #endif + + #ifdef Lsrand + int srand_ (const integer *seed) { + extern int G77_srand_0 (const integer *seed); + return G77_srand_0 (seed); + } + #endif + + #ifdef Lstat + integer stat_ (const char *name, integer statb[13], const ftnlen Lname) { + extern integer G77_stat_0 (const char *name, integer statb[13], const ftnlen Lname); + return G77_stat_0 (name, statb, Lname); + } + #endif + + #ifdef Lsymlnk + integer symlnk_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) { + extern integer G77_symlnk_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2); + return G77_symlnk_0 (path1, path2, Lpath1, Lpath2); + } + #endif + + #ifdef Lsclock + int system_clock_ (integer *count, integer *count_rate, integer *count_max) { + extern int G77_system_clock_0 (integer *count, integer *count_rate, integer *count_max); + return G77_system_clock_0 (count, count_rate, count_max); + } + #endif + + #ifdef Ltime + longint time_ (void) { + extern longint G77_time_0 (void); + return G77_time_0 (); + } + #endif + + #ifdef Lttynam + void ttynam_ (char *ret_val, ftnlen ret_val_len, integer *lunit) { + extern void G77_ttynam_0 (char *ret_val, ftnlen ret_val_len, integer *lunit); + G77_ttynam_0 (ret_val, ret_val_len, lunit); + } + #endif + + #ifdef Lumask + integer umask_ (integer *mask) { + extern integer G77_umask_0 (integer *mask); + return G77_umask_0 (mask); + } + #endif + + #ifdef Lunlink + integer unlink_ (const char *str, const ftnlen Lstr) { + extern integer G77_unlink_0 (const char *str, const ftnlen Lstr); + return G77_unlink_0 (str, Lstr); + } + #endif + + #ifdef Lvxtidt + int vxtidate_ (integer *m, integer *d, integer *y) { + extern int G77_vxtidate_0 (integer *m, integer *d, integer *y); + return G77_vxtidate_0 (m, d, y); + } + #endif + + #ifdef Lvxttim + void vxttime_ (char chtime[8], const ftnlen Lchtime) { + extern void G77_vxttime_0 (char chtime[8], const ftnlen Lchtime); + G77_vxttime_0 (chtime, Lchtime); + } + #endif diff -rcp2N g77-0.5.20/f/runtime/libF77/F77_aloc.c g77-0.5.21/f/runtime/libF77/F77_aloc.c *** g77-0.5.20/f/runtime/libF77/F77_aloc.c Thu Oct 31 10:34:26 1996 --- g77-0.5.21/f/runtime/libF77/F77_aloc.c Fri Jul 11 00:08:10 1997 *************** static integer memfailure = 3; *** 9,13 **** #ifdef KR_headers extern char *malloc(); ! extern void exit_(); char * --- 9,13 ---- #ifdef KR_headers extern char *malloc(); ! extern void G77_exit_0 (); char * *************** F77_aloc(Len, whence) integer Len; char *** 15,19 **** #else #include ! extern void exit_(integer*); char * --- 15,19 ---- #else #include ! extern void G77_exit_0 (integer*); char * *************** F77_aloc(integer Len, char *whence) *** 27,31 **** fprintf(stderr, "malloc(%u) failure in %s\n", uLen, whence); ! exit_(&memfailure); } return rv; --- 27,31 ---- fprintf(stderr, "malloc(%u) failure in %s\n", uLen, whence); ! G77_exit_0 (&memfailure); } return rv; diff -rcp2N g77-0.5.20/f/runtime/libF77/Makefile.in g77-0.5.21/f/runtime/libF77/Makefile.in *** g77-0.5.20/f/runtime/libF77/Makefile.in Tue Feb 11 18:27:08 1997 --- g77-0.5.21/f/runtime/libF77/Makefile.in Fri Jul 11 00:08:10 1997 *************** CROSS = @CROSS@ *** 54,58 **** 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 \ pow_qq.o --- 54,58 ---- 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 \ pow_qq.o diff -rcp2N g77-0.5.20/f/runtime/libF77/Notice g77-0.5.21/f/runtime/libF77/Notice *** g77-0.5.20/f/runtime/libF77/Notice Fri Nov 18 21:24:14 1994 --- g77-0.5.21/f/runtime/libF77/Notice Mon Aug 11 23:01:37 1997 *************** *** 1,4 **** /**************************************************************** ! Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories and Bellcore. Permission to use, copy, modify, and distribute this software --- 1,4 ---- /**************************************************************** ! Copyright 1990 - 1997 by AT&T, Lucent Technologies and Bellcore. Permission to use, copy, modify, and distribute this software *************** granted, provided that the above copyrig *** 7,23 **** copies and that both that the copyright notice and this permission notice and warranty disclaimer appear in supporting ! documentation, and that the names of AT&T Bell Laboratories or ! Bellcore or any of their entities not be used in advertising or ! publicity pertaining to distribution of the software without ! specific, written prior permission. ! AT&T and Bellcore disclaim all warranties with regard to this ! software, including all implied warranties of merchantability ! and fitness. In no event shall AT&T or Bellcore be liable for ! any special, indirect or consequential damages or any damages ! whatsoever resulting from loss of use, data or profits, whether ! in an action of contract, negligence or other tortious action, ! arising out of or in connection with the use or performance of ! this software. ****************************************************************/ --- 7,23 ---- copies and that both that the copyright notice and this permission notice and warranty disclaimer appear in supporting ! documentation, and that the names of AT&T, Bell Laboratories, ! Lucent or Bellcore or any of their entities not be used in ! advertising or publicity pertaining to distribution of the ! software without specific, written prior permission. ! AT&T, Lucent and Bellcore disclaim all warranties with regard to ! this software, including all implied warranties of ! merchantability and fitness. In no event shall AT&T, Lucent or ! Bellcore be liable for any special, indirect or consequential ! damages or any damages whatsoever resulting from loss of use, ! data or profits, whether in an action of contract, negligence or ! other tortious action, arising out of or in connection with the ! use or performance of this software. ****************************************************************/ diff -rcp2N g77-0.5.20/f/runtime/libF77/README g77-0.5.21/f/runtime/libF77/README *** g77-0.5.20/f/runtime/libF77/README Thu Oct 31 10:34:26 1996 --- g77-0.5.21/f/runtime/libF77/README Thu Jan 1 00:00:00 1970 *************** *** 1,113 **** - If your compiler does not recognize ANSI C headers, - compile with KR_headers defined: either add -DKR_headers - to the definition of CFLAGS in the makefile, or insert - - #define KR_headers - - at the top of f2c.h , cabs.c , main.c , and sig_die.c . - - Under MS-DOS, compile s_paus.c with -DMSDOS. - - If you have a really ancient K&R C compiler that does not understand - void, add -Dvoid=int to the definition of CFLAGS in the makefile. - - If you use a C++ compiler, first create a local f2c.h by appending - f2ch.add to the usual f2c.h, e.g., by issuing the command - make f2c.h - which assumes f2c.h is installed in /usr/include . - - If your system lacks onexit() and you are not using an ANSI C - compiler, then you should compile main.c, s_paus.c, s_stop.c, and - sig_die.c with NO_ONEXIT defined. See the comments about onexit in - the makefile. - - You may need to specify the return type of signal handlers for - signal.c. By default this is `int' if KR_headers is defined, `void' - otherwise. Define RETSIGTYPE to be `int' or `void' to override the - default. - - If your system has a double drem() function such that drem(a,b) - is the IEEE remainder function (with double a, b), then you may - wish to compile r_mod.c and d_mod.c with IEEE_drem defined. - On some systems, you may also need to compile with -Ddrem=remainder . - - To check for transmission errors, issue the command - make check - This assumes you have the xsum program whose source, xsum.c, - is distributed as part of "all from f2c/src". If you do not - have xsum, you can obtain xsum.c by sending the following E-mail - message to netlib@bell-labs.com - send xsum.c from f2c/src - - The makefile assumes you have installed f2c.h in a standard - place (and does not cause recompilation when f2c.h is changed); - f2c.h comes with "all from f2c" (the source for f2c) and is - available separately ("f2c.h from f2c"). - - Most of the routines in libF77 are support routines for Fortran - intrinsic functions or for operations that f2c chooses not - to do "in line". There are a few exceptions, summarized below -- - functions and subroutines that appear to your program as ordinary - external Fortran routines. - - 1. CALL ABORT prints a message and causes a core dump. - - 2. ERF(r) and DERF(d) and the REAL and DOUBLE PRECISION - error functions (with x REAL and d DOUBLE PRECISION); - DERF must be declared DOUBLE PRECISION in your program. - Both ERF and DERF assume your C library provides the - underlying erf() function (which not all systems do). - - 3. ERFC(r) and DERFC(d) are the complementary error functions: - ERFC(r) = 1 - ERF(r) and DERFC(d) = 1.d0 - DERFC(d) - (except that their results may be more accurate than - explicitly evaluating the above formulae would give). - Again, ERFC and r are REAL, and DERFC and d are DOUBLE - PRECISION (and must be declared as such in your program), - and ERFC and DERFC rely on your system's erfc(). - - 4. CALL GETARG(n,s), where n is an INTEGER and s is a CHARACTER - variable, sets s to the n-th command-line argument (or to - all blanks if there are fewer than n command-line arguments); - CALL GETARG(0,s) sets s to the name of the program (on systems - that support this feature). See IARGC below. - - 5. CALL GETENV(name, value), where name and value are of type - CHARACTER, sets value to the environment value, $name, of - name (or to blanks if $name has not been set). - - 6. NARGS = IARGC() sets NARGS to the number of command-line - arguments (an INTEGER value). - - 7. CALL SIGNAL(n,func), where n is an INTEGER and func is an - EXTERNAL procedure, arranges for func to be invoked when - signal n occurs (on systems where this makes sense). - - 8. CALL SYSTEM(cmd), where cmd is of type CHARACTER, passes - cmd to the system's command processor (on systems where - this can be done). - - The makefile does not attempt to compile pow_qq.c, qbitbits.c, - and qbitshft.c, which are meant for use with INTEGER*8. To use - INTEGER*8, you must modify f2c.h to declare longint and ulongint - appropriately; then add pow_qq.o to the POW = line in the makefile, - and add " qbitbits.o qbitshft.o" to the makefile's F90BIT = line. - - Following Fortran 90, s_cat.c and s_copy.c allow the target of a - (character string) assignment to be appear on its right-hand, at - the cost of some extra overhead for all run-time concatenations. - If you prefer the extra efficiency that comes with the Fortran 77 - requirement that the left-hand side of a character assignment not - be involved in the right-hand side, compile s_cat.c and s_copy.c - with -DNO_OVERWRITE . - - If your system lacks a ranlib command, you don't need it. - Either comment out the makefile's ranlib invocation, or install - a harmless "ranlib" command somewhere in your PATH, such as the - one-line shell script - - exit 0 - - or (on some systems) - - exec /usr/bin/ar lts $1 >/dev/null --- 0 ---- diff -rcp2N g77-0.5.20/f/runtime/libF77/README.netlib g77-0.5.21/f/runtime/libF77/README.netlib *** g77-0.5.20/f/runtime/libF77/README.netlib Thu Jan 1 00:00:00 1970 --- g77-0.5.21/f/runtime/libF77/README.netlib Mon Aug 11 23:48:03 1997 *************** *** 0 **** --- 1,108 ---- + If your compiler does not recognize ANSI C headers, + compile with KR_headers defined: either add -DKR_headers + to the definition of CFLAGS in the makefile, or insert + + #define KR_headers + + at the top of f2c.h , cabs.c , main.c , and sig_die.c . + + Under MS-DOS, compile s_paus.c with -DMSDOS. + + If you have a really ancient K&R C compiler that does not understand + void, add -Dvoid=int to the definition of CFLAGS in the makefile. + + If you use a C++ compiler, first create a local f2c.h by appending + f2ch.add to the usual f2c.h, e.g., by issuing the command + make f2c.h + which assumes f2c.h is installed in /usr/include . + + If your system lacks onexit() and you are not using an ANSI C + compiler, then you should compile main.c, s_paus.c, s_stop.c, and + sig_die.c with NO_ONEXIT defined. See the comments about onexit in + the makefile. + + If your system has a double drem() function such that drem(a,b) + is the IEEE remainder function (with double a, b), then you may + wish to compile r_mod.c and d_mod.c with IEEE_drem defined. + On some systems, you may also need to compile with -Ddrem=remainder . + + To check for transmission errors, issue the command + make check + This assumes you have the xsum program whose source, xsum.c, + is distributed as part of "all from f2c/src". If you do not + have xsum, you can obtain xsum.c by sending the following E-mail + message to netlib@netlib.bell-labs.com + send xsum.c from f2c/src + + The makefile assumes you have installed f2c.h in a standard + place (and does not cause recompilation when f2c.h is changed); + f2c.h comes with "all from f2c" (the source for f2c) and is + available separately ("f2c.h from f2c"). + + Most of the routines in libF77 are support routines for Fortran + intrinsic functions or for operations that f2c chooses not + to do "in line". There are a few exceptions, summarized below -- + functions and subroutines that appear to your program as ordinary + external Fortran routines. + + 1. CALL ABORT prints a message and causes a core dump. + + 2. ERF(r) and DERF(d) and the REAL and DOUBLE PRECISION + error functions (with x REAL and d DOUBLE PRECISION); + DERF must be declared DOUBLE PRECISION in your program. + Both ERF and DERF assume your C library provides the + underlying erf() function (which not all systems do). + + 3. ERFC(r) and DERFC(d) are the complementary error functions: + ERFC(r) = 1 - ERF(r) and DERFC(d) = 1.d0 - DERFC(d) + (except that their results may be more accurate than + explicitly evaluating the above formulae would give). + Again, ERFC and r are REAL, and DERFC and d are DOUBLE + PRECISION (and must be declared as such in your program), + and ERFC and DERFC rely on your system's erfc(). + + 4. CALL GETARG(n,s), where n is an INTEGER and s is a CHARACTER + variable, sets s to the n-th command-line argument (or to + all blanks if there are fewer than n command-line arguments); + CALL GETARG(0,s) sets s to the name of the program (on systems + that support this feature). See IARGC below. + + 5. CALL GETENV(name, value), where name and value are of type + CHARACTER, sets value to the environment value, $name, of + name (or to blanks if $name has not been set). + + 6. NARGS = IARGC() sets NARGS to the number of command-line + arguments (an INTEGER value). + + 7. CALL SIGNAL(n,func), where n is an INTEGER and func is an + EXTERNAL procedure, arranges for func to be invoked when + signal n occurs (on systems where this makes sense). + + 8. CALL SYSTEM(cmd), where cmd is of type CHARACTER, passes + cmd to the system's command processor (on systems where + this can be done). + + The makefile does not attempt to compile pow_qq.c, qbitbits.c, + and qbitshft.c, which are meant for use with INTEGER*8. To use + INTEGER*8, you must modify f2c.h to declare longint and ulongint + appropriately; then add pow_qq.o to the POW = line in the makefile, + and add " qbitbits.o qbitshft.o" to the makefile's F90BIT = line. + + Following Fortran 90, s_cat.c and s_copy.c allow the target of a + (character string) assignment to be appear on its right-hand, at + the cost of some extra overhead for all run-time concatenations. + If you prefer the extra efficiency that comes with the Fortran 77 + requirement that the left-hand side of a character assignment not + be involved in the right-hand side, compile s_cat.c and s_copy.c + with -DNO_OVERWRITE . + + If your system lacks a ranlib command, you don't need it. + Either comment out the makefile's ranlib invocation, or install + a harmless "ranlib" command somewhere in your PATH, such as the + one-line shell script + + exit 0 + + or (on some systems) + + exec /usr/bin/ar lts $1 >/dev/null diff -rcp2N g77-0.5.20/f/runtime/libF77/Version.c g77-0.5.21/f/runtime/libF77/Version.c *** g77-0.5.20/f/runtime/libF77/Version.c Sat Mar 1 04:06:54 1997 --- g77-0.5.21/f/runtime/libF77/Version.c Tue Sep 9 06:10:54 1997 *************** *** 1,8 **** ! static char junk[] = "\n@(#)LIBF77 VERSION 19960619\n"; /* */ ! char __G77_LIBF77_VERSION__[] = "0.5.20"; /* --- 1,8 ---- ! static char junk[] = "\n@(#)LIBF77 VERSION 19970404\n"; /* */ ! char __G77_LIBF77_VERSION__[] = "0.5.21"; /* *************** char __G77_LIBF77_VERSION__[] = "0.5.20" *** 48,51 **** --- 48,57 ---- 13 May 1996: add [lq]bitbits.c and [lq]bitshft.c (f90 bit intrinsics). 19 June 1996: add casts to unsigned in [lq]bitshft.c. + 26 Feb. 1997: adjust functions with a complex output argument + to permit aliasing it with input arguments. + (For now, at least, this is just for possible + benefit of g77.) + 4 April 1997: [cz]_div.c: tweaks invisible on most systems (that may + affect systems using gratuitous extra precision). */ diff -rcp2N g77-0.5.20/f/runtime/libF77/abort_.c g77-0.5.21/f/runtime/libF77/abort_.c *** g77-0.5.20/f/runtime/libF77/abort_.c Thu Oct 31 10:34:26 1996 --- g77-0.5.21/f/runtime/libF77/abort_.c Fri Jul 11 00:08:11 1997 *************** *** 5,13 **** extern VOID sig_die(); ! int abort_() #else extern void sig_die(char*,int); ! int abort_(void) #endif { --- 5,13 ---- extern VOID sig_die(); ! int G77_abort_0 () #else extern void sig_die(char*,int); ! int G77_abort_0 (void) #endif { diff -rcp2N g77-0.5.20/f/runtime/libF77/derf_.c g77-0.5.21/f/runtime/libF77/derf_.c *** g77-0.5.20/f/runtime/libF77/derf_.c Fri Nov 18 21:24:57 1994 --- g77-0.5.21/f/runtime/libF77/derf_.c Fri Jul 11 00:08:11 1997 *************** *** 3,10 **** #ifdef KR_headers double erf(); ! double derf_(x) doublereal *x; #else extern double erf(double); ! double derf_(doublereal *x) #endif { --- 3,10 ---- #ifdef KR_headers double erf(); ! double G77_derf_0 (x) doublereal *x; #else extern double erf(double); ! double G77_derf_0 (doublereal *x) #endif { diff -rcp2N g77-0.5.20/f/runtime/libF77/derfc_.c g77-0.5.21/f/runtime/libF77/derfc_.c *** g77-0.5.20/f/runtime/libF77/derfc_.c Fri Nov 18 21:24:58 1994 --- g77-0.5.21/f/runtime/libF77/derfc_.c Fri Jul 11 00:08:11 1997 *************** *** 4,12 **** extern double erfc(); ! double derfc_(x) doublereal *x; #else extern double erfc(double); ! double derfc_(doublereal *x) #endif { --- 4,12 ---- extern double erfc(); ! double G77_derfc_0 (x) doublereal *x; #else extern double erfc(double); ! double G77_derfc_0 (doublereal *x) #endif { diff -rcp2N g77-0.5.20/f/runtime/libF77/dtime_.c g77-0.5.21/f/runtime/libF77/dtime_.c *** g77-0.5.20/f/runtime/libF77/dtime_.c Thu Jan 1 00:00:00 1970 --- g77-0.5.21/f/runtime/libF77/dtime_.c Mon Aug 11 23:50:37 1997 *************** *** 0 **** --- 1,45 ---- + #include "time.h" + #ifndef USE_CLOCK + #include "sys/types.h" + #include "sys/times.h" + #endif + + #undef Hz + #ifdef CLK_TCK + #define Hz CLK_TCK + #else + #ifdef HZ + #define Hz HZ + #else + #define Hz 60 + #endif + #endif + + float + #ifdef KR_headers + dtime_(tarray) float *tarray; + #else + dtime_(float *tarray) + #endif + { + #ifdef USE_CLOCK + #ifndef CLOCKS_PER_SECOND + #define CLOCKS_PER_SECOND Hz + #endif + static double t0; + double t = clock(); + tarray[1] = 0; + tarray[0] = (t - t0) / CLOCKS_PER_SECOND; + t0 = t; + return tarray[0]; + #else + struct tms t; + static struct tms t0; + + times(&t); + tarray[0] = (t.tms_utime - t0.tms_utime) / Hz; + tarray[1] = (t.tms_stime - t0.tms_stime) / Hz; + t0 = t; + return tarray[0] + tarray[1]; + #endif + } diff -rcp2N g77-0.5.20/f/runtime/libF77/ef1asc_.c g77-0.5.21/f/runtime/libF77/ef1asc_.c *** g77-0.5.20/f/runtime/libF77/ef1asc_.c Fri Nov 18 21:24:59 1994 --- g77-0.5.21/f/runtime/libF77/ef1asc_.c Fri Jul 11 00:08:11 1997 *************** *** 9,16 **** #ifdef KR_headers extern VOID s_copy(); ! ef1asc_(a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb; #else extern void s_copy(char*,char*,ftnlen,ftnlen); ! int ef1asc_(ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) #endif { --- 9,16 ---- #ifdef KR_headers extern VOID s_copy(); ! G77_ef1asc_0 (a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb; #else extern void s_copy(char*,char*,ftnlen,ftnlen); ! int G77_ef1asc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) #endif { diff -rcp2N g77-0.5.20/f/runtime/libF77/ef1cmc_.c g77-0.5.21/f/runtime/libF77/ef1cmc_.c *** g77-0.5.20/f/runtime/libF77/ef1cmc_.c Fri Nov 18 21:25:00 1994 --- g77-0.5.21/f/runtime/libF77/ef1cmc_.c Fri Jul 11 00:08:11 1997 *************** *** 5,12 **** #ifdef KR_headers extern integer s_cmp(); ! integer ef1cmc_(a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb; #else extern integer s_cmp(char*,char*,ftnlen,ftnlen); ! integer ef1cmc_(ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) #endif { --- 5,12 ---- #ifdef KR_headers extern integer s_cmp(); ! integer G77_ef1cmc_0 (a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb; #else extern integer s_cmp(char*,char*,ftnlen,ftnlen); ! integer G77_ef1cmc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) #endif { diff -rcp2N g77-0.5.20/f/runtime/libF77/erf_.c g77-0.5.21/f/runtime/libF77/erf_.c *** g77-0.5.20/f/runtime/libF77/erf_.c Fri Nov 18 21:25:02 1994 --- g77-0.5.21/f/runtime/libF77/erf_.c Fri Jul 11 00:08:11 1997 *************** *** 3,10 **** #ifdef KR_headers double erf(); ! double erf_(x) real *x; #else extern double erf(double); ! double erf_(real *x) #endif { --- 3,10 ---- #ifdef KR_headers double erf(); ! double G77_erf_0 (x) real *x; #else extern double erf(double); ! double G77_erf_0 (real *x) #endif { diff -rcp2N g77-0.5.20/f/runtime/libF77/erfc_.c g77-0.5.21/f/runtime/libF77/erfc_.c *** g77-0.5.20/f/runtime/libF77/erfc_.c Fri Nov 18 21:25:03 1994 --- g77-0.5.21/f/runtime/libF77/erfc_.c Fri Jul 11 00:08:11 1997 *************** *** 3,10 **** #ifdef KR_headers double erfc(); ! double erfc_(x) real *x; #else extern double erfc(double); ! double erfc_(real *x) #endif { --- 3,10 ---- #ifdef KR_headers double erfc(); ! double G77_erfc_0 (x) real *x; #else extern double erfc(double); ! double G77_erfc_0 (real *x) #endif { diff -rcp2N g77-0.5.20/f/runtime/libF77/etime_.c g77-0.5.21/f/runtime/libF77/etime_.c *** g77-0.5.20/f/runtime/libF77/etime_.c Thu Jan 1 00:00:00 1970 --- g77-0.5.21/f/runtime/libF77/etime_.c Mon Aug 11 23:51:03 1997 *************** *** 0 **** --- 1,38 ---- + #include "time.h" + #ifndef USE_CLOCK + #include "sys/types.h" + #include "sys/times.h" + #endif + + #undef Hz + #ifdef CLK_TCK + #define Hz CLK_TCK + #else + #ifdef HZ + #define Hz HZ + #else + #define Hz 60 + #endif + #endif + + float + #ifdef KR_headers + etime_(tarray) float *tarray; + #else + etime_(float *tarray) + #endif + { + #ifdef USE_CLOCK + #ifndef CLOCKS_PER_SECOND + #define CLOCKS_PER_SECOND Hz + #endif + double t = clock(); + tarray[1] = 0; + return tarray[0] = t / CLOCKS_PER_SECOND; + #else + struct tms t; + + times(&t); + return (tarray[0] = t.tms_utime/Hz) + (tarray[1] = t.tms_stime/Hz); + #endif + } diff -rcp2N g77-0.5.20/f/runtime/libF77/exit.c g77-0.5.21/f/runtime/libF77/exit.c *** g77-0.5.20/f/runtime/libF77/exit.c Thu Oct 31 10:35:20 1996 --- g77-0.5.21/f/runtime/libF77/exit.c Thu Jan 1 00:00:00 1970 *************** *** 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 - #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 --- 0 ---- diff -rcp2N g77-0.5.20/f/runtime/libF77/exit_.c g77-0.5.21/f/runtime/libF77/exit_.c *** g77-0.5.20/f/runtime/libF77/exit_.c Thu Jan 1 00:00:00 1970 --- g77-0.5.21/f/runtime/libF77/exit_.c Fri Jul 11 00:08:11 1997 *************** *** 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 + #ifdef __cplusplus + extern "C" { + #endif + extern void f_exit(void); + #endif + + void + #ifdef KR_headers + G77_exit_0 (rc) integer *rc; + #else + G77_exit_0 (integer *rc) + #endif + { + #ifdef NO_ONEXIT + f_exit(); + #endif + exit(*rc); + } + #ifdef __cplusplus + } + #endif diff -rcp2N g77-0.5.20/f/runtime/libF77/getarg_.c g77-0.5.21/f/runtime/libF77/getarg_.c *** g77-0.5.20/f/runtime/libF77/getarg_.c Fri Nov 18 21:25:04 1994 --- g77-0.5.21/f/runtime/libF77/getarg_.c Fri Jul 11 00:08:12 1997 *************** *** 8,14 **** #ifdef KR_headers ! VOID getarg_(n, s, ls) ftnint *n; register char *s; ftnlen ls; #else ! void getarg_(ftnint *n, register char *s, ftnlen ls) #endif { --- 8,14 ---- #ifdef KR_headers ! VOID G77_getarg_0 (n, s, ls) ftnint *n; register char *s; ftnlen ls; #else ! void G77_getarg_0 (ftnint *n, register char *s, ftnlen ls) #endif { diff -rcp2N g77-0.5.20/f/runtime/libF77/getenv_.c g77-0.5.21/f/runtime/libF77/getenv_.c *** g77-0.5.20/f/runtime/libF77/getenv_.c Fri Nov 18 21:25:06 1994 --- g77-0.5.21/f/runtime/libF77/getenv_.c Fri Jul 11 00:08:12 1997 *************** *** 14,20 **** #ifdef KR_headers ! VOID getenv_(fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen; #else ! void getenv_(char *fname, char *value, ftnlen flen, ftnlen vlen) #endif { --- 14,20 ---- #ifdef KR_headers ! VOID G77_getenv_0 (fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen; #else ! void G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen) #endif { diff -rcp2N g77-0.5.20/f/runtime/libF77/iargc_.c g77-0.5.21/f/runtime/libF77/iargc_.c *** g77-0.5.20/f/runtime/libF77/iargc_.c Fri Nov 18 21:25:32 1994 --- g77-0.5.21/f/runtime/libF77/iargc_.c Fri Jul 11 00:08:13 1997 *************** *** 2,8 **** #ifdef KR_headers ! ftnint iargc_() #else ! ftnint iargc_(void) #endif { --- 2,8 ---- #ifdef KR_headers ! ftnint G77_iargc_0 () #else ! ftnint G77_iargc_0 (void) #endif { diff -rcp2N g77-0.5.20/f/runtime/libF77/main.c g77-0.5.21/f/runtime/libF77/main.c *** g77-0.5.20/f/runtime/libF77/main.c Thu Oct 31 10:35:46 1996 --- g77-0.5.21/f/runtime/libF77/main.c Fri Jul 11 00:08:13 1997 *************** *** 2,6 **** #include ! #include #ifndef SIGIOT --- 2,6 ---- #include ! #include "signal1.h" #ifndef SIGIOT *************** int xargc; *** 91,94 **** --- 91,98 ---- char **xargv; + #ifdef __cplusplus + } + #endif + #ifdef KR_headers main(argc, argv) int argc; char **argv; *************** main(int argc, char **argv) *** 99,116 **** xargc = argc; xargv = argv; ! signal(SIGFPE, sigfdie); /* ignore underflow, enable overflow */ #ifdef SIGIOT ! signal(SIGIOT, sigidie); #endif #ifdef SIGTRAP ! signal(SIGTRAP, sigtrdie); #endif #ifdef SIGQUIT ! if(signal(SIGQUIT,sigqdie) == SIG_IGN) ! signal(SIGQUIT, SIG_IGN); #endif ! if(signal(SIGINT, sigindie) == SIG_IGN) ! signal(SIGINT, SIG_IGN); ! signal(SIGTERM,sigtdie); #ifdef pdp11 --- 103,120 ---- xargc = argc; xargv = argv; ! signal1(SIGFPE, sigfdie); /* ignore underflow, enable overflow */ #ifdef SIGIOT ! signal1(SIGIOT, sigidie); #endif #ifdef SIGTRAP ! signal1(SIGTRAP, sigtrdie); #endif #ifdef SIGQUIT ! if(signal1(SIGQUIT,sigqdie) == SIG_IGN) ! signal1(SIGQUIT, SIG_IGN); #endif ! if(signal1(SIGINT, sigindie) == SIG_IGN) ! signal1(SIGINT, SIG_IGN); ! signal1(SIGTERM,sigtdie); #ifdef pdp11 *************** return 0; /* For compilers that complain *** 130,134 **** /* others will complain that this is unreachable code. */ } - #ifdef __cplusplus - } - #endif --- 134,135 ---- diff -rcp2N g77-0.5.20/f/runtime/libF77/makefile g77-0.5.21/f/runtime/libF77/makefile *** g77-0.5.20/f/runtime/libF77/makefile Sat Feb 8 06:48:08 1997 --- g77-0.5.21/f/runtime/libF77/makefile Thu Jan 1 00:00:00 1970 *************** *** 1,84 **** - .SUFFIXES: .c .o - CC = cc - SHELL = /bin/sh - CFLAGS = -O - - # If your system lacks onexit() and you are not using an - # ANSI C compiler, then you should add -DNO_ONEXIT to CFLAGS, - # e.g., by changing the above "CFLAGS =" line to - # CFLAGS = -O -DNO_ONEXIT - - # On at least some Sun systems, it is more appropriate to change the - # "CFLAGS =" line to - # CFLAGS = -O -Donexit=on_exit - - # compile, then strip unnecessary symbols - .c.o: - $(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c - ld -r -x -o $*.xxx $*.o - mv $*.xxx $*.o - ## Under Solaris, omit -x in the ld line above. - - MISC = F77_aloc.o 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 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 - DCX = z_abs.o z_cos.o z_div.o z_exp.o z_log.o z_sin.o z_sqrt.o - REAL = r_abs.o r_acos.o r_asin.o r_atan.o r_atn2.o r_cnjg.o r_cos.o\ - r_cosh.o r_dim.o r_exp.o r_imag.o r_int.o\ - r_lg10.o r_log.o r_mod.o r_nint.o r_sign.o\ - r_sin.o r_sinh.o r_sqrt.o r_tan.o r_tanh.o - DBL = d_abs.o d_acos.o d_asin.o d_atan.o d_atn2.o\ - d_cnjg.o d_cos.o d_cosh.o d_dim.o d_exp.o\ - d_imag.o d_int.o d_lg10.o d_log.o d_mod.o\ - d_nint.o d_prod.o d_sign.o d_sin.o d_sinh.o\ - d_sqrt.o d_tan.o d_tanh.o - INT = i_abs.o i_dim.o i_dnnt.o i_indx.o i_len.o i_mod.o i_nint.o i_sign.o - HALF = h_abs.o h_dim.o h_dnnt.o h_indx.o h_len.o h_mod.o h_nint.o h_sign.o - CMP = l_ge.o l_gt.o l_le.o l_lt.o hl_ge.o hl_gt.o hl_le.o hl_lt.o - EFL = ef1asc_.o ef1cmc_.o - CHAR = s_cat.o s_cmp.o s_copy.o - F90BIT = lbitbits.o lbitshft.o - - libF77.a : $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \ - $(HALF) $(CMP) $(EFL) $(CHAR) $(F90BIT) - ar r libF77.a $? - -ranlib libF77.a - - ### If your system lacks ranlib, you don't need it; see README. - - Version.o: Version.c - $(CC) -c Version.c - - # To compile with C++, first "make f2c.h" - f2c.h: f2ch.add - cat /usr/include/f2c.h f2ch.add >f2c.h - - install: libF77.a - mv libF77.a /usr/lib - ranlib /usr/lib/libF77.a - - clean: - rm -f libF77.a *.o - - check: - xsum F77_aloc.c Notice README Version.c abort_.c c_abs.c c_cos.c \ - c_div.c c_exp.c c_log.c c_sin.c c_sqrt.c cabs.c d_abs.c d_acos.c \ - d_asin.c d_atan.c d_atn2.c d_cnjg.c d_cos.c d_cosh.c d_dim.c \ - d_exp.c d_imag.c d_int.c d_lg10.c d_log.c d_mod.c d_nint.c \ - d_prod.c d_sign.c d_sin.c d_sinh.c d_sqrt.c d_tan.c d_tanh.c \ - derf_.c derfc_.c ef1asc_.c ef1cmc_.c erf_.c erfc_.c exit.c f2ch.add \ - getarg_.c getenv_.c h_abs.c h_dim.c h_dnnt.c h_indx.c h_len.c \ - h_mod.c h_nint.c h_sign.c hl_ge.c hl_gt.c hl_le.c hl_lt.c \ - i_abs.c i_dim.c i_dnnt.c i_indx.c i_len.c i_mod.c i_nint.c \ - i_sign.c iargc_.c l_ge.c l_gt.c l_le.c l_lt.c lbitbits.c lbitshft.c \ - main.c makefile pow_ci.c pow_dd.c pow_di.c pow_hh.c pow_ii.c \ - pow_qq.c pow_ri.c pow_zi.c pow_zz.c qbitbits.c qbitshft.c \ - r_abs.c r_acos.c r_asin.c r_atan.c r_atn2.c \ - r_cnjg.c r_cos.c r_cosh.c r_dim.c r_exp.c r_imag.c r_int.c r_lg10.c \ - r_log.c r_mod.c r_nint.c r_sign.c r_sin.c r_sinh.c r_sqrt.c \ - r_tan.c r_tanh.c s_cat.c s_cmp.c s_copy.c \ - s_paus.c s_rnge.c s_stop.c sig_die.c signal_.c system_.c \ - z_abs.c z_cos.c z_div.c z_exp.c z_log.c z_sin.c z_sqrt.c >zap - cmp zap libF77.xsum && rm zap || diff libF77.xsum zap --- 0 ---- diff -rcp2N g77-0.5.20/f/runtime/libF77/makefile.netlib g77-0.5.21/f/runtime/libF77/makefile.netlib *** g77-0.5.20/f/runtime/libF77/makefile.netlib Thu Jan 1 00:00:00 1970 --- g77-0.5.21/f/runtime/libF77/makefile.netlib Mon Aug 11 23:49:40 1997 *************** *** 0 **** --- 1,103 ---- + .SUFFIXES: .c .o + CC = cc + SHELL = /bin/sh + CFLAGS = -O + + # If your system lacks onexit() and you are not using an + # ANSI C compiler, then you should add -DNO_ONEXIT to CFLAGS, + # e.g., by changing the above "CFLAGS =" line to + # CFLAGS = -O -DNO_ONEXIT + + # On at least some Sun systems, it is more appropriate to change the + # "CFLAGS =" line to + # CFLAGS = -O -Donexit=on_exit + + # compile, then strip unnecessary symbols + .c.o: + $(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c + ld -r -x -o $*.xxx $*.o + mv $*.xxx $*.o + ## Under Solaris (and other systems that do not understand ld -x), + ## omit -x in the ld line above. + ## If your system does not have the ld command, comment out + ## or remove both the ld and mv lines above. + + MISC = F77_aloc.o 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 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 + DCX = z_abs.o z_cos.o z_div.o z_exp.o z_log.o z_sin.o z_sqrt.o + REAL = r_abs.o r_acos.o r_asin.o r_atan.o r_atn2.o r_cnjg.o r_cos.o\ + r_cosh.o r_dim.o r_exp.o r_imag.o r_int.o\ + r_lg10.o r_log.o r_mod.o r_nint.o r_sign.o\ + r_sin.o r_sinh.o r_sqrt.o r_tan.o r_tanh.o + DBL = d_abs.o d_acos.o d_asin.o d_atan.o d_atn2.o\ + d_cnjg.o d_cos.o d_cosh.o d_dim.o d_exp.o\ + d_imag.o d_int.o d_lg10.o d_log.o d_mod.o\ + d_nint.o d_prod.o d_sign.o d_sin.o d_sinh.o\ + d_sqrt.o d_tan.o d_tanh.o + INT = i_abs.o i_dim.o i_dnnt.o i_indx.o i_len.o i_mod.o i_nint.o i_sign.o + HALF = h_abs.o h_dim.o h_dnnt.o h_indx.o h_len.o h_mod.o h_nint.o h_sign.o + CMP = l_ge.o l_gt.o l_le.o l_lt.o hl_ge.o hl_gt.o hl_le.o hl_lt.o + EFL = ef1asc_.o ef1cmc_.o + CHAR = F77_aloc.o s_cat.o s_cmp.o s_copy.o + F90BIT = lbitbits.o lbitshft.o + QINT = pow_qq.o qbitbits.o qbitshft.o + TIME = dtime_.o etime_.o + + all: signal1.h libF77.a + + # You may need to adjust signal1.h suitably for your system... + signal1.h: signal1.h0 + cp signal1.h0 signal1.h + + # If you get an error compiling dtime_.c or etime_.c, try adding + # -DUSE_CLOCK to the CFLAGS assignment above; if that does not work, + # omit $(TIME) from the dependency list for libF77.a below. + + # For INTEGER*8 support (which requires system-dependent adjustments to + # f2c.h), add $(QINT) to the libf2c.a dependency list below... + + libF77.a : $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \ + $(HALF) $(CMP) $(EFL) $(CHAR) $(F90BIT) $(TIME) + ar r libF77.a $? + -ranlib libF77.a + + ### If your system lacks ranlib, you don't need it; see README. + + Version.o: Version.c + $(CC) -c Version.c + + # To compile with C++, first "make f2c.h" + f2c.h: f2ch.add + cat /usr/include/f2c.h f2ch.add >f2c.h + + install: libF77.a + mv libF77.a /usr/lib + ranlib /usr/lib/libF77.a + + clean: + rm -f libF77.a *.o + + check: + xsum F77_aloc.c Notice README Version.c abort_.c c_abs.c c_cos.c \ + c_div.c c_exp.c c_log.c c_sin.c c_sqrt.c cabs.c d_abs.c d_acos.c \ + d_asin.c d_atan.c d_atn2.c d_cnjg.c d_cos.c d_cosh.c d_dim.c \ + d_exp.c d_imag.c d_int.c d_lg10.c d_log.c d_mod.c d_nint.c \ + d_prod.c d_sign.c d_sin.c d_sinh.c d_sqrt.c d_tan.c d_tanh.c \ + derf_.c derfc_.c dtime_.c \ + ef1asc_.c ef1cmc_.c erf_.c erfc_.c etime_.c exit_.c f2ch.add \ + getarg_.c getenv_.c h_abs.c h_dim.c h_dnnt.c h_indx.c h_len.c \ + h_mod.c h_nint.c h_sign.c hl_ge.c hl_gt.c hl_le.c hl_lt.c \ + i_abs.c i_dim.c i_dnnt.c i_indx.c i_len.c i_mod.c i_nint.c \ + i_sign.c iargc_.c l_ge.c l_gt.c l_le.c l_lt.c lbitbits.c lbitshft.c \ + main.c makefile pow_ci.c pow_dd.c pow_di.c pow_hh.c pow_ii.c \ + pow_qq.c pow_ri.c pow_zi.c pow_zz.c qbitbits.c qbitshft.c \ + r_abs.c r_acos.c r_asin.c r_atan.c r_atn2.c \ + r_cnjg.c r_cos.c r_cosh.c r_dim.c r_exp.c r_imag.c r_int.c r_lg10.c \ + r_log.c r_mod.c r_nint.c r_sign.c r_sin.c r_sinh.c r_sqrt.c \ + r_tan.c r_tanh.c s_cat.c s_cmp.c s_copy.c \ + s_paus.c s_rnge.c s_stop.c sig_die.c signal1.h0 signal_.c system_.c \ + z_abs.c z_cos.c z_div.c z_exp.c z_log.c z_sin.c z_sqrt.c >zap + cmp zap libF77.xsum && rm zap || diff libF77.xsum zap diff -rcp2N g77-0.5.20/f/runtime/libF77/s_cat.c g77-0.5.21/f/runtime/libF77/s_cat.c *** g77-0.5.20/f/runtime/libF77/s_cat.c Sat Feb 8 06:48:08 1997 --- g77-0.5.21/f/runtime/libF77/s_cat.c Fri Jul 11 00:08:13 1997 *************** *** 11,15 **** extern char *F77_aloc(); extern void free(); ! extern void exit_(); #else #undef min --- 11,15 ---- extern char *F77_aloc(); extern void free(); ! extern void G77_exit_0 (); #else #undef min diff -rcp2N g77-0.5.20/f/runtime/libF77/s_paus.c g77-0.5.21/f/runtime/libF77/s_paus.c *** g77-0.5.20/f/runtime/libF77/s_paus.c Thu Dec 19 19:16:13 1996 --- g77-0.5.21/f/runtime/libF77/s_paus.c Fri Jul 11 00:08:13 1997 *************** *** 13,17 **** #undef max #include ! #include #ifdef __cplusplus extern "C" { --- 13,17 ---- #undef max #include ! #include "signal1.h" #ifdef __cplusplus extern "C" { *************** s_paus(char *s, ftnlen n) *** 75,79 **** "To resume execution, execute a kill -%d %d command\n", PAUSESIG, getpid() ); ! signal(PAUSESIG, waitpause); fflush(stderr); pause(); --- 75,79 ---- "To resume execution, execute a kill -%d %d command\n", PAUSESIG, getpid() ); ! signal1(PAUSESIG, waitpause); fflush(stderr); pause(); diff -rcp2N g77-0.5.20/f/runtime/libF77/signal1.h g77-0.5.21/f/runtime/libF77/signal1.h *** g77-0.5.20/f/runtime/libF77/signal1.h Thu Jan 1 00:00:00 1970 --- g77-0.5.21/f/runtime/libF77/signal1.h Mon Aug 11 23:55:58 1997 *************** *** 0 **** --- 1,5 ---- + /* The g77 implementation of libf2c directly includes signal1.h0, + instead of copying it to signal1.h, since that seems easier to + cope with at this point. */ + + #include "signal1.h0" diff -rcp2N g77-0.5.20/f/runtime/libF77/signal1.h0 g77-0.5.21/f/runtime/libF77/signal1.h0 *** g77-0.5.20/f/runtime/libF77/signal1.h0 Thu Jan 1 00:00:00 1970 --- g77-0.5.21/f/runtime/libF77/signal1.h0 Mon Aug 11 23:54:43 1997 *************** *** 0 **** --- 1,25 ---- + /* You may need to adjust the definition of signal1 to supply a */ + /* cast to the correct argument type. This detail is system- and */ + /* compiler-dependent. The #define below assumes signal.h declares */ + /* type SIG_PF for the signal function's second argument. */ + + #include + + #ifndef Sigret_t + #define Sigret_t void + #endif + #ifndef Sigarg_t + #ifdef KR_headers + #define Sigarg_t + #else + #define Sigarg_t int + #endif + #endif /*Sigarg_t*/ + + #ifdef USE_SIG_PF /* compile with -DUSE_SIG_PF under IRIX */ + #define sig_pf SIG_PF + #else + typedef Sigret_t (*sig_pf)(Sigarg_t); + #endif + + #define signal1(a,b) signal(a,(sig_pf)b) diff -rcp2N g77-0.5.20/f/runtime/libF77/signal_.c g77-0.5.21/f/runtime/libF77/signal_.c *** g77-0.5.20/f/runtime/libF77/signal_.c Sat Feb 8 06:53:52 1997 --- g77-0.5.21/f/runtime/libF77/signal_.c Fri Jul 11 00:08:13 1997 *************** *** 1,23 **** #include "f2c.h" - #ifndef RETSIGTYPE - /* we shouldn't rely on this... */ #ifdef KR_headers ! #define RETSIGTYPE int #else ! #define RETSIGTYPE void ! #endif ! #endif ! typedef RETSIGTYPE (*sig_type)(); ! ! #ifdef KR_headers ! extern sig_type signal(); ! ! ftnint signal_(sigp, proc) integer *sigp; sig_type proc; ! #else ! #include ! typedef int (*sig_proc)(int); ! ! ftnint signal_(integer *sigp, sig_proc proc) #endif { --- 1,9 ---- #include "f2c.h" + #include "signal1.h" #ifdef KR_headers ! ftnint G77_signal_0 (sigp, proc) integer *sigp; sig_pf proc; #else ! ftnint G77_signal_0 (integer *sigp, sig_pf proc) #endif { *************** ftnint signal_(integer *sigp, sig_proc p *** 25,28 **** sig = (int)*sigp; ! return (ftnint)signal(sig, (sig_type)proc); } --- 11,14 ---- sig = (int)*sigp; ! return (ftnint)signal(sig, proc); } diff -rcp2N g77-0.5.20/f/runtime/libF77/system_.c g77-0.5.21/f/runtime/libF77/system_.c *** g77-0.5.20/f/runtime/libF77/system_.c Thu Oct 31 10:36:52 1996 --- g77-0.5.21/f/runtime/libF77/system_.c Fri Jul 11 00:08:14 1997 *************** extern char *F77_aloc(); *** 7,11 **** integer ! system_(s, n) register char *s; ftnlen n; #else #undef abs --- 7,11 ---- integer ! G77_system_0 (s, n) register char *s; ftnlen n; #else #undef abs *************** extern char *F77_aloc(ftnlen, char*); *** 16,20 **** integer ! system_(register char *s, ftnlen n) #endif { --- 16,20 ---- integer ! G77_system_0 (register char *s, ftnlen n) #endif { diff -rcp2N g77-0.5.20/f/runtime/libF77/z_div.c g77-0.5.21/f/runtime/libF77/z_div.c *** g77-0.5.20/f/runtime/libF77/z_div.c Fri Feb 7 20:13:07 1997 --- g77-0.5.21/f/runtime/libF77/z_div.c Fri Jul 11 00:08:14 1997 *************** *** 2,6 **** #ifdef KR_headers ! extern void sig_die(); VOID z_div(resx, a, b) doublecomplex *a, *b, *resx; #else --- 2,6 ---- #ifdef KR_headers ! extern VOID sig_die(); VOID z_div(resx, a, b) doublecomplex *a, *b, *resx; #else diff -rcp2N g77-0.5.20/f/runtime/libI77/Notice g77-0.5.21/f/runtime/libI77/Notice *** g77-0.5.20/f/runtime/libI77/Notice Sun Feb 12 06:06:47 1995 --- g77-0.5.21/f/runtime/libI77/Notice Mon Aug 11 23:01:37 1997 *************** *** 1,4 **** /**************************************************************** ! Copyright 1990 - 1995 by AT&T Bell Laboratories and Bellcore. Permission to use, copy, modify, and distribute this software --- 1,4 ---- /**************************************************************** ! Copyright 1990 - 1997 by AT&T, Lucent Technologies and Bellcore. Permission to use, copy, modify, and distribute this software *************** granted, provided that the above copyrig *** 7,23 **** copies and that both that the copyright notice and this permission notice and warranty disclaimer appear in supporting ! documentation, and that the names of AT&T Bell Laboratories or ! Bellcore or any of their entities not be used in advertising or ! publicity pertaining to distribution of the software without ! specific, written prior permission. ! AT&T and Bellcore disclaim all warranties with regard to this ! software, including all implied warranties of merchantability ! and fitness. In no event shall AT&T or Bellcore be liable for ! any special, indirect or consequential damages or any damages ! whatsoever resulting from loss of use, data or profits, whether ! in an action of contract, negligence or other tortious action, ! arising out of or in connection with the use or performance of ! this software. ****************************************************************/ --- 7,23 ---- copies and that both that the copyright notice and this permission notice and warranty disclaimer appear in supporting ! documentation, and that the names of AT&T, Bell Laboratories, ! Lucent or Bellcore or any of their entities not be used in ! advertising or publicity pertaining to distribution of the ! software without specific, written prior permission. ! AT&T, Lucent and Bellcore disclaim all warranties with regard to ! this software, including all implied warranties of ! merchantability and fitness. In no event shall AT&T, Lucent or ! Bellcore be liable for any special, indirect or consequential ! damages or any damages whatsoever resulting from loss of use, ! data or profits, whether in an action of contract, negligence or ! other tortious action, arising out of or in connection with the ! use or performance of this software. ****************************************************************/ diff -rcp2N g77-0.5.20/f/runtime/libI77/README g77-0.5.21/f/runtime/libI77/README *** g77-0.5.20/f/runtime/libI77/README Sat Feb 8 07:21:08 1997 --- g77-0.5.21/f/runtime/libI77/README Thu Jan 1 00:00:00 1970 *************** *** 1,225 **** - If your compiler does not recognize ANSI C headers, - compile with KR_headers defined: either add -DKR_headers - to the definition of CFLAGS in the makefile, or insert - - #define KR_headers - - at the top of f2c.h and fmtlib.c . - - - If you have a really ancient K&R C compiler that does not understand - void, add -Dvoid=int to the definition of CFLAGS in the makefile. - - If you use a C++ compiler, first create a local f2c.h by appending - f2ch.add to the usual f2c.h, e.g., by issuing the command - make f2c.h - which assumes f2c.h is installed in /usr/include . - - If your system lacks /usr/include/fcntl.h , then you - should simply create an empty fcntl.h in this directory. - If your compiler then complains about creat and open not - having a prototype, compile with OPEN_DECL defined. - On many systems, open and creat are declared in fcntl.h . - - If your system has /usr/include/fcntl.h, you may need to add - -D_POSIX_SOURCE to the makefile's definition of CFLAGS. - - If your system's sprintf does not work the way ANSI C - specifies -- specifically, if it does not return the - number of characters transmitted -- then insert the line - - #define USE_STRLEN - - at the end of fmt.h . This is necessary with - at least some versions of Sun and DEC software. - In particular, if you get a warning about an improper - pointer/integer combination in compiling wref.c, then - you need to compile with -DUSE_STRLEN . - - If your system's fopen does not like the ANSI binary - reading and writing modes "rb" and "wb", then you should - compile open.c with NON_ANSI_RW_MODES #defined. - - If you get error messages about references to cf->_ptr - and cf->_base when compiling wrtfmt.c and wsfe.c or to - stderr->_flag when compiling err.c, then insert the line - - #define MISSING_FILE_ELEMS - - at the beginning of fio.h, and recompile everything (or - at least those modules that contain MISSING_FILE_ELEMS). - - Unformatted sequential records consist of a length of record - contents, the record contents themselves, and the length of - record contents again (for backspace). Prior to 17 Oct. 1991, - the length was of type int; now it is of type long, but you - can change it back to int by inserting - - #define UIOLEN_int - - at the beginning of fio.h. This affects only sue.c and uio.c . - - On VAX, Cray, or Research Tenth-Edition Unix systems, you may - need to add -DVAX, -DCRAY, or -DV10 (respectively) to CFLAGS - to make fp.h work correctly. Alternatively, you may need to - edit fp.h to suit your machine. - - You may need to supply the following non-ANSI routines: - - fstat(int fileds, struct stat *buf) is similar - to stat(char *name, struct stat *buf), except that - the first argument, fileds, is the file descriptor - returned by open rather than the name of the file. - fstat is used in the system-dependent routine - canseek (in the libI77 source file err.c), which - is supposed to return 1 if it's possible to issue - seeks on the file in question, 0 if it's not; you may - need to suitably modify err.c . On non-UNIX systems, - you can avoid references to fstat and stat by compiling - with NON_UNIX_STDIO defined; in that case, you may need - to supply access(char *Name,0), which is supposed to - return 0 if file Name exists, nonzero otherwise. - - char * mktemp(char *buf) is supposed to replace the - 6 trailing X's in buf with a unique number and then - return buf. The idea is to get a unique name for - a temporary file. - - On non-UNIX systems, you may need to change a few other, - e.g.: the form of name computed by mktemp() in endfile.c and - open.c; the use of the open(), close(), and creat() system - calls in endfile.c, err.c, open.c; and the modes in calls on - fopen() and fdopen() (and perhaps the use of fdopen() itself - -- it's supposed to return a FILE* corresponding to a given - an integer file descriptor) in err.c and open.c (component ufmt - of struct unit is 1 for formatted I/O -- text mode on some systems - -- and 0 for unformatted I/O -- binary mode on some systems). - Compiling with -DNON_UNIX_STDIO omits all references to creat() - and almost all references to open() and close(), the exception - being in the function f__isdev() (in open.c). - - For MS-DOS, compile all of libI77 with -DMSDOS (which implies - -DNON_UNIX_STDIO). You may need to make other compiler-dependent - adjustments; for example, for Turbo C++ you need to adjust the mktemp - invocations and to #undef ungetc in lread.c and rsne.c . - - If you want to be able to load against libI77 but not libF77, - then you will need to add sig_die.o (from libF77) to libI77. - - If you wish to use translated Fortran that has funny notions - of record length for direct unformatted I/O (i.e., that assumes - RECL= values in OPEN statements are not bytes but rather counts - of some other units -- e.g., 4-character words for VMS), then you - should insert an appropriate #define for url_Adjust at the - beginning of open.c . For VMS Fortran, for example, - #define url_Adjust(x) x *= 4 - would suffice. - - To check for transmission errors, issue the command - make check - This assumes you have the xsum program whose source, xsum.c, - is distributed as part of "all from f2c/src". If you do not - have xsum, you can obtain xsum.c by sending the following E-mail - message to netlib@bell-labs.com - send xsum.c from f2c/src - - The makefile assumes you have installed f2c.h in a standard - place (and does not cause recompilation when f2c.h is changed); - f2c.h comes with "all from f2c" (the source for f2c) and is - available separately ("f2c.h from f2c"). - - By default, Fortran I/O units 5, 6, and 0 are pre-connected to - stdin, stdout, and stderr, respectively. You can change this - behavior by changing f_init() in err.c to suit your needs. - Note that f2c assumes READ(*... means READ(5... and WRITE(*... - means WRITE(6... . Moreover, an OPEN(n,... statement that does - not specify a file name (and does not specify STATUS='SCRATCH') - assumes FILE='fort.n' . You can change this by editing open.c - and endfile.c suitably. - - Unless you adjust the "#define MXUNIT" line in fio.h, Fortran units - 0, 1, ..., 99 are available, i.e., the highest allowed unit number - is MXUNIT - 1. - - Lines protected from compilation by #ifdef Allow_TYQUAD - are for a possible extension to 64-bit integers in which - integer = int = 32 bits and longint = long = 64 bits. - - Extensions (Feb. 1993) to NAMELIST processing: - 1. Reading a ? instead of &name (the start of a namelist) causes - the namelist being sought to be written to stdout (unit 6); - to omit this feature, compile rsne.c with -DNo_Namelist_Questions. - 2. Reading the wrong namelist name now leads to an error message - and an attempt to skip input until the right namelist name is found; - to omit this feature, compile rsne.c with -DNo_Bad_Namelist_Skip. - 3. Namelist writes now insert newlines before each variable; to omit - this feature, compile xwsne.c with -DNo_Extra_Namelist_Newlines. - 4. (Sept. 1995) When looking for the &name that starts namelist - input, lines whose first non-blank character is something other - than &, $, or ? are treated as comment lines and ignored, unless - rsne.c is compiled with -DNo_Namelist_Comments. - - Nonstandard extension (Feb. 1993) to open: for sequential files, - ACCESS='APPEND' (or access='anything else starting with "A" or "a"') - causes the file to be positioned at end-of-file, so a write will - append to the file. - - Some buggy Fortran programs use unformatted direct I/O to write - an incomplete record and later read more from that record than - they have written. For records other than the last, the unwritten - portion of the record reads as binary zeros. The last record is - a special case: attempting to read more from it than was written - gives end-of-file -- which may help one find a bug. Some other - Fortran I/O libraries treat the last record no differently than - others and thus give no help in finding the bug of reading more - than was written. If you wish to have this behavior, compile - uio.c with -DPad_UDread . - - If you want to be able to catch write failures (e.g., due to a - disk being full) with an ERR= specifier, compile dfe.c, due.c, - sfe.c, sue.c, and wsle.c with -DALWAYS_FLUSH. This will lead to - slower execution and more I/O, but should make ERR= work as - expected, provided fflush returns an error return when its - physical write fails. - - Carriage controls are meant to be interpreted by the UNIX col - program (or a similar program). Sometimes it's convenient to use - only ' ' as the carriage control character (normal single spacing). - If you compile lwrite.c and wsfe.c with -DOMIT_BLANK_CC, formatted - external output lines will have an initial ' ' quietly omitted, - making use of the col program unnecessary with output that only - has ' ' for carriage control. - - The Fortran 77 Standard leaves it up to the implementation whether - formatted writes of floating-point numbers of absolute value < 1 have - a zero before the decimal point. By default, libI77 omits such - superfluous zeros, but you can cause them to appear by compiling - lwrite.c, wref.c, and wrtfmt.c with -DWANT_LEAD_0 . - - If your system lacks a ranlib command, you don't need it. - Either comment out the makefile's ranlib invocation, or install - a harmless "ranlib" command somewhere in your PATH, such as the - one-line shell script - - exit 0 - - or (on some systems) - - exec /usr/bin/ar lts $1 >/dev/null - - Most of the routines in libI77 are support routines for Fortran - I/O. There are a few exceptions, summarized below -- I/O related - functions and subroutines that appear to your program as ordinary - external Fortran routines. - - 1. CALL FLUSH flushes all buffers. - - 2. FTELL(i) is an INTEGER function that returns the current - offset of Fortran unit i (or -1 if unit i is not open). - - 3. CALL FSEEK(i, offset, whence, *errlab) attemps to move - Fortran unit i to the specified offset: absolute offset - if whence = 0; relative to the current offset if whence = 1; - relative to the end of the file if whence = 2. It branches - to label errlab if unit i is not open or if the call - otherwise fails. --- 0 ---- diff -rcp2N g77-0.5.20/f/runtime/libI77/README.netlib g77-0.5.21/f/runtime/libI77/README.netlib *** g77-0.5.20/f/runtime/libI77/README.netlib Thu Jan 1 00:00:00 1970 --- g77-0.5.21/f/runtime/libI77/README.netlib Tue Aug 12 00:00:29 1997 *************** *** 0 **** --- 1,225 ---- + If your compiler does not recognize ANSI C headers, + compile with KR_headers defined: either add -DKR_headers + to the definition of CFLAGS in the makefile, or insert + + #define KR_headers + + at the top of f2c.h and fmtlib.c . + + + If you have a really ancient K&R C compiler that does not understand + void, add -Dvoid=int to the definition of CFLAGS in the makefile. + + If you use a C++ compiler, first create a local f2c.h by appending + f2ch.add to the usual f2c.h, e.g., by issuing the command + make f2c.h + which assumes f2c.h is installed in /usr/include . + + If your system lacks /usr/include/fcntl.h , then you + should simply create an empty fcntl.h in this directory. + If your compiler then complains about creat and open not + having a prototype, compile with OPEN_DECL defined. + On many systems, open and creat are declared in fcntl.h . + + If your system has /usr/include/fcntl.h, you may need to add + -D_POSIX_SOURCE to the makefile's definition of CFLAGS. + + If your system's sprintf does not work the way ANSI C + specifies -- specifically, if it does not return the + number of characters transmitted -- then insert the line + + #define USE_STRLEN + + at the end of fmt.h . This is necessary with + at least some versions of Sun and DEC software. + In particular, if you get a warning about an improper + pointer/integer combination in compiling wref.c, then + you need to compile with -DUSE_STRLEN . + + If your system's fopen does not like the ANSI binary + reading and writing modes "rb" and "wb", then you should + compile open.c with NON_ANSI_RW_MODES #defined. + + If you get error messages about references to cf->_ptr + and cf->_base when compiling wrtfmt.c and wsfe.c or to + stderr->_flag when compiling err.c, then insert the line + + #define NON_UNIX_STDIO + + at the beginning of fio.h, and recompile everything (or + at least those modules that contain NON_UNIX_STDIO). + + Unformatted sequential records consist of a length of record + contents, the record contents themselves, and the length of + record contents again (for backspace). Prior to 17 Oct. 1991, + the length was of type int; now it is of type long, but you + can change it back to int by inserting + + #define UIOLEN_int + + at the beginning of fio.h. This affects only sue.c and uio.c . + + On VAX, Cray, or Research Tenth-Edition Unix systems, you may + need to add -DVAX, -DCRAY, or -DV10 (respectively) to CFLAGS + to make fp.h work correctly. Alternatively, you may need to + edit fp.h to suit your machine. + + You may need to supply the following non-ANSI routines: + + fstat(int fileds, struct stat *buf) is similar + to stat(char *name, struct stat *buf), except that + the first argument, fileds, is the file descriptor + returned by open rather than the name of the file. + fstat is used in the system-dependent routine + canseek (in the libI77 source file err.c), which + is supposed to return 1 if it's possible to issue + seeks on the file in question, 0 if it's not; you may + need to suitably modify err.c . On non-UNIX systems, + you can avoid references to fstat and stat by compiling + with NON_UNIX_STDIO defined; in that case, you may need + to supply access(char *Name,0), which is supposed to + return 0 if file Name exists, nonzero otherwise. + + char * mktemp(char *buf) is supposed to replace the + 6 trailing X's in buf with a unique number and then + return buf. The idea is to get a unique name for + a temporary file. + + On non-UNIX systems, you may need to change a few other, + e.g.: the form of name computed by mktemp() in endfile.c and + open.c; the use of the open(), close(), and creat() system + calls in endfile.c, err.c, open.c; and the modes in calls on + fopen() and fdopen() (and perhaps the use of fdopen() itself + -- it's supposed to return a FILE* corresponding to a given + an integer file descriptor) in err.c and open.c (component ufmt + of struct unit is 1 for formatted I/O -- text mode on some systems + -- and 0 for unformatted I/O -- binary mode on some systems). + Compiling with -DNON_UNIX_STDIO omits all references to creat() + and almost all references to open() and close(), the exception + being in the function f__isdev() (in open.c). + + For MS-DOS, compile all of libI77 with -DMSDOS (which implies + -DNON_UNIX_STDIO). You may need to make other compiler-dependent + adjustments; for example, for Turbo C++ you need to adjust the mktemp + invocations and to #undef ungetc in lread.c and rsne.c . + + If you want to be able to load against libI77 but not libF77, + then you will need to add sig_die.o (from libF77) to libI77. + + If you wish to use translated Fortran that has funny notions + of record length for direct unformatted I/O (i.e., that assumes + RECL= values in OPEN statements are not bytes but rather counts + of some other units -- e.g., 4-character words for VMS), then you + should insert an appropriate #define for url_Adjust at the + beginning of open.c . For VMS Fortran, for example, + #define url_Adjust(x) x *= 4 + would suffice. + + To check for transmission errors, issue the command + make check + This assumes you have the xsum program whose source, xsum.c, + is distributed as part of "all from f2c/src". If you do not + have xsum, you can obtain xsum.c by sending the following E-mail + message to netlib@netlib.bell-labs.com + send xsum.c from f2c/src + + The makefile assumes you have installed f2c.h in a standard + place (and does not cause recompilation when f2c.h is changed); + f2c.h comes with "all from f2c" (the source for f2c) and is + available separately ("f2c.h from f2c"). + + By default, Fortran I/O units 5, 6, and 0 are pre-connected to + stdin, stdout, and stderr, respectively. You can change this + behavior by changing f_init() in err.c to suit your needs. + Note that f2c assumes READ(*... means READ(5... and WRITE(*... + means WRITE(6... . Moreover, an OPEN(n,... statement that does + not specify a file name (and does not specify STATUS='SCRATCH') + assumes FILE='fort.n' . You can change this by editing open.c + and endfile.c suitably. + + Unless you adjust the "#define MXUNIT" line in fio.h, Fortran units + 0, 1, ..., 99 are available, i.e., the highest allowed unit number + is MXUNIT - 1. + + Lines protected from compilation by #ifdef Allow_TYQUAD + are for a possible extension to 64-bit integers in which + integer = int = 32 bits and longint = long = 64 bits. + + Extensions (Feb. 1993) to NAMELIST processing: + 1. Reading a ? instead of &name (the start of a namelist) causes + the namelist being sought to be written to stdout (unit 6); + to omit this feature, compile rsne.c with -DNo_Namelist_Questions. + 2. Reading the wrong namelist name now leads to an error message + and an attempt to skip input until the right namelist name is found; + to omit this feature, compile rsne.c with -DNo_Bad_Namelist_Skip. + 3. Namelist writes now insert newlines before each variable; to omit + this feature, compile xwsne.c with -DNo_Extra_Namelist_Newlines. + 4. (Sept. 1995) When looking for the &name that starts namelist + input, lines whose first non-blank character is something other + than &, $, or ? are treated as comment lines and ignored, unless + rsne.c is compiled with -DNo_Namelist_Comments. + + Nonstandard extension (Feb. 1993) to open: for sequential files, + ACCESS='APPEND' (or access='anything else starting with "A" or "a"') + causes the file to be positioned at end-of-file, so a write will + append to the file. + + Some buggy Fortran programs use unformatted direct I/O to write + an incomplete record and later read more from that record than + they have written. For records other than the last, the unwritten + portion of the record reads as binary zeros. The last record is + a special case: attempting to read more from it than was written + gives end-of-file -- which may help one find a bug. Some other + Fortran I/O libraries treat the last record no differently than + others and thus give no help in finding the bug of reading more + than was written. If you wish to have this behavior, compile + uio.c with -DPad_UDread . + + If you want to be able to catch write failures (e.g., due to a + disk being full) with an ERR= specifier, compile dfe.c, due.c, + sfe.c, sue.c, and wsle.c with -DALWAYS_FLUSH. This will lead to + slower execution and more I/O, but should make ERR= work as + expected, provided fflush returns an error return when its + physical write fails. + + Carriage controls are meant to be interpreted by the UNIX col + program (or a similar program). Sometimes it's convenient to use + only ' ' as the carriage control character (normal single spacing). + If you compile lwrite.c and wsfe.c with -DOMIT_BLANK_CC, formatted + external output lines will have an initial ' ' quietly omitted, + making use of the col program unnecessary with output that only + has ' ' for carriage control. + + The Fortran 77 Standard leaves it up to the implementation whether + formatted writes of floating-point numbers of absolute value < 1 have + a zero before the decimal point. By default, libI77 omits such + superfluous zeros, but you can cause them to appear by compiling + lwrite.c, wref.c, and wrtfmt.c with -DWANT_LEAD_0 . + + If your system lacks a ranlib command, you don't need it. + Either comment out the makefile's ranlib invocation, or install + a harmless "ranlib" command somewhere in your PATH, such as the + one-line shell script + + exit 0 + + or (on some systems) + + exec /usr/bin/ar lts $1 >/dev/null + + Most of the routines in libI77 are support routines for Fortran + I/O. There are a few exceptions, summarized below -- I/O related + functions and subroutines that appear to your program as ordinary + external Fortran routines. + + 1. CALL FLUSH flushes all buffers. + + 2. FTELL(i) is an INTEGER function that returns the current + offset of Fortran unit i (or -1 if unit i is not open). + + 3. CALL FSEEK(i, offset, whence, *errlab) attemps to move + Fortran unit i to the specified offset: absolute offset + if whence = 0; relative to the current offset if whence = 1; + relative to the end of the file if whence = 2. It branches + to label errlab if unit i is not open or if the call + otherwise fails. diff -rcp2N g77-0.5.20/f/runtime/libI77/Version.c g77-0.5.21/f/runtime/libI77/Version.c *** g77-0.5.20/f/runtime/libI77/Version.c Sat Mar 1 04:06:54 1997 --- g77-0.5.21/f/runtime/libI77/Version.c Tue Sep 9 06:10:54 1997 *************** *** 1,8 **** ! static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19961209\n"; /* */ ! char __G77_LIBI77_VERSION__[] = "0.5.20"; /* --- 1,8 ---- ! static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19970816\n"; /* */ ! char __G77_LIBI77_VERSION__[] = "0.5.21"; /* *************** wrtfmt.c: *** 246,249 **** --- 246,269 ---- in direct read and write statements. ftell_.c: change param "unit" to "Unit" for -DKR_headers. */ + /* 26 Feb. 1997: ftell_.c: on systems that define SEEK_SET, etc., use + SEEK_SET, SEEK_CUR, SEEK_END for *whence = 0, 1, 2. */ + /* 7 Apr. 1997: fmt.c: adjust to complain at missing numbers in formats + (but still treat missing ".nnn" as ".0"). */ + /* 11 Apr. 1997: err.c: attempt to make stderr line buffered rather + than fully buffered. (Buffering is needed for format + items T and TR.) */ + /* 27 May 1997: ftell_.c: fix typo (that caused the third argument to be + treated as 2 on some systems). */ + /* 5 Aug. 1997: lread.c: adjust to accord with a change to the Fortran 8X + draft (in 1990 or 1991) that rescinded permission to elide + quote marks in namelist input of character data; compile + with -DF8X_NML_ELIDE_QUOTES to get the old behavior. + wrtfmt.o: wrt_G: tweak to print the right number of 0's + for zero under G format. */ + /* 16 Aug. 1997: iio.c: fix bug in internal writes to an array of character + strings that sometimes caused one more array element than + required by the format to be blank-filled. Example: + format(1x). */ + /* 17 June 1997: detect recursive I/O and call f__fatal explaining it. */ #include diff -rcp2N g77-0.5.20/f/runtime/libI77/backspace.c g77-0.5.21/f/runtime/libI77/backspace.c *** g77-0.5.20/f/runtime/libI77/backspace.c Sat Feb 8 07:27:59 1997 --- g77-0.5.21/f/runtime/libI77/backspace.c Fri Jul 11 00:08:14 1997 *************** integer f_back(alist *a) *** 15,18 **** --- 15,20 ---- long x, y; char buf[32]; + if (f__init & 2) + f__fatal (131, "I/O recursion"); if(a->aunit >= MXUNIT || a->aunit < 0) err(a->aerr,101,"backspace"); diff -rcp2N g77-0.5.20/f/runtime/libI77/close.c g77-0.5.21/f/runtime/libI77/close.c *** g77-0.5.20/f/runtime/libI77/close.c Thu Oct 31 10:37:16 1996 --- g77-0.5.21/f/runtime/libI77/close.c Tue Sep 9 06:10:54 1997 *************** integer f_clos(cllist *a) *** 28,31 **** --- 28,33 ---- { unit *b; + if (f__init & 2) + f__fatal (131, "I/O recursion"); if(a->cunit >= MXUNIT) return(0); b= &f__units[a->cunit]; *************** f_exit(void) *** 72,75 **** --- 74,79 ---- { int i; static cllist xx; + if (! (f__init & 1)) + return; /* Not initialized, so no open units. */ if (!xx.cerr) { xx.cerr=1; *************** f_exit(void) *** 84,90 **** int #ifdef KR_headers ! flush_() #else ! flush_(void) #endif { int i; --- 88,94 ---- int #ifdef KR_headers ! G77_flush_0 () #else ! G77_flush_0 (void) #endif { int i; diff -rcp2N g77-0.5.20/f/runtime/libI77/dfe.c g77-0.5.21/f/runtime/libI77/dfe.c *** g77-0.5.20/f/runtime/libI77/dfe.c Sat Feb 8 07:27:59 1997 --- g77-0.5.21/f/runtime/libI77/dfe.c Fri Jul 11 00:08:15 1997 *************** y_getc(Void) *** 31,37 **** } err(f__elist->cierr,errno,"readingd"); - #ifdef __cplusplus - return 0; - #endif } #ifdef KR_headers --- 31,34 ---- *************** y_err(Void) *** 60,66 **** { err(f__elist->cierr, 110, "dfe"); - #ifdef __cplusplus - return 0; - #endif } --- 57,60 ---- *************** integer s_rdfe(cilist *a) *** 110,114 **** { int n; ! if(!f__init) f_init(); f__reading=1; if(n=c_dfe(a))return(n); --- 104,109 ---- { int n; ! if(f__init != 1) f_init(); ! f__init = 3; f__reading=1; if(n=c_dfe(a))return(n); *************** integer s_wdfe(cilist *a) *** 132,136 **** { int n; ! if(!f__init) f_init(); f__reading=0; if(n=c_dfe(a)) return(n); --- 127,132 ---- { int n; ! if(f__init != 1) f_init(); ! f__init = 3; f__reading=0; if(n=c_dfe(a)) return(n); *************** integer s_wdfe(cilist *a) *** 150,153 **** --- 146,150 ---- integer e_rdfe(Void) { + f__init = 1; (void) en_fio(); return(0); *************** integer e_rdfe(Void) *** 155,158 **** --- 152,156 ---- integer e_wdfe(Void) { + f__init = 1; return en_fio(); } diff -rcp2N g77-0.5.20/f/runtime/libI77/due.c g77-0.5.21/f/runtime/libI77/due.c *** g77-0.5.20/f/runtime/libI77/due.c Sat Feb 8 07:27:59 1997 --- g77-0.5.21/f/runtime/libI77/due.c Fri Jul 11 00:08:15 1997 *************** c_due(cilist *a) *** 8,12 **** #endif { ! if(!f__init) f_init(); if(a->ciunit>=MXUNIT || a->ciunit<0) err(a->cierr,101,"startio"); --- 8,13 ---- #endif { ! if(f__init != 1) f_init(); ! f__init = 3; if(a->ciunit>=MXUNIT || a->ciunit<0) err(a->cierr,101,"startio"); *************** integer s_wdue(cilist *a) *** 54,57 **** --- 55,59 ---- integer e_rdue(Void) { + f__init = 1; if(f__curunit->url==1 || f__recpos==f__curunit->url) return(0); *************** integer e_rdue(Void) *** 63,66 **** --- 65,69 ---- integer e_wdue(Void) { + f__init = 1; #ifdef ALWAYS_FLUSH if (fflush(f__cf)) diff -rcp2N g77-0.5.20/f/runtime/libI77/endfile.c g77-0.5.21/f/runtime/libI77/endfile.c *** g77-0.5.20/f/runtime/libI77/endfile.c Thu Oct 31 10:37:16 1996 --- g77-0.5.21/f/runtime/libI77/endfile.c Fri Jul 11 00:08:15 1997 *************** integer f_end(alist *a) *** 35,38 **** --- 35,40 ---- { unit *b; + if (f__init & 2) + f__fatal (131, "I/O recursion"); if(a->aunit>=MXUNIT || a->aunit<0) err(a->aerr,101,"endfile"); b = &f__units[a->aunit]; diff -rcp2N g77-0.5.20/f/runtime/libI77/err.c g77-0.5.21/f/runtime/libI77/err.c *** g77-0.5.20/f/runtime/libI77/err.c Sat Feb 8 07:21:29 1997 --- g77-0.5.21/f/runtime/libI77/err.c Fri Jul 11 00:11:14 1997 *************** *** 4,10 **** #endif #include "f2c.h" - #include "fio.h" - #include "fmt.h" /* for struct syl */ - #include "rawio.h" /* for fcntl.h, fdopen */ #if defined (NON_UNIX_STDIO) || defined (MISSING_FILE_ELEMS) #ifdef KR_headers --- 4,7 ---- *************** extern char *malloc(); *** 17,24 **** #endif #endif /*global definitions*/ unit f__units[MXUNIT]; /*unit table*/ ! flag f__init; /*0 on entry, 1 after initializations*/ cilist *f__elist; /*active external io list*/ icilist *f__svic; /*active internal io list*/ --- 14,26 ---- #endif #endif + #include "fio.h" + #include "fmt.h" /* for struct syl */ + #include "rawio.h" /* for fcntl.h, fdopen */ /*global definitions*/ unit f__units[MXUNIT]; /*unit table*/ ! int f__init; /*bit 0: set after initializations; ! bit 1: set during I/O involving returns to ! caller of library (or calls to user code)*/ cilist *f__elist; /*active external io list*/ icilist *f__svic; /*active internal io list*/ *************** char *F_err[] = *** 77,81 **** "'new' file exists", /* 128 */ "can't append to file", /* 129 */ ! "non-positive record number" /* 130 */ }; #define MAXERR (sizeof(F_err)/sizeof(char *)+100) --- 79,84 ---- "'new' file exists", /* 128 */ "can't append to file", /* 129 */ ! "non-positive record number", /* 130 */ ! "I/O started while already doing I/O" /* 131 */ }; #define MAXERR (sizeof(F_err)/sizeof(char *)+100) *************** f__fatal(int n, char *s) *** 142,145 **** --- 145,150 ---- #endif { + static int dead = 0; + if(n<100 && n>=0) perror(s); /*SYSDEP*/ else if(n >= (int)MAXERR || n < -1) *************** f__fatal(int n, char *s) *** 149,164 **** else fprintf(stderr,"%s: %s\n",s,F_err[n-100]); ! if (f__curunit) { ! fprintf(stderr,"apparent state: unit %d ",f__curunit-f__units); ! fprintf(stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n", ! f__curunit->ufnm); ! } ! else ! fprintf(stderr,"apparent state: internal I/O\n"); ! if (f__fmtbuf) ! fprintf(stderr,"last format: %s\n",f__fmtbuf); ! fprintf(stderr,"lately %s %s %s %s",f__reading?"reading":"writing", ! f__sequential?"sequential":"direct",f__formatted?"formatted":"unformatted", ! f__external?"external":"internal"); sig_die(" IO", 1); } --- 154,177 ---- else fprintf(stderr,"%s: %s\n",s,F_err[n-100]); ! if (dead) { ! fprintf (stderr, "(libf2c f__fatal already called, aborting.)"); ! abort(); ! } ! dead = 1; ! if (f__init & 1) { ! if (f__curunit) { ! fprintf(stderr,"apparent state: unit %d ",f__curunit-f__units); ! fprintf(stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n", ! f__curunit->ufnm); ! } ! else ! fprintf(stderr,"apparent state: internal I/O\n"); ! if (f__fmtbuf) ! fprintf(stderr,"last format: %s\n",f__fmtbuf); ! fprintf(stderr,"lately %s %s %s %s",f__reading?"reading":"writing", ! f__sequential?"sequential":"direct",f__formatted?"formatted":"unformatted", ! f__external?"external":"internal"); ! } ! f__init &= ~2; /* No longer doing I/O (no more user code to be called). */ sig_die(" IO", 1); } *************** f_init(Void) *** 168,180 **** { unit *p; ! f__init=1; p= &f__units[0]; p->ufd=stderr; p->useek=f__canseek(stderr); #if defined (NON_UNIX_STDIO) || defined (MISSING_FILE_ELEMS) ! setbuf(stderr, (char *)malloc(BUFSIZ)); #else stderr->_flag &= ~_IONBF; #endif p->ufmt=1; p->uwrt=1; --- 181,199 ---- { unit *p; ! if (f__init & 2) ! f__fatal (131, "I/O recursion"); ! f__init = 1; p= &f__units[0]; p->ufd=stderr; p->useek=f__canseek(stderr); + #ifdef _IOLBF + setvbuf(stderr, (char*)malloc(BUFSIZ+8), _IOLBF, BUFSIZ+8); + #else #if defined (NON_UNIX_STDIO) || defined (MISSING_FILE_ELEMS) ! setbuf(stderr, (char *)malloc(BUFSIZ+8)); #else stderr->_flag &= ~_IONBF; #endif + #endif p->ufmt=1; p->uwrt=1; *************** err__fl(int f, int m, char *s) *** 275,278 **** --- 294,298 ---- if (f__doend) (*f__doend)(); + f__init &= ~2; return errno = m; } diff -rcp2N g77-0.5.20/f/runtime/libI77/fio.h g77-0.5.21/f/runtime/libI77/fio.h *** g77-0.5.20/f/runtime/libI77/fio.h Sat Feb 8 07:10:17 1997 --- g77-0.5.21/f/runtime/libI77/fio.h Fri Jul 11 00:11:14 1997 *************** typedef struct *** 42,46 **** } unit; ! extern flag f__init; extern cilist *f__elist; /*active external io list*/ extern flag f__reading,f__external,f__sequential,f__formatted; --- 42,46 ---- } unit; ! extern int f__init; extern cilist *f__elist; /*active external io list*/ extern flag f__reading,f__external,f__sequential,f__formatted; *************** extern FILE *f__cf; /*current file*/ *** 81,85 **** extern unit *f__curunit; /*current unit*/ extern unit f__units[]; ! #define err(f,m,s) do {if(f) errno= m; else f__fatal(m,s); return(m);} while(0) #define errfl(f,m,s) do {return err__fl((int)f,m,s);} while(0) --- 81,85 ---- extern unit *f__curunit; /*current unit*/ extern unit f__units[]; ! #define err(f,m,s) do {if(f) {f__init &= ~2; errno= m;} else f__fatal(m,s); return(m);} while(0) #define errfl(f,m,s) do {return err__fl((int)f,m,s);} while(0) diff -rcp2N g77-0.5.20/f/runtime/libI77/fmt.c g77-0.5.21/f/runtime/libI77/fmt.c *** g77-0.5.20/f/runtime/libI77/fmt.c Fri Nov 18 21:17:53 1994 --- g77-0.5.21/f/runtime/libI77/fmt.c Fri Jul 11 00:08:16 1997 *************** struct syl f__syl[SYLMX]; *** 22,25 **** --- 22,26 ---- int f__parenlvl,f__pc,f__revloc; + static #ifdef KR_headers char *ap_end(s) char *s; *************** char *ap_end(char *s) *** 40,43 **** --- 41,45 ---- /*NOTREACHED*/ return 0; } + static #ifdef KR_headers op_gen(a,b,c,d) *************** op_gen(int a, int b, int c, int d) *** 57,65 **** } #ifdef KR_headers ! char *f_list(); ! char *gt_num(s,n) char *s; int *n; #else ! char *f_list(char*); ! char *gt_num(char *s, int *n) #endif { int m=0,f__cnt=0; --- 59,67 ---- } #ifdef KR_headers ! static char *f_list(); ! static char *gt_num(s,n,n1) char *s; int *n, n1; #else ! static char *f_list(char*); ! static char *gt_num(char *s, int *n, int n1) #endif { int m=0,f__cnt=0; *************** char *gt_num(char *s, int *n) *** 75,82 **** s++; } ! if(f__cnt==0) *n=1; else *n=m; return(s); } #ifdef KR_headers char *f_s(s,curloc) char *s; --- 77,90 ---- s++; } ! if(f__cnt==0) { ! if (!n1) ! s = 0; ! *n=n1; ! } else *n=m; return(s); } + + static #ifdef KR_headers char *f_s(s,curloc) char *s; *************** char *f_s(char *s, int curloc) *** 99,102 **** --- 107,112 ---- return(s); } + + static #ifdef KR_headers ne_d(s,p) char *s,**p; *************** ne_d(char *s, char **p) *** 136,140 **** case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': ! s=gt_num(s,&n); switch(*s) { --- 146,153 ---- case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': ! if (!(s=gt_num(s,&n,0))) { ! bad: *p = 0; ! return 1; ! } switch(*s) { *************** ne_d(char *s, char **p) *** 172,176 **** } else x=T; ! s=gt_num(s+1,&n); s--; (void) op_gen(x,n,0,0); --- 185,190 ---- } else x=T; ! if (!(s=gt_num(s+1,&n,0))) ! goto bad; s--; (void) op_gen(x,n,0,0); *************** ne_d(char *s, char **p) *** 185,188 **** --- 199,204 ---- return(1); } + + static #ifdef KR_headers e_d(s,p) char *s,**p; *************** e_d(char *s, char **p) *** 192,196 **** { int i,im,n,w,d,e,found=0,x=0; char *sv=s; ! s=gt_num(s,&n); (void) op_gen(STACK,n,0,0); switch(*s++) --- 208,212 ---- { int i,im,n,w,d,e,found=0,x=0; char *sv=s; ! s=gt_num(s,&n,1); (void) op_gen(STACK,n,0,0); switch(*s++) *************** e_d(char *s, char **p) *** 202,219 **** case 'g': found=1; ! s=gt_num(s,&w); if(w==0) break; ! if(*s=='.') ! { s++; ! s=gt_num(s,&d); ! } else d=0; if(*s!='E' && *s != 'e') (void) op_gen(x==1?E:G,w,d,0); /* default is Ew.dE2 */ ! else ! { s++; ! s=gt_num(s,&e); (void) op_gen(x==1?EE:GE,w,d,e); ! } break; case 'O': --- 218,239 ---- case 'g': found=1; ! if (!(s=gt_num(s,&w,0))) { ! bad: ! *p = 0; ! return 1; ! } if(w==0) break; ! if(*s=='.') { ! if (!(s=gt_num(s+1,&d,0))) ! goto bad; ! } else d=0; if(*s!='E' && *s != 'e') (void) op_gen(x==1?E:G,w,d,0); /* default is Ew.dE2 */ ! else { ! if (!(s=gt_num(s+1,&e,0))) ! goto bad; (void) op_gen(x==1?EE:GE,w,d,e); ! } break; case 'O': *************** e_d(char *s, char **p) *** 230,234 **** case 'l': found=1; ! s=gt_num(s,&w); if(w==0) break; (void) op_gen(L,w,0,0); --- 250,255 ---- case 'l': found=1; ! if (!(s=gt_num(s,&w,0))) ! goto bad; if(w==0) break; (void) op_gen(L,w,0,0); *************** e_d(char *s, char **p) *** 239,243 **** skip(s); if(*s>='0' && *s<='9') ! { s=gt_num(s,&w); if(w==0) break; (void) op_gen(AW,w,0,0); --- 260,264 ---- skip(s); if(*s>='0' && *s<='9') ! { s=gt_num(s,&w,1); if(w==0) break; (void) op_gen(AW,w,0,0); *************** e_d(char *s, char **p) *** 248,258 **** case 'F': case 'f': found=1; - s=gt_num(s,&w); if(w==0) break; ! if(*s=='.') ! { s++; ! s=gt_num(s,&d); ! } else d=0; (void) op_gen(F,w,d,0); --- 269,280 ---- case 'F': case 'f': + if (!(s=gt_num(s,&w,0))) + goto bad; found=1; if(w==0) break; ! if(*s=='.') { ! if (!(s=gt_num(s+1,&d,0))) ! goto bad; ! } else d=0; (void) op_gen(F,w,d,0); *************** e_d(char *s, char **p) *** 261,270 **** case 'd': found=1; ! s=gt_num(s,&w); if(w==0) break; ! if(*s=='.') ! { s++; ! s=gt_num(s,&d); ! } else d=0; (void) op_gen(D,w,d,0); --- 283,293 ---- case 'd': found=1; ! if (!(s=gt_num(s,&w,0))) ! goto bad; if(w==0) break; ! if(*s=='.') { ! if (!(s=gt_num(s+1,&d,0))) ! goto bad; ! } else d=0; (void) op_gen(D,w,d,0); *************** e_d(char *s, char **p) *** 275,280 **** im = IM; finish_I: found=1; - s=gt_num(s,&w); if(w==0) break; if(*s!='.') --- 298,304 ---- im = IM; finish_I: + if (!(s=gt_num(s,&w,0))) + goto bad; found=1; if(w==0) break; if(*s!='.') *************** e_d(char *s, char **p) *** 282,287 **** break; } ! s++; ! s=gt_num(s,&d); (void) op_gen(im,w,d,0); break; --- 306,311 ---- break; } ! if (!(s=gt_num(s+1,&d,0))) ! goto bad; (void) op_gen(im,w,d,0); break; *************** e_d(char *s, char **p) *** 295,298 **** --- 319,323 ---- return(1); } + static #ifdef KR_headers char *i_tem(s) char *s; *************** char *i_tem(char *s) *** 305,312 **** if(ne_d(s,&t)) return(t); if(e_d(s,&t)) return(t); ! s=gt_num(s,&n); if((curloc=op_gen(STACK,n,0,0))<0) return(NULL); return(f_s(s,curloc)); } #ifdef KR_headers char *f_list(s) char *s; --- 330,339 ---- if(ne_d(s,&t)) return(t); if(e_d(s,&t)) return(t); ! s=gt_num(s,&n,1); if((curloc=op_gen(STACK,n,0,0))<0) return(NULL); return(f_s(s,curloc)); } + + static #ifdef KR_headers char *f_list(s) char *s; *************** int f__cnt[STKSZ],f__ret[STKSZ],f__cp,f_ *** 350,353 **** --- 377,381 ---- flag f__workdone, f__nonl; + static #ifdef KR_headers type_f(n) diff -rcp2N g77-0.5.20/f/runtime/libI77/ftell_.c g77-0.5.21/f/runtime/libI77/ftell_.c *** g77-0.5.20/f/runtime/libI77/ftell_.c Sat Feb 8 07:14:49 1997 --- g77-0.5.21/f/runtime/libI77/ftell_.c Fri Jul 11 00:08:16 1997 *************** unit_chk(integer Unit, char *who) *** 16,22 **** integer #ifdef KR_headers ! ftell_(Unit) integer *Unit; #else ! ftell_(integer *Unit) #endif { --- 16,22 ---- integer #ifdef KR_headers ! G77_ftell_0 (Unit) integer *Unit; #else ! G77_ftell_0 (integer *Unit) #endif { *************** ftell_(integer *Unit) *** 25,54 **** } ! int #ifdef KR_headers ! fseek_(Unit, offset, xwhence) integer *Unit, *offset, *xwhence; #else ! fseek_(integer *Unit, integer *offset, integer *xwhence) #endif { - int whence; FILE *f; ! ! switch (*xwhence) { ! default: ! errno = EINVAL; ! return 1; ! case 0: ! whence = SEEK_SET; ! break; ! case 1: ! whence = SEEK_CUR; ! break; ! case 2: ! whence = SEEK_END; ! break; ! } ! return !(f = unit_chk(*Unit, "fseek")) ! || fseek(f, *offset, whence) ? 1 : 0; } --- 25,46 ---- } ! integer #ifdef KR_headers ! G77_fseek_0 (Unit, offset, xwhence) integer *Unit, *offset, *xwhence; #else ! G77_fseek_0 (integer *Unit, integer *offset, integer *xwhence) #endif { FILE *f; ! int w = (int)*xwhence; ! #ifdef SEEK_SET ! static int wohin[3] = { SEEK_SET, SEEK_CUR, SEEK_END }; ! #endif ! if (w < 0 || w > 2) ! w = 0; ! #ifdef SEEK_SET ! w = wohin[w]; ! #endif return !(f = unit_chk(*Unit, "fseek")) ! || fseek(f, *offset, w) ? 1 : 0; } diff -rcp2N g77-0.5.20/f/runtime/libI77/iio.c g77-0.5.21/f/runtime/libI77/iio.c *** g77-0.5.20/f/runtime/libI77/iio.c Mon Aug 7 12:17:41 1995 --- g77-0.5.21/f/runtime/libI77/iio.c Tue Sep 2 21:25:50 1997 *************** c_si(icilist *a) *** 49,52 **** --- 49,55 ---- #endif { + if (f__init & 2) + f__fatal (131, "I/O recursion"); + f__init |= 2; f__elist = (cilist *)a; f__fmtbuf=a->icifmt; *************** integer s_wsfi(icilist *a) *** 126,129 **** --- 129,133 ---- integer e_rsfi(Void) { int n; + f__init &= ~2; n = en_fio(); f__fmtbuf = NULL; *************** integer e_wsfi(Void) *** 133,139 **** { int n; n = en_fio(); f__fmtbuf = NULL; ! if(f__icnum >= f__svic->icirnum) return(n); while(f__recpos++ < f__svic->icirlen) --- 137,145 ---- { int n; + f__init &= ~2; n = en_fio(); f__fmtbuf = NULL; ! if(f__icnum >= f__svic->icirnum ! || !f__recpos && f__icnum) return(n); while(f__recpos++ < f__svic->icirlen) diff -rcp2N g77-0.5.20/f/runtime/libI77/ilnw.c g77-0.5.21/f/runtime/libI77/ilnw.c *** g77-0.5.20/f/runtime/libI77/ilnw.c Fri Nov 18 21:17:59 1994 --- g77-0.5.21/f/runtime/libI77/ilnw.c Fri Jul 11 00:12:43 1997 *************** s_wsni(icilist *a) *** 52,55 **** --- 52,57 ---- cilist ca; + if(f__init != 1) f_init(); + f__init = 3; c_liw(a); ca.cifmt = a->icifmt; *************** s_wsli(icilist *a) *** 66,69 **** --- 68,73 ---- #endif { + if(f__init != 1) f_init(); + f__init = 3; f__lioproc = l_write; c_liw(a); *************** s_wsli(icilist *a) *** 73,76 **** --- 77,81 ---- integer e_wsli(Void) { + f__init = 1; z_wSL(); return(0); diff -rcp2N g77-0.5.20/f/runtime/libI77/inquire.c g77-0.5.21/f/runtime/libI77/inquire.c *** g77-0.5.20/f/runtime/libI77/inquire.c Thu Oct 31 10:37:35 1996 --- g77-0.5.21/f/runtime/libI77/inquire.c Mon Aug 11 23:02:26 1997 *************** *** 1,4 **** --- 1,5 ---- #include "f2c.h" #include "fio.h" + #include #ifdef KR_headers integer f_inqu(a) inlist *a; *************** integer f_inqu(a) inlist *a; *** 8,12 **** #undef min #undef max - #include #include "io.h" #endif --- 9,12 ---- *************** integer f_inqu(inlist *a) *** 18,21 **** --- 18,23 ---- char buf[256]; long x; + if (f__init & 2) + f__fatal (131, "I/O recursion"); if(a->infile!=NULL) { byfile=1; diff -rcp2N g77-0.5.20/f/runtime/libI77/lread.c g77-0.5.21/f/runtime/libI77/lread.c *** g77-0.5.20/f/runtime/libI77/lread.c Sat Feb 8 07:27:59 1997 --- g77-0.5.21/f/runtime/libI77/lread.c Mon Aug 11 23:24:20 1997 *************** *** 1,8 **** #include "f2c.h" #include "fio.h" ! #include "fmt.h" ! #include "lio.h" ! #include ! #include "fp.h" extern char *f__fmtbuf; --- 1,10 ---- + #include #include "f2c.h" #include "fio.h" ! ! /* Compile with -DF8X_NML_ELIDE_QUOTES to permit eliding quotation */ ! /* marks in namelist input a la the Fortran 8X Draft published in */ ! /* the May 1989 issue of Fortran Forum. */ ! extern char *f__fmtbuf; *************** int (*f__lioproc)(ftnint*, char*, ftnlen *** 25,28 **** --- 27,35 ---- (*l_ungetc)(int,FILE*); #endif + + #include "fmt.h" + #include "lio.h" + #include "fp.h" + int l_eof; *************** integer e_rsle(Void) *** 79,82 **** --- 86,90 ---- { int ch; + f__init = 1; if(f__curunit->uend) return(0); while((ch=t_getc())!='\n') *************** int f__lcount,f__ltype,nml_read; *** 93,97 **** char *f__lchar; double f__lx,f__ly; ! #define ERR(x) if(n=(x)) return(n) #define GETC(x) (x=(*l_getc)()) #define Ungetc(x,y) (*l_ungetc)(x,y) --- 101,105 ---- char *f__lchar; double f__lx,f__ly; ! #define ERR(x) if(n=(x)) {f__init &= ~2; return(n);} #define GETC(x) (x=(*l_getc)()) #define Ungetc(x,y) (*l_ungetc)(x,y) *************** l_CHAR(Void) *** 386,389 **** --- 394,401 ---- if (f__lcount == 0) { f__lcount = 1; + #ifndef F8X_NML_ELIDE_QUOTES + if (nml_read) + goto no_quote; + #endif goto noquote; } *************** l_CHAR(Void) *** 404,407 **** --- 416,426 ---- if (!isdigit(ch)) { f__lcount = 1; + #ifndef F8X_NML_ELIDE_QUOTES + if (nml_read) { + no_quote: + errfl(f__elist->cierr,112, + "undelimited character string"); + } + #endif goto noquote; } *************** l_CHAR(Void) *** 420,427 **** have_lcount: if(GETC(ch)=='\'' || ch=='"') quote=ch; ! else if(isblnk(ch) || (issep(ch) && ch != '\n') || ch==EOF) ! { (void) Ungetc(ch,f__cf); ! return(0); ! } else { /* Fortran 8x-style unquoted string */ --- 439,453 ---- have_lcount: if(GETC(ch)=='\'' || ch=='"') quote=ch; ! else if(isblnk(ch) || (issep(ch) && ch != '\n') || ch==EOF) { ! Ungetc(ch,f__cf); ! return 0; ! } ! #ifndef F8X_NML_ELIDE_QUOTES ! else if (nml_read > 1) { ! Ungetc(ch,f__cf); ! f__lquit = 2; ! return 0; ! } ! #endif else { /* Fortran 8x-style unquoted string */ *************** c_le(cilist *a) *** 490,495 **** #endif { ! if(!f__init) ! f_init(); f__fmtbuf="list io"; if(a->ciunit>=MXUNIT || a->ciunit<0) --- 516,521 ---- #endif { ! if(f__init != 1) f_init(); ! f__init = 3; f__fmtbuf="list io"; if(a->ciunit>=MXUNIT || a->ciunit<0) *************** l_read(ftnint *number, char *ptr, ftnlen *** 557,562 **** n = l_R(0); quad_read = 0; ! if (n) ! return n; break; #endif --- 583,587 ---- n = l_R(0); quad_read = 0; ! ERR(n); break; #endif diff -rcp2N g77-0.5.20/f/runtime/libI77/makefile g77-0.5.21/f/runtime/libI77/makefile *** g77-0.5.20/f/runtime/libI77/makefile Sat Feb 8 07:21:29 1997 --- g77-0.5.21/f/runtime/libI77/makefile Thu Jan 1 00:00:00 1970 *************** *** 1,101 **** - .SUFFIXES: .c .o - CC = cc - CFLAGS = -O - SHELL = /bin/sh - - # compile, then strip unnecessary symbols - .c.o: - $(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c - ld -r -x -o $*.xxx $*.o - mv $*.xxx $*.o - ## Under Solaris, omit -x in the ld line above. - - OBJ = Version.o backspace.o close.o dfe.o dolio.o due.o endfile.o err.o \ - fmt.o fmtlib.o ftell_.o iio.o ilnw.o inquire.o lread.o lwrite.o \ - open.o rdfmt.o rewind.o rsfe.o rsli.o rsne.o sfe.o sue.o typesize.o \ - uio.o util.o wref.o wrtfmt.o wsfe.o wsle.o wsne.o xwsne.o - libI77.a: $(OBJ) - ar r libI77.a $? - -ranlib libI77.a - - ### If your system lacks ranlib, you don't need it; see README. - - install: libI77.a - cp libI77.a /usr/lib/libI77.a - ranlib /usr/lib/libI77.a - - Version.o: Version.c - $(CC) -c Version.c - - # To compile with C++, first "make f2c.h" - f2c.h: f2ch.add - cat /usr/include/f2c.h f2ch.add >f2c.h - - - clean: - rm -f $(OBJ) libI77.a - - clobber: clean - rm -f libI77.a - - backspace.o: fio.h - close.o: fio.h - dfe.o: fio.h - dfe.o: fmt.h - due.o: fio.h - endfile.o: fio.h rawio.h - err.o: fio.h rawio.h - fmt.o: fio.h - fmt.o: fmt.h - ftell_.o: fio.h - iio.o: fio.h - iio.o: fmt.h - ilnw.o: fio.h - ilnw.o: lio.h - inquire.o: fio.h - lread.o: fio.h - lread.o: fmt.h - lread.o: lio.h - lread.o: fp.h - lwrite.o: fio.h - lwrite.o: fmt.h - lwrite.o: lio.h - open.o: fio.h rawio.h - rdfmt.o: fio.h - rdfmt.o: fmt.h - rdfmt.o: fp.h - rewind.o: fio.h - rsfe.o: fio.h - rsfe.o: fmt.h - rsli.o: fio.h - rsli.o: lio.h - rsne.o: fio.h - rsne.o: lio.h - sfe.o: fio.h - sue.o: fio.h - uio.o: fio.h - util.o: fio.h - wref.o: fio.h - wref.o: fmt.h - wref.o: fp.h - wrtfmt.o: fio.h - wrtfmt.o: fmt.h - wsfe.o: fio.h - wsfe.o: fmt.h - wsle.o: fio.h - wsle.o: fmt.h - wsle.o: lio.h - wsne.o: fio.h - wsne.o: lio.h - xwsne.o: fio.h - xwsne.o: lio.h - xwsne.o: fmt.h - - check: - xsum Notice README Version.c backspace.c close.c dfe.c dolio.c \ - due.c endfile.c err.c f2ch.add fio.h fmt.c fmt.h fmtlib.c fp.h \ - ftell_.c iio.c ilnw.c inquire.c lio.h lread.c lwrite.c makefile \ - open.c rawio.h rdfmt.c rewind.c rsfe.c rsli.c rsne.c sfe.c sue.c \ - typesize.c uio.c util.c wref.c wrtfmt.c wsfe.c wsle.c wsne.c \ - xwsne.c >zap - cmp zap libI77.xsum && rm zap || diff libI77.xsum zap --- 0 ---- diff -rcp2N g77-0.5.20/f/runtime/libI77/makefile.netlib g77-0.5.21/f/runtime/libI77/makefile.netlib *** g77-0.5.20/f/runtime/libI77/makefile.netlib Thu Jan 1 00:00:00 1970 --- g77-0.5.21/f/runtime/libI77/makefile.netlib Fri Jul 11 00:11:14 1997 *************** *** 0 **** --- 1,104 ---- + .SUFFIXES: .c .o + CC = cc + CFLAGS = -O + SHELL = /bin/sh + + # compile, then strip unnecessary symbols + .c.o: + $(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c + ld -r -x -o $*.xxx $*.o + mv $*.xxx $*.o + ## Under Solaris (and other systems that do not understand ld -x), + ## omit -x in the ld line above. + ## If your system does not have the ld command, comment out + ## or remove both the ld and mv lines above. + + OBJ = Version.o backspace.o close.o dfe.o dolio.o due.o endfile.o err.o \ + fmt.o fmtlib.o ftell_.o iio.o ilnw.o inquire.o lread.o lwrite.o \ + open.o rdfmt.o rewind.o rsfe.o rsli.o rsne.o sfe.o sue.o typesize.o \ + uio.o util.o wref.o wrtfmt.o wsfe.o wsle.o wsne.o xwsne.o + libI77.a: $(OBJ) + ar r libI77.a $? + -ranlib libI77.a + + ### If your system lacks ranlib, you don't need it; see README. + + install: libI77.a + cp libI77.a /usr/lib/libI77.a + ranlib /usr/lib/libI77.a + + Version.o: Version.c + $(CC) -c Version.c + + # To compile with C++, first "make f2c.h" + f2c.h: f2ch.add + cat /usr/include/f2c.h f2ch.add >f2c.h + + + clean: + rm -f $(OBJ) libI77.a + + clobber: clean + rm -f libI77.a + + backspace.o: fio.h + close.o: fio.h + dfe.o: fio.h + dfe.o: fmt.h + due.o: fio.h + endfile.o: fio.h rawio.h + err.o: fio.h rawio.h + fmt.o: fio.h + fmt.o: fmt.h + ftell_.o: fio.h + iio.o: fio.h + iio.o: fmt.h + ilnw.o: fio.h + ilnw.o: lio.h + inquire.o: fio.h + lread.o: fio.h + lread.o: fmt.h + lread.o: lio.h + lread.o: fp.h + lwrite.o: fio.h + lwrite.o: fmt.h + lwrite.o: lio.h + open.o: fio.h rawio.h + rdfmt.o: fio.h + rdfmt.o: fmt.h + rdfmt.o: fp.h + rewind.o: fio.h + rsfe.o: fio.h + rsfe.o: fmt.h + rsli.o: fio.h + rsli.o: lio.h + rsne.o: fio.h + rsne.o: lio.h + sfe.o: fio.h + sue.o: fio.h + uio.o: fio.h + util.o: fio.h + wref.o: fio.h + wref.o: fmt.h + wref.o: fp.h + wrtfmt.o: fio.h + wrtfmt.o: fmt.h + wsfe.o: fio.h + wsfe.o: fmt.h + wsle.o: fio.h + wsle.o: fmt.h + wsle.o: lio.h + wsne.o: fio.h + wsne.o: lio.h + xwsne.o: fio.h + xwsne.o: lio.h + xwsne.o: fmt.h + + check: + xsum Notice README Version.c backspace.c close.c dfe.c dolio.c \ + due.c endfile.c err.c f2ch.add fio.h fmt.c fmt.h fmtlib.c fp.h \ + ftell_.c iio.c ilnw.c inquire.c lio.h lread.c lwrite.c makefile \ + open.c rawio.h rdfmt.c rewind.c rsfe.c rsli.c rsne.c sfe.c sue.c \ + typesize.c uio.c util.c wref.c wrtfmt.c wsfe.c wsle.c wsne.c \ + xwsne.c >zap + cmp zap libI77.xsum && rm zap || diff libI77.xsum zap diff -rcp2N g77-0.5.20/f/runtime/libI77/open.c g77-0.5.21/f/runtime/libI77/open.c *** g77-0.5.20/f/runtime/libI77/open.c Sat Feb 8 07:27:59 1997 --- g77-0.5.21/f/runtime/libI77/open.c Fri Jul 11 00:10:03 1997 *************** integer f_open(olist *a) *** 82,89 **** struct stat stb; #endif if(a->ounit>=MXUNIT || a->ounit<0) err(a->oerr,101,"open"); - if (!f__init) - f_init(); f__curunit = b = &f__units[a->ounit]; if(b->ufd) { --- 82,88 ---- struct stat stb; #endif + if(f__init != 1) f_init(); if(a->ounit>=MXUNIT || a->ounit<0) err(a->oerr,101,"open"); f__curunit = b = &f__units[a->ounit]; if(b->ufd) { *************** fk_open(int seq, int fmt, ftnint n) *** 226,229 **** --- 225,231 ---- { char nbuf[10]; olist a; + int rtn; + int save_init; + (void) sprintf(nbuf,"fort.%ld",n); a.oerr=1; *************** fk_open(int seq, int fmt, ftnint n) *** 236,239 **** a.orl = seq==DIR?1:0; a.oblnk=NULL; ! return(f_open(&a)); } --- 238,245 ---- a.orl = seq==DIR?1:0; a.oblnk=NULL; ! save_init = f__init; ! f__init &= ~2; ! rtn = f_open(&a); ! f__init = save_init | 1; ! return rtn; } diff -rcp2N g77-0.5.20/f/runtime/libI77/rawio.h g77-0.5.21/f/runtime/libI77/rawio.h *** g77-0.5.20/f/runtime/libI77/rawio.h Thu Oct 31 10:37:36 1996 --- g77-0.5.21/f/runtime/libI77/rawio.h Fri Jul 11 00:08:17 1997 *************** extern FILE *fdopen(); *** 4,7 **** --- 4,8 ---- #if defined (MSDOS) && !defined (GO32) #include "io.h" + #ifndef WATCOM #define close _close #define creat _creat *************** extern FILE *fdopen(); *** 9,13 **** #define read _read #define write _write ! #endif #ifdef __cplusplus extern "C" { --- 10,15 ---- #define read _read #define write _write ! #endif /*WATCOM*/ ! #endif /*MSDOS*/ #ifdef __cplusplus extern "C" { *************** extern FILE *fdopen(int, const char*); *** 25,29 **** #endif #endif ! #endif extern char *mktemp(char*); --- 27,31 ---- #endif #endif ! #endif /*KR_HEADERS*/ extern char *mktemp(char*); diff -rcp2N g77-0.5.20/f/runtime/libI77/rdfmt.c g77-0.5.21/f/runtime/libI77/rdfmt.c *** g77-0.5.20/f/runtime/libI77/rdfmt.c Thu Oct 31 10:37:53 1996 --- g77-0.5.21/f/runtime/libI77/rdfmt.c Fri Jul 11 00:08:17 1997 *************** *** 1,7 **** #include "f2c.h" #include "fio.h" - #include "fmt.h" - #include "fp.h" - #include extern int f__cursor; --- 1,5 ---- + #include #include "f2c.h" #include "fio.h" extern int f__cursor; *************** extern double atof(); *** 14,17 **** --- 12,18 ---- #include #endif + + #include "fmt.h" + #include "fp.h" static int diff -rcp2N g77-0.5.20/f/runtime/libI77/rewind.c g77-0.5.21/f/runtime/libI77/rewind.c *** g77-0.5.20/f/runtime/libI77/rewind.c Sat Feb 8 07:27:59 1997 --- g77-0.5.21/f/runtime/libI77/rewind.c Fri Jul 11 00:08:17 1997 *************** integer f_rew(alist *a) *** 8,11 **** --- 8,13 ---- { unit *b; + if (f__init & 2) + f__fatal (131, "I/O recursion"); if(a->aunit>=MXUNIT || a->aunit<0) err(a->aerr,101,"rewind"); diff -rcp2N g77-0.5.20/f/runtime/libI77/rsfe.c g77-0.5.21/f/runtime/libI77/rsfe.c *** g77-0.5.20/f/runtime/libI77/rsfe.c Tue Mar 19 17:59:07 1996 --- g77-0.5.21/f/runtime/libI77/rsfe.c Fri Jul 11 00:08:18 1997 *************** integer s_rsfe(cilist *a) /* start */ *** 50,54 **** #endif { int n; ! if(!f__init) f_init(); if(n=c_sfe(a)) return(n); f__reading=1; --- 50,55 ---- #endif { int n; ! if(f__init != 1) f_init(); ! f__init = 3; if(n=c_sfe(a)) return(n); f__reading=1; diff -rcp2N g77-0.5.20/f/runtime/libI77/rsli.c g77-0.5.21/f/runtime/libI77/rsli.c *** g77-0.5.20/f/runtime/libI77/rsli.c Thu Oct 31 10:37:53 1996 --- g77-0.5.21/f/runtime/libI77/rsli.c Fri Jul 11 00:11:50 1997 *************** c_lir(icilist *a) *** 47,50 **** --- 47,52 ---- { extern int l_eof; + if(f__init != 1) f_init(); + f__init = 3; f__reading = 1; f__external = 0; *************** integer s_rsli(icilist *a) *** 81,85 **** integer e_rsli(Void) ! { return 0; } #ifdef KR_headers --- 83,87 ---- integer e_rsli(Void) ! { f__init = 1; return 0; } #ifdef KR_headers diff -rcp2N g77-0.5.20/f/runtime/libI77/rsne.c g77-0.5.21/f/runtime/libI77/rsne.c *** g77-0.5.20/f/runtime/libI77/rsne.c Sat Feb 8 07:21:30 1997 --- g77-0.5.21/f/runtime/libI77/rsne.c Fri Jul 11 00:11:50 1997 *************** nl_init(Void) { *** 150,155 **** register int c; - if(!f__init) - f_init(); for(s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; c = *s++; ) Alpha[c] --- 150,153 ---- diff -rcp2N g77-0.5.20/f/runtime/libI77/sfe.c g77-0.5.21/f/runtime/libI77/sfe.c *** g77-0.5.20/f/runtime/libI77/sfe.c Sat Feb 8 07:27:59 1997 --- g77-0.5.21/f/runtime/libI77/sfe.c Fri Jul 11 00:11:15 1997 *************** extern char *f__fmtbuf; *** 7,10 **** --- 7,11 ---- integer e_rsfe(Void) { int n; + f__init = 1; n=en_fio(); if (f__cf == stdout) *************** integer e_wsfe(Void) *** 32,35 **** --- 33,37 ---- #ifdef ALWAYS_FLUSH int n; + f__init = 1; n = en_fio(); f__fmtbuf=NULL; diff -rcp2N g77-0.5.20/f/runtime/libI77/sue.c g77-0.5.21/f/runtime/libI77/sue.c *** g77-0.5.20/f/runtime/libI77/sue.c Sat Feb 8 07:27:59 1997 --- g77-0.5.21/f/runtime/libI77/sue.c Fri Jul 11 00:11:50 1997 *************** integer s_rsue(cilist *a) *** 30,34 **** { int n; ! if(!f__init) f_init(); f__reading=1; if(n=c_sue(a)) return(n); --- 30,35 ---- { int n; ! if(f__init != 1) f_init(); ! f__init = 3; f__reading=1; if(n=c_sue(a)) return(n); *************** integer s_wsue(cilist *a) *** 54,58 **** { int n; ! if(!f__init) f_init(); if(n=c_sue(a)) return(n); f__reading=0; --- 55,60 ---- { int n; ! if(f__init != 1) f_init(); ! f__init = 3; if(n=c_sue(a)) return(n); f__reading=0; *************** integer s_wsue(cilist *a) *** 66,69 **** --- 68,72 ---- integer e_wsue(Void) { long loc; + f__init = 1; fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf); #ifdef ALWAYS_FLUSH *************** integer e_wsue(Void) *** 79,82 **** --- 82,86 ---- integer e_rsue(Void) { + f__init = 1; (void) fseek(f__cf,(long)(f__reclen-f__recpos+sizeof(uiolen)),SEEK_CUR); return(0); diff -rcp2N g77-0.5.20/f/runtime/libI77/uio.c g77-0.5.21/f/runtime/libI77/uio.c *** g77-0.5.20/f/runtime/libI77/uio.c Sat Feb 8 07:27:59 1997 --- g77-0.5.21/f/runtime/libI77/uio.c Fri Jul 11 00:08:18 1997 *************** integer do_ud(ftnint *number, char *ptr, *** 51,55 **** #else if(fread(ptr,(size_t)len,(size_t)(*number),f__cf) != *number) ! err(f__elist->cierr,EOF,"do_ud") else return(0); #endif --- 51,55 ---- #else if(fread(ptr,(size_t)len,(size_t)(*number),f__cf) != *number) ! err(f__elist->cierr,EOF,"do_ud"); else return(0); #endif diff -rcp2N g77-0.5.20/f/runtime/libI77/wref.c g77-0.5.21/f/runtime/libI77/wref.c *** g77-0.5.20/f/runtime/libI77/wref.c Thu Oct 31 10:37:53 1996 --- g77-0.5.21/f/runtime/libI77/wref.c Fri Jul 11 00:08:19 1997 *************** *** 1,6 **** #include "f2c.h" #include "fio.h" - #include "fmt.h" - #include "fp.h" #ifndef VAX #include --- 1,4 ---- *************** *** 14,17 **** --- 12,18 ---- #include #endif + + #include "fmt.h" + #include "fp.h" #ifdef KR_headers diff -rcp2N g77-0.5.20/f/runtime/libI77/wrtfmt.c g77-0.5.21/f/runtime/libI77/wrtfmt.c *** g77-0.5.20/f/runtime/libI77/wrtfmt.c Sat Feb 8 07:24:39 1997 --- g77-0.5.21/f/runtime/libI77/wrtfmt.c Mon Aug 11 23:24:20 1997 *************** wrt_G(ufloat *p, int w, int d, int e, ft *** 293,299 **** if (x != 0.) return(wrt_E(p,w,d,e,len)); - #ifdef WANT_LEAD_0 i = 1; - #endif goto have_i; } --- 293,297 ---- diff -rcp2N g77-0.5.20/f/runtime/libI77/wsfe.c g77-0.5.21/f/runtime/libI77/wsfe.c *** g77-0.5.20/f/runtime/libI77/wsfe.c Sun Feb 12 06:06:49 1995 --- g77-0.5.21/f/runtime/libI77/wsfe.c Fri Jul 11 00:08:19 1997 *************** integer s_wsfe(cilist *a) /*start*/ *** 56,60 **** #endif { int n; ! if(!f__init) f_init(); if(n=c_sfe(a)) return(n); f__reading=0; --- 56,61 ---- #endif { int n; ! if(f__init != 1) f_init(); ! f__init = 3; if(n=c_sfe(a)) return(n); f__reading=0; diff -rcp2N g77-0.5.20/f/runtime/libI77/wsle.c g77-0.5.21/f/runtime/libI77/wsle.c *** g77-0.5.20/f/runtime/libI77/wsle.c Thu Nov 16 09:57:24 1995 --- g77-0.5.21/f/runtime/libI77/wsle.c Fri Jul 11 00:08:19 1997 *************** integer s_wsle(cilist *a) *** 26,29 **** --- 26,30 ---- integer e_wsle(Void) { + f__init = 1; t_putc('\n'); f__recpos=0; diff -rcp2N g77-0.5.20/f/runtime/libU77/Makefile.in g77-0.5.21/f/runtime/libU77/Makefile.in *** g77-0.5.20/f/runtime/libU77/Makefile.in Mon Feb 24 23:08:05 1997 --- g77-0.5.21/f/runtime/libU77/Makefile.in Mon Aug 11 05:45:23 1997 *************** OBJS = VersionU.o gerror_.o perror_.o i *** 55,63 **** srand_.o irand_.o sleep_.o idate_.o ctime_.o etime_.o \ dtime_.o isatty_.o ltime_.o fstat_.o stat_.o \ ! lstat_.o access_.o link_.o getlog_.o ttynam_.o getcwd_.o \ vxttime_.o vxtidate_.o gmtime_.o fdate_.o secnds_.o \ bes.o dbes.o \ chdir_.o chmod_.o lnblnk_.o hostnm_.o rename_.o fgetc_.o fputc_.o \ ! umask_.o system_clock_.o date_.o second_.o flush1_.o SRCS = Version.c gerror_.c perror_.c ierrno_.c itime_.c time_.c \ unlink_.c fnum_.c getpid_.c getuid_.c getgid_.c kill_.c rand_.c \ --- 55,64 ---- srand_.o irand_.o sleep_.o idate_.o ctime_.o etime_.o \ dtime_.o isatty_.o ltime_.o fstat_.o stat_.o \ ! lstat_.o access_.o link_.o getlog_.o ttynam_.o getcwd_.o symlnk_.o \ vxttime_.o vxtidate_.o gmtime_.o fdate_.o secnds_.o \ bes.o dbes.o \ chdir_.o chmod_.o lnblnk_.o hostnm_.o rename_.o fgetc_.o fputc_.o \ ! umask_.o system_clock_.o date_.o second_.o flush1_.o mclock_.o \ ! alarm_.o SRCS = Version.c gerror_.c perror_.c ierrno_.c itime_.c time_.c \ unlink_.c fnum_.c getpid_.c getuid_.c getgid_.c kill_.c rand_.c \ *************** SRCS = Version.c gerror_.c perror_.c ie *** 68,72 **** bes.c dbes.c \ chdir_.c chmod_.c lnblnk_.c hostnm_.c rename_.c fgetc_.c fputc_.c \ ! umask_.c system_clock_.c date_.c second_.c flush1_.c F2C_H = ../../../include/f2c.h --- 69,74 ---- bes.c dbes.c \ chdir_.c chmod_.c lnblnk_.c hostnm_.c rename_.c fgetc_.c fputc_.c \ ! umask_.c system_clock_.c date_.c second_.c flush1_.c mclock_.c \ ! alarm_.c F2C_H = ../../../include/f2c.h *************** system_clock_.o: system_clock_.c *** 148,151 **** --- 150,155 ---- umask_.o: umask_.c flush1_.o: flush1_.c + mclock_.o: mclock_.c + alarm_.o: alarm_.c .PHONY: mostlyclean clean distclean maintainer-clean lint check all diff -rcp2N g77-0.5.20/f/runtime/libU77/PROJECTS g77-0.5.21/f/runtime/libU77/PROJECTS *** g77-0.5.20/f/runtime/libU77/PROJECTS Mon Feb 3 04:27:28 1997 --- g77-0.5.21/f/runtime/libU77/PROJECTS Fri Jul 11 00:08:20 1997 *************** *** 1,7 **** -*- indented-text-*- - * Interface to stream i/o (if C stdio compatible with Fortran i/o, as - seems to be the case) - * Interface to strget --- 1,4 ---- diff -rcp2N g77-0.5.20/f/runtime/libU77/README g77-0.5.21/f/runtime/libU77/README *** g77-0.5.20/f/runtime/libU77/README Mon Feb 3 04:27:28 1997 --- g77-0.5.21/f/runtime/libU77/README Tue Aug 12 01:45:24 1997 *************** *** 1,3 **** ! -*-text-*- g77 libU77 --- 1,3 ---- ! 19970811 -*-text-*- g77 libU77 *************** The contents of libU77 and its interface *** 13,36 **** implementations. This one is mostly taken from documentation for (an old version of) the Convex implementation and the v2 SunPro one. ! Where there are differences with or between other implementations, the ! routines should be made g77 intrinsics. (This won't probably happen ! before g77 v0.6.) Some routines have a version with a name prefixed by `vxt', corresponding to the VMS Fortran versions, and these should be integrated with g77's intrinsics visibility control. A few routines are currently missing; in the case of `fork', for ! instance, because they're probably not useful and in the case of `qsort' and those for stream-based i/o handling, because they need more effort/research. The configuration should weed out those few which correspond to facilities which may not be present on some Unix ! systems, such as symbolic links. I'm undecided whether the interfaces to the native library random number routines should be retained, since their implementation is likely to be something one should avoid assiduously. ! I've tested it under SunOS4.1.3 and Irix5.2 and there has been some ! feedback from Linux; presumably potential problems lie mainly with ! systems with impoverished native C library support which I haven't ! properly taken care of with autoconf. There's another GPL'd implementation of this stuff which I only found --- 13,35 ---- implementations. This one is mostly taken from documentation for (an old version of) the Convex implementation and the v2 SunPro one. ! As of g77 version 0.5.20, most of these routines have been made ! into g77 intrinsics. Some routines have a version with a name prefixed by `vxt', corresponding to the VMS Fortran versions, and these should be integrated with g77's intrinsics visibility control. A few routines are currently missing; in the case of `fork', for ! instance, because they're probably not useful, and in the case of `qsort' and those for stream-based i/o handling, because they need more effort/research. The configuration should weed out those few which correspond to facilities which may not be present on some Unix ! systems, such as symbolic links. It's unclear whether the interfaces to the native library random number routines should be retained, since their implementation is likely to be something one should avoid assiduously. ! This library has been tested it under SunOS4.1.3 and Irix5.2 and there ! has been some feedback from Linux; presumably potential problems lie ! mainly with systems with impoverished native C library support which ! haven't been properly taken care of with autoconf. There's another GPL'd implementation of this stuff which I only found *************** how they should be amalgamated. *** 39,40 **** --- 38,40 ---- Dave Love Aug '95 + (minor changes by Craig Burley Aug '97) diff -rcp2N g77-0.5.20/f/runtime/libU77/Version.c g77-0.5.21/f/runtime/libU77/Version.c *** g77-0.5.20/f/runtime/libU77/Version.c Sat Mar 1 04:06:54 1997 --- g77-0.5.21/f/runtime/libU77/Version.c Tue Sep 9 06:10:54 1997 *************** *** 1,5 **** ! static char junk[] = "\n@(#) LIBU77 VERSION 19970204\n"; ! char __G77_LIBU77_VERSION__[] = "0.5.20"; #include --- 1,5 ---- ! static char junk[] = "\n@(#) LIBU77 VERSION 19970609\n"; ! char __G77_LIBU77_VERSION__[] = "0.5.21"; #include diff -rcp2N g77-0.5.20/f/runtime/libU77/access_.c g77-0.5.21/f/runtime/libU77/access_.c *** g77-0.5.20/f/runtime/libU77/access_.c Sat Feb 8 22:01:54 1997 --- g77-0.5.21/f/runtime/libU77/access_.c Fri Jul 11 00:08:20 1997 *************** *** 1,3 **** ! /* Copyright (C) 1995 Free Software Foundation, Inc. This file is part of GNU Fortran libU77 library. --- 1,3 ---- ! /* Copyright (C) 1995, 1997 Free Software Foundation, Inc. This file is part of GNU Fortran libU77 library. *************** Boston, MA 02111-1307, USA. */ *** 47,56 **** #ifdef KR_headers ! integer access_ (name, mode, Lname, Lmode) char *name, *mode; ftnlen Lname, Lmode; #else ! integer access_ (const char *name, const char *mode, ! ftnlen Lname, ftnlen Lmode) #endif { --- 47,59 ---- #ifdef KR_headers ! void g_char (); ! ! integer G77_access_0 (name, mode, Lname, Lmode) char *name, *mode; ftnlen Lname, Lmode; #else ! void g_char(const char *a, ftnlen alen, char *b); ! ! integer G77_access_0 (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode) #endif { *************** integer access_ (const char *name, const *** 61,68 **** buff = malloc (Lname+1); if (buff == NULL) return -1; ! blast = buff + Lname; ! for (bp = buff ; bp + #endif + + #include "f2c.h" + + #ifndef RETSIGTYPE + /* we shouldn't rely on this... */ + #ifdef KR_headers + #define RETSIGTYPE int + #else + #define RETSIGTYPE void + #endif + #endif + typedef RETSIGTYPE (*sig_type)(); + + #ifdef KR_headers + extern sig_type signal(); + + integer G77_alarm_0 (seconds, proc) + integer *seconds; + sig_type proc; + #else + #include + typedef int (*sig_proc)(int); + + integer G77_alarm_0 (integer *seconds, sig_proc proc) + #endif + { + int status; + + if (signal(SIGALRM, (sig_type)proc) == SIG_ERR) + status = -1; + else + status = alarm (*seconds); + return status; + } diff -rcp2N g77-0.5.20/f/runtime/libU77/bes.c g77-0.5.21/f/runtime/libU77/bes.c *** g77-0.5.20/f/runtime/libU77/bes.c Thu Feb 20 14:47:20 1997 --- g77-0.5.21/f/runtime/libU77/bes.c Tue Sep 2 21:25:50 1997 *************** not, write to the Free Software Foundati *** 17,45 **** Boston, MA 02111-1307, USA. */ ! #if 0 /* Don't include these unless necessary -- jcb. */ #include "f2c.h" #include ! doublereal besj0_ (const real *x) { return j0 (*x); } ! doublereal besj1_ (const real *x) { return j1 (*x); } ! doublereal besjn_ (const integer *n, real *x) { return jn (*n, *x); } ! doublereal besy0_ (const real *x) { return y0 (*x); } ! doublereal besy1_ (const real *x) { return y1 (*x); } ! doublereal besyn_ (const integer *n, real *x) { return yn (*n, *x); } --- 17,45 ---- Boston, MA 02111-1307, USA. */ ! #if 0 /* Don't include these unless necessary -- jcb. */ #include "f2c.h" #include ! double G77_besj0_0 (const real *x) { return j0 (*x); } ! double G77_besj1_0 (const real *x) { return j1 (*x); } ! double G77_besjn_0 (const integer *n, real *x) { return jn (*n, *x); } ! double G77_besy0_0 (const real *x) { return y0 (*x); } ! double G77_besy1_0 (const real *x) { return y1 (*x); } ! double G77_besyn_0 (const integer *n, real *x) { return yn (*n, *x); } diff -rcp2N g77-0.5.20/f/runtime/libU77/chdir_.c g77-0.5.21/f/runtime/libU77/chdir_.c *** g77-0.5.20/f/runtime/libU77/chdir_.c Mon Feb 3 04:27:28 1997 --- g77-0.5.21/f/runtime/libU77/chdir_.c Fri Jul 11 00:08:20 1997 *************** *** 1,3 **** ! /* Copyright (C) 1995 Free Software Foundation, Inc. This file is part of GNU Fortran libU77 library. --- 1,3 ---- ! /* Copyright (C) 1995, 1997 Free Software Foundation, Inc. This file is part of GNU Fortran libU77 library. *************** Boston, MA 02111-1307, USA. */ *** 34,42 **** #ifdef KR_headers ! integer chdir_ (name, Lname) char *name; ftnlen Lname; #else ! integer chdir_ (const char *name, const ftnlen Lname) #endif { --- 34,46 ---- #ifdef KR_headers ! void g_char (); ! ! integer G77_chdir_0 (name, Lname) char *name; ftnlen Lname; #else ! void g_char(const char *a, ftnlen alen, char *b); ! ! integer G77_chdir_0 (const char *name, const ftnlen Lname) #endif { *************** integer chdir_ (const char *name, const *** 47,54 **** buff = malloc (Lname+1); if (buff == NULL) return -1; ! blast = buff + Lname; ! for (bp = buff ; bp 1) && (name[l2-1] == ' '); ) ! l2--; ! ii[4] = l2; a[4] = name; ! ii[5] = 13; a[5] = "' 2>/dev/null"; ! s_cat (buff, a, ii, &six, Lname+Lmode+l+3+13); ! buff[Lname+Lmode+l+3+13] = '\0'; i = system (buff); free (buff); diff -rcp2N g77-0.5.20/f/runtime/libU77/ctime_.c g77-0.5.21/f/runtime/libU77/ctime_.c *** g77-0.5.20/f/runtime/libU77/ctime_.c Sun Feb 9 19:00:09 1997 --- g77-0.5.21/f/runtime/libU77/ctime_.c Fri Jul 11 00:08:20 1997 *************** Boston, MA 02111-1307, USA. */ *** 40,50 **** #ifdef KR_headers ! /* Character */ void ctime_ (chtime, Lchtime, xstime) char *chtime; longint * xstime; ftnlen Lchtime; #else ! /* Character */ void ctime_ (char *chtime, const ftnlen Lchtime, ! longint * xstime) #endif { --- 40,49 ---- #ifdef KR_headers ! /* Character */ void G77_ctime_0 (chtime, Lchtime, xstime) char *chtime; longint * xstime; ftnlen Lchtime; #else ! /* Character */ void G77_ctime_0 (char *chtime, const ftnlen Lchtime, longint * xstime) #endif { diff -rcp2N g77-0.5.20/f/runtime/libU77/date_.c g77-0.5.21/f/runtime/libU77/date_.c *** g77-0.5.20/f/runtime/libU77/date_.c Mon Feb 10 16:49:10 1997 --- g77-0.5.21/f/runtime/libU77/date_.c Fri Jul 11 00:08:21 1997 *************** *** 10,16 **** static integer c__5 = 5; ! /* Subroutine */ int date_(buf, buf_len) ! char *buf; ! ftnlen buf_len; { /* System generated locals */ --- 10,14 ---- static integer c__5 = 5; ! /* Subroutine */ int G77_date_0 (char *buf, ftnlen buf_len) { /* System generated locals */ *************** ftnlen buf_len; *** 24,32 **** /* Local variables */ static char cbuf[24]; ! extern integer time_(); ! extern /* Character */ VOID ctime_(); ! i__1 = time_(); ! ctime_(ch__1, 24L, &i__1); s_copy(cbuf, ch__1, 24L, 24L); /* Writing concatenation */ --- 22,30 ---- /* Local variables */ static char cbuf[24]; ! extern integer G77_time_0 (); ! extern /* Character */ VOID G77_ctime_0 (); ! i__1 = G77_time_0 (); ! G77_ctime_0 (ch__1, 24L, &i__1); s_copy(cbuf, ch__1, 24L, 24L); /* Writing concatenation */ *************** ftnlen buf_len; *** 37,41 **** i__2[4] = 2, a__1[4] = cbuf + 22; s_cat(buf, a__1, i__2, &c__5, buf_len); ! return 1; } /* date_ */ --- 35,39 ---- i__2[4] = 2, a__1[4] = cbuf + 22; s_cat(buf, a__1, i__2, &c__5, buf_len); ! return 0; } /* date_ */ diff -rcp2N g77-0.5.20/f/runtime/libU77/dbes.c g77-0.5.21/f/runtime/libU77/dbes.c *** g77-0.5.20/f/runtime/libU77/dbes.c Mon Feb 3 04:27:29 1997 --- g77-0.5.21/f/runtime/libU77/dbes.c Tue Sep 2 21:25:50 1997 *************** Boston, MA 02111-1307, USA. */ *** 20,44 **** #include ! doublereal dbesj0_ (const double *x) { return j0 (*x); } ! doublereal dbesj1_ (const double *x) { return j1 (*x); } ! doublereal dbesjn_ (const integer *n, double *x) { return jn (*n, *x); } ! doublereal dbesy0_ (const double *x) { return y0 (*x); } ! doublereal dbesy1_ (const double *x) { return y1 (*x); } ! doublereal dbesyn_ (const integer *n, double *x) { return yn (*n, *x); } --- 20,46 ---- #include ! #if 0 /* Don't include these unless necessary -- dnp. */ ! double G77_dbesj0_0 (const double *x) { return j0 (*x); } ! double G77_dbesj1_0 (const double *x) { return j1 (*x); } ! double G77_dbesjn_0 (const integer *n, double *x) { return jn (*n, *x); } ! double G77_dbesy0_0 (const double *x) { return y0 (*x); } ! double G77_dbesy1_0 (const double *x) { return y1 (*x); } ! double G77_dbesyn_0 (const integer *n, double *x) { return yn (*n, *x); } + #endif diff -rcp2N g77-0.5.20/f/runtime/libU77/dtime_.c g77-0.5.21/f/runtime/libU77/dtime_.c *** g77-0.5.20/f/runtime/libU77/dtime_.c Mon Feb 10 16:51:22 1997 --- g77-0.5.21/f/runtime/libU77/dtime_.c Tue Sep 2 21:25:50 1997 *************** static long clk_tck = 0; *** 38,45 **** #ifdef KR_headers ! doublereal dtime_ (tarray) real tarray[2]; #else ! doublereal dtime_ (real tarray[2]) #endif { --- 38,45 ---- #ifdef KR_headers ! double G77_dtime_0 (tarray) real tarray[2]; #else ! double G77_dtime_0 (real tarray[2]) #endif { diff -rcp2N g77-0.5.20/f/runtime/libU77/etime_.c g77-0.5.21/f/runtime/libU77/etime_.c *** g77-0.5.20/f/runtime/libU77/etime_.c Mon Feb 10 17:05:28 1997 --- g77-0.5.21/f/runtime/libU77/etime_.c Tue Sep 2 21:25:50 1997 *************** static long clk_tck = 0; *** 40,47 **** #ifdef KR_headers ! doublereal etime_ (tarray) real tarray[2]; #else ! doublereal etime_ (real tarray[2]) #endif { --- 40,47 ---- #ifdef KR_headers ! double G77_etime_0 (tarray) real tarray[2]; #else ! double G77_etime_0 (real tarray[2]) #endif { diff -rcp2N g77-0.5.20/f/runtime/libU77/fdate_.c g77-0.5.21/f/runtime/libU77/fdate_.c *** g77-0.5.20/f/runtime/libU77/fdate_.c Mon Feb 3 04:27:29 1997 --- g77-0.5.21/f/runtime/libU77/fdate_.c Fri Jul 11 00:08:22 1997 *************** Boston, MA 02111-1307, USA. */ *** 43,47 **** essentially the same for both. */ ! /* Character *24 */ void fdate_(char *ret_val, ftnlen ret_val_len) { int s_copy (); --- 43,47 ---- essentially the same for both. */ ! /* Character *24 */ void G77_fdate_0 (char *ret_val, ftnlen ret_val_len) { int s_copy (); diff -rcp2N g77-0.5.20/f/runtime/libU77/fgetc_.c g77-0.5.21/f/runtime/libU77/fgetc_.c *** g77-0.5.20/f/runtime/libU77/fgetc_.c Thu Feb 20 20:15:52 1997 --- g77-0.5.21/f/runtime/libU77/fgetc_.c Fri Jul 11 00:08:22 1997 *************** Boston, MA 02111-1307, USA. */ *** 28,37 **** #ifdef KR_headers ! integer fgetc_ (lunit, c, Lc) integer *lunit; ftnlen Lc; /* should be 1 */ char *c; #else ! integer fgetc_ (const integer *lunit, char *c, ftnlen Lc) #endif { --- 28,37 ---- #ifdef KR_headers ! integer G77_fgetc_0 (lunit, c, Lc) integer *lunit; ftnlen Lc; /* should be 1 */ char *c; #else ! integer G77_fgetc_0 (const integer *lunit, char *c, ftnlen Lc) #endif { *************** integer fgetc_ (const integer *lunit, ch *** 58,70 **** #ifdef KR_headers ! integer fget_ (c, Lc) ftnlen Lc; /* should be 1 */ char *c; #else ! integer fget_ (char *c, const ftnlen Lc) #endif { integer five = 5; ! return fgetc_ (&five, c, Lc); } --- 58,70 ---- #ifdef KR_headers ! integer G77_fget_0 (c, Lc) ftnlen Lc; /* should be 1 */ char *c; #else ! integer G77_fget_0 (char *c, const ftnlen Lc) #endif { integer five = 5; ! return G77_fgetc_0 (&five, c, Lc); } diff -rcp2N g77-0.5.20/f/runtime/libU77/flush1_.c g77-0.5.21/f/runtime/libU77/flush1_.c *** g77-0.5.20/f/runtime/libU77/flush1_.c Mon Feb 3 04:27:29 1997 --- g77-0.5.21/f/runtime/libU77/flush1_.c Fri Jul 11 00:08:22 1997 *************** Boston, MA 02111-1307, USA. */ *** 27,38 **** #ifdef KR_headers ! extern integer fnum_ (); ! /* Subroutine */ int flush1_ (lunit) integer *lunit; #else ! extern integer fnum_ (integer *); ! /* Subroutine */ int flush1_ (const integer *lunit) #endif { --- 27,38 ---- #ifdef KR_headers ! extern integer G77_fnum_0 (); ! /* Subroutine */ int G77_flush1_0 (lunit) integer *lunit; #else ! extern integer G77_fnum_0 (integer *); ! /* Subroutine */ int G77_flush1_0 (const integer *lunit) #endif { diff -rcp2N g77-0.5.20/f/runtime/libU77/fnum_.c g77-0.5.21/f/runtime/libU77/fnum_.c *** g77-0.5.20/f/runtime/libU77/fnum_.c Mon Feb 3 04:27:29 1997 --- g77-0.5.21/f/runtime/libU77/fnum_.c Fri Jul 11 00:08:22 1997 *************** Boston, MA 02111-1307, USA. */ *** 24,31 **** #ifdef KR_headers ! integer fnum_ (lunit) integer *lunit; #else ! integer fnum_ (integer *lunit) #endif { --- 24,31 ---- #ifdef KR_headers ! integer G77_fnum_0 (lunit) integer *lunit; #else ! integer G77_fnum_0 (integer *lunit) #endif { diff -rcp2N g77-0.5.20/f/runtime/libU77/fputc_.c g77-0.5.21/f/runtime/libU77/fputc_.c *** g77-0.5.20/f/runtime/libU77/fputc_.c Thu Feb 20 20:15:58 1997 --- g77-0.5.21/f/runtime/libU77/fputc_.c Fri Jul 11 00:08:22 1997 *************** Boston, MA 02111-1307, USA. */ *** 28,37 **** #ifdef KR_headers ! integer fputc_ (lunit, c, Lc) integer *lunit; ftnlen Lc; /* should be 1 */ char *c; #else ! integer fputc_ (const integer *lunit, const char *c, const ftnlen Lc) #endif { --- 28,37 ---- #ifdef KR_headers ! integer G77_fputc_0 (lunit, c, Lc) integer *lunit; ftnlen Lc; /* should be 1 */ char *c; #else ! integer G77_fputc_0 (const integer *lunit, const char *c, const ftnlen Lc) #endif { *************** integer fputc_ (const integer *lunit, co *** 53,65 **** #ifdef KR_headers ! integer fput_ (c, Lc) ftnlen Lc; /* should be 1 */ char *c; #else ! integer fput_ (const char *c, const ftnlen Lc) #endif { integer six = 6; ! return fputc_ (&six, c, Lc); } --- 53,65 ---- #ifdef KR_headers ! integer G77_fput_0 (c, Lc) ftnlen Lc; /* should be 1 */ char *c; #else ! integer G77_fput_0 (const char *c, const ftnlen Lc) #endif { integer six = 6; ! return G77_fputc_0 (&six, c, Lc); } diff -rcp2N g77-0.5.20/f/runtime/libU77/fstat_.c g77-0.5.21/f/runtime/libU77/fstat_.c *** g77-0.5.20/f/runtime/libU77/fstat_.c Mon Feb 3 04:27:29 1997 --- g77-0.5.21/f/runtime/libU77/fstat_.c Fri Jul 11 00:08:23 1997 *************** Boston, MA 02111-1307, USA. */ *** 28,40 **** #ifdef KR_headers ! extern integer fnum_ (); ! integer fstat_ (lunit, statb) integer *lunit; integer statb[13]; #else ! extern integer fnum_ (const integer *); ! integer fstat_ (const integer *lunit, integer statb[13]) #endif { --- 28,40 ---- #ifdef KR_headers ! extern integer G77_fnum_0 (); ! integer G77_fstat_0 (lunit, statb) integer *lunit; integer statb[13]; #else ! extern integer G77_fnum_0 (const integer *); ! integer G77_fstat_0 (const integer *lunit, integer statb[13]) #endif { *************** integer fstat_ (const integer *lunit, in *** 42,46 **** struct stat buf; ! err = fstat (fnum_ (lunit), &buf); statb[0] = buf.st_dev; statb[1] = buf.st_ino; --- 42,46 ---- struct stat buf; ! err = fstat (G77_fnum_0 (lunit), &buf); statb[0] = buf.st_dev; statb[1] = buf.st_ino; diff -rcp2N g77-0.5.20/f/runtime/libU77/gerror_.c g77-0.5.21/f/runtime/libU77/gerror_.c *** g77-0.5.20/f/runtime/libU77/gerror_.c Mon Feb 3 04:27:30 1997 --- g77-0.5.21/f/runtime/libU77/gerror_.c Fri Jul 11 00:08:23 1997 *************** Boston, MA 02111-1307, USA. */ *** 35,43 **** #ifdef KR_headers extern void s_copy (); ! /* Subroutine */ int gerror_ (str, Lstr) ! char *str; ftnlen Lstr; #else extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); ! /* Subroutine */ int gerror_ (char *str, ftnlen Lstr) #endif { --- 35,43 ---- #ifdef KR_headers extern void s_copy (); ! /* Subroutine */ int G77_gerror_0 (str, Lstr) ! char *str; ftnlen Lstr; #else extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); ! /* Subroutine */ int G77_gerror_0 (char *str, ftnlen Lstr) #endif { diff -rcp2N g77-0.5.20/f/runtime/libU77/getcwd_.c g77-0.5.21/f/runtime/libU77/getcwd_.c *** g77-0.5.20/f/runtime/libU77/getcwd_.c Mon Feb 3 04:27:30 1997 --- g77-0.5.21/f/runtime/libU77/getcwd_.c Tue Sep 2 21:25:50 1997 *************** Boston, MA 02111-1307, USA. */ *** 27,33 **** #endif #include /* for NULL */ #include "f2c.h" ! #ifdef HAVE_GETCWD #ifdef HAVE_UNISTD_H --- 27,34 ---- #endif #include /* for NULL */ + #include /* for ENOSYS */ #include "f2c.h" ! #if HAVE_GETCWD #ifdef HAVE_UNISTD_H *************** Boston, MA 02111-1307, USA. */ *** 39,47 **** #ifdef KR_headers extern void s_copy (); ! integer getcwd_ (str, Lstr) ! char *str; ftnlen Lstr; #else extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); ! integer getcwd_ (char *str, const ftnlen Lstr) #endif { --- 40,48 ---- #ifdef KR_headers extern void s_copy (); ! integer G77_getcwd_0 (str, Lstr) ! char *str; ftnlen Lstr; #else extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); ! integer G77_getcwd_0 (char *str, const ftnlen Lstr) #endif { *************** integer getcwd_ (char *str, const ftnlen *** 64,72 **** #ifdef KR_headers extern VOID s_copy (); ! integer getcwd_ (str, Lstr) ! char *str; ftnlen Lstr; #else extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); ! integer getcwd_ (char *str, const ftnlen Lstr) #endif { --- 65,73 ---- #ifdef KR_headers extern VOID s_copy (); ! integer G77_getcwd_0 (str, Lstr) ! char *str; ftnlen Lstr; #else extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); ! integer G77_getcwd_0 (char *str, const ftnlen Lstr) #endif { *************** integer getcwd_ (char *str, const ftnlen *** 82,88 **** } ! #else /* HAVE_GETWD */ ! #error getcwd and getwd both missing #endif --- 83,99 ---- } ! #else /* !HAVE_GETWD && !HAVE_GETCWD */ ! #ifdef KR_headers ! extern VOID s_copy (); ! integer G77_getcwd_0 (str, Lstr) ! char *str; ftnlen Lstr; ! #else ! extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); ! integer G77_getcwd_0 (char *str, const ftnlen Lstr) ! #endif ! { ! return errno = ENOSYS; ! } #endif diff -rcp2N g77-0.5.20/f/runtime/libU77/getgid_.c g77-0.5.21/f/runtime/libU77/getgid_.c *** g77-0.5.20/f/runtime/libU77/getgid_.c Mon Feb 3 04:27:30 1997 --- g77-0.5.21/f/runtime/libU77/getgid_.c Fri Jul 11 00:08:23 1997 *************** Boston, MA 02111-1307, USA. */ *** 27,33 **** #ifdef KR_headers ! integer getgid_ () #else ! integer getgid_ (void) #endif { --- 27,33 ---- #ifdef KR_headers ! integer G77_getgid_0 () #else ! integer G77_getgid_0 (void) #endif { diff -rcp2N g77-0.5.20/f/runtime/libU77/getlog_.c g77-0.5.21/f/runtime/libU77/getlog_.c *** g77-0.5.20/f/runtime/libU77/getlog_.c Mon Feb 3 04:27:30 1997 --- g77-0.5.21/f/runtime/libU77/getlog_.c Fri Jul 11 00:08:23 1997 *************** Boston, MA 02111-1307, USA. */ *** 42,50 **** #ifdef KR_headers extern VOID s_copy (); ! /* Subroutine */ int getlog_ (str, Lstr) ! char *str; ftnlen Lstr; #else extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); ! /* Subroutine */ int getlog_ (char *str, const ftnlen Lstr) #endif { --- 42,50 ---- #ifdef KR_headers extern VOID s_copy (); ! /* Subroutine */ int G77_getlog_0 (str, Lstr) ! char *str; ftnlen Lstr; #else extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); ! /* Subroutine */ int G77_getlog_0 (char *str, const ftnlen Lstr) #endif { diff -rcp2N g77-0.5.20/f/runtime/libU77/getpid_.c g77-0.5.21/f/runtime/libU77/getpid_.c *** g77-0.5.20/f/runtime/libU77/getpid_.c Mon Feb 3 04:27:30 1997 --- g77-0.5.21/f/runtime/libU77/getpid_.c Fri Jul 11 00:08:24 1997 *************** Boston, MA 02111-1307, USA. */ *** 27,33 **** #ifdef KR_headers ! integer getpid_ () #else ! integer getpid_ (void) #endif { --- 27,33 ---- #ifdef KR_headers ! integer G77_getpid_0 () #else ! integer G77_getpid_0 (void) #endif { diff -rcp2N g77-0.5.20/f/runtime/libU77/getuid_.c g77-0.5.21/f/runtime/libU77/getuid_.c *** g77-0.5.20/f/runtime/libU77/getuid_.c Mon Feb 3 04:27:30 1997 --- g77-0.5.21/f/runtime/libU77/getuid_.c Fri Jul 11 00:08:24 1997 *************** Boston, MA 02111-1307, USA. */ *** 27,33 **** #ifdef KR_headers ! integer getuid_ () #else ! integer getuid_ (void) #endif { --- 27,33 ---- #ifdef KR_headers ! integer G77_getuid_0 () #else ! integer G77_getuid_0 (void) #endif { diff -rcp2N g77-0.5.20/f/runtime/libU77/gmtime_.c g77-0.5.21/f/runtime/libU77/gmtime_.c *** g77-0.5.20/f/runtime/libU77/gmtime_.c Mon Feb 3 04:27:30 1997 --- g77-0.5.21/f/runtime/libU77/gmtime_.c Fri Jul 11 00:08:24 1997 *************** Boston, MA 02111-1307, USA. */ *** 34,41 **** #ifdef KR_headers ! /* Subroutine */ int gmtime_ (stime, tarray) integer *stime, tarray[9]; #else ! /* Subroutine */ int gmtime_ (const integer * stime, integer tarray[9]) #endif { --- 34,41 ---- #ifdef KR_headers ! /* Subroutine */ int G77_gmtime_0 (stime, tarray) integer *stime, tarray[9]; #else ! /* Subroutine */ int G77_gmtime_0 (const integer * stime, integer tarray[9]) #endif { diff -rcp2N g77-0.5.20/f/runtime/libU77/hostnm_.c g77-0.5.21/f/runtime/libU77/hostnm_.c *** g77-0.5.20/f/runtime/libU77/hostnm_.c Mon Feb 10 16:49:10 1997 --- g77-0.5.21/f/runtime/libU77/hostnm_.c Tue Sep 2 21:25:51 1997 *************** Boston, MA 02111-1307, USA. */ *** 28,37 **** # include #endif #include "f2c.h" ! integer hostnm_(char *name, ftnlen Lname) { int ret, i; ret = gethostname (name, Lname); if (ret==0) { --- 28,39 ---- # include #endif + #include /* for ENOSYS */ #include "f2c.h" ! integer G77_hostnm_0 (char *name, ftnlen Lname) { int ret, i; + #if HAVE_GETHOSTNAME ret = gethostname (name, Lname); if (ret==0) { *************** integer hostnm_(char *name, ftnlen Lname *** 42,44 **** --- 44,49 ---- } return ret; + #else + return errno = ENOSYS; + #endif } diff -rcp2N g77-0.5.20/f/runtime/libU77/idate_.c g77-0.5.21/f/runtime/libU77/idate_.c *** g77-0.5.20/f/runtime/libU77/idate_.c Mon Feb 3 04:27:30 1997 --- g77-0.5.21/f/runtime/libU77/idate_.c Fri Jul 11 00:08:24 1997 *************** Boston, MA 02111-1307, USA. */ *** 38,45 **** #ifdef KR_headers ! /* Subroutine */ int idate_ (iarray) int iarray[3]; #else ! /* Subroutine */ int idate_ (int iarray[3]) #endif { --- 38,45 ---- #ifdef KR_headers ! /* Subroutine */ int G77_idate_0 (iarray) int iarray[3]; #else ! /* Subroutine */ int G77_idate_0 (int iarray[3]) #endif { diff -rcp2N g77-0.5.20/f/runtime/libU77/ierrno_.c g77-0.5.21/f/runtime/libU77/ierrno_.c *** g77-0.5.20/f/runtime/libU77/ierrno_.c Mon Feb 3 04:27:30 1997 --- g77-0.5.21/f/runtime/libU77/ierrno_.c Fri Jul 11 00:08:24 1997 *************** Boston, MA 02111-1307, USA. */ *** 24,30 **** #ifdef KR_headers ! integer ierrno_ () #else ! integer ierrno_ (void) #endif { --- 24,30 ---- #ifdef KR_headers ! integer G77_ierrno_0 () #else ! integer G77_ierrno_0 (void) #endif { diff -rcp2N g77-0.5.20/f/runtime/libU77/irand_.c g77-0.5.21/f/runtime/libU77/irand_.c *** g77-0.5.20/f/runtime/libU77/irand_.c Mon Feb 3 04:27:30 1997 --- g77-0.5.21/f/runtime/libU77/irand_.c Fri Jul 11 00:08:25 1997 *************** Boston, MA 02111-1307, USA. */ *** 33,40 **** #ifdef KR_headers ! integer irand_ (flag) integer *flag; #else ! integer irand_ (integer *flag) #endif { --- 33,40 ---- #ifdef KR_headers ! integer G77_irand_0 (flag) integer *flag; #else ! integer G77_irand_0 (integer *flag) #endif { diff -rcp2N g77-0.5.20/f/runtime/libU77/isatty_.c g77-0.5.21/f/runtime/libU77/isatty_.c *** g77-0.5.20/f/runtime/libU77/isatty_.c Mon Feb 3 04:27:30 1997 --- g77-0.5.21/f/runtime/libU77/isatty_.c Fri Jul 11 00:08:25 1997 *************** Boston, MA 02111-1307, USA. */ *** 27,38 **** #ifdef KR_headers ! extern integer fnum_ (); ! logical isatty_ (lunit) integer *lunit; #else ! extern integer fnum_ (integer *); ! logical isatty_ (integer *lunit) #endif { --- 27,38 ---- #ifdef KR_headers ! extern integer G77_fnum_0 (); ! logical G77_isatty_0 (lunit) integer *lunit; #else ! extern integer G77_fnum_0 (integer *); ! logical G77_isatty_0 (integer *lunit) #endif { *************** logical isatty_ (integer *lunit) *** 41,44 **** /* f__units is a table of descriptions for the unit numbers (defined in io.h) with file descriptors rather than streams */ ! return (isatty(fnum_(lunit)) ? TRUE_ : FALSE_); } --- 41,44 ---- /* f__units is a table of descriptions for the unit numbers (defined in io.h) with file descriptors rather than streams */ ! return (isatty(G77_fnum_0 (lunit)) ? TRUE_ : FALSE_); } diff -rcp2N g77-0.5.20/f/runtime/libU77/itime_.c g77-0.5.21/f/runtime/libU77/itime_.c *** g77-0.5.20/f/runtime/libU77/itime_.c Mon Feb 3 04:27:30 1997 --- g77-0.5.21/f/runtime/libU77/itime_.c Fri Jul 11 00:08:25 1997 *************** Boston, MA 02111-1307, USA. */ *** 34,41 **** #ifdef KR_headers ! /* Subroutine */ int itime_ (tarray) integer tarray[3]; #else ! /* Subroutine */ int itime_ (integer tarray[3]) #endif { --- 34,41 ---- #ifdef KR_headers ! /* Subroutine */ int G77_itime_0 (tarray) integer tarray[3]; #else ! /* Subroutine */ int G77_itime_0 (integer tarray[3]) #endif { diff -rcp2N g77-0.5.20/f/runtime/libU77/kill_.c g77-0.5.21/f/runtime/libU77/kill_.c *** g77-0.5.20/f/runtime/libU77/kill_.c Mon Feb 3 04:27:30 1997 --- g77-0.5.21/f/runtime/libU77/kill_.c Fri Jul 11 00:08:25 1997 *************** Boston, MA 02111-1307, USA. */ *** 28,35 **** #ifdef KR_headers ! integer kill_ (pid, signum) ! integer pid, signum; #else ! integer kill_ (const integer *pid, const integer *signum) #endif { --- 28,35 ---- #ifdef KR_headers ! integer G77_kill_0 (pid, signum) ! integer *pid, *signum; #else ! integer G77_kill_0 (const integer *pid, const integer *signum) #endif { diff -rcp2N g77-0.5.20/f/runtime/libU77/link_.c g77-0.5.21/f/runtime/libU77/link_.c *** g77-0.5.20/f/runtime/libU77/link_.c Mon Feb 3 04:27:30 1997 --- g77-0.5.21/f/runtime/libU77/link_.c Fri Jul 11 00:08:26 1997 *************** *** 1,3 **** ! /* Copyright (C) 1995 Free Software Foundation, Inc. This file is part of GNU Fortran libU77 library. --- 1,3 ---- ! /* Copyright (C) 1995, 1997 Free Software Foundation, Inc. This file is part of GNU Fortran libU77 library. *************** Boston, MA 02111-1307, USA. */ *** 33,41 **** #ifdef KR_headers ! integer link_ (path1, path2, Lpath1, Lpath2) char *path1, *path2; ftnlen Lpath1, Lpath2; #else ! integer link_ (const char *path1, const char *path2, const ftnlen Lpath1, ! const ftnlen Lpath2) #endif { --- 33,44 ---- #ifdef KR_headers ! void g_char (); ! ! integer G77_link_0 (path1, path2, Lpath1, Lpath2) char *path1, *path2; ftnlen Lpath1, Lpath2; #else ! void g_char(const char *a, ftnlen alen, char *b); ! ! integer G77_link_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) #endif { *************** integer link_ (const char *path1, const *** 46,59 **** buff1 = malloc (Lpath1+1); if (buff1 == NULL) return -1; ! blast = buff1 + Lpath1; ! for (bp = buff1 ; bp #include + #include /* for ENOSYS */ #include "f2c.h" *************** Boston, MA 02111-1307, USA. */ *** 31,42 **** #ifdef KR_headers ! integer lstat_ (name, statb, Lname) char *name; integer statb[13]; ftnlen Lname; #else ! integer lstat_ (const char *name, integer statb[13], const ftnlen Lname) #endif { char *buff; char *bp, *blast; --- 32,48 ---- #ifdef KR_headers ! void g_char(); ! ! integer G77_lstat_0 (name, statb, Lname) char *name; integer statb[13]; ftnlen Lname; #else ! void g_char(const char *a, ftnlen alen, char *b); ! ! integer G77_lstat_0 (const char *name, integer statb[13], const ftnlen Lname) #endif { + #if HAVE_LSTAT char *buff; char *bp, *blast; *************** integer lstat_ (const char *name, intege *** 46,53 **** buff = malloc (Lname+1); if (buff == NULL) return -1; ! blast = buff + Lname; ! for (bp = buff ; bp 2*sizeof(long), you may need + to adjust f2c.h appropriately. f2c assumes + sizeof(doublecomplex) = 2*sizeof(doublereal) + sizeof(doublereal) = sizeof(complex) + sizeof(doublereal) = 2*sizeof(real) + sizeof(real) = sizeof(integer) + sizeof(real) = sizeof(logical) + sizeof(real) = 2*sizeof(shortint) + EQUIVALENCEs may not be translated correctly if these + assumptions are violated. + + On machines, such as those using a DEC Alpha processor, on + which sizeof(short) == 2, sizeof(int) == sizeof(float) == 4, + and sizeof(long) == sizeof(double) == 8, it suffices to + modify f2c.h by removing the first occurrence of "long " + on each line containing "long ", e.g., by issuing the + commands + mv f2c.h f2c.h0 + sed 's/long //' f2c.h0 >f2c.h + On such machines, one can enable INTEGER*8 by uncommenting + the typedef of longint in f2c.h, so it reads + typedef long longint; + by compiling libI77 with -DAllow_TYQUAD, and by adjusting + libF77/makefile as described in libF77/README. + + Some machines may have sizeof(int) == 4 and + sizeof(long long) == 8. On such machines, adjust f2c.h + by changing "long int " to "long long ", e.g., by saying + mv f2c.h f2c.h0 + sed 's/long int /long long /' f2c.h0 >f2c.h + One can enable INTEGER*8 on such machines as described + above, but with + typedef long long longint; + + There exists a C compiler that objects to the lines + typedef VOID C_f; /* complex function */ + typedef VOID H_f; /* character function */ + typedef VOID Z_f; /* double complex function */ + in f2c.h . If yours is such a compiler, do two things: + 1. Complain to your vendor about this compiler bug. + 2. Find the line + #define VOID void + in f2c.h and change it to + #define VOID int + (For readability, the f2c.h lines shown above have had two + tabs inserted before their first character.) + + FTP: All the material described above is now available by anonymous + ftp from netlib.bell-labs.com (login: anonymous; Password: your + E-mail address; cd netlib/f2c). Note that you can say, e.g., + + cd /netlib/f2c/src + binary + prompt + mget *.Z + + to get all the .Z files in src. You must uncompress the .Z + files once you have a copy of them, e.g., by + + uncompress *.Z + + Subdirectory msdos contains two PC versions of f2c, + f2c.exe.Z and f2cx.exe.Z; the latter uses extended memory. + The README in that directory provides more details. + + Changes appear first in the f2c files available by E-mail + from netlib@netlib.bell-labs.com. If the deamons work right, + changed files are available the next day by ftp from + netlib.bell-labs.com. In due course, they reach other netlib servers. + + CHANGE NOTIFICATION: + Send the E-mail message + subscribe f2c + to netlib@netlib.bell-labs.com to request notification of new and + changed f2c files. (Beware that automatically sent change + notifications may reach you before changes have reached + ftp://netlib.bell-labs.com/netlib/f2c or to other netlib servers.) + Send the E-mail message + unsubscribe f2c + to recant your notification request. + + ----------------- + Recent change log (partial) + ----------------- + + Mon May 13 23:35:26 EDT 1996 + Recognize Fortran 90's /= as a synonym for .NE.. (<> remains a + synonym for .NE..) + Emit an empty int function of no arguments to supply an external + name to named block data subprograms (so they can be called somewhere + to force them to be loaded from a library). + Fix bug (memory fault) in handling the following illegal Fortran: + parameter(i=1) + equivalence(i,j) + end + Treat cdabs, cdcos, cdexp, cdlog, cdsin, and cdsqrt as synonyms for + the double complex intrinsics zabs, zcos, zexp, zlog, zsin, and zsqrt, + respectively, unless -cd is specified. + Recognize the Fortran 90 bit-manipulation intrinsics btest, iand, + ibclr, ibits, ibset, ieor, ior, ishft, and ishftc, unless -i90 is + specified. Note that iand, ieor, and ior are thus now synonyms for + "and", "xor", and "or", respectively. + Add three macros (bit_test, bit_clear, bit_set) to f2c.h for use + with btest, ibclr, and ibset, respectively. Add new functions + [lq]bit_bits, [lq]bit_shift, and [lq]_bit_cshift to libF77 for + use with ibits, ishft, and ishftc, respectively. + Add integer function ftell(unit) (returning -1 on error) and + subroutine fseek(unit, offset, whence, *) to libI77 (with branch to + label * on error). + + Tue May 14 23:21:12 EDT 1996 + Fix glitch (possible memory fault, or worse) in handling multiple + entry points with names over 28 characters long. + + Mon Jun 10 01:20:16 EDT 1996 + Update netlib E-mail and ftp addresses in f2c/readme and + f2c/src/readme (which are different files) -- to reflect the upcoming + breakup of AT&T. + libf77: trivial tweaks to F77_aloc.c and system_.c; Version.c not + changed. + libi77: Adjust rsli.c and lread.c so internal list input with too + few items in the input string will honor end= . + + Mon Jun 10 22:59:57 EDT 1996 + Add Bits_per_Byte to sysdep.h and adjust definition of Table_size + to depend on Bits_per_Byte (forcing Table_size to be a power of 2); in + lex.c, change "comstart[c & 0xfff]" to "comstart[c & (Table_size-1)]" + to avoid an out-of-range subscript on end-of-file. + + Wed Jun 12 00:24:28 EDT 1996 + Fix bug in output.c (dereferencing a freed pointer) revealed in + print * !np in out_call in output.c clobbered by free + end !during out_expr. + + Wed Jun 19 08:12:47 EDT 1996 + f2c.h: add types uinteger, ulongint (for libF77); add qbit_clear + and qbit_set macros (in a commented-out section) for integer*8. + For integer*8, use qbit_clear and qbit_set for ibclr and ibset. + libf77: add casts to unsigned in [lq]bitshft.c. + + Thu Jun 20 13:30:43 EDT 1996 + Complain at character*(*) in common (rather than faulting). + Fix bug in recognizing hex constants that start with "16#" (e.g., + 16#1234abcd, which is a synonym for z'1234abcd'). + Fix bugs in constant folding of expressions involving btest, ibclr, + and ibset. + Fix bug in constant folding of rshift(16#80000000, -31) (on a 32-bit + machine; more generally, the bug was in constant folding of + rshift(ibset(0,NBITS-1), 1-NBITS) when f2c runs on a machine with + long ints having NBITS bits. + + Mon Jun 24 07:58:53 EDT 1996 + Adjust struct Literal and newlabel() function to accommodate huge + source files (with more than 32767 newlabel() invocations). + Omit .c file when the .f file has a missing final end statement. + + Wed Jun 26 14:00:02 EDT 1996 + libi77: Add discussion of MXUNIT (highest allowed Fortran unit number) + to libI77/README. + + Fri Jun 28 14:16:11 EDT 1996 + Fix glitch with -onetrip: the temporary variable used for nonconstant + initial loop variable values was recycled too soon. Example: + do i = j+1, k + call foo(i+1) ! temp for j+1 was reused here + enddo + end + + Tue Jul 2 16:11:27 EDT 1996 + formatdata.c: add a 0 to the end of the basetype array (for TYBLANK) + (an omission that was harmless on most machines). + expr.c: fix a dereference of NULL that was only possible with buggy + input, such as + subroutine $sub(s) ! the '$' is erroneous + character s*(*) + s(1:) = ' ' + end + + Sat Jul 6 00:44:56 EDT 1996 + Fix glitch in the intrinsic "real" function when applied to a + complex (or double complex) variable and passed as an argument to + some intrinsic functions. Example: + complex a + b = sqrt(real(a)) + end + Fix glitch (only visible if you do not use f2c's malloc and the + malloc you do use is defective in the sense that malloc(0) returns 0) + in handling include files that end with another include (perhaps + followed by comments). + Fix glitch with character*(*) arguments named "h" and "i" when + the body of the subroutine invokes the intrinsic LEN function. + Arrange that after a previous "f2c -P foo.f" has produced foo.P, + running "f2c foo.P foo.f" will produce valid C when foo.f contains + call sub('1234') + end + subroutine sub(msg) + end + Specifically, the length argument in "call sub" is now suppressed. + With or without foo.P, it is also now suppressed when the order of + subprograms in file foo.f is reversed: + subroutine sub(msg) + end + call sub('1234') + end + Adjust copyright notices to reflect AT&T breakup. + + Wed Jul 10 09:25:49 EDT 1996 + Fix bug (possible memory fault) in handling erroneously placed + and inconsistent declarations. Example that faulted: + character*1 w(8) + call foo(w) + end + subroutine foo(m) + data h /0.5/ + integer m(2) ! should be before data + end + Fix bug (possible fault) in handling illegal "if" constructions. + Example (that faulted): + subroutine foo(i,j) + if (i) then ! bug: i is integer, not logical + else if (j) then ! bug: j is integer, not logical + endif + end + Fix glitch with character*(*) argument named "ret_len" to a + character*(*) function. + + Wed Jul 10 23:04:16 EDT 1996 + Fix more glitches in the intrinsic "real" function when applied to a + complex (or double complex) variable and passed as an argument to + some intrinsic functions. Example: + complex a, b + r = sqrt(real(conjg(a))) + sqrt(real(a*b)) + end + + Thu Jul 11 17:27:16 EDT 1996 + Fix a memory fault associated with complicated, illegal input. + Example: + subroutine goo + character a + call foo(a) ! inconsistent with subsequent def and call + end + subroutine foo(a) + end + call foo(a) + end + + Wed Jul 17 19:18:28 EDT 1996 + Fix yet another case of intrinsic "real" applied to a complex + argument. Example: + complex a(3) + x = sqrt(real(a(2))) ! gave error message about bad tag + end + + Mon Aug 26 11:28:57 EDT 1996 + Tweak sysdep.c for non-Unix systems in which process ID's can be + over 5 digits long. + + Tue Aug 27 08:31:32 EDT 1996 + Adjust the ishft intrinsic to use unsigned right shifts. (Previously, + a negative constant second operand resulted in a possibly signed shift.) + + Thu Sep 12 14:04:07 EDT 1996 + equiv.c: fix glitch with -DKR_headers. + libi77: fmtlib.c: fix bug in printing the most negative integer. + + Fri Sep 13 08:54:40 EDT 1996 + Diagnose some illegal appearances of substring notation. + + Tue Sep 17 17:48:09 EDT 1996 + Fix fault in handling some complex parameters. Example: + subroutine foo(a) + double complex a, b + parameter(b = (0,1)) + a = b ! f2c faulted here + end + + Thu Sep 26 07:47:10 EDT 1996 + libi77: fmt.h: for formatted writes of negative integer*1 values, + make ic signed on ANSI systems. If formatted writes of integer*1 + values trouble you when using a K&R C compiler, switch to an ANSI + compiler or use a compiler flag that makes characters signed. + + Tue Oct 1 14:41:36 EDT 1996 + Give a better error message when dummy arguments appear in data + statements. + + Thu Oct 17 13:37:22 EDT 1996 + Fix bug in typechecking arguments to character and complex (or + double complex) functions; the bug could cause length arguments + for character arguments to be omitted on invocations appearing + textually after the first invocation. For example, in + subroutine foo + character c + complex zot + call goo(zot(c), zot(c)) + end + the length was omitted from the second invocation of zot, and + there was an erroneous error message about inconsistent calling + sequences. + + Wed Dec 4 13:59:14 EST 1996 + Fix bug revealed by + subroutine test(cdum,rdum) + complex cdum + rdum=cos(real(cdum)) ! "Unexpected tag 3 in opconv_fudge" + end + Fix glitch in parsing "DO 10 D0 = 1, 10". + Fix glitch in parsing + real*8 x + real*8 x ! erroneous "incompatible type" message + call foo(x) + end + lib[FI]77/makefile: add comment about omitting -x under Solaris. + + Mon Dec 9 23:15:02 EST 1996 + Fix glitch in parameter adjustments for arrays whose lower + bound depends on a scalar argument. Example: + subroutine bug(p,z,m,n) + integer z(*),m,n + double precision p(z(m):z(m) + n) ! p_offset botched + call foo(p(0), p(n)) + end + libi77: complain about non-positive rec= in direct read and write + statements. + libf77: trivial adjustments; Version.c not changed. + + Wed Feb 12 00:18:03 EST 1997 + output.c: fix (seldom problematic) glitch in out_call: put parens + around the ... in a test of the form "if (q->tag == TADDR && ...)". + vax.c: fix bug revealed in the "psi_offset =" assignment in the + following example: + subroutine foo(psi,m) + integer z(100),m + common /a/ z + double precision psi(z(m):z(m) + 10) + call foo(m+1, psi(0),psi(10)) + end + + Mon Feb 24 23:44:54 EST 1997 + For consistency with f2c's current treatment of adjacent character + strings in FORMAT statements, recognize a Hollerith string following + a string (and merge adjacent strings in FORMAT statements). + + Wed Feb 26 13:41:11 EST 1997 + New libf2c.zip, a combination of the libf77 and libi77 bundles (and + available only by ftp). + libf77: adjust functions with a complex output argument to permit + aliasing it with input arguments. (For now, at least, this is just + for possible benefit of g77.) + libi77: tweak to ftell_.c for systems with strange definitions of + SEEK_SET, etc. + + Tue Apr 8 20:57:08 EDT 1997 + libf77: [cz]_div.c: tweaks invisible on most systems (that may + improve things slightly with optimized compilation on systems that use + gratuitous extra precision). + libi77: fmt.c: adjust to complain at missing numbers in formats + (but still treat missing ".nnn" as ".0"). + + Fri Apr 11 14:05:57 EDT 1997 + libi77: err.c: attempt to make stderr line buffered rather than + fully buffered. (Buffering is needed for format items T and TR.) + + Thu Apr 17 22:42:43 EDT 1997 + libf77: add F77_aloc.o to makefile (and makefile.u in libf2c.zip). + + Fri Apr 25 19:32:09 EDT 1997 + libf77: add [de]time_.c (which may give trouble on some systems). + + Tue May 27 09:18:52 EDT 1997 + libi77: ftell_.c: fix typo that caused the third argument to be + treated as 2 on some systems. + + Mon Jun 9 00:04:37 EDT 1997 + libi77 (and libf2c.zip): adjust include order in err.c lread.c wref.c + rdfmt.c to include fmt.h (etc.) after system includes. Version.c not + changed. + + Mon Jun 9 14:29:13 EDT 1997 + src/gram.c updated; somehow it did not reflect the change of + 19961001 to gram.dcl. + + Mon Jul 21 16:04:54 EDT 1997 + proc.c: fix glitch in logic for "nonpositive dimension" message. + libi77: inquire.c: always include string.h (for possible use with + -DNON_UNIX_STDIO); Version.c not changed. + + Thu Jul 24 17:11:23 EDT 1997 + Tweak "Notice" to reflect the AT&T breakup -- we missed it when + updating the copyright notices in the source files last summer. + Adjust src/makefile so malloc.o is not used by default, but can + be specified with "make MALLOC=malloc.o". + Add comments to src/README about the "CRAY" T3E. + + Tue Aug 5 14:53:25 EDT 1997 + Add definition of calloc to malloc.c; this makes f2c's malloc + work on some systems where trouble hitherto arose because references + to calloc brought in the system's malloc. (On sensible systems, + calloc is defined separately from malloc. To avoid confusion on + other systems, f2c/malloc.c now defines calloc.) + libi77: lread.c: adjust to accord with a change to the Fortran 8X + draft (in 1990 or 1991) that rescinded permission to elide quote marks + in namelist input of character data; to get the old behavior, compile + with F8X_NML_ELIDE_QUOTES #defined. wrtfmt.o: wrt_G: tweak to print + the right number of 0's for zero under G format. + + Sat Aug 16 05:45:32 EDT 1997 + libI77: iio.c: fix bug in internal writes to an array of character + strings that sometimes caused one more array element than required by + the format to be blank-filled. Example: format(1x). + + Current timestamps of files in "all from f2c/src", sorted by time, + appear below (mm/dd/year hh:mm:ss). To bring your source up to date, + obtain source files with a timestamp later than the time shown in your + version.c. Note that the time shown in the current version.c is the + timestamp of the source module that immediately follows version.c below: + + 8/05/1997 14:51:56 xsum0.out + 8/05/1997 14:42:48 version.c + 8/05/1997 10:31:26 malloc.c + 7/24/1997 17:10:55 README + 7/24/1997 17:00:57 makefile + 7/24/1997 16:06:19 Notice + 7/21/1997 12:58:44 proc.c + 2/19/1997 13:34:09 lex.c + 2/11/1997 23:39:14 vax.c + 12/22/1996 11:51:22 output.c + 12/04/1996 13:07:53 gram.exec + 10/17/1996 13:10:40 putpcc.c + 10/01/1996 14:36:18 gram.dcl + 10/01/1996 14:36:18 init.c + 10/01/1996 14:36:18 defs.h + 10/01/1996 14:36:17 data.c + 9/17/1996 17:29:44 expr.c + 9/12/1996 12:12:46 equiv.c + 8/27/1996 8:30:32 intr.c + 8/26/1996 9:41:13 sysdep.c + 7/09/1996 10:41:13 format.c + 7/09/1996 10:40:45 names.c + 7/04/1996 9:58:31 formatdata.c + 7/04/1996 9:55:45 sysdep.h + 7/04/1996 9:55:43 put.c + 7/04/1996 9:55:41 pread.c + 7/04/1996 9:55:40 parse_args.c + 7/04/1996 9:55:40 p1output.c + 7/04/1996 9:55:38 niceprintf.c + 7/04/1996 9:55:37 misc.c + 7/04/1996 9:55:36 memset.c + 7/04/1996 9:55:36 mem.c + 7/04/1996 9:55:35 main.c + 7/04/1996 9:55:33 io.c + 7/04/1996 9:55:30 exec.c + 7/04/1996 9:55:29 error.c + 7/04/1996 9:55:27 cds.c + 7/03/1996 15:47:49 xsum.c + 6/19/1996 7:04:27 f2c.h + 6/19/1996 2:52:05 defines.h + 5/13/1996 0:40:32 gram.head + 5/12/1996 23:37:11 f2c.1 + 5/12/1996 23:37:02 f2c.1t + 2/25/1994 2:07:19 parse.h + 2/22/1994 19:07:20 iob.h + 2/22/1994 18:56:53 p1defs.h + 2/22/1994 18:53:46 output.h + 2/22/1994 18:51:14 names.h + 2/22/1994 18:30:41 format.h + 1/18/1994 18:12:52 tokens + 3/06/1993 14:13:58 gram.expr + 1/28/1993 9:03:16 ftypes.h + 4/06/1990 0:00:57 gram.io + 2/03/1990 0:58:26 niceprintf.h + 1/07/1990 1:20:01 usignal.h + 11/27/1989 8:27:37 machdefs.h + 7/01/1989 11:59:44 pccdefs.h diff -rcp2N g77-0.5.20/f/st.c g77-0.5.21/f/st.c *** g77-0.5.20/f/st.c Wed Aug 30 19:53:35 1995 --- g77-0.5.21/f/st.c Sun Jul 13 20:42:39 1997 *************** ffest_seen_first_exec () *** 418,421 **** --- 418,430 ---- } + /* Shut down current parsing possibility, but without bothering the + user with a diagnostic if we're not inhibited. */ + + void + ffest_shutdown () + { + ffesta_shutdown (); + } + /* ffest_sym_end_transition -- Update symbol info just before end of unit diff -rcp2N g77-0.5.20/f/st.h g77-0.5.21/f/st.h *** g77-0.5.20/f/st.h Wed Aug 30 19:53:35 1995 --- g77-0.5.21/f/st.h Sun Jul 13 20:42:40 1997 *************** the Free Software Foundation, 59 Temple *** 53,57 **** void ffest_confirmed (void); void ffest_eof (void); - bool ffest_seen_first_exec (void); bool ffest_ffebad_start (ffebad errnum); void ffest_ffebad_here_current_stmt (ffebadIndex i); --- 53,56 ---- *************** void ffest_init_4 (void); *** 65,68 **** --- 64,69 ---- bool ffest_is_entry_valid (void); bool ffest_is_inhibited (void); + bool ffest_seen_first_exec (void); + void ffest_shutdown (void); ffesymbol ffest_sym_end_transition (ffesymbol s); ffesymbol ffest_sym_exec_transition (ffesymbol s); diff -rcp2N g77-0.5.20/f/sta.c g77-0.5.21/f/sta.c *** g77-0.5.20/f/sta.c Wed Feb 5 05:58:46 1997 --- g77-0.5.21/f/sta.c Sun Jul 13 20:42:40 1997 *************** ffesta_set_outpooldisp (ffestaPooldisp d *** 1803,1806 **** --- 1803,1816 ---- } + /* Shut down current parsing possibility, but without bothering the + user with a diagnostic if we're not inhibited. */ + + void + ffesta_shutdown () + { + if (ffesta_is_inhibited_) + ffesta_current_shutdown_ = TRUE; + } + /* ffesta_two -- Deal with the first two tokens after a swallowed statement diff -rcp2N g77-0.5.20/f/sta.h g77-0.5.21/f/sta.h *** g77-0.5.20/f/sta.h Wed Aug 30 19:53:34 1995 --- g77-0.5.21/f/sta.h Sun Jul 13 20:42:40 1997 *************** void ffesta_terminate_3 (void); *** 86,89 **** --- 86,90 ---- void ffesta_terminate_4 (void); void ffesta_ffebad_here_doiter (ffebadIndex i, ffesymbol s); + void ffesta_shutdown (void); ffesymbol ffesta_sym_end_transition (ffesymbol s); ffesymbol ffesta_sym_exec_transition (ffesymbol s); diff -rcp2N g77-0.5.20/f/stb.c g77-0.5.21/f/stb.c *** g77-0.5.20/f/stb.c Sat Mar 1 04:28:14 1997 --- g77-0.5.21/f/stb.c Tue Sep 2 21:25:53 1997 *************** ffestb_do3_ (ffelexToken t) *** 2209,2213 **** { case FFELEX_typeEQUALS: ! next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextDO, (ffeexprCallback) ffestb_do6_))) (ffesta_tokens[2]); --- 2209,2213 ---- { case FFELEX_typeEQUALS: ! next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextDO, (ffeexprCallback) ffestb_do6_))) (ffesta_tokens[2]); *************** ffestb_R5284_ (ffelexToken t) *** 5801,5804 **** --- 5801,5805 ---- case FFELEX_typeNAME: + case FFELEX_typeOPEN_PAREN: return (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs (ffesta_output_pool, *************** ffestb_R10014_ (ffelexToken t) *** 9230,9234 **** return (ffelexHandler) ffestb_R10014_; ! case FFELEX_typeCOLONCOLON:/* "::". */ if (ffestb_local_.format.pre.present) { --- 9231,9235 ---- return (ffelexHandler) ffestb_R10014_; ! case FFELEX_typeCOLONCOLON: /* "::". */ if (ffestb_local_.format.pre.present) { *************** ffestb_R10014_ (ffelexToken t) *** 9248,9252 **** f->u.R1010.val.u.unsigned_val = 1; } ! /* Fall through. */ case FFELEX_typeCOLON: if (ffestb_local_.format.pre.present) --- 9249,9261 ---- f->u.R1010.val.u.unsigned_val = 1; } ! f = ffestt_formatlist_append (ffestb_local_.format.f); ! f->type = FFESTP_formattypeCOLON; ! f->t = ffelex_token_use (t); ! f->u.R1010.val.present = FALSE; ! f->u.R1010.val.rtexpr = FALSE; ! f->u.R1010.val.t = NULL; ! f->u.R1010.val.u.unsigned_val = 1; ! return (ffelexHandler) ffestb_R100112_; ! case FFELEX_typeCOLON: if (ffestb_local_.format.pre.present) *************** ffestb_R10014_ (ffelexToken t) *** 9267,9270 **** --- 9276,9290 ---- case FFELEX_typeCONCAT: /* "//". */ + if (ffestb_local_.format.sign) + { + ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN); + ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t), + ffelex_token_where_column (ffestb_local_.format.pre.t)); + ffebad_finish (); + ffestb_local_.format.pre.u.unsigned_val + = (ffestb_local_.format.pre.u.signed_val < 0) + ? -ffestb_local_.format.pre.u.signed_val + : ffestb_local_.format.pre.u.signed_val; + } f = ffestt_formatlist_append (ffestb_local_.format.f); f->type = FFESTP_formattypeSLASH; *************** ffestb_R10014_ (ffelexToken t) *** 9275,9279 **** ffestb_local_.format.pre.t = NULL; ffestb_local_.format.pre.u.unsigned_val = 1; ! /* Fall through. */ case FFELEX_typeSLASH: if (ffestb_local_.format.sign) --- 9295,9304 ---- ffestb_local_.format.pre.t = NULL; ffestb_local_.format.pre.u.unsigned_val = 1; ! f = ffestt_formatlist_append (ffestb_local_.format.f); ! f->type = FFESTP_formattypeSLASH; ! f->t = ffelex_token_use (t); ! f->u.R1010.val = ffestb_local_.format.pre; ! return (ffelexHandler) ffestb_R100112_; ! case FFELEX_typeSLASH: if (ffestb_local_.format.sign) *************** ffestb_R10014_ (ffelexToken t) *** 9664,9673 **** if (!isdigit (*p)) { ! if (ffestb_local_.format.current != FFESTP_formattypeH) ! ffestb_local_.format.current = FFESTP_formattypeNone; ! p = strpbrk (p, "0123456789"); if (p == NULL) return (ffelexHandler) ffestb_R10015_; ! i = p - ffelex_token_text (t); /* Collect digits anyway. */ } ffestb_local_.format.post.present = TRUE; --- 9689,9702 ---- if (!isdigit (*p)) { ! if (ffestb_local_.format.current == FFESTP_formattypeH) ! p = strpbrk (p, "0123456789"); ! else ! { ! p = NULL; ! ffestb_local_.format.current = FFESTP_formattypeNone; ! } if (p == NULL) return (ffelexHandler) ffestb_R10015_; ! i = p - ffelex_token_text (t); /* Collect digits. */ } ffestb_local_.format.post.present = TRUE; diff -rcp2N g77-0.5.20/f/stc.c g77-0.5.21/f/stc.c *** g77-0.5.20/f/stc.c Mon Feb 10 19:00:02 1997 --- g77-0.5.21/f/stc.c Fri Jul 11 00:08:37 1997 *************** ffestc_labeldef_notloop_ () *** 1160,1164 **** assert (ffestc_shriek_after1_ == NULL); ! ffestc_labeldef_notloop_begin_ (); } --- 1160,1241 ---- assert (ffestc_shriek_after1_ == NULL); ! if (!ffestc_labeldef_begin_ ()) ! return; ! ! switch (ffelab_type (ffestc_label_)) ! { ! case FFELAB_typeUNKNOWN: ! case FFELAB_typeASSIGNABLE: ! ffelab_set_type (ffestc_label_, FFELAB_typeNOTLOOP); ! ffelab_set_blocknum (ffestc_label_, ! ffestw_blocknum (ffestw_stack_top ())); ! ffestd_labeldef_notloop (ffestc_label_); ! break; ! ! case FFELAB_typeNOTLOOP: ! if (ffelab_blocknum (ffestc_label_) ! < ffestw_blocknum (ffestw_stack_top ())) ! { ! ffebad_start (FFEBAD_LABEL_BLOCK); ! ffebad_here (0, ffelex_token_where_line (ffesta_label_token), ! ffelex_token_where_column (ffesta_label_token)); ! ffebad_here (1, ffelab_firstref_line (ffestc_label_), ! ffelab_firstref_column (ffestc_label_)); ! ffebad_finish (); ! } ! ffelab_set_blocknum (ffestc_label_, ! ffestw_blocknum (ffestw_stack_top ())); ! ffestd_labeldef_notloop (ffestc_label_); ! break; ! ! case FFELAB_typeLOOPEND: ! if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO) ! || (ffestw_label (ffestw_stack_top ()) != ffestc_label_)) ! { /* Unterminated block. */ ! ffelab_set_type (ffestc_label_, FFELAB_typeANY); ! ffestd_labeldef_any (ffestc_label_); ! ! ffebad_start (FFEBAD_LABEL_DO_BLOCK_END); ! ffebad_here (0, ffelab_doref_line (ffestc_label_), ! ffelab_doref_column (ffestc_label_)); ! ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ())); ! ffebad_here (2, ffelex_token_where_line (ffesta_label_token), ! ffelex_token_where_column (ffesta_label_token)); ! ffebad_finish (); ! break; ! } ! ffestd_labeldef_notloop (ffestc_label_); ! ffebad_start (FFEBAD_LABEL_USE_DEF); ! ffebad_here (0, ffelex_token_where_line (ffesta_label_token), ! ffelex_token_where_column (ffesta_label_token)); ! ffebad_here (1, ffelab_doref_line (ffestc_label_), ! ffelab_doref_column (ffestc_label_)); ! ffebad_finish (); ! ffestc_labeldef_branch_end_ (); ! return; ! ! case FFELAB_typeFORMAT: ! ffelab_set_type (ffestc_label_, FFELAB_typeANY); ! ffestd_labeldef_any (ffestc_label_); ! ! ffebad_start (FFEBAD_LABEL_USE_DEF); ! ffebad_here (0, ffelex_token_where_line (ffesta_label_token), ! ffelex_token_where_column (ffesta_label_token)); ! ffebad_here (1, ffelab_firstref_line (ffestc_label_), ! ffelab_firstref_column (ffestc_label_)); ! ffebad_finish (); ! break; ! ! default: ! assert ("bad label" == NULL); ! /* Fall through. */ ! case FFELAB_typeANY: ! break; ! } ! ! ffestc_try_shriek_do_ (); ! ! ffelex_token_kill (ffesta_label_token); ! ffesta_label_token = NULL; } *************** ffestc_labeldef_notloop_begin_ () *** 1219,1223 **** break; } ! ffestd_labeldef_notloop (ffestc_label_); ffebad_start (FFEBAD_LABEL_USE_DEF); ffebad_here (0, ffelex_token_where_line (ffesta_label_token), --- 1296,1300 ---- break; } ! ffestd_labeldef_branch (ffestc_label_); ffebad_start (FFEBAD_LABEL_USE_DEF); ffebad_here (0, ffelex_token_where_line (ffesta_label_token), *************** ffestc_labeldef_notloop_begin_ () *** 1226,1230 **** ffelab_doref_column (ffestc_label_)); ffebad_finish (); - ffestc_labeldef_branch_end_ (); return; --- 1303,1306 ---- *************** ffestc_R501_item (ffelexToken name, ffeb *** 6510,6516 **** ffestc_local_.decl.initlist = ffebld_new_item (symter, NULL); } ! if (na & FFESYMBOL_attrsINTRINSIC) ! ; /* Do none of the below. */ ! else if (ffesymbol_basictype (s) == FFEINFO_basictypeNONE) { ffesymbol_set_info (s, --- 6586,6590 ---- ffestc_local_.decl.initlist = ffebld_new_item (symter, NULL); } ! if (ffesymbol_basictype (s) == FFEINFO_basictypeNONE) { ffesymbol_set_info (s, *************** ffestc_R547_item_object (ffelexToken nam *** 8305,8308 **** --- 8379,8399 ---- if (na == FFESYMBOL_attrsetNONE) ffesymbol_error (s, name); + else if ((ffesymbol_equiv (s) != NULL) + && (ffeequiv_common (ffesymbol_equiv (s)) != NULL) + && (ffeequiv_common (ffesymbol_equiv (s)) + != ffestc_local_.common.symbol)) + { + /* Oops, just COMMONed a symbol to a different area (via equiv). */ + ffebad_start (FFEBAD_EQUIV_COMMON); + ffebad_here (0, ffelex_token_where_line (name), + ffelex_token_where_column (name)); + ffebad_string (ffesymbol_text (ffestc_local_.common.symbol)); + ffebad_string (ffesymbol_text (ffeequiv_common (ffesymbol_equiv (s)))); + ffebad_finish (); + ffesymbol_set_attr (s, na | FFESYMBOL_attrANY); + ffesymbol_set_info (s, ffeinfo_new_any ()); + ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD); + ffesymbol_signal_unreported (s); + } else if (!(na & FFESYMBOL_attrsANY)) { *************** ffestc_R547_item_object (ffelexToken nam *** 8322,8335 **** ffeequiv_set_common (ffesymbol_equiv (s), /* Yes, tell equiv obj. */ ffestc_local_.common.symbol); - else - { /* Oops, just COMMONed a symbol to a - different area (via equiv). */ - ffebad_start (FFEBAD_EQUIV_COMMON); - ffebad_here (0, ffelex_token_where_line (name), - ffelex_token_where_column (name)); - ffebad_string (ffesymbol_text (ffestc_local_.common.symbol)); - ffebad_string (ffesymbol_text (ffeequiv_common (ffesymbol_equiv (s)))); - ffebad_finish (); - } #if FFEGLOBAL_ENABLED if (ffeequiv_is_init (ffesymbol_equiv (s))) --- 8413,8416 ---- *************** ffestc_R1207_item (ffelexToken name) *** 11830,11834 **** ffesymbol_set_state (s, FFESYMBOL_stateSEEN); ffesymbol_set_explicitwhere (s, TRUE); ! ffesymbol_globalize (s); ffesymbol_signal_unreported (s); } --- 11911,11915 ---- ffesymbol_set_state (s, FFESYMBOL_stateSEEN); ffesymbol_set_explicitwhere (s, TRUE); ! ffesymbol_reference (s, name, FALSE); ffesymbol_signal_unreported (s); } *************** ffestc_R1208_item (ffelexToken name) *** 11941,11951 **** ffesymbol_set_implementation (s, imp); ffesymbol_set_info (s, ! ffeinfo_new (FFEINFO_basictypeNONE, ! FFEINFO_kindtypeNONE, 0, FFEINFO_kindNONE, FFEINFO_whereINTRINSIC, ! FFETARGET_charactersizeNONE)); ffesymbol_set_explicitwhere (s, TRUE); } --- 12022,12033 ---- ffesymbol_set_implementation (s, imp); ffesymbol_set_info (s, ! ffeinfo_new (ffesymbol_basictype (s), ! ffesymbol_kindtype (s), 0, FFEINFO_kindNONE, FFEINFO_whereINTRINSIC, ! ffesymbol_size (s))); ffesymbol_set_explicitwhere (s, TRUE); + ffesymbol_reference (s, name, TRUE); } *************** ffestc_R1219 (ffelexToken funcname, ffes *** 12128,12132 **** FFEINFO_whereLOCAL, ffestc_local_.decl.size)); ! ffestc_parent_ok_ = TRUE; } else --- 12210,12222 ---- FFEINFO_whereLOCAL, ffestc_local_.decl.size)); ! ! /* Check whether the type info fits the filewide expectations; ! set ok flag accordingly. */ ! ! ffesymbol_reference (fs, funcname, FALSE); ! if (ffesymbol_attrs (fs) & FFESYMBOL_attrsANY) ! ffestc_parent_ok_ = FALSE; ! else ! ffestc_parent_ok_ = TRUE; } else *************** ffestc_R1226 (ffelexToken entryname, ffe *** 12492,12496 **** ffesymbol_size (s))); ! /* 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 --- 12582,12592 ---- ffesymbol_size (s))); ! ! /* Check whether the type info fits the filewide expectations; ! set ok flag accordingly. */ ! ! ffesymbol_reference (fs, entryname, FALSE); ! ! /* ~~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 diff -rcp2N g77-0.5.20/f/ste.c g77-0.5.21/f/ste.c *** g77-0.5.20/f/ste.c Sat Mar 1 04:28:42 1997 --- g77-0.5.21/f/ste.c Mon Aug 11 18:53:40 1997 *************** ffeste_R1227 (ffestw block UNUSED, ffebl *** 4881,4885 **** rtn = ffecom_return_expr (expr); ! if (rtn == NULL_TREE) expand_null_return (); else --- 4881,4886 ---- rtn = ffecom_return_expr (expr); ! if ((rtn == NULL_TREE) ! || (rtn == error_mark_node)) expand_null_return (); else *************** ffeste_R1227 (ffestw block UNUSED, ffebl *** 4887,4894 **** tree result = DECL_RESULT (current_function_decl); ! expand_return (ffecom_modify (NULL_TREE, ! result, ! convert (TREE_TYPE (result), ! rtn))); } --- 4888,4899 ---- tree result = DECL_RESULT (current_function_decl); ! if ((result != error_mark_node) ! && (TREE_TYPE (result) != error_mark_node)) ! expand_return (ffecom_modify (NULL_TREE, ! result, ! convert (TREE_TYPE (result), ! rtn))); ! else ! expand_null_return (); } diff -rcp2N g77-0.5.20/f/storag.c g77-0.5.21/f/storag.c *** g77-0.5.20/f/storag.c Sat Mar 1 04:28:51 1997 --- g77-0.5.21/f/storag.c Fri Jul 11 00:08:37 1997 *************** ffestorag_update_init (ffestorag s) *** 530,533 **** --- 530,536 ---- ffesymbol_update_init (s->symbol); + if (s->parent != NULL) + ffestorag_update_init (s->parent); + for (sq = s->equivs_.first; sq != (ffestorag) &s->equivs_.first; *************** ffestorag_update_save (ffestorag s) *** 557,560 **** --- 560,566 ---- && !ffesymbol_is_save (s->symbol)) ffesymbol_update_save (s->symbol); + + if (s->parent != NULL) + ffestorag_update_save (s->parent); for (sq = s->equivs_.first; diff -rcp2N g77-0.5.20/f/stu.c g77-0.5.21/f/stu.c *** g77-0.5.20/f/stu.c Sat Mar 1 04:29:43 1997 --- g77-0.5.21/f/stu.c Tue Sep 9 06:11:37 1997 *************** *** 1,4 **** /* stu.c -- Implementation File (module.c template V1.0) ! Copyright (C) 1995, 1996 Free Software Foundation, Inc. Contributed by James Craig Burley (burley@gnu.ai.mit.edu). --- 1,4 ---- /* stu.c -- Implementation File (module.c template V1.0) ! Copyright (C) 1995-1997 Free Software Foundation, Inc. Contributed by James Craig Burley (burley@gnu.ai.mit.edu). *************** the Free Software Foundation, 59 Temple *** 28,31 **** --- 28,32 ---- #include "com.h" #include "equiv.h" + #include "global.h" #include "info.h" #include "implic.h" *************** ffestu_sym_end_transition (ffesymbol s) *** 114,119 **** && ((skd == FFEINFO_kindFUNCTION) || (skd == FFEINFO_kindSUBROUTINE))) ! ffestu_dummies_transition_ (ffecom_sym_end_transition, ! ffesymbol_dummyargs (s)); else if (swh == FFEINFO_whereDUMMY) { --- 115,193 ---- && ((skd == FFEINFO_kindFUNCTION) || (skd == FFEINFO_kindSUBROUTINE))) ! { ! int n_args; ! ffebld list; ! ffebld item; ! ffeglobalArgSummary as; ! ffeinfoBasictype bt; ! ffeinfoKindtype kt; ! bool array; ! char *name = NULL; ! ! ffestu_dummies_transition_ (ffecom_sym_end_transition, ! ffesymbol_dummyargs (s)); ! ! n_args = ffebld_list_length (ffesymbol_dummyargs (s)); ! ffeglobal_proc_def_nargs (s, n_args); ! for (list = ffesymbol_dummyargs (s), n_args = 0; ! list != NULL; ! list = ffebld_trail (list), ++n_args) ! { ! item = ffebld_head (list); ! array = FALSE; ! if (item != NULL) ! { ! bt = ffeinfo_basictype (ffebld_info (item)); ! kt = ffeinfo_kindtype (ffebld_info (item)); ! array = (ffeinfo_rank (ffebld_info (item)) > 0); ! switch (ffebld_op (item)) ! { ! case FFEBLD_opSTAR: ! as = FFEGLOBAL_argsummaryALTRTN; ! break; ! ! case FFEBLD_opSYMTER: ! name = ffesymbol_text (ffebld_symter (item)); ! as = FFEGLOBAL_argsummaryNONE; ! ! switch (ffeinfo_kind (ffebld_info (item))) ! { ! case FFEINFO_kindFUNCTION: ! as = FFEGLOBAL_argsummaryFUNC; ! break; ! ! case FFEINFO_kindSUBROUTINE: ! as = FFEGLOBAL_argsummarySUBR; ! break; ! ! case FFEINFO_kindNONE: ! as = FFEGLOBAL_argsummaryPROC; ! break; ! ! default: ! break; ! } ! ! if (as != FFEGLOBAL_argsummaryNONE) ! break; ! ! /* Fall through. */ ! default: ! if (bt == FFEINFO_basictypeCHARACTER) ! as = FFEGLOBAL_argsummaryDESCR; ! else ! as = FFEGLOBAL_argsummaryREF; ! break; ! } ! } ! else ! { ! as = FFEGLOBAL_argsummaryNONE; ! bt = FFEINFO_basictypeNONE; ! kt = FFEINFO_kindtypeNONE; ! } ! ffeglobal_proc_def_arg (s, n_args, name, as, bt, kt, array); ! } ! } else if (swh == FFEINFO_whereDUMMY) { *************** ffestu_sym_end_transition (ffesymbol s) *** 144,149 **** return s; } - ns = FFESYMBOL_stateUNDERSTOOD; na = sa = ffesymbol_attrs (s); --- 218,223 ---- return s; } + ns = FFESYMBOL_stateUNDERSTOOD; na = sa = ffesymbol_attrs (s); *************** ffestu_sym_end_transition (ffesymbol s) *** 266,269 **** --- 340,344 ---- ffesymbol_resolve_intrin (s); s = ffecom_sym_learned (s); + ffesymbol_reference (s, NULL, FALSE); ffestorag_end_layout (s); ffesymbol_signal_unreported (s); /* For debugging purposes. */ *************** ffestu_sym_end_transition (ffesymbol s) *** 300,306 **** ffesymbol_resolve_intrin (s); s = ffecom_sym_learned (s); ffestorag_end_layout (s); - if (nwh == FFEINFO_whereGLOBAL) - ffesymbol_globalize (s); ffesymbol_signal_unreported (s); /* For debugging purposes. */ } --- 375,380 ---- ffesymbol_resolve_intrin (s); s = ffecom_sym_learned (s); + ffesymbol_reference (s, NULL, FALSE); ffestorag_end_layout (s); ffesymbol_signal_unreported (s); /* For debugging purposes. */ } *************** ffestu_sym_exec_transition (ffesymbol s) *** 369,372 **** --- 443,447 ---- } + ffesymbol_reference (s, NULL, FALSE); ffestorag_exec_layout (s); ffesymbol_signal_unreported (s); /* For debugging purposes. */ *************** ffestu_sym_exec_transition (ffesymbol s) *** 720,723 **** --- 795,799 ---- FFETARGET_charactersizeNONE)); ffesymbol_resolve_intrin (s); + ffesymbol_reference (s, NULL, FALSE); ffestorag_exec_layout (s); ffesymbol_signal_unreported (s); /* For debugging purposes. */ *************** ffestu_sym_exec_transition (ffesymbol s) *** 731,734 **** --- 807,811 ---- ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD); ffesymbol_resolve_intrin (s); + ffesymbol_reference (s, NULL, FALSE); ffestorag_exec_layout (s); ffesymbol_signal_unreported (s); /* For debugging purposes. */ *************** ffestu_sym_exec_transition (ffesymbol s) *** 803,807 **** if (na == FFESYMBOL_attrsetNONE) ffesymbol_error (s, ffesta_tokens[0]); ! else if (!(na & FFESYMBOL_attrsANY)) { ffesymbol_signal_change (s); --- 880,886 ---- if (na == FFESYMBOL_attrsetNONE) ffesymbol_error (s, ffesta_tokens[0]); ! else if (!(na & FFESYMBOL_attrsANY) ! && (needs_type || (nkd != skd) || (nwh != swh) ! || (na != sa) || (ns != ss))) { ffesymbol_signal_change (s); *************** ffestu_sym_exec_transition (ffesymbol s) *** 822,828 **** else if (resolve_intrin) ffesymbol_resolve_intrin (s); ffestorag_exec_layout (s); - if (nwh == FFEINFO_whereGLOBAL) - ffesymbol_globalize (s); ffesymbol_signal_unreported (s); /* For debugging purposes. */ } --- 901,906 ---- else if (resolve_intrin) ffesymbol_resolve_intrin (s); + ffesymbol_reference (s, NULL, FALSE); ffestorag_exec_layout (s); ffesymbol_signal_unreported (s); /* For debugging purposes. */ } diff -rcp2N g77-0.5.20/f/symbol.c g77-0.5.21/f/symbol.c *** g77-0.5.20/f/symbol.c Sat Mar 1 04:29:57 1997 --- g77-0.5.21/f/symbol.c Tue Sep 9 06:11:37 1997 *************** *** 1,4 **** /* Implementation of Fortran symbol manager ! Copyright (C) 1995, 1996 Free Software Foundation, Inc. Contributed by James Craig Burley (burley@gnu.ai.mit.edu). --- 1,4 ---- /* Implementation of Fortran symbol manager ! Copyright (C) 1995-1997 Free Software Foundation, Inc. Contributed by James Craig Burley (burley@gnu.ai.mit.edu). *************** ffesymbol_error (ffesymbol s, ffelexToke *** 864,874 **** void - ffesymbol_globalize (ffesymbol s) - { - if (ffesymbol_global (s) == NULL) - ffesymbol_set_global (s, ffeglobal_promoted (s)); - } - - void ffesymbol_init_0 () { --- 864,867 ---- *************** ffesymbol_lookup_local (ffelexToken t) *** 929,932 **** --- 922,1009 ---- s = ffename_symbol (n); return s; /* May be NULL here, too. */ + } + + /* Registers the symbol as one that is referenced by the + current program unit. Currently applies only to + symbols known to have global interest (globals and + intrinsics). + + s is the (global/intrinsic) symbol referenced; t is the + referencing token; explicit is TRUE if the reference + is, e.g., INTRINSIC FOO. */ + + void + ffesymbol_reference (ffesymbol s, ffelexToken t, bool explicit) + { + ffename gn; + ffesymbol gs = NULL; + ffeinfoKind kind; + ffeinfoWhere where; + bool okay; + + if (ffesymbol_retractable_) + return; + + if (t == NULL) + t = ffename_token (s->name); /* Use the first reference in this program unit. */ + + kind = ffesymbol_kind (s); + where = ffesymbol_where (s); + + if (where == FFEINFO_whereINTRINSIC) + { + ffeglobal_ref_intrinsic (s, t, + explicit + || s->explicit_where + || ffeintrin_is_standard (s->generic, s->specific)); + return; + } + + if ((where != FFEINFO_whereGLOBAL) + && ((where != FFEINFO_whereLOCAL) + || ((kind != FFEINFO_kindFUNCTION) + && (kind != FFEINFO_kindSUBROUTINE)))) + return; + + gn = ffename_lookup (ffesymbol_global_, t); + if (gn != NULL) + gs = ffename_symbol (gn); + if ((gs != NULL) && (gs != s)) + { + /* We have just discovered another global symbol with the same name + but a different `nature'. Complain. Note that COMMON /FOO/ can + coexist with local symbol FOO, e.g. local variable, just not with + CALL FOO, hence the separate namespaces. */ + + ffesymbol_error (gs, t); + ffesymbol_error (s, NULL); + return; + } + + switch (kind) + { + case FFEINFO_kindBLOCKDATA: + okay = ffeglobal_ref_blockdata (s, t); + break; + + case FFEINFO_kindSUBROUTINE: + okay = ffeglobal_ref_subroutine (s, t); + break; + + case FFEINFO_kindFUNCTION: + okay = ffeglobal_ref_function (s, t); + break; + + case FFEINFO_kindNONE: + okay = ffeglobal_ref_external (s, t); + break; + + default: + assert ("bad kind in global ref" == NULL); + return; + } + + if (! okay) + ffesymbol_error (s, NULL); } diff -rcp2N g77-0.5.20/f/symbol.h g77-0.5.21/f/symbol.h *** g77-0.5.20/f/symbol.h Sat Mar 1 04:30:10 1997 --- g77-0.5.21/f/symbol.h Fri Jul 11 00:08:38 1997 *************** void ffesymbol_error (ffesymbol s, ffele *** 191,195 **** #define ffesymbol_generic(s) ((s)->generic) #define ffesymbol_global(s) ((s)->global) - void ffesymbol_globalize (ffesymbol s); #define ffesymbol_hook(s) ((s)->hook) #define ffesymbol_implementation(s) ((s)->implementation) --- 191,194 ---- *************** ffesymbol ffesymbol_lookup_local (ffelex *** 220,223 **** --- 219,223 ---- #define ffesymbol_ptr_to_namelist(s) (&(s)->namelist) #define ffesymbol_rank(s) ffeinfo_rank((s)->info) + void ffesymbol_reference (ffesymbol s, ffelexToken t, bool explicit); ffesymbol ffesymbol_report (ffesymbol s); void ffesymbol_report_all (void); diff -rcp2N g77-0.5.20/f/top.c g77-0.5.21/f/top.c *** g77-0.5.20/f/top.c Sat Feb 22 17:10:33 1997 --- g77-0.5.21/f/top.c Fri Jul 11 00:11:15 1997 *************** bool ffe_is_f2c_library_ = FFETARGET_def *** 76,79 **** --- 76,80 ---- bool ffe_is_ffedebug_ = FALSE; bool ffe_is_free_form_ = FFETARGET_defaultIS_FREE_FORM; + bool ffe_is_globals_ = TRUE; bool ffe_is_ident_ = TRUE; bool ffe_is_init_local_zero_ = FFETARGET_defaultIS_INIT_LOCAL_ZERO; *************** bool ffe_is_ugly_logint_ = FALSE; *** 94,97 **** --- 95,99 ---- bool ffe_is_version_ = FALSE; bool ffe_is_vxt_ = FALSE; + bool ffe_is_warn_globals_ = TRUE; bool ffe_is_warn_implicit_ = FALSE; bool ffe_is_warn_surprising_ = FALSE; *************** ffeCase ffe_case_match_ = FFETARGET_defa *** 101,104 **** --- 103,107 ---- ffeCase ffe_case_source_ = FFETARGET_defaultCASE_SOURCE; ffeCase ffe_case_symbol_ = FFETARGET_defaultCASE_SYMBOL; + ffeIntrinsicState ffe_intrinsic_state_badu77_ = FFE_intrinsicstateENABLED; ffeIntrinsicState ffe_intrinsic_state_gnu_ = FFE_intrinsicstateENABLED; ffeIntrinsicState ffe_intrinsic_state_f2c_ = FFE_intrinsicstateENABLED; *************** ffe_decode_option (char *opt) *** 292,298 **** else if (strcmp (&opt[2], "no-ugly-logint") == 0) ffe_set_is_ugly_logint (FALSE); ! else if (strcmp (&opt[2], "debug") == 0) ffe_set_is_ffedebug (TRUE); ! else if (strcmp (&opt[2], "no-debug") == 0) ffe_set_is_ffedebug (FALSE); else if (strcmp (&opt[2], "init-local-zero") == 0) --- 295,301 ---- else if (strcmp (&opt[2], "no-ugly-logint") == 0) ffe_set_is_ugly_logint (FALSE); ! else if (strcmp (&opt[2], "xyzzy") == 0) ffe_set_is_ffedebug (TRUE); ! else if (strcmp (&opt[2], "no-xyzzy") == 0) ffe_set_is_ffedebug (FALSE); else if (strcmp (&opt[2], "init-local-zero") == 0) *************** ffe_decode_option (char *opt) *** 332,335 **** --- 335,342 ---- else if (strcmp (&opt[2], "no-silent") == 0) ffe_set_is_silent (FALSE); + else if (strcmp (&opt[2], "globals") == 0) + ffe_set_is_globals (TRUE); + else if (strcmp (&opt[2], "no-globals") == 0) + ffe_set_is_globals (FALSE); else if (strcmp (&opt[2], "typeless-boz") == 0) ffe_set_is_typeless_boz (TRUE); *************** ffe_decode_option (char *opt) *** 408,411 **** --- 415,426 ---- ffe_set_case_symbol (FFE_caseNONE); } + else if (strcmp (&opt[2], "badu77-intrinsics-delete") == 0) + ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateDELETED); + else if (strcmp (&opt[2], "badu77-intrinsics-hide") == 0) + ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateHIDDEN); + else if (strcmp (&opt[2], "badu77-intrinsics-disable") == 0) + ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateDISABLED); + else if (strcmp (&opt[2], "badu77-intrinsics-enable") == 0) + ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateENABLED); else if (strcmp (&opt[2], "gnu-intrinsics-delete") == 0) ffe_set_intrinsic_state_gnu (FFE_intrinsicstateDELETED); *************** ffe_decode_option (char *opt) *** 489,492 **** --- 504,511 ---- else if (!strcmp (&opt[2], "no-import")) ; /* cpp handles this one. */ + else if (!strcmp (&opt[2], "globals")) + ffe_set_is_warn_globals (TRUE); + else if (!strcmp (&opt[2], "no-globals")) + ffe_set_is_warn_globals (FALSE); else if (!strcmp (&opt[2], "implicit")) ffe_set_is_warn_implicit (TRUE); diff -rcp2N g77-0.5.20/f/top.h g77-0.5.21/f/top.h *** g77-0.5.20/f/top.h Sat Feb 22 17:09:57 1997 --- g77-0.5.21/f/top.h Fri Jul 11 00:11:15 1997 *************** extern bool ffe_is_f2c_library_; *** 92,95 **** --- 92,96 ---- extern bool ffe_is_ffedebug_; extern bool ffe_is_free_form_; + extern bool ffe_is_globals_; extern bool ffe_is_ident_; extern bool ffe_is_init_local_zero_; *************** extern bool ffe_is_ugly_logint_; *** 109,112 **** --- 110,114 ---- extern bool ffe_is_version_; extern bool ffe_is_vxt_; + extern bool ffe_is_warn_globals_; extern bool ffe_is_warn_implicit_; extern bool ffe_is_warn_surprising_; *************** extern ffeCase ffe_case_match_; *** 116,119 **** --- 118,122 ---- extern ffeCase ffe_case_source_; extern ffeCase ffe_case_symbol_; + extern ffeIntrinsicState ffe_intrinsic_state_badu77_; extern ffeIntrinsicState ffe_intrinsic_state_gnu_; extern ffeIntrinsicState ffe_intrinsic_state_f2c_; *************** void ffe_terminate_4 (void); *** 158,161 **** --- 161,165 ---- #define ffe_case_source() ffe_case_source_ #define ffe_case_symbol() ffe_case_symbol_ + #define ffe_intrinsic_state_badu77() ffe_intrinsic_state_badu77_ #define ffe_intrinsic_state_f2c() ffe_intrinsic_state_f2c_ #define ffe_intrinsic_state_f90() ffe_intrinsic_state_f90_ *************** void ffe_terminate_4 (void); *** 175,178 **** --- 179,183 ---- #define ffe_is_ffedebug() ffe_is_ffedebug_ #define ffe_is_free_form() ffe_is_free_form_ + #define ffe_is_globals() ffe_is_globals_ #define ffe_is_ident() ffe_is_ident_ #define ffe_is_init_local_zero() ffe_is_init_local_zero_ *************** void ffe_terminate_4 (void); *** 195,198 **** --- 200,204 ---- #define ffe_is_version() ffe_is_version_ #define ffe_is_vxt() ffe_is_vxt_ + #define ffe_is_warn_globals() ffe_is_warn_globals_ #define ffe_is_warn_implicit() ffe_is_warn_implicit_ #define ffe_is_warn_surprising() ffe_is_warn_surprising_ *************** void ffe_terminate_4 (void); *** 206,209 **** --- 212,216 ---- #define ffe_set_case_source(f) (ffe_case_source_ = (f)) #define ffe_set_case_symbol(f) (ffe_case_symbol_ = (f)) + #define ffe_set_intrinsic_state_badu77(s) (ffe_intrinsic_state_badu77_ = (s)) #define ffe_set_intrinsic_state_f2c(s) (ffe_intrinsic_state_f2c_ = (s)) #define ffe_set_intrinsic_state_f90(s) (ffe_intrinsic_state_f90_ = (s)) *************** void ffe_terminate_4 (void); *** 223,226 **** --- 230,234 ---- #define ffe_set_is_ffedebug(f) (ffe_is_ffedebug_ = (f)) #define ffe_set_is_free_form(f) (ffe_is_free_form_ = (f)) + #define ffe_set_is_globals(f) (ffe_is_globals_ = (f)) #define ffe_set_is_ident(f) (ffe_is_ident_ = (f)) #define ffe_set_is_init_local_zero(f) (ffe_is_init_local_zero_ = (f)) *************** void ffe_terminate_4 (void); *** 242,245 **** --- 250,254 ---- #define ffe_set_is_version(f) (ffe_is_version_ = (f)) #define ffe_set_is_vxt(f) (ffe_is_vxt_ = (f)) + #define ffe_set_is_warn_globals(f) (ffe_is_warn_globals_ = (f)) #define ffe_set_is_warn_implicit(f) (ffe_is_warn_implicit_ = (f)) #define ffe_set_is_warn_surprising(f) (ffe_is_warn_surprising_ = (f)) diff -rcp2N g77-0.5.20/f/type.c g77-0.5.21/f/type.c *** g77-0.5.20/f/type.c Fri Feb 28 06:54:55 1997 --- g77-0.5.21/f/type.c Fri Jul 11 00:08:39 1997 *************** void *** 68,71 **** --- 68,73 ---- ffetype_set_kind (ffetype base_type, int kind, ffetype type) { + assert (kind < (int) sizeof (*(base_type->kinds_))); + if (base_type->kinds_ == NULL) { diff -rcp2N g77-0.5.20/f/where.c g77-0.5.21/f/where.c *** g77-0.5.20/f/where.c Mon Dec 4 06:10:30 1995 --- g77-0.5.21/f/where.c Sun Jul 13 21:40:49 1997 *************** ffewhere_line_new (ffewhereLineNumber ln *** 271,275 **** wl = malloc_new_ks (ffe_pool_file (), "FFEWHERE line", offsetof (struct _ffewhere_line_, content) ! + ffelex_line_length () + 1); wl->next = (ffewhereLine) &ffewhere_root_line_; wl->previous = ffewhere_root_line_.last; --- 271,275 ---- wl = malloc_new_ks (ffe_pool_file (), "FFEWHERE line", offsetof (struct _ffewhere_line_, content) ! + (size_t) ffelex_line_length () + 1); wl->next = (ffewhereLine) &ffewhere_root_line_; wl->previous = ffewhere_root_line_.last; *************** ffewhere_set_from_track (ffewhereLine *w *** 355,368 **** ffewhereIndex k; ! if (i == 0) { *wol = ffewhere_line_use (wrl); *woc = ffewhere_column_use (wrc); - } - else if (i >= FFEWHERE_indexMAX) - { - assert ("i >= FFEWHERE_indexMAX" == NULL); - *wol = ffewhere_line_unknown (); - *woc = ffewhere_column_unknown (); } else --- 355,362 ---- ffewhereIndex k; ! if ((i == 0) || (i >= FFEWHERE_indexMAX)) { *wol = ffewhere_line_use (wrl); *woc = ffewhere_column_use (wrc); } else diff -rcp2N g77-0.5.20/f/zzz.c g77-0.5.21/f/zzz.c *** g77-0.5.20/f/zzz.c Sat Mar 1 04:06:54 1997 --- g77-0.5.21/f/zzz.c Tue Sep 9 06:10:54 1997 *************** the Free Software Foundation, 59 Temple *** 52,56 **** #endif /* !defined (FFEZZZ_TIME) */ ! char *ffezzz_version_string = "0.5.20"; char *ffezzz_date = FFEZZZ_DATE; char *ffezzz_time = FFEZZZ_TIME; --- 52,56 ---- #endif /* !defined (FFEZZZ_TIME) */ ! char *ffezzz_version_string = "0.5.21"; char *ffezzz_date = FFEZZZ_DATE; char *ffezzz_time = FFEZZZ_TIME;