diff -rcp2N g77-0.5.8/README.g77 g77-0.5.9/README.g77 *** g77-0.5.8/README.g77 Fri Feb 17 03:34:12 1995 --- g77-0.5.9/README.g77 Tue Feb 21 13:39:10 1995 *************** *** 1,5 **** 950218 ! This directory contains the version 0.5.8 release of the GNU Fortran compiler. The GNU Fortran compiler is free software. See the file COPYING.g77 for copying permission. --- 1,5 ---- 950218 ! This directory contains the version 0.5.9 release of the GNU Fortran compiler. The GNU Fortran compiler is free software. See the file COPYING.g77 for copying permission. *************** If you have just unpacked the g77 distri *** 21,25 **** you must merge the contents of the g77 distribution with the appropriate gcc distribution on your system before proceeding. Using sample ! versions of 2.6.3 for gcc and 0.5.8 for g77, the process of unpacking and merging both distributions would be done as follows (where # is the shell prompt): --- 21,25 ---- you must merge the contents of the g77 distribution with the appropriate gcc distribution on your system before proceeding. Using sample ! versions of 2.6.3 for gcc and 0.5.9 for g77, the process of unpacking and merging both distributions would be done as follows (where # is the shell prompt): *************** shell prompt): *** 26,32 **** # tar xf gcc-2.6.3.tar # Creates ./gcc-2.6.3/ ! # tar xf g77-0.5.8.tar # Creates ./g77-0.5.8/ ! * # mv g77-0.5.8/* gcc-2.6.3/ # Merges gcc and g77 into ./gcc-2.6.3/ ! # rmdir g77-0.5.8 # Remove empty ./g77-0.5.8/ Another approach is to do the following: --- 26,32 ---- # tar xf gcc-2.6.3.tar # Creates ./gcc-2.6.3/ ! # tar xf g77-0.5.9.tar # Creates ./g77-0.5.9/ ! * # mv g77-0.5.9/* gcc-2.6.3/ # Merges gcc and g77 into ./gcc-2.6.3/ ! # rmdir g77-0.5.9 # Remove empty ./g77-0.5.9/ Another approach is to do the following: *************** Another approach is to do the following: *** 33,38 **** # tar xf gcc-2.6.3.tar # Creates ./gcc-2.6.3/ ! # ln -s gcc-2.6.3 g77-0.5.8 # Make g77-0.5.8 a link to gcc-2.6.3 ! # tar xf g77-0.5.8.tar # Unpacks g77 into gcc-2.6.3 The latter approach leaves the symbolic link, which might help others --- 33,38 ---- # tar xf gcc-2.6.3.tar # Creates ./gcc-2.6.3/ ! # ln -s gcc-2.6.3 g77-0.5.9 # Make g77-0.5.9 a link to gcc-2.6.3 ! # tar xf g77-0.5.9.tar # Unpacks g77 into gcc-2.6.3 The latter approach leaves the symbolic link, which might help others *************** problem occurs using one of the above me *** 46,50 **** The resulting directory layout is as follows, where gcc/ might be, ! for example, gcc-0.5.8/: gcc/ Non-Fortran files in gcc (not part of g77*.tar) --- 46,50 ---- The resulting directory layout is as follows, where gcc/ might be, ! for example, gcc-0.5.9/: gcc/ Non-Fortran files in gcc (not part of g77*.tar) diff -rcp2N g77-0.5.8/f/BUGS g77-0.5.9/f/BUGS *** g77-0.5.8/f/BUGS Wed Feb 15 16:02:58 1995 --- g77-0.5.9/f/BUGS Tue Feb 21 13:51:28 1995 *************** *** 1,3 **** ! 950215 1. g77 statically assumes INTEGER constants range from -2**31 to 2**31-1, --- 1,3 ---- ! 950221 1. g77 statically assumes INTEGER constants range from -2**31 to 2**31-1, *************** *** 55,72 **** 9. It should be possible to build the runtime without building cc1 etc. - - 10. g77 currently warns if its configuration is likely to result in - bugs or crashes for certain programs. E.g. if INTEGER cannot - hold all the bits in a "char *" type, g77 will warn about this - condition. If actual code is compiled that requires the lossy - conversions, g77 currently crashes, because otherwise the code might - silently fail if its implementation of the ASSIGN statement cannot - safely copy a pointer to the label into the integer. At least for - the ASSIGN case, it could quietly choose a different (and probably - somewhat less efficient) implementation when the type of the target - of the ASSIGN can't hold a simple pointer to the label (this would - allow, e.g., ASSIGN 10 TO I where I is even as small as INTEGER*1). - For now, however, it is worthwhile to first find out whether the - capabilities actually are needed before work is done to provide them. 11. RS/6000 support is not complete as of the gcc 2.6.3 back end. --- 55,58 ---- diff -rcp2N g77-0.5.8/f/ChangeLog g77-0.5.9/f/ChangeLog *** g77-0.5.8/f/ChangeLog Fri Feb 17 10:09:19 1995 --- g77-0.5.9/f/ChangeLog Tue Feb 21 13:38:19 1995 *************** *** 1,2 **** --- 1,83 ---- + Tue Feb 21 11:45:25 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.9 released. + + * Make-lang.in (f/proj.h): touch file to register update, + because the previous commands won't necessarily modify it. + + * Makefile.in (f/proj.h): touch file to register update, + because the previous commands won't necessarily modify it. + + * Makefile.in (f/str-*.h, f/str-*.j): Explicitly specify + output file names, so these targets go in build, not source, + directory. + + * bits.c, bits.h: Switch to valid ANSI C replacement for + ARRAY_ZERO. + + * com.c (ffecom_expr_): Add assignp arg to support ASSIGN better. + If assignp is TRUE, use different tree for FFEBLD_opSYMTER case. + (ffecom_sym_transform_assign_): New function. + (ffecom_expr_assign): New function. + (ffecom_expr_assign_w): New function. + + * com.c (ffecom_f2c_make_type_): Do make_signed_type instead + of make_unsigned_type throughout. + + * com.c (ffecom_finish_symbol_transform_): Expand scope of + commented-out code to probably produce faster compiler code. + + * com.c (ffecom_gen_sfuncdef_): Push/pop calltemps so + COMPLEX works right. + Remove obsolete comment. + + * com.c (ffecom_start_progunit_): If non-multi alt-entry + COMPLEX function, primary (static) entry point returns result + directory, not via extra arg -- to agree with ffecom_return_expr + and others. + Pretransform all symbols so statement functions are defined + before any code emitted. + + * com.c (ffecom_finish_progunit): Don't posttransform all + symbols here -- pretransform them instead. + + * com.c (ffecom_init_0): Don't warn about possible ASSIGN + crash, as this shouldn't happen now. + + * com.c (ffecom_push_tempvar): Fix to handle temp vars + pushed while context is a statement (nested) function, and + add appropriate commentary. + + * com.c (ffecom_return_expr): Check TREE_USED to determine + where return value is unset. + + * com.h (struct _ffecom_symbol_): Add note about length_tree + now being used to keep tree for ASSIGN version of symbol. + + * com.h (ffecom_expr_assign, ffecom_expr_assign_rw): New decls. + (error): Add this prototype for back-end function. + + * fini.c (main): Grab input, output, and include names + directly off the command line instead of making the latter + two out of the first. + + * lex.c: Improve tab handling for both fixed and free source + forms, and ignore carriage-returns on input, while generally + improving the code. ffelex_handle_tab_ has been renamed and + reinvented as ffelex_image_char_, among other things. + + * malloc.c, malloc.h: Switch to valid ANSI C replacement for + ARRAY_ZERO, and kill the full number of bytes in pools and + areas. + + * proj.h.in (ARRAY_ZERO, ARRAY_ZERO_SIZE): Remove. + + * ste.c (ffeste_io_cilist_, ffeste_io_icilist_, ffeste_R838, + ffeste_R839): Issue diagnostic if a too-narrow variable used in an + ASSIGN context despite changes to this code and code in com.c. + + * where.c, where.h: Switch to valid ANSI C replacement for + ARRAY_ZERO. + Fri Feb 17 03:35:19 1995 Craig Burley (burley@gnu.ai.mit.edu) diff -rcp2N g77-0.5.8/f/DOC g77-0.5.9/f/DOC *** g77-0.5.8/f/DOC Wed Feb 15 16:29:49 1995 --- g77-0.5.9/f/DOC Tue Feb 21 13:50:58 1995 *************** *** 1,3 **** ! 950215 *IMPORTANT GENERAL INFORMATION* --- 1,3 ---- ! 950221 *IMPORTANT GENERAL INFORMATION* *************** configuration that probably make doing n *** 51,64 **** a hassle, requiring manual intervention. - Further, a known bug exists that causes g77 to emit a warning - every time the compiler is invoked when it is running on a - configuration where a pointer (in C, a char *) is wider than - the INTEGER type, and causes g77 to crash if an attempt is made - to ASSIGN a label to a type (normally INTEGER) that is not at - least as wide as a pointer. (I.e. the warning indicates that - the crash might happen.) This bug could be fixed if there - is enough interest. - *CHANGES DURING 0.5.x* In 0.5.5: --- 51,82 ---- a hassle, requiring manual intervention. *CHANGES DURING 0.5.x* + + In 0.5.9: + + - Carriage returns ('\r') in source lines are ignored. This is somewhat + different from f2c, which seems to treat them as spaces outside + character/hollerith constants, and encodes them as '\r' inside such + constants. + + - A source line with a TAB character anywhere in it is treated as + entirely significant -- however long it is -- instead of ending + in column 72 (for fixed-form source) or 132 (for free-form source). + This also is different from f2c, which encodes tabs as '\t' inside + character and hollerith constants, but nevertheless seems to treat + the column position as if it had been affected by any tab. + + NOTE: this default behavior probably will change for 0.6, when + it will presumably be available via a command-line option. The + default as of 0.6 is expected to be a "pure visual" model, where + tabs are immediately converted to spaces and otherwise have no + effect, so the way a typical user sees source lines produces a + consistent result no matter how the spacing in those source lines + is actually implemented via tabs, spaces, and trailing tabs/spaces + before newline. Command-line options are likely to be added to + specify whether all or just-tabbed lines are to be extended to + 132 or full input-line length, and perhaps even an option will be + added to specify the truncated-line behavior to which Digital compilers + default. In 0.5.5: diff -rcp2N g77-0.5.8/f/Make-lang.in g77-0.5.9/f/Make-lang.in *** g77-0.5.8/f/Make-lang.in Thu Feb 16 14:01:31 1995 --- g77-0.5.9/f/Make-lang.in Tue Feb 21 13:38:20 1995 *************** f/proj.h: $(srcdir)/f/proj.h.in $(srcdir *** 201,204 **** --- 201,205 ---- cd f; \ CC="$(CC)" CONFIG_SITE=/dev/null $(SHELL) $${src}/conf-proj --srcdir=$${src} + touch f/proj.h #Make sure date/time follows dependents! # NB. Put stdout for autoconf in temp file, so that if autoconf doesn't # exist, we don't create a null conf-proj that causes the build to try diff -rcp2N g77-0.5.8/f/Makefile.in g77-0.5.9/f/Makefile.in *** g77-0.5.8/f/Makefile.in Fri Feb 17 02:36:07 1995 --- g77-0.5.9/f/Makefile.in Tue Feb 21 13:38:20 1995 *************** f/proj.h: $(srcdir)/proj.h.in $(srcdir)/ *** 261,264 **** --- 261,265 ---- cd f; \ CC="$(CC)" CONFIG_SITE=/dev/null $(SHELL) $${src}/conf-proj --srcdir=$${src} + touch f/proj.h #Make sure date/time follows dependents! $(srcdir)/conf-proj: $(srcdir)/conf-proj.in cd $(srcdir) && autoconf conf-proj.in > conf-proj.out && \ *************** f/stamp-str: f/str-1t.h f/str-1t.j f/str *** 472,494 **** f/str-1t.h f/str-1t.j: f/fini f/str-1t.fin ! ./f/fini `echo $(srcdir)/str-1t | sed 's,^\./,,'` f/str-2t.h f/str-2t.j: f/fini f/str-2t.fin ! ./f/fini `echo $(srcdir)/str-2t | sed 's,^\./,,'` f/str-fo.h f/str-fo.j: f/fini f/str-fo.fin ! ./f/fini `echo $(srcdir)/str-fo | sed 's,^\./,,'` f/str-io.h f/str-io.j: f/fini f/str-io.fin ! ./f/fini `echo $(srcdir)/str-io | sed 's,^\./,,'` f/str-nq.h f/str-nq.j: f/fini f/str-nq.fin ! ./f/fini `echo $(srcdir)/str-nq | sed 's,^\./,,'` f/str-op.h f/str-op.j: f/fini f/str-op.fin ! ./f/fini `echo $(srcdir)/str-op | sed 's,^\./,,'` f/str-ot.h f/str-ot.j: f/fini f/str-ot.fin ! ./f/fini `echo $(srcdir)/str-ot | sed 's,^\./,,'` f/fini: f/fini.o f/proj.o --- 473,495 ---- f/str-1t.h f/str-1t.j: f/fini f/str-1t.fin ! ./f/fini `echo $(srcdir)/str-1t.fin | sed 's,^\./,,'` f/str-1t.j f/str-1t.h f/str-2t.h f/str-2t.j: f/fini f/str-2t.fin ! ./f/fini `echo $(srcdir)/str-2t.fin | sed 's,^\./,,'` f/str-2t.j f/str-2t.h f/str-fo.h f/str-fo.j: f/fini f/str-fo.fin ! ./f/fini `echo $(srcdir)/str-fo.fin | sed 's,^\./,,'` f/str-fo.j f/str-fo.h f/str-io.h f/str-io.j: f/fini f/str-io.fin ! ./f/fini `echo $(srcdir)/str-io.fin | sed 's,^\./,,'` f/str-io.j f/str-io.h f/str-nq.h f/str-nq.j: f/fini f/str-nq.fin ! ./f/fini `echo $(srcdir)/str-nq.fin | sed 's,^\./,,'` f/str-nq.j f/str-nq.h f/str-op.h f/str-op.j: f/fini f/str-op.fin ! ./f/fini `echo $(srcdir)/str-op.fin | sed 's,^\./,,'` f/str-op.j f/str-op.h f/str-ot.h f/str-ot.j: f/fini f/str-ot.fin ! ./f/fini `echo $(srcdir)/str-ot.fin | sed 's,^\./,,'` f/str-ot.j f/str-ot.h f/fini: f/fini.o f/proj.o diff -rcp2N g77-0.5.8/f/PROJECTS g77-0.5.9/f/PROJECTS *** g77-0.5.8/f/PROJECTS Wed Feb 15 16:10:54 1995 --- g77-0.5.9/f/PROJECTS Tue Feb 21 14:01:07 1995 *************** *** 1,3 **** ! 950215 0. Improved efficiency. --- 1,3 ---- ! 950221 0. Improved efficiency. *************** them show up only given certain kinds of *** 139,142 **** --- 139,157 ---- INTEGER*8, and so on. + * Provide as the default source-line model a "pure visual" mode, where + the interpretation of a source program in this mode can be accurately + determined by a user looking at a traditionally displayed rendition + of the program (assuming the user knows whether the program is fixed + or free form). That is, assume the user cannot tell tabs from spaces + and cannot see trailing spaces on lines, but has canonical tab stops + and, for fixed-form source, has the ability to always know exactly + where column 72 is. Then provide common alternate models (Digital, f2c, + &c) via command-line options. This includes allowing arbitrarily long + lines for free-form source as well as fixed-form source and providing + pedantic limits and diagnostics as appropriate, plus even on a non- + tabbed fixed-form line, treating a line with the first non-blank character + starting with column 6 being a digit as a continuation line (to effect + the "1continuationline..." behavior in "pure visual" mode). + * Intrinsics in constant expressions. This, plus F90 intrinsics such as SELECTED_INT_KIND, would give users the ability to write clear, *************** them show up only given certain kinds of *** 155,160 **** replacement for things like the VXT PARAMETER statement when people really need typelessness in a maintainable, portable, clearly documented ! way. (But wait until it's clear there's a real need, in the form of ! funding, for this.) * Allow DATA VAR/.../ to come before COMMON /.../ ...,VAR,.... --- 170,174 ---- replacement for things like the VXT PARAMETER statement when people really need typelessness in a maintainable, portable, clearly documented ! way. * Allow DATA VAR/.../ to come before COMMON /.../ ...,VAR,.... *************** them show up only given certain kinds of *** 161,167 **** * Character-type selector/cases for SELECT CASE. - - * Allow arbitrarily long lines for free-form source as well as fixed-form - source; provide pedantic limits and diagnostics as appropriate. * Option to initialize everything not explicitly initialized to "weird" --- 175,178 ---- diff -rcp2N g77-0.5.8/f/bit.c g77-0.5.9/f/bit.c *** g77-0.5.8/f/bit.c Wed Feb 15 16:58:42 1995 --- g77-0.5.9/f/bit.c Tue Feb 21 13:38:20 1995 *************** void *** 100,104 **** ffebit_kill (ffebit b) { ! malloc_kill_ks (b->pool, b, sizeof (*b) + (b->size + CHAR_BIT - 1) / CHAR_BIT); } --- 100,106 ---- ffebit_kill (ffebit b) { ! malloc_kill_ks (b->pool, b, ! offsetof (struct _ffebit_, bits) ! + (b->size + CHAR_BIT - 1) / CHAR_BIT); } *************** ffebit_new (mallocPool pool, ffebitCount *** 118,122 **** ffebit b; ! b = malloc_new_zks (pool, "ffebit", sizeof (*b) + (size + CHAR_BIT - 1) / CHAR_BIT, 0); b->pool = pool; --- 120,126 ---- ffebit b; ! b = malloc_new_zks (pool, "ffebit", ! offsetof (struct _ffebit_, bits) ! + (size + CHAR_BIT - 1) / CHAR_BIT, 0); b->pool = pool; diff -rcp2N g77-0.5.8/f/bit.h g77-0.5.9/f/bit.h *** g77-0.5.8/f/bit.h Thu Feb 16 21:42:52 1995 --- g77-0.5.9/f/bit.h Tue Feb 21 13:38:20 1995 *************** struct _ffebit_ *** 49,53 **** mallocPool pool; ffebitCount size; ! unsigned char bits[ARRAY_ZERO]; }; --- 49,53 ---- mallocPool pool; ffebitCount size; ! unsigned char bits[1]; }; diff -rcp2N g77-0.5.8/f/com.c g77-0.5.9/f/com.c *** g77-0.5.8/f/com.c Wed Feb 15 16:58:41 1995 --- g77-0.5.9/f/com.c Tue Feb 21 13:38:22 1995 *************** static ffecomConcatList_ ffecom_concat_l *** 297,301 **** static void ffecom_do_entry_ (ffesymbol fn, int entrynum); static tree ffecom_expr_ (ffebld expr, tree dest_tree, ! ffeinfo dest_info, bool *dest_used); static tree ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree, ffeinfo dest_info, bool *dest_used); --- 297,302 ---- static void ffecom_do_entry_ (ffesymbol fn, int entrynum); static tree ffecom_expr_ (ffebld expr, tree dest_tree, ! ffeinfo dest_info, bool *dest_used, ! bool assignp); static tree ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree, ffeinfo dest_info, bool *dest_used); *************** static void ffecom_push_dummy_decls_ (ff *** 332,335 **** --- 333,337 ---- static void ffecom_start_progunit_ (void); static ffesymbol ffecom_sym_transform_ (ffesymbol s); + static ffesymbol ffecom_sym_transform_assign_ (ffesymbol s); static void ffecom_transform_common_ (ffesymbol s); static void ffecom_transform_equiv_ (ffestorag st); *************** ffecom_do_entry_ (ffesymbol fn, int entr *** 1631,1635 **** } ! /* This code appends the length arguments for character variables/arrays. */ for (list = ffecom_master_arglist_; --- 1633,1638 ---- } ! /* This code appends the length arguments for character ! variables/arrays. */ for (list = ffecom_master_arglist_; *************** ffecom_do_entry_ (ffesymbol fn, int entr *** 1760,1764 **** static tree ffecom_expr_ (ffebld expr, tree dest_tree, ! ffeinfo dest_info, bool *dest_used) { tree item; --- 1763,1768 ---- static tree ffecom_expr_ (ffebld expr, tree dest_tree, ! ffeinfo dest_info, bool *dest_used, ! bool assignp) { tree item; *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 1832,1845 **** return ffecom_ptr_to_expr (expr); /* Same as %REF(intrinsic). */ s = ffebld_symter (expr); ! t = ffesymbol_hook (s).decl_tree; ! if (t == NULL_TREE) { - s = ffecom_sym_transform_ (s); t = ffesymbol_hook (s).decl_tree; } - assert (t != NULL_TREE); - if (ffesymbol_hook (s).addr) - t = ffecom_1 (INDIRECT_REF, - TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (t))), t); return t; --- 1836,1862 ---- return ffecom_ptr_to_expr (expr); /* Same as %REF(intrinsic). */ s = ffebld_symter (expr); ! if (assignp) ! { /* ASSIGN'ed-label expr. */ ! t = ffesymbol_hook (s).length_tree; ! if (t == NULL_TREE) ! { ! s = ffecom_sym_transform_assign_ (s); ! t = ffesymbol_hook (s).length_tree; ! assert (t != NULL_TREE); ! } ! } ! else { t = ffesymbol_hook (s).decl_tree; + if (t == NULL_TREE) + { + s = ffecom_sym_transform_ (s); + t = ffesymbol_hook (s).decl_tree; + assert (t != NULL_TREE); + } + if (ffesymbol_hook (s).addr) + t = ffecom_1 (INDIRECT_REF, + TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (t))), t); } return t; *************** ffecom_f2c_make_type_ (tree *type, int t *** 4826,4846 **** { case FFECOM_f2ccodeCHAR: ! *type = make_unsigned_type (CHAR_TYPE_SIZE); break; case FFECOM_f2ccodeSHORT: ! *type = make_unsigned_type (SHORT_TYPE_SIZE); break; case FFECOM_f2ccodeINT: ! *type = make_unsigned_type (INT_TYPE_SIZE); break; case FFECOM_f2ccodeLONG: ! *type = make_unsigned_type (LONG_TYPE_SIZE); break; case FFECOM_f2ccodeLONGLONG: ! *type = make_unsigned_type (LONG_LONG_TYPE_SIZE); break; --- 4843,4863 ---- { case FFECOM_f2ccodeCHAR: ! *type = make_signed_type (CHAR_TYPE_SIZE); break; case FFECOM_f2ccodeSHORT: ! *type = make_signed_type (SHORT_TYPE_SIZE); break; case FFECOM_f2ccodeINT: ! *type = make_signed_type (INT_TYPE_SIZE); break; case FFECOM_f2ccodeLONG: ! *type = make_signed_type (LONG_TYPE_SIZE); break; case FFECOM_f2ccodeLONGLONG: ! *type = make_signed_type (LONG_LONG_TYPE_SIZE); break; *************** ffecom_finish_symbol_transform_ (ffesymb *** 4985,4991 **** && (ffesymbol_hook (s).decl_tree != error_mark_node)) { int yes = suspend_momentary (); - #ifdef SOMEONE_GETS_DEBUG_SUPPORT_WORKING /* This isn't working, at least for dbxout. The .s file looks okay to me (burley), but in gdb 4.9 at least, the variables --- 5002,5008 ---- && (ffesymbol_hook (s).decl_tree != error_mark_node)) { + #ifdef SOMEONE_GETS_DEBUG_SUPPORT_WORKING int yes = suspend_momentary (); /* This isn't working, at least for dbxout. The .s file looks okay to me (burley), but in gdb 4.9 at least, the variables *************** ffecom_finish_symbol_transform_ (ffesymb *** 4996,5002 **** ffecom_member_phase2_ (ffesymbol_storage (ffesymbol_common (s)), ffesymbol_storage (s)); - #endif resume_momentary (yes); } --- 5013,5019 ---- ffecom_member_phase2_ (ffesymbol_storage (ffesymbol_common (s)), ffesymbol_storage (s)); resume_momentary (yes); + #endif } *************** ffecom_gen_sfuncdef_ (ffesymbol s, ffein *** 5142,5153 **** recurse = TRUE; - /* ~~Backend does not support inlining yet; for the time being, should we - do it here in the FFE? NOTE: I think the back end now does support - inlining of nested functions, and I believe the work I'm doing in 0.4 to - support -g (keeping track of blocks and their decls) should help g77's - front end support the back end's requirements to make such inlining - work. I'll probably try enabling it conditionally for a while and see - what happens. */ - yes = suspend_momentary (); --- 5159,5162 ---- *************** ffecom_gen_sfuncdef_ (ffesymbol s, ffein *** 5154,5157 **** --- 5163,5168 ---- push_f_function_context (); + ffecom_push_calltemps (); + if (charfunc) type = void_type_node; *************** ffecom_gen_sfuncdef_ (ffesymbol s, ffein *** 5228,5231 **** --- 5239,5244 ---- finish_function (1); + ffecom_pop_calltemps (); + pop_f_function_context (); *************** ffecom_start_progunit_ () *** 5765,5769 **** charfunc = cmplxfunc = FALSE; ! if (charfunc || cmplxfunc || multi) type = void_type_node; else --- 5778,5784 ---- charfunc = cmplxfunc = FALSE; ! if (charfunc ! || multi ! || (cmplxfunc && !altentries)) type = void_type_node; else *************** ffecom_start_progunit_ () *** 5831,5835 **** } ! if (charfunc || cmplxfunc || multi) { /* Arg for result (return value). */ tree type; --- 5846,5852 ---- } ! if (charfunc ! || multi ! || (cmplxfunc && !altentries)) { /* Arg for result (return value). */ tree type; *************** ffecom_start_progunit_ () *** 5886,5889 **** --- 5903,5913 ---- lineno = old_lineno; input_filename = old_input_filename; + + /* This handles any symbols still untransformed, in case -g specified. + This used to be done in ffecom_finish_progunit, but it turns out to + be necessary to do it here so that statement functions are + expanded before code. */ + + ffesymbol_drive (ffecom_finish_symbol_transform_); } *************** ffecom_sym_transform_ (ffesymbol s) *** 6806,6809 **** --- 6830,6888 ---- #endif + /* Transform into ASSIGNable symbol. + + Symbol has already been transformed, but for whatever reason, the + resulting decl_tree has been deemed not usable for an ASSIGN target. + (E.g. it isn't wide enough to hold a pointer.) So, here we invent + another local symbol of type void * and stuff that in the length_tree + argument. The F77/F90 standards allow this implementation. */ + + #if FFECOM_targetCURRENT == FFECOM_targetGCC + static ffesymbol + ffecom_sym_transform_assign_ (ffesymbol s) + { + tree t; /* Transformed thingy. */ + int yes; + int old_lineno = lineno; + char *old_input_filename = input_filename; + + if (ffesymbol_sfdummyparent (s) == NULL) + { + input_filename = ffesymbol_where_filename (s); + lineno = ffesymbol_where_filelinenum (s); + } + else + { + ffesymbol sf = ffesymbol_sfdummyparent (s); + + input_filename = ffesymbol_where_filename (sf); + lineno = ffesymbol_where_filelinenum (sf); + } + + assert (!ffecom_transform_only_dummies_); + + yes = suspend_momentary (); + + t = build_decl (VAR_DECL, + ffecom_get_invented_identifier ("__g77_ASSIGN_%s", + ffesymbol_text (s), + 0), + TREE_TYPE (null_pointer_node)); + TREE_STATIC (t) = 0; /* No need to make static. */ + + t = start_decl (t, FALSE); + finish_decl (t, NULL_TREE, FALSE); + + resume_momentary (yes); + + ffesymbol_hook (s).length_tree = t; + + lineno = old_lineno; + input_filename = old_input_filename; + + return s; + } + + #endif /* Implement COMMON area in back end. *************** ffecom_expand_let_stmt (ffebld dest, ffe *** 8577,8581 **** || TREE_ADDRESSABLE (dest_tree)) source_tree = ffecom_expr_ (source, dest_tree, ffebld_info (dest), ! &dest_used); else { --- 8656,8660 ---- || TREE_ADDRESSABLE (dest_tree)) source_tree = ffecom_expr_ (source, dest_tree, ffebld_info (dest), ! &dest_used, FALSE); else { *************** tree *** 8618,8622 **** ffecom_expr (ffebld expr) { ! return ffecom_expr_ (expr, NULL_TREE, ffeinfo_new_null (), NULL); } --- 8697,8724 ---- ffecom_expr (ffebld expr) { ! return ffecom_expr_ (expr, NULL_TREE, ffeinfo_new_null (), NULL, ! FALSE); ! } ! ! #endif ! /* Like ffecom_expr, but return tree usable for assigned GOTO or FORMAT. */ ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_expr_assign (ffebld expr) ! { ! return ffecom_expr_ (expr, NULL_TREE, ffeinfo_new_null (), NULL, ! TRUE); ! } ! ! #endif ! /* Like ffecom_expr_rw, but return tree usable for ASSIGN. */ ! ! #if FFECOM_targetCURRENT == FFECOM_targetGCC ! tree ! ffecom_expr_assign_w (ffebld expr) ! { ! return ffecom_expr_ (expr, NULL_TREE, ffeinfo_new_null (), NULL, ! TRUE); } *************** void *** 8668,8674 **** ffecom_finish_progunit () { - /* This handles any symbols still untransformed, in case -g specified. */ - ffesymbol_drive (ffecom_finish_symbol_transform_); - ffecom_end_compstmt_ (); --- 8770,8773 ---- *************** ffecom_init_0 () *** 9223,9230 **** } - /* Warn if g77 will crash for certain attempted constructs, so the - person configuring/building g77 knows right away there might - be a problem. */ - #if 0 /* Code in ste.c that would crash has been commented out. */ if (TYPE_PRECISION (ffecom_f2c_ftnlen_type_node) --- 9322,9325 ---- *************** ffecom_init_0 () *** 9236,9239 **** --- 9331,9335 ---- #endif + #if 0 /* ASSIGN-related stuff has been changed to accommodate this. */ if (TYPE_PRECISION (ffecom_integer_type_node) < TYPE_PRECISION (string_type_node)) *************** ffecom_init_0 () *** 9243,9246 **** --- 9339,9343 ---- TYPE_PRECISION (string_type_node), TYPE_PRECISION (ffecom_integer_type_node)); + #endif } *************** ffecom_notify_primary_entry (ffesymbol s *** 9648,9652 **** push_calltemps and pop_calltemps, that are marked as "auto-pop" meaning they won't be explicitly popped (freed), are popped ! at this point so they can be reused later. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC --- 9745,9762 ---- push_calltemps and pop_calltemps, that are marked as "auto-pop" meaning they won't be explicitly popped (freed), are popped ! at this point so they can be reused later. ! ! NOTE: when called by ffecom_gen_sfuncdef_, ffecom_pending_calls_ ! should come in == 1, and all of the in-use auto-pop temps ! should have DECL_CONTEXT (temp->t) == current_function_decl. ! Moreover, these temps should _never_ be re-used in future ! calls to ffecom_push_tempvar -- since current_function_decl will ! never be the same again. ! ! SO, it could be a minor win in terms of compile time to just ! strip these temps off the list. That is, if the above assumptions ! are correct, just remove from the list of temps any temp ! that is both in-use and has DECL_CONTEXT (temp->t) ! == current_function_decl, when called from ffecom_gen_sfuncdef_. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC *************** ffecom_push_tempvar (tree type, ffetarge *** 9877,9881 **** || (temp->type != type) || (temp->size != size) ! || (temp->elements != elements)) continue; --- 9987,9992 ---- || (temp->type != type) || (temp->size != size) ! || (temp->elements != elements) ! || (DECL_CONTEXT (temp->t) != current_function_decl)) continue; *************** ffecom_return_expr (ffebld expr) *** 9987,9991 **** situation; if the return value has never been referenced, it won't have a tree under 2pass mode. */ ! if (rtn == NULL_TREE) { ffebad_start (FFEBAD_RETURN_VALUE_UNSET); --- 10098,10103 ---- situation; if the return value has never been referenced, it won't have a tree under 2pass mode. */ ! if ((rtn == NULL_TREE) ! || !TREE_USED (rtn)) { ffebad_start (FFEBAD_RETURN_VALUE_UNSET); diff -rcp2N g77-0.5.8/f/com.h g77-0.5.9/f/com.h *** g77-0.5.8/f/com.h Thu Feb 16 21:42:52 1995 --- g77-0.5.9/f/com.h Tue Feb 21 13:38:22 1995 *************** struct _ffecom_symbol_ *** 192,196 **** { tree decl_tree; ! tree length_tree; /* For CHARACTER dummies &c. */ tree vardesc_tree; /* For NAMELIST. */ bool addr; /* Is address of item instead of item. */ --- 192,196 ---- { tree decl_tree; ! tree length_tree; /* For CHARACTER dummies and ASSIGN'ed vars. */ tree vardesc_tree; /* For NAMELIST. */ bool addr; /* Is address of item instead of item. */ *************** void ffecom_expand_let_stmt (ffebld dest *** 265,268 **** --- 265,270 ---- #if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_expr (ffebld expr); + tree ffecom_expr_assign (ffebld expr); + tree ffecom_expr_assign_w (ffebld expr); tree ffecom_expr_rw (ffebld expr); void ffecom_finish_compile (void); *************** void emit_nop (void); *** 311,314 **** --- 313,317 ---- void announce_function (tree decl); int count_error (int warningp); + void error (char *s, ...); void expand_decl (tree decl); void expand_computed_goto (tree exp); diff -rcp2N g77-0.5.8/f/data.c g77-0.5.9/f/data.c *** g77-0.5.8/f/data.c Wed Feb 15 16:58:41 1995 --- g77-0.5.9/f/data.c Sat Feb 18 10:01:50 1995 *************** ffedata_value_ (ffebld value, ffelexToke *** 1633,1636 **** --- 1633,1637 ---- ffebad_here (0, ffelex_token_where_line (token), ffelex_token_where_column (token)); + ffebad_string (ffesymbol_text (ffedata_symbol_)); ffebad_string (bignum); ffebad_finish (); diff -rcp2N g77-0.5.8/f/fini.c g77-0.5.9/f/fini.c *** g77-0.5.8/f/fini.c Wed Feb 15 16:58:41 1995 --- g77-0.5.9/f/fini.c Tue Feb 21 13:38:22 1995 *************** static char *spaces[] *** 224,228 **** "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 159 */ }; - static char *filename; void testname (bool nested, int indent, name first, name last); --- 224,227 ---- *************** main (int argc, char **argv) *** 244,250 **** name n; name newname; ! char input_name[256]; ! char output_name[256]; ! char include_name[256]; FILE *incl; int fixlengths; --- 243,249 ---- name n; name newname; ! char *input_name; ! char *output_name; ! char *include_name; FILE *incl; int fixlengths; *************** main (int argc, char **argv) *** 263,274 **** names_alpha.last = (name) &names_alpha; ! filename = argv[1]; ! strcpy (input_name, filename); ! strcpy (input_name + strlen (filename), ".fin"); ! strcpy (output_name, filename); ! strcpy (output_name + strlen (filename), ".j"); ! strcpy (include_name, filename); ! strcpy (include_name + strlen (filename), ".h"); in = fopen (input_name, "r"); --- 262,274 ---- names_alpha.last = (name) &names_alpha; ! if (argc != 4) ! { ! fprintf (stderr, "Command form: fini input output-code output-include\n"); ! exit (1); ! } ! input_name = argv[1]; ! output_name = argv[2]; ! include_name = argv[3]; in = fopen (input_name, "r"); diff -rcp2N g77-0.5.8/f/lex.c g77-0.5.9/f/lex.c *** g77-0.5.8/f/lex.c Wed Feb 15 16:58:40 1995 --- g77-0.5.9/f/lex.c Tue Feb 21 13:38:23 1995 *************** static ffewhereColumnNumber ffelex_final *** 65,68 **** --- 65,69 ---- static ffelexType ffelex_first_char_[256]; static char *ffelex_card_image_;/* Current size is ffelex_max_columns_. */ + static bool ffelex_saw_tab_; /* True if we saw a tab on the current line. */ static FILE *ffelex_include_file_; /* File to start reading from. */ static ffewhereFile ffelex_include_wherefile_; *************** static void ffelex_display_token_ (void) *** 115,119 **** #endif static void ffelex_finish_statement_ (void); ! static ffewhereColumnNumber ffelex_handle_tab_ (ffewhereColumnNumber col); static bool ffelex_is_free_char_ctx_contin_ (ffewhereColumnNumber col); static bool ffelex_is_free_nonc_ctx_contin_ (ffewhereColumnNumber col); --- 116,121 ---- #endif static void ffelex_finish_statement_ (void); ! static ffewhereColumnNumber ffelex_image_char_ (int c, ! ffewhereColumnNumber col); static bool ffelex_is_free_char_ctx_contin_ (ffewhereColumnNumber col); static bool ffelex_is_free_nonc_ctx_contin_ (ffewhereColumnNumber col); *************** ffelex_file_fixed (ffewhereFile wf, FILE *** 170,174 **** register int c; /* Character currently under consideration. */ register ffewhereColumnNumber column; /* Not really; 0 means column 1... */ - register bool saw_tab; /* True if we saw a tab on the current line. */ bool disallow_continuation_line; bool ignore_disallowed_continuation; --- 172,175 ---- *************** beginning_of_line_again: /* :::::::::::: *** 265,269 **** while (((lextype = ffelex_first_char_[c]) == FFELEX_typeCOMMENT) ! || (lextype == FFELEX_typeERROR) || (lextype == FFELEX_typeSLASH)) { if (lextype == FFELEX_typeERROR) --- 266,271 ---- while (((lextype = ffelex_first_char_[c]) == FFELEX_typeCOMMENT) ! || (lextype == FFELEX_typeERROR) ! || (lextype == FFELEX_typeSLASH)) { if (lextype == FFELEX_typeERROR) *************** beginning_of_line_again: /* :::::::::::: *** 270,277 **** { /* Bad first character, get line and display it with message. */ ! ffelex_card_image_[0] = c; ! column = 1; ! if (c == '\t') ! column = ffelex_handle_tab_ (column); bad_first_character: /* :::::::::::::::::::: */ --- 272,276 ---- { /* Bad first character, get line and display it with message. */ ! column = ffelex_image_char_ (c, 0); bad_first_character: /* :::::::::::::::::::: */ *************** beginning_of_line_again: /* :::::::::::: *** 280,288 **** { if (column < FFELEX_columnMAX_ERROR_) ! { ! ffelex_card_image_[column++] = c; ! if (c == '\t') ! column = ffelex_handle_tab_ (column); ! } } ffelex_card_image_[column] = '\0'; --- 279,283 ---- { if (column < FFELEX_columnMAX_ERROR_) ! column = ffelex_image_char_ (c, column); } ffelex_card_image_[column] = '\0'; *************** beginning_of_line_again: /* :::::::::::: *** 300,303 **** --- 295,301 ---- /* Typical case (straight comment), just ignore rest of line. */ { + + comment_line: /* :::::::::::::::::::: */ + while ((c != '\n') && (c != EOF)) c = getc (f); *************** beginning_of_line_again: /* :::::::::::: *** 321,324 **** --- 319,324 ---- } /* while [c, first char, means comment] */ + ffelex_saw_tab_ = FALSE; + if (lextype == FFELEX_typeDEBUG) c = ' '; /* A 'D' or 'd' in column 1 with the *************** beginning_of_line_again: /* :::::::::::: *** 325,394 **** debug-lines option on. */ ! /* Non-comment character (like a space or digit). Read the whole line in ! very quickly. Stop after reading the character corresponding to the ! last column in the card (72 normally, 132 if extend_source is ! specified). However, if a tab is seen, process it as a typical number of ! tab stops and let the line be as long as it wants. */ ! column = 1; ! saw_tab = FALSE; ! ffelex_card_image_[0] = c; ! if (c == '\t') { ! saw_tab = TRUE; ! column = ffelex_handle_tab_ (column); ! } ! /* Read with no checking as long as we've got the space (72 or 132 columns ! at least). This is the typical case, so do it as fast as possible. */ ! while (((c = getc (f)) != '\n') && (c != EOF) ! && (column < ffelex_final_nontab_column_)) ! { ! ffelex_card_image_[column++] = c; ! if (c == '\t') ! { ! saw_tab = TRUE; ! column = ffelex_handle_tab_ (column); } } ! /* If we saw a tab anywhere so far and until we come to the end of the ! line, continue reading and allow for growing the card image to ! accommodate any size line. */ ! if (saw_tab) ! { ! while ((c != '\n') && (c != EOF)) ! { ! if (column >= ffelex_max_columns_) ! { ! ffelex_card_image_ = malloc_resize_ksr (malloc_pool_image (), ! ffelex_card_image_, ! (ffelex_max_columns_ << 1) + 1, ffelex_max_columns_ + 1); ! ffelex_max_columns_ <<= 1; ! if (column >= ffelex_max_columns_) ! { ! ffelex_card_image_[column] = '\0'; ! ffelex_card_length_ = column; ! ffelex_bad_1_ (FFEBAD_LINE_TOO_LONG, ffelex_linecount_, ! column + 1); ! goto beginning_of_line_again; /* :::::::::::::::::::: */ ! } ! } ! ffelex_card_image_[column++] = c; ! if (c == '\t') ! column = ffelex_handle_tab_ (column); ! c = getc (f); ! } ! } ! else ! /* Ignore anything past column 72/132. */ { ! while ((c != '\n') && (c != EOF)) ! c = getc (f); ! ! /* Technically, we should now fill ffelex_card_image_ up to column 72/132 with spaces, since character/hollerith constants must count them in that manner. To save CPU time in several ways (avoid a loop --- 325,362 ---- debug-lines option on. */ ! column = ffelex_image_char_ (c, 0); ! /* Read the entire line in as is (with whitespace processing). */ ! while (((c = getc (f)) != '\n') && (c != EOF)) { ! if (column >= ffelex_max_columns_) ! { ! ffewhereColumnNumber newmax = ffelex_max_columns_ << 1; ! if (newmax <= ffelex_max_columns_) ! { /* Overflowed column number. */ ! ffelex_card_image_[column] = '\0'; ! ffelex_card_length_ = column; ! ffelex_bad_1_ (FFEBAD_LINE_TOO_LONG, ffelex_linecount_, ! column + 1); ! goto comment_line; /* :::::::::::::::::::: */ ! } ! ffelex_card_image_ ! = malloc_resize_ksr (malloc_pool_image (), ! ffelex_card_image_, ! newmax + 1, ! ffelex_max_columns_ + 1); ! ffelex_max_columns_ = newmax; } + column = ffelex_image_char_ (c, column); } ! /* If no tab, cut off line after column 72/132. */ ! if (!ffelex_saw_tab_ && (column > ffelex_final_nontab_column_)) { ! /* Technically, we should now fill ffelex_card_image_ up thru column 72/132 with spaces, since character/hollerith constants must count them in that manner. To save CPU time in several ways (avoid a loop *************** beginning_of_line_again: /* :::::::::::: *** 400,403 **** --- 368,372 ---- constant. */ + column = ffelex_final_nontab_column_; } ffelex_card_image_[column] = '\0'; *************** stop_looking: /* :::::::::::::::::::: *** 546,551 **** while ((c = ffelex_card_image_[++column]) == ' ') ; ! if ((c == '\0') || (c == '!') || ((c == '/') ! && (ffelex_card_image_[column + 1] == '*'))) { if (ffelex_strict_ansi_ && (c == '/')) --- 515,522 ---- while ((c = ffelex_card_image_[++column]) == ' ') ; ! if ((c == '\0') ! || (c == '!') ! || ((c == '/') ! && (ffelex_card_image_[column + 1] == '*'))) { if (ffelex_strict_ansi_ && (c == '/')) *************** stop_looking: /* :::::::::::::::::::: *** 582,586 **** column + 1); if ((ffelex_raw_mode_ != 0) ! && (((c = ffelex_card_image_[column + 1]) != '\0') || !saw_tab)) { ++column; --- 553,558 ---- column + 1); if ((ffelex_raw_mode_ != 0) ! && (((c = ffelex_card_image_[column + 1]) != '\0') ! || !ffelex_saw_tab_)) { ++column; *************** stop_looking: /* :::::::::::::::::::: *** 589,594 **** while ((c = ffelex_card_image_[++column]) == ' ') ; ! if ((c == '\0') || (c == '!') || ((c == '/') ! && (ffelex_card_image_[column + 1] == '*'))) { if (ffelex_strict_ansi_ && (c == '/')) --- 561,568 ---- while ((c = ffelex_card_image_[++column]) == ' ') ; ! if ((c == '\0') ! || (c == '!') ! || ((c == '/') ! && (ffelex_card_image_[column + 1] == '*'))) { if (ffelex_strict_ansi_ && (c == '/')) *************** stop_looking: /* :::::::::::::::::::: *** 622,626 **** } if ((ffelex_raw_mode_ != 0) ! && (((c = ffelex_card_image_[column + 1]) != '\0') || !saw_tab)) { ++column; --- 596,601 ---- } if ((ffelex_raw_mode_ != 0) ! && (((c = ffelex_card_image_[column + 1]) != '\0') ! || !ffelex_saw_tab_)) { ++column; *************** stop_looking: /* :::::::::::::::::::: *** 629,634 **** while ((c = ffelex_card_image_[++column]) == ' ') ; ! if ((c == '\0') || (c == '!') || ((c == '/') ! && (ffelex_card_image_[column + 1] == '*'))) { if (ffelex_strict_ansi_ && (c == '/')) --- 604,611 ---- while ((c = ffelex_card_image_[++column]) == ' ') ; ! if ((c == '\0') ! || (c == '!') ! || ((c == '/') ! && (ffelex_card_image_[column + 1] == '*'))) { if (ffelex_strict_ansi_ && (c == '/')) *************** stop_looking: /* :::::::::::::::::::: *** 691,695 **** ffewhereColumnNumber i; ! if (saw_tab || (column >= ffelex_final_nontab_column_)) { if (!ffelex_raw_include_) --- 668,672 ---- ffewhereColumnNumber i; ! if (ffelex_saw_tab_ || (column >= ffelex_final_nontab_column_)) { if (!ffelex_raw_include_) *************** ffelex_file_free (ffewhereFile wf, FILE *** 1412,1418 **** register int c; /* Character currently under consideration. */ register ffewhereColumnNumber column; /* Not really; 0 means column 1... */ - register bool saw_tab; /* True if we saw a tab on the current line. */ - register ffewhereColumnNumber coltemp; /* For lines with initial - blank(s). */ bool continuation_line; ffewhereColumnNumber continuation_column; --- 1389,1392 ---- *************** first_line: /* :::::::::::::::::::: */ *** 1504,1567 **** } ! /* Non-comment character (like a space or digit). Read the whole line in ! very quickly. Stop after reading the character corresponding to the ! last column in the card (72 normally, 132 if extend_source is ! specified). However, if a tab is seen, process it as a typical number of ! tab stops and let the line be as long as it wants. */ ! column = 0; ! saw_tab = FALSE; ! /* Skip over initial spaces and tabs to see if the first nonblank character ! is exclamation point, newline, or EOF (line is therefore a comment) or ! ampersand (line is therefore a continuation line). */ ! while ((c == ' ') || (c == '\t')) { ! column++; ! if (c == '\t') { ! saw_tab = TRUE; ! column = ffelex_handle_tab_ (column); ! } ! c = getc (f); ! } ! ! continuation_column = 0; ! ! switch (c) ! { ! case '!': ! case '\n': ! case EOF: ! goto comment_line; /* :::::::::::::::::::: */ ! ! case '&': ! continuation_column = column + 1; ! /* Fall through. */ ! default: ! for (coltemp = 0; coltemp < column; coltemp++) ! ffelex_card_image_[coltemp] = ' '; ! } ! /* Read with no checking as long as we've got the space (132 columns). This ! is the typical case, so do it as fast as possible. */ ! while ((c != '\n') && (c != EOF) ! && (column < FFELEX_FREE_MAX_COLUMNS_)) ! { ! ffelex_card_image_[column++] = c; ! if (c == '\t') ! { ! saw_tab = TRUE; ! column = ffelex_handle_tab_ (column); } ! c = getc (f); } ! /* Ignore anything past column FFELEX_FREE_MAX_COLUMNS_. */ ! while ((c != '\n') && (c != EOF)) ! c = getc (f); ffelex_card_image_[column] = '\0'; --- 1478,1516 ---- } ! ffelex_saw_tab_ = FALSE; ! column = ffelex_image_char_ (c, 0); ! /* Read the entire line in as is (with whitespace processing). */ ! while (((c = getc (f)) != '\n') && (c != EOF)) { ! if (column >= ffelex_max_columns_) { ! ffewhereColumnNumber newmax = ffelex_max_columns_ << 1; ! if (newmax <= ffelex_max_columns_) ! { /* Overflowed column number. */ ! ffelex_card_image_[column] = '\0'; ! ffelex_card_length_ = column; ! ffelex_bad_1_ (FFEBAD_LINE_TOO_LONG, ffelex_linecount_, ! column + 1); ! goto comment_line; /* :::::::::::::::::::: */ ! } ! ffelex_card_image_ ! = malloc_resize_ksr (malloc_pool_image (), ! ffelex_card_image_, ! newmax + 1, ! ffelex_max_columns_ + 1); ! ffelex_max_columns_ = newmax; } ! column = ffelex_image_char_ (c, column); } ! /* If no tab, cut off line after column 132. */ ! if (!ffelex_saw_tab_ && (column > FFELEX_FREE_MAX_COLUMNS_)) ! column = FFELEX_FREE_MAX_COLUMNS_; ffelex_card_image_[column] = '\0'; *************** first_line: /* :::::::::::::::::::: */ *** 1573,1576 **** --- 1522,1548 ---- last_char_in_file = c; /* Should be either '\n' or EOF. */ + column = 0; + continuation_column = 0; + + /* Skip over initial spaces to see if the first nonblank character + is exclamation point, newline, or EOF (line is therefore a comment) or + ampersand (line is therefore a continuation line). */ + + while ((c = ffelex_card_image_[column]) == ' ') + ++column; + + switch (c) + { + case '!': + case '\0': + goto beginning_of_line; /* :::::::::::::::::::: */ + + case '&': + continuation_column = column + 1; + /* Fall through. */ + default: + break; + } + /* The line definitely has content of some kind, install new end-statement point for error messages. */ *************** first_line: /* :::::::::::::::::::: */ *** 1585,1589 **** if (continuation_line) { - column = continuation_column; if (continuation_column == 0) { --- 1557,1560 ---- *************** first_line: /* :::::::::::::::::::: */ *** 1591,1595 **** { ffelex_bad_1_ (FFEBAD_BAD_CHAR_CONTINUE, ffelex_linecount_, ! coltemp + 1); } else if (ffelex_token_->type != FFELEX_typeNONE) --- 1562,1566 ---- { ffelex_bad_1_ (FFEBAD_BAD_CHAR_CONTINUE, ffelex_linecount_, ! column + 1); } else if (ffelex_token_->type != FFELEX_typeNONE) *************** first_line: /* :::::::::::::::::::: */ *** 1596,1608 **** { ffelex_bad_1_ (FFEBAD_BAD_LEXTOK_CONTINUE, ffelex_linecount_, ! coltemp + 1); } } ! else if (ffelex_is_free_char_ctx_contin_ (column)) { /* Line contains only a single "&" as only nonblank character. */ ! ffelex_bad_1_ (FFEBAD_BAD_FREE_CONTINUE, ffelex_linecount_, column); goto beginning_of_line; /* :::::::::::::::::::: */ } } else --- 1567,1581 ---- { ffelex_bad_1_ (FFEBAD_BAD_LEXTOK_CONTINUE, ffelex_linecount_, ! column + 1); } } ! else if (ffelex_is_free_char_ctx_contin_ (continuation_column)) { /* Line contains only a single "&" as only nonblank character. */ ! ffelex_bad_1_ (FFEBAD_BAD_FREE_CONTINUE, ffelex_linecount_, ! continuation_column); goto beginning_of_line; /* :::::::::::::::::::: */ } + column = continuation_column; } else *************** first_line: /* :::::::::::::::::::: */ *** 1609,1614 **** column = 0; - continuation_line = FALSE; c = ffelex_card_image_[column]; /* Here is the main engine for parsing. c holds the character at column. --- 1582,1587 ---- column = 0; c = ffelex_card_image_[column]; + continuation_line = FALSE; /* Here is the main engine for parsing. c holds the character at column. *************** ffelex_init_1 () *** 2381,2385 **** ffelex_final_nontab_column_ = 72; ffelex_max_columns_ = FFELEX_columnINITIAL_SIZE_; ! ffelex_card_image_ = malloc_new_ksr (malloc_pool_image (), "FFELEX card image", FFELEX_columnINITIAL_SIZE_ + 1); ffelex_card_image_[0] = '\0'; --- 2354,2359 ---- ffelex_final_nontab_column_ = 72; ffelex_max_columns_ = FFELEX_columnINITIAL_SIZE_; ! ffelex_card_image_ = malloc_new_ksr (malloc_pool_image (), ! "FFELEX card image", FFELEX_columnINITIAL_SIZE_ + 1); ffelex_card_image_[0] = '\0'; *************** ffelex_init_1 () *** 2392,2396 **** ffelex_first_char_['\v'] = FFELEX_typeCOMMENT; ffelex_first_char_['\f'] = FFELEX_typeCOMMENT; ! ffelex_first_char_['\r'] = FFELEX_typeCOMMENT; ffelex_first_char_[' '] = FFELEX_typeRAW; ffelex_first_char_['!'] = FFELEX_typeCOMMENT; --- 2366,2370 ---- ffelex_first_char_['\v'] = FFELEX_typeCOMMENT; ffelex_first_char_['\f'] = FFELEX_typeCOMMENT; ! ffelex_first_char_['\r'] = FFELEX_typeRAW; ffelex_first_char_[' '] = FFELEX_typeRAW; ffelex_first_char_['!'] = FFELEX_typeCOMMENT; *************** ffelex_finish_statement_ () *** 3360,3379 **** } ! /* ffelex_handle_tab_ -- Deal with tab in ffelex_card_image_, adjust column number ! ffewhereColumnNumber c; ! c = ffelex_handle_tab_(c); - Assumes a tab is in ffelex_card_image_[c - 1], replaces it with a space and - inserts an appropriate number of subsequent spaces, returning the new - column value. "Appropriate" is to the next tab position, where tab - positions start in column 9 and each eighth column afterwards. - - Overwrite tab with space in ffelex_card_image_. - Calculate how many additional spaces should be written. - Write that many spaces. - Add that number to the column value. - Return the column value. - Columns are numbered and tab stops set as illustrated below: --- 3334,3359 ---- } ! /* "Image" a character onto the card image, return incremented column number. ! Normally invoking this function as in ! column = ffelex_image_char_ (c, column); ! is the same as doing: ! ffelex_card_image_[column++] = c; ! ! However, tabs and carriage returns are handled specially, to preserve ! the visual "image" of the input line (in most editors) in the card ! image. ! ! Carriage returns are ignored, as they are assumed to be followed ! by newlines. ! ! A tab is handled by first doing: ! ffelex_card_image_[column++] = ' '; ! That is, it translates to at least one space. Then, as many spaces ! are imaged as necessary to bring the column number to the next tab ! position, where tab positions start in the ninth column and each ! eighth column afterwards. ALSO, a static var named ffelex_saw_tab_ ! is set to TRUE to notify the lexer that a tab was seen. Columns are numbered and tab stops set as illustrated below: *************** ffelex_finish_statement_ () *** 3383,3412 **** ... xxxxxxx yyyyyyy zzzzzzz ! xxxxxxxx yyyyyyyy... ! ! When this function is called, the column number has already been ! incremented by 1, so it is never zero. We calculate how many more ! spaces are needed, a value with range 0-7 according to the following ! column status: - c % 8: 01234567 - ++: 07654321 */ - static ffewhereColumnNumber ! ffelex_handle_tab_ (ffewhereColumnNumber c) { ! ffewhereColumnNumber spaces; ! ! assert (c != 0); ! ! ffelex_card_image_[c - 1] = ' '; ! spaces = (8 - (c % 8)) % 8; ! assert (spaces < 8); ! while (spaces-- > 0) ! ffelex_card_image_[c++] = ' '; ! return c; } --- 3363,3389 ---- ... xxxxxxx yyyyyyy zzzzzzz ! xxxxxxxx yyyyyyyy... */ static ffewhereColumnNumber ! ffelex_image_char_ (int c, ffewhereColumnNumber column) { ! switch (c) ! { ! case '\r': ! break; ! case '\t': ! ffelex_card_image_[column++] = ' '; ! while ((column & 7) != 0) ! ffelex_card_image_[column++] = ' '; ! break; ! default: ! ffelex_saw_tab_ = TRUE; ! ffelex_card_image_[column++] = c; ! break; ! } ! return column; } diff -rcp2N g77-0.5.8/f/malloc.c g77-0.5.9/f/malloc.c *** g77-0.5.8/f/malloc.c Wed Feb 15 16:58:39 1995 --- g77-0.5.9/f/malloc.c Tue Feb 21 13:38:24 1995 *************** malloc_kill_area_ (mallocPool pool, mall *** 98,102 **** pool->freed += s; pool->frees++; ! malloc_kill_ (a, sizeof (*a)); } --- 98,104 ---- pool->freed += s; pool->frees++; ! malloc_kill_ (a, ! offsetof (struct _malloc_area_, name) ! + strlen (a->name) + 1); } *************** malloc_pool_kill (mallocPool p) *** 191,195 **** /* Finally, free the pool itself. */ ! malloc_kill_ (p, sizeof (*p)); } --- 193,199 ---- /* Finally, free the pool itself. */ ! malloc_kill_ (p, ! offsetof (struct _malloc_pool_, name) ! + strlen (p->name) + 1); } *************** malloc_pool_new (char *name, mallocPool *** 209,213 **** parent = malloc_pool_image (); ! p = malloc_new_ (sizeof (*p) + strlen (name) + 1 - MALLOC_ARRAY_ZERO_SIZE); p->next = (mallocPool) & (parent->eldest); p->previous = parent->youngest; --- 213,217 ---- parent = malloc_pool_image (); ! p = malloc_new_ (offsetof (struct _malloc_pool_, name) + strlen (name) + 1); p->next = (mallocPool) & (parent->eldest); p->previous = parent->youngest; *************** malloc_new_inpool_ (mallocPool pool, mal *** 351,355 **** ptr = malloc_new_ (s + (i = strlen (name) + 1)); strcpy (((char *) (ptr)) + s, name); ! a = malloc_new_ (sizeof (*a) + i - MALLOC_ARRAY_ZERO_SIZE); switch (type) { /* A little optimization to speed up killing --- 355,359 ---- ptr = malloc_new_ (s + (i = strlen (name) + 1)); strcpy (((char *) (ptr)) + s, name); ! a = malloc_new_ (offsetof (struct _malloc_area_, name) + i); switch (type) { /* A little optimization to speed up killing diff -rcp2N g77-0.5.8/f/malloc.h g77-0.5.9/f/malloc.h *** g77-0.5.8/f/malloc.h Thu Feb 16 21:42:52 1995 --- g77-0.5.9/f/malloc.h Tue Feb 21 13:38:24 1995 *************** the Free Software Foundation, 675 Mass A *** 32,46 **** /* Simple definitions and enumerations. */ - #if 0 - #define MALLOC_ARRAY_ZERO - #define MALLOC_ARRAY_ZERO_SIZE 0 - #elif 1 - #define MALLOC_ARRAY_ZERO 0 - #define MALLOC_ARRAY_ZERO_SIZE 0 - #elif 0 - #define MALLOC_ARRAY_ZERO 1 - #define MALLOC_ARRAY_ZERO_SIZE 1 - #endif - typedef enum { --- 32,35 ---- *************** struct _malloc_area_ *** 73,77 **** mallocSize size; mallocType_ type; ! char name[MALLOC_ARRAY_ZERO]; }; --- 62,66 ---- mallocSize size; mallocType_ type; ! char name[1]; }; *************** struct _malloc_pool_ *** 92,96 **** unsigned long resizes; unsigned long uses; ! char name[MALLOC_ARRAY_ZERO]; }; --- 81,85 ---- unsigned long resizes; unsigned long uses; ! char name[1]; }; diff -rcp2N g77-0.5.8/f/proj.h.in g77-0.5.9/f/proj.h.in *** g77-0.5.8/f/proj.h.in Wed Feb 15 16:58:39 1995 --- g77-0.5.9/f/proj.h.in Tue Feb 21 13:38:24 1995 *************** typedef enum *** 142,147 **** #define ARRAY_SIZE(a) (sizeof(a)/sizeof(a[0])) - #define ARRAY_ZERO 0 /* nil, 0, or 1. */ - #define ARRAY_ZERO_SIZE 0 /* 0, 0, or 1, but not fully supported yet. */ #if defined(__STDC__) #define STR(s) # s --- 142,145 ---- diff -rcp2N g77-0.5.8/f/ste.c g77-0.5.9/f/ste.c *** g77-0.5.8/f/ste.c Wed Feb 15 16:58:38 1995 --- g77-0.5.9/f/ste.c Tue Feb 21 13:38:25 1995 *************** ffeste_io_cilist_ (bool have_err, *** 1099,1103 **** case FFESTV_formatINTEXPR: formatinit = null_pointer_node; ! formatexp = ffecom_expr (format_spec->u.expr); break; --- 1099,1108 ---- case FFESTV_formatINTEXPR: formatinit = null_pointer_node; ! formatexp = ffecom_expr_assign (format_spec->u.expr); ! if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (formatexp))) ! < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node)))) ! error ("Cannot safely convert to assigned-FORMAT an expression\ ! narrower than a pointer"); ! formatexp = convert (string_type_node, formatexp); break; *************** ffeste_io_icilist_ (bool have_err, *** 1418,1422 **** case FFESTV_formatINTEXPR: formatinit = null_pointer_node; ! formatexp = ffecom_expr (format_spec->u.expr); break; --- 1423,1432 ---- case FFESTV_formatINTEXPR: formatinit = null_pointer_node; ! formatexp = ffecom_expr_assign (format_spec->u.expr); ! if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (formatexp))) ! < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node)))) ! error ("Cannot safely convert to assigned-FORMAT an expression\ ! narrower than a pointer"); ! formatexp = convert (string_type_node, formatexp); break; *************** ffeste_R838 (ffelab label, ffebld target *** 2788,2800 **** label_tree); TREE_CONSTANT (label_tree) = 1; ! target_tree = ffecom_expr_rw (target); ! /* Make sure variable can hold the entire pointer, or we're ! in trouble. Someday this should be a diagnostic, or better ! yet, choice of an alternate implementation that just produces ! correct code (e.g. an enumeration of possible target labels ! and use of a switch statement when GOTO is seen). */ if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (target_tree))) < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (label_tree)))) ! fatal ("Cannot ASSIGN wide pointer to label to narrower variable"); expr_tree = ffecom_modify (void_type_node, target_tree, --- 2798,2807 ---- label_tree); TREE_CONSTANT (label_tree) = 1; ! target_tree = ffecom_expr_assign_w (target); if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (target_tree))) < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (label_tree)))) ! error ("Cannot safely ASSIGN to an target narrower than a\ ! label-pointer"); ! label_tree = convert (TREE_TYPE (target_tree), label_tree); expr_tree = ffecom_modify (void_type_node, target_tree, *************** ffeste_R839 (ffebld target) *** 2828,2838 **** #else #if FFECOM_targetCURRENT == FFECOM_targetGCC ! ffeste_emit_line_note_ (); ! ffecom_push_calltemps (); ! expand_computed_goto (ffecom_expr (target)); ! ffecom_pop_calltemps (); ! clear_momentary (); #endif #endif --- 2835,2853 ---- #else #if FFECOM_targetCURRENT == FFECOM_targetGCC ! { ! tree t; ! ffeste_emit_line_note_ (); ! ffecom_push_calltemps (); ! t = ffecom_expr_assign (target); ! if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (t))) ! < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node)))) ! error ("Cannot safely GOTO an expression narrower than a pointer"); ! expand_computed_goto (convert (TREE_TYPE (null_pointer_node), t)); ! ! ffecom_pop_calltemps (); ! clear_momentary (); ! } #endif #endif diff -rcp2N g77-0.5.8/f/where.c g77-0.5.9/f/where.c *** g77-0.5.8/f/where.c Wed Feb 15 16:58:36 1995 --- g77-0.5.9/f/where.c Tue Feb 21 13:38:25 1995 *************** void *** 154,158 **** ffewhere_file_kill (ffewhereFile wf) { ! malloc_kill_ks (ffe_pool_file (), wf, sizeof (*wf) + wf->length + 1); } --- 154,160 ---- ffewhere_file_kill (ffewhereFile wf) { ! malloc_kill_ks (ffe_pool_file (), wf, ! offsetof (struct _ffewhere_file_, text) ! + wf->length + 1); } *************** ffewhere_file_new (char *name, size_t le *** 165,169 **** wf = malloc_new_ks (ffe_pool_file (), "ffewhereFile", ! sizeof (*wf) + length + 1); wf->length = length; memcpy (&wf->text[0], name, length); --- 167,172 ---- wf = malloc_new_ks (ffe_pool_file (), "ffewhereFile", ! offsetof (struct _ffewhere_file_, text) ! + length + 1); wf->length = length; memcpy (&wf->text[0], name, length); *************** ffewhere_line_kill (ffewhereLine wl) *** 274,278 **** wl->previous->next = wl->next; wl->next->previous = wl->previous; ! malloc_kill_ks (ffe_pool_file (), wl, sizeof (*wl) + wl->length + 1); } } --- 277,283 ---- wl->previous->next = wl->next; wl->next->previous = wl->previous; ! malloc_kill_ks (ffe_pool_file (), wl, ! offsetof (struct _ffewhere_line_, content) ! + wl->length + 1); } } *************** ffewhere_line_new (ffewhereLineNumber ln *** 303,307 **** #endif wl = malloc_new_ks (ffe_pool_file (), "FFEWHERE line", ! sizeof (*wl) + ffelex_line_length () + 1); wl->next = (ffewhereLine) &ffewhere_root_line_; wl->previous = ffewhere_root_line_.last; --- 308,313 ---- #endif 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; *************** ffewhere_line_new (ffewhereLineNumber ln *** 340,344 **** ln); ! wl = malloc_new_ks (ffe_pool_file (), "FFEWHERE line", sizeof (*wl) + 1); wl->next = (ffewhereLine) &ffewhere_root_line_; wl->previous = ffewhere_root_line_.last; --- 346,352 ---- ln); ! wl = malloc_new_ks (ffe_pool_file (), "FFEWHERE line", ! offsetof (struct _ffewhere_line_, content) ! + 1); wl->next = (ffewhereLine) &ffewhere_root_line_; wl->previous = ffewhere_root_line_.last; diff -rcp2N g77-0.5.8/f/where.h g77-0.5.9/f/where.h *** g77-0.5.8/f/where.h Thu Feb 16 21:42:52 1995 --- g77-0.5.9/f/where.h Tue Feb 21 13:38:25 1995 *************** struct _ffewhere_file_ *** 69,73 **** { size_t length; ! char text[ARRAY_ZERO]; }; --- 69,73 ---- { size_t length; ! char text[1]; }; *************** struct _ffewhere_line_ *** 79,83 **** ffewhereUses_ uses; ffewhereLength_ length; ! char content[ARRAY_ZERO]; }; --- 79,83 ---- ffewhereUses_ uses; ffewhereLength_ length; ! char content[1]; }; diff -rcp2N g77-0.5.8/f/zzz.c g77-0.5.9/f/zzz.c *** g77-0.5.8/f/zzz.c Fri Feb 17 03:52:05 1995 --- g77-0.5.9/f/zzz.c Sat Feb 18 10:06:20 1995 *************** the Free Software Foundation, 675 Mass A *** 36,40 **** /* Externals defined here. */ ! char *ffezzz_version_string = "0.5.8"; char *ffezzz_date = __DATE__; char *ffezzz_time = __TIME__; --- 36,40 ---- /* Externals defined here. */ ! char *ffezzz_version_string = "0.5.9"; char *ffezzz_date = __DATE__; char *ffezzz_time = __TIME__;