diff -rcp2N g77-0.5.12/README.g77 g77-0.5.13/README.g77 *** g77-0.5.12/README.g77 Thu Feb 23 13:33:50 1995 --- g77-0.5.13/README.g77 Sat Feb 25 18:31:18 1995 *************** *** 1,5 **** ! 950224 ! This directory contains the version 0.5.12 release of the GNU Fortran compiler. The GNU Fortran compiler is free software. See the file COPYING.g77 for copying permission. --- 1,5 ---- ! 950225 ! This directory contains the version 0.5.13 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.11 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.13 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.11.tar # Creates ./g77-0.5.11/ ! * # mv g77-0.5.11/* gcc-2.6.3/ # Merges gcc and g77 into ./gcc-2.6.3/ ! # rmdir g77-0.5.11 # Remove empty ./g77-0.5.11/ 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.13.tar # Creates ./g77-0.5.13/ ! * # mv g77-0.5.13/* gcc-2.6.3/ # Merges gcc and g77 into ./gcc-2.6.3/ ! # rmdir g77-0.5.13 # Remove empty ./g77-0.5.13/ 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.11 # Make g77-0.5.11 a link to gcc-2.6.3 ! # tar xf g77-0.5.11.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.13 # Make g77-0.5.13 a link to gcc-2.6.3 ! # tar xf g77-0.5.13.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.11/: 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.13/: gcc/ Non-Fortran files in gcc (not part of g77*.tar) diff -rcp2N g77-0.5.12/f/ChangeLog g77-0.5.13/f/ChangeLog *** g77-0.5.12/f/ChangeLog Thu Feb 23 13:33:21 1995 --- g77-0.5.13/f/ChangeLog Sat Feb 25 18:30:30 1995 *************** *** 1,2 **** --- 1,56 ---- + Fri Feb 24 16:21:31 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.13 released. + + * INSTALL: Warn that f/zzz.o will compare differently between + stages, since it puts the __TIME__ macro into a string. + + * com.c (ffecom_sym_transform_): Transform kindFUNCTION/whereDUMMY + to pointer-to-function, not function. + (ffecom_expr_): Use ffecom_arg_ptr_to_expr instead of + ffecom_char_args_ to handle comparison between CHARACTER + types, so either operand can be a CONCATENATE. + (ffecom_transform_common_): Set size of initialized common area + to global (largest-known) size, even though size of init might + be smaller. + + * equiv.c (ffeequiv_offset_): Check symbol info for ANY. + + * expr.c (ffeexpr_find_close_paren_, ffeexpr_nil_*): New functions + to handle following the contour of a rejected expression, so + statements like "PRINT(I,I,I)=0" don't cause the PRINT statement + code to get the second passed back to it as if there was a + missing close-paren before it, the comma causing the PRINT code + to confirm the statement, resulting in an ambiguity vis-a-vis + the let statement code. + Use the new ffecom_find_close_paren_ handler when an expected + close-paren is missing. + (ffeexpr_isdigits_): New function, use in all places that + currently use isdigit in repetitive code. + (ffeexpr_collapse_symter): Collapse to ANY if init-expr is ANY, + so as to avoid having symbol get "transformed" if used to + dimension an array. + (ffeexpr_token_real_, ffeexpr_token_number_real_): Don't issue + diagnostic about exponent, since it'll be passed along the + handler path, resulting in a diagnostic anyway. + (ffeexpr_token_apos_char_): Use consistent handler path + regardless of whether diagnostics inhibited. + (ffeexpr_token_name_apos_name_): Skip past closing quote/apos + even if not a match or other diagnostic issued. + (ffeexpr_sym_impdoitem_): Exec-transition local SEEN symbol. + + * lex.c (ffelex_image_char_): Set ffelex_saw_tab_ if TAB + seen, not if anything other than TAB seen! + + * stc.c (ffestc_R537_item): If source is ANY but dest isn't, + set dest symbol's init expr to ANY. + (ffestc_R501_attrib, ffestc_R522, ffestc_R522start): Complain + about conflict between "SAVE" by itself and other uses of + SAVE only in pedantic mode. + + * ste.c (ffeste_R1212): Fix loop over labels to always + increment caseno, to avoid pushcase returning 2 for duplicate + values when one of the labels is invalid. + Thu Feb 23 12:42:04 1995 Craig Burley (burley@gnu.ai.mit.edu) diff -rcp2N g77-0.5.12/f/INSTALL g77-0.5.13/f/INSTALL *** g77-0.5.12/f/INSTALL Wed Feb 22 16:20:08 1995 --- g77-0.5.13/f/INSTALL Sat Feb 25 18:30:30 1995 *************** notice and permission notice. Contribut *** 5,9 **** (burley@gnu.ai.mit.edu). ! 950222 Here are the steps that seem important to take before doing any builds: --- 5,9 ---- (burley@gnu.ai.mit.edu). ! 950225 Here are the steps that seem important to take before doing any builds: *************** Here are the steps that seem important t *** 41,44 **** --- 41,51 ---- 3. Follow the directions in the INSTALL file in the gcc source tree (such as running ./configure, doing "make", and so on). + + WARNING: If you follow the procedure to build successive "stages" + and you compare the object files produced by various stages, + the file f/zzz.o WILL be different. That is because it + contains a string with an expansion of the __TIME__ macro, + which expands to the current time of day. It is nothing + to worry about, since f/zzz.c doesn't contain any actual code. NOTE: Configuring with the --srcdir argument is only known diff -rcp2N g77-0.5.12/f/bad.def g77-0.5.13/f/bad.def *** g77-0.5.12/f/bad.def Thu Feb 23 04:38:40 1995 --- g77-0.5.13/f/bad.def Sat Feb 25 18:30:30 1995 *************** FFEBAD_MSGS (FFEBAD_TYPE_WRONG_NAME, FAT *** 260,264 **** FFEBAD_MSGS (FFEBAD_EOF_BEFORE_BLOCK_END, FATAL, "End of source file before end of block started at %0", "End of source file before end of block started at %0") FFEBAD_MSGS (FFEBAD_UNDEF_LABEL, FATAL, "Undefined label, first referenced at %0", "Undefined label, first referenced at %0") ! FFEBAD_MSGS (FFEBAD_CONFLICTING_SAVES, FATAL, "SAVE statement or attribute at %1 cannot be specified along with SAVE statement or attribute at %0", "SAVE statement or attribute at %1 cannot be specified along with SAVE statement or attribute at %0") FFEBAD_MSGS (FFEBAD_CONFLICTING_ACCESSES, FATAL, "PUBLIC or PRIVATE statement at %1 cannot be specified along with PUBLIC or PRIVATE statement at %0", "PUBLIC or PRIVATE statement at %1 cannot be specified along with PUBLIC or PRIVATE statement at %0") FFEBAD_MSGS (FFEBAD_RETURN_IN_MAIN, FATAL, "RETURN statement at %0 invalid within a main program unit", "RETURN statement at %0 invalid within a main program unit") --- 260,264 ---- FFEBAD_MSGS (FFEBAD_EOF_BEFORE_BLOCK_END, FATAL, "End of source file before end of block started at %0", "End of source file before end of block started at %0") FFEBAD_MSGS (FFEBAD_UNDEF_LABEL, FATAL, "Undefined label, first referenced at %0", "Undefined label, first referenced at %0") ! FFEBAD_MSGS (FFEBAD_CONFLICTING_SAVES, WARN, "SAVE statement or attribute at %1 cannot be specified along with SAVE statement or attribute at %0", "SAVE statement or attribute at %1 cannot be specified along with SAVE statement or attribute at %0") FFEBAD_MSGS (FFEBAD_CONFLICTING_ACCESSES, FATAL, "PUBLIC or PRIVATE statement at %1 cannot be specified along with PUBLIC or PRIVATE statement at %0", "PUBLIC or PRIVATE statement at %1 cannot be specified along with PUBLIC or PRIVATE statement at %0") FFEBAD_MSGS (FFEBAD_RETURN_IN_MAIN, FATAL, "RETURN statement at %0 invalid within a main program unit", "RETURN statement at %0 invalid within a main program unit") diff -rcp2N g77-0.5.12/f/com.c g77-0.5.13/f/com.c *** g77-0.5.12/f/com.c Thu Feb 23 13:33:23 1995 --- g77-0.5.13/f/com.c Sat Feb 25 18:30:31 1995 *************** ffecom_expr_ (ffebld expr, tree dest_tre *** 2394,2399 **** right = ffebld_left (right); ! ffecom_char_args_ (&left_tree, &left_length, left); ! ffecom_char_args_ (&right_tree, &right_length, right); if (left_tree == error_mark_node || left_length == error_mark_node --- 2394,2399 ---- right = ffebld_left (right); ! left_tree = ffecom_arg_ptr_to_expr (left, &left_length); ! right_tree = ffecom_arg_ptr_to_expr (right, &right_length); if (left_tree == error_mark_node || left_length == error_mark_node *************** ffecom_sym_transform_ (ffesymbol s) *** 6577,6583 **** if (ffesymbol_is_f2c (s) && (ffesymbol_where (s) != FFEINFO_whereCONSTANT)) ! t = ffecom_tree_fun_type[bt][kt]; else ! t = build_function_type (ffecom_tree_type[bt][kt], NULL_TREE); t = build_decl (PARM_DECL, --- 6577,6584 ---- if (ffesymbol_is_f2c (s) && (ffesymbol_where (s) != FFEINFO_whereCONSTANT)) ! t = ffecom_tree_ptr_to_fun_type[bt][kt]; else ! t = build_pointer_type ! (build_function_type (ffecom_tree_type[bt][kt], NULL_TREE)); t = build_decl (PARM_DECL, *************** ffecom_transform_common_ (ffesymbol s) *** 6969,6980 **** end_temporary_allocation (); if (cbt == NULL_TREE) { - if (init) - /* Make a permanent copy of the initializer's type. */ - cbtype = ffecom_type_permanent_copy_ (TREE_TYPE (init)); - else - cbtype = build_array_type (char_type_node, NULL_TREE); - cbt = build_decl (VAR_DECL, --- 6970,6987 ---- end_temporary_allocation (); + /* cbtype must be permanently allocated! */ + + if (init) + cbtype = build_array_type (char_type_node, + build_range_type (integer_type_node, + integer_one_node, + build_int_2 + (ffeglobal_size (g), + 0))); + else + cbtype = build_array_type (char_type_node, NULL_TREE); + if (cbt == NULL_TREE) { cbt = build_decl (VAR_DECL, *************** ffecom_transform_common_ (ffesymbol s) *** 6990,6996 **** { assert (init); - - /* Make a permanent copy of the initializer's type. */ - cbtype = ffecom_type_permanent_copy_ (TREE_TYPE (init)); TREE_TYPE (cbt) = cbtype; --- 6997,7000 ---- diff -rcp2N g77-0.5.12/f/equiv.c g77-0.5.13/f/equiv.c *** g77-0.5.12/f/equiv.c Wed Feb 15 16:58:41 1995 --- g77-0.5.13/f/equiv.c Sat Feb 25 18:30:31 1995 *************** again: /* :::::::::::::::::::: */ *** 395,398 **** --- 395,400 ---- sym = ffebld_symter (expr); + if (ffesymbol_basictype (sym) == FFEINFO_basictypeANY) + return FALSE; if (value < 0) *************** again: /* :::::::::::::::::::: */ *** 455,458 **** --- 457,463 ---- sym = ffebld_symter (symexp); + if (ffesymbol_basictype (sym) == FFEINFO_basictypeANY) + return FALSE; + if (ffesymbol_size (sym) == FFETARGET_charactersizeNONE) width = 1; *************** again: /* :::::::::::::::::::: */ *** 549,552 **** --- 554,561 ---- else sym = NULL; + + if ((sym != NULL) + && (ffesymbol_basictype (sym) == FFEINFO_basictypeANY)) + return FALSE; if (begin == NULL) diff -rcp2N g77-0.5.12/f/expr.c g77-0.5.13/f/expr.c *** g77-0.5.12/f/expr.c Thu Feb 23 04:38:46 1995 --- g77-0.5.13/f/expr.c Sat Feb 25 18:30:34 1995 *************** struct _ffeexpr_stack_ *** 228,231 **** --- 228,238 ---- }; + struct _ffeexpr_find_ + { + ffelexToken t; + ffelexHandler after; + int level; + }; + /* Static objects accessed by functions in this module. */ *************** static long ffeexpr_hollerith_count_; /* *** 236,239 **** --- 243,247 ---- static int ffeexpr_level_; /* Level of DATA implied-DO construct. */ static bool ffeexpr_is_substr_ok_; /* If OPEN_PAREN as binary "op" ok. */ + static struct _ffeexpr_find_ ffeexpr_find_; /* Static functions (internal). */ *************** static ffeexprContext ffeexpr_context_ou *** 277,280 **** --- 285,289 ---- static ffeexprDotdot_ ffeexpr_dotdot_ (ffelexToken t); static ffeexprExpr_ ffeexpr_expr_new_ (void); + static bool ffeexpr_isdigits_ (char *p); static ffelexHandler ffeexpr_token_first_lhs_ (ffelexToken t); static ffelexHandler ffeexpr_token_first_lhs_1_ (ffelexToken t); *************** static ffebld ffeexpr_reduced_ugly2_ (ff *** 316,319 **** --- 325,360 ---- static ffebld ffeexpr_reduced_ugly2log_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op, ffeexprExpr_ r); + static ffelexHandler ffeexpr_find_close_paren_ (ffelexToken t, + ffelexHandler after); + static ffelexHandler ffeexpr_nil_finished_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_rhs_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_period_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_end_period_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_swallow_period_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_real_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_real_exponent_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_real_exp_sign_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_number_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_number_exponent_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_number_exp_sign_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_number_period_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_number_per_exp_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_number_real_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_num_per_exp_sign_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_number_real_exp_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_num_real_exp_sn_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_binary_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_binary_period_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_binary_end_per_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_binary_sw_per_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_quote_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_apostrophe_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_apos_char_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_name_rhs_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_name_apos_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_name_apos_name_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_percent_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_percent_name_ (ffelexToken t); + static ffelexHandler ffeexpr_nil_substrp_ (ffelexToken t); static ffelexHandler ffeexpr_finished_ (ffelexToken t); static ffebld ffeexpr_finished_ambig_ (ffelexToken t, ffebld expr); *************** ffeexpr_collapse_symter (ffebld expr, ff *** 6452,6457 **** return expr; /* A PARAMETER lhs in progress. */ ! if (ffebld_op (r) != FFEBLD_opCONTER) ! return expr; bt = ffeinfo_basictype (ffebld_info (r)); --- 6493,6507 ---- return expr; /* A PARAMETER lhs in progress. */ ! switch (ffebld_op (r)) ! { ! case FFEBLD_opCONTER: ! break; ! ! case FFEBLD_opANY: ! return r; ! ! default: ! return expr; ! } bt = ffeinfo_basictype (ffebld_info (r)); *************** ffeexpr_cb_close_paren_ (ffelexToken ft, *** 6990,6994 **** } ! return (ffelexHandler) ffeexpr_token_binary_ (t); } --- 7040,7047 ---- } ! return ! (ffelexHandler) ffeexpr_find_close_paren_ (t, ! (ffelexHandler) ! ffeexpr_token_binary_); } *************** ffeexpr_cb_comma_c_ (ffelexToken ft, ffe *** 7359,7363 **** } ! return (ffelexHandler) ffeexpr_token_binary_ (t); } --- 7412,7419 ---- } ! return ! (ffelexHandler) ffeexpr_find_close_paren_ (t, ! (ffelexHandler) ! ffeexpr_token_binary_); } *************** ffeexpr_cb_end_loc_ (ffelexToken ft, ffe *** 7839,7843 **** ffelex_token_kill (ffeexpr_stack_->tokens[1]); ! return (ffelexHandler) ffeexpr_token_binary_ (t); } --- 7895,7902 ---- ffelex_token_kill (ffeexpr_stack_->tokens[1]); ! return ! (ffelexHandler) ffeexpr_find_close_paren_ (t, ! (ffelexHandler) ! ffeexpr_token_binary_); } *************** ffeexpr_cb_end_notloc_ (ffelexToken ft, *** 7953,7957 **** ffelex_token_kill (ffeexpr_stack_->tokens[1]); ! return (ffelexHandler) ffeexpr_token_binary_ (t); } --- 8012,8019 ---- ffelex_token_kill (ffeexpr_stack_->tokens[1]); ! return ! (ffelexHandler) ffeexpr_find_close_paren_ (t, ! (ffelexHandler) ! ffeexpr_cb_end_notloc_1_); } *************** ffeexpr_cb_end_notloc_1_ (ffelexToken t) *** 8026,8030 **** ffelex_token_kill (ffeexpr_stack_->tokens[1]); ! return (ffelexHandler) ffeexpr_token_binary_ (t); } --- 8088,8093 ---- ffelex_token_kill (ffeexpr_stack_->tokens[1]); ! return ! (ffelexHandler) ffeexpr_token_binary_ (t); } *************** ffeexpr_expr_new_ () *** 9125,9128 **** --- 9188,9202 ---- } + /* Check whether rest of string is all decimal digits. */ + + static bool + ffeexpr_isdigits_ (char *p) + { + for (; *p != '\0'; ++p) + if (!isdigit (*p)) + return FALSE; + return TRUE; + } + /* ffeexpr_exprstack_push_ -- Push an arbitrary expression object onto the stack *************** ffeexpr_reduced_ugly2log_ (ffebld reduce *** 11005,11008 **** --- 11079,11653 ---- } + /* Fumble through tokens until a nonmatching CLOSE_PAREN, EOS, or SEMICOLON + is found. + + The idea is to process the tokens as they would be done by normal + expression processing, with the key things being telling the lexer + when hollerith/character constants are about to happen, until the + true closing token is found. */ + + static ffelexHandler + ffeexpr_find_close_paren_ (ffelexToken t, + ffelexHandler after) + { + ffeexpr_find_.after = after; + ffeexpr_find_.level = 1; + return (ffelexHandler) ffeexpr_nil_rhs_ (t); + } + + static ffelexHandler + ffeexpr_nil_finished_ (ffelexToken t) + { + switch (ffelex_token_type (t)) + { + case FFELEX_typeCLOSE_PAREN: + if (--ffeexpr_find_.level == 0) + return (ffelexHandler) ffeexpr_find_.after; + return (ffelexHandler) ffeexpr_nil_binary_; + + case FFELEX_typeCOMMA: + case FFELEX_typeCOLON: + case FFELEX_typeEQUALS: + case FFELEX_typePOINTS: + return (ffelexHandler) ffeexpr_nil_rhs_; + + default: + if (--ffeexpr_find_.level == 0) + return (ffelexHandler) ffeexpr_find_.after (t); + return (ffelexHandler) ffeexpr_nil_rhs_ (t); + } + } + + static ffelexHandler + ffeexpr_nil_rhs_ (ffelexToken t) + { + switch (ffelex_token_type (t)) + { + case FFELEX_typeQUOTE: + if (ffe_is_vxt_not_90 ()) + return (ffelexHandler) ffeexpr_nil_quote_; + ffelex_set_expecting_hollerith (-1, FALSE, '\"', + ffelex_token_where_line (t), + ffelex_token_where_column (t)); + return (ffelexHandler) ffeexpr_nil_apostrophe_; + + case FFELEX_typeAPOSTROPHE: + ffelex_set_expecting_hollerith (-1, + (ffeexpr_stack_->context == FFEEXPR_contextINCLUDE), '\'', + ffelex_token_where_line (t), ffelex_token_where_column (t)); + return (ffelexHandler) ffeexpr_nil_apostrophe_; + + case FFELEX_typePERCENT: + return (ffelexHandler) ffeexpr_nil_percent_; + + case FFELEX_typeOPEN_PAREN: + ++ffeexpr_find_.level; + return (ffelexHandler) ffeexpr_nil_rhs_; + + case FFELEX_typePLUS: + case FFELEX_typeMINUS: + return (ffelexHandler) ffeexpr_nil_rhs_; + + case FFELEX_typePERIOD: + return (ffelexHandler) ffeexpr_nil_period_; + + case FFELEX_typeNUMBER: + ffeexpr_hollerith_count_ = atol (ffelex_token_text (t)); + if (ffeexpr_hollerith_count_ > 0) + ffelex_set_expecting_hollerith (ffeexpr_hollerith_count_, + FALSE, + '\0', + ffelex_token_where_line (t), + ffelex_token_where_column (t)); + return (ffelexHandler) ffeexpr_nil_number_; + + case FFELEX_typeNAME: + case FFELEX_typeNAMES: + return (ffelexHandler) ffeexpr_nil_name_rhs_; + + case FFELEX_typeASTERISK: + case FFELEX_typeSLASH: + case FFELEX_typePOWER: + case FFELEX_typeCONCAT: + case FFELEX_typeREL_EQ: + case FFELEX_typeREL_NE: + case FFELEX_typeREL_LE: + case FFELEX_typeREL_GE: + return (ffelexHandler) ffeexpr_nil_rhs_; + + default: + return (ffelexHandler) ffeexpr_nil_finished_ (t); + } + } + + static ffelexHandler + ffeexpr_nil_period_ (ffelexToken t) + { + switch (ffelex_token_type (t)) + { + case FFELEX_typeNAME: + case FFELEX_typeNAMES: + ffeexpr_current_dotdot_ = ffeexpr_dotdot_ (t); + switch (ffeexpr_current_dotdot_) + { + case FFEEXPR_dotdotNONE_: + return (ffelexHandler) ffeexpr_nil_rhs_ (t); + + case FFEEXPR_dotdotTRUE_: + case FFEEXPR_dotdotFALSE_: + case FFEEXPR_dotdotNOT_: + return (ffelexHandler) ffeexpr_nil_end_period_; + + default: + return (ffelexHandler) ffeexpr_nil_swallow_period_; + } + break; /* Nothing really reaches here. */ + + case FFELEX_typeNUMBER: + return (ffelexHandler) ffeexpr_nil_real_; + + default: + return (ffelexHandler) ffeexpr_nil_rhs_ (t); + } + } + + static ffelexHandler + ffeexpr_nil_end_period_ (ffelexToken t) + { + switch (ffeexpr_current_dotdot_) + { + case FFEEXPR_dotdotNOT_: + if (ffelex_token_type (t) != FFELEX_typePERIOD) + return (ffelexHandler) ffeexpr_nil_rhs_ (t); + return (ffelexHandler) ffeexpr_nil_rhs_; + + case FFEEXPR_dotdotTRUE_: + case FFEEXPR_dotdotFALSE_: + if (ffelex_token_type (t) != FFELEX_typePERIOD) + return (ffelexHandler) ffeexpr_nil_binary_ (t); + return (ffelexHandler) ffeexpr_nil_binary_; + + default: + assert ("Bad [nil] unary dotdot in ffeexpr_current_dotdot_" == NULL); + exit (0); + return NULL; + } + } + + static ffelexHandler + ffeexpr_nil_swallow_period_ (ffelexToken t) + { + if (ffelex_token_type (t) != FFELEX_typePERIOD) + return (ffelexHandler) ffeexpr_nil_rhs_ (t); + return (ffelexHandler) ffeexpr_nil_rhs_; + } + + static ffelexHandler + ffeexpr_nil_real_ (ffelexToken t) + { + char d; + char *p; + + if (((ffelex_token_type (t) != FFELEX_typeNAME) + && (ffelex_token_type (t) != FFELEX_typeNAMES)) + || !(((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))), + 'D', 'd') + || ffesrc_char_match_init (d, 'E', 'e') + || ffesrc_char_match_init (d, 'Q', 'q'))) + && ffeexpr_isdigits_ (++p))) + return (ffelexHandler) ffeexpr_nil_binary_ (t); + + if (*p == '\0') + return (ffelexHandler) ffeexpr_nil_real_exponent_; + return (ffelexHandler) ffeexpr_nil_binary_; + } + + static ffelexHandler + ffeexpr_nil_real_exponent_ (ffelexToken t) + { + if ((ffelex_token_type (t) != FFELEX_typePLUS) + && (ffelex_token_type (t) != FFELEX_typeMINUS)) + return (ffelexHandler) ffeexpr_nil_binary_ (t); + + return (ffelexHandler) ffeexpr_nil_real_exp_sign_; + } + + static ffelexHandler + ffeexpr_nil_real_exp_sign_ (ffelexToken t) + { + if (ffelex_token_type (t) != FFELEX_typeNUMBER) + return (ffelexHandler) ffeexpr_nil_binary_ (t); + return (ffelexHandler) ffeexpr_nil_binary_; + } + + static ffelexHandler + ffeexpr_nil_number_ (ffelexToken t) + { + char d; + char *p; + + if (ffeexpr_hollerith_count_ > 0) + ffelex_set_expecting_hollerith (0, FALSE, '\0', ffewhere_line_unknown (), + ffewhere_column_unknown ()); + + switch (ffelex_token_type (t)) + { + case FFELEX_typeNAME: + case FFELEX_typeNAMES: + if ((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))), + 'D', 'd') + || ffesrc_char_match_init (d, 'E', 'e') + || ffesrc_char_match_init (d, 'Q', 'q')) + && ffeexpr_isdigits_ (++p)) + { + if (*p == '\0') + { + ffeexpr_find_.t = ffelex_token_use (t); + return (ffelexHandler) ffeexpr_nil_number_exponent_; + } + return (ffelexHandler) ffeexpr_nil_binary_; + } + break; + + case FFELEX_typePERIOD: + ffeexpr_find_.t = ffelex_token_use (t); + return (ffelexHandler) ffeexpr_nil_number_period_; + + case FFELEX_typeHOLLERITH: + return (ffelexHandler) ffeexpr_nil_binary_; + + default: + break; + } + return (ffelexHandler) ffeexpr_nil_binary_ (t); + } + + /* Expects ffeexpr_find_.t. */ + + static ffelexHandler + ffeexpr_nil_number_exponent_ (ffelexToken t) + { + ffelexHandler nexthandler; + + if ((ffelex_token_type (t) != FFELEX_typePLUS) + && (ffelex_token_type (t) != FFELEX_typeMINUS)) + { + nexthandler + = (ffelexHandler) ffeexpr_nil_binary_ (ffeexpr_find_.t); + ffelex_token_kill (ffeexpr_find_.t); + return (ffelexHandler) (*nexthandler) (t); + } + + ffelex_token_kill (ffeexpr_find_.t); + return (ffelexHandler) ffeexpr_nil_number_exp_sign_; + } + + static ffelexHandler + ffeexpr_nil_number_exp_sign_ (ffelexToken t) + { + if (ffelex_token_type (t) != FFELEX_typeNUMBER) + return (ffelexHandler) ffeexpr_nil_binary_ (t); + + return (ffelexHandler) ffeexpr_nil_binary_; + } + + /* Expects ffeexpr_find_.t. */ + + static ffelexHandler + ffeexpr_nil_number_period_ (ffelexToken t) + { + ffelexHandler nexthandler; + char d; + char *p; + + switch (ffelex_token_type (t)) + { + case FFELEX_typeNAME: + case FFELEX_typeNAMES: + if ((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))), + 'D', 'd') + || ffesrc_char_match_init (d, 'E', 'e') + || ffesrc_char_match_init (d, 'Q', 'q')) + && ffeexpr_isdigits_ (++p)) + { + if (*p == '\0') + return (ffelexHandler) ffeexpr_nil_number_per_exp_; + ffelex_token_kill (ffeexpr_find_.t); + return (ffelexHandler) ffeexpr_nil_binary_; + } + nexthandler + = (ffelexHandler) ffeexpr_nil_binary_ (ffeexpr_find_.t); + ffelex_token_kill (ffeexpr_find_.t); + return (ffelexHandler) (*nexthandler) (t); + + case FFELEX_typeNUMBER: + ffelex_token_kill (ffeexpr_find_.t); + return (ffelexHandler) ffeexpr_nil_number_real_; + + default: + break; + } + ffelex_token_kill (ffeexpr_find_.t); + return (ffelexHandler) ffeexpr_nil_binary_ (t); + } + + /* Expects ffeexpr_find_.t. */ + + static ffelexHandler + ffeexpr_nil_number_per_exp_ (ffelexToken t) + { + if ((ffelex_token_type (t) != FFELEX_typePLUS) + && (ffelex_token_type (t) != FFELEX_typeMINUS)) + { + ffelexHandler nexthandler; + + nexthandler + = (ffelexHandler) ffeexpr_nil_binary_ (ffeexpr_find_.t); + ffelex_token_kill (ffeexpr_find_.t); + return (ffelexHandler) (*nexthandler) (t); + } + + ffelex_token_kill (ffeexpr_find_.t); + return (ffelexHandler) ffeexpr_nil_num_per_exp_sign_; + } + + static ffelexHandler + ffeexpr_nil_number_real_ (ffelexToken t) + { + char d; + char *p; + + if (((ffelex_token_type (t) != FFELEX_typeNAME) + && (ffelex_token_type (t) != FFELEX_typeNAMES)) + || !(((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))), + 'D', 'd') + || ffesrc_char_match_init (d, 'E', 'e') + || ffesrc_char_match_init (d, 'Q', 'q'))) + && ffeexpr_isdigits_ (++p))) + return (ffelexHandler) ffeexpr_nil_binary_ (t); + + if (*p == '\0') + return (ffelexHandler) ffeexpr_nil_number_real_exp_; + + return (ffelexHandler) ffeexpr_nil_binary_; + } + + static ffelexHandler + ffeexpr_nil_num_per_exp_sign_ (ffelexToken t) + { + if (ffelex_token_type (t) != FFELEX_typeNUMBER) + return (ffelexHandler) ffeexpr_nil_binary_ (t); + return (ffelexHandler) ffeexpr_nil_binary_; + } + + static ffelexHandler + ffeexpr_nil_number_real_exp_ (ffelexToken t) + { + if ((ffelex_token_type (t) != FFELEX_typePLUS) + && (ffelex_token_type (t) != FFELEX_typeMINUS)) + return (ffelexHandler) ffeexpr_nil_binary_ (t); + return (ffelexHandler) ffeexpr_nil_num_real_exp_sn_; + } + + static ffelexHandler + ffeexpr_nil_num_real_exp_sn_ (ffelexToken t) + { + if (ffelex_token_type (t) != FFELEX_typeNUMBER) + return (ffelexHandler) ffeexpr_nil_binary_ (t); + return (ffelexHandler) ffeexpr_nil_binary_; + } + + static ffelexHandler + ffeexpr_nil_binary_ (ffelexToken t) + { + switch (ffelex_token_type (t)) + { + case FFELEX_typePLUS: + case FFELEX_typeMINUS: + case FFELEX_typeASTERISK: + case FFELEX_typeSLASH: + case FFELEX_typePOWER: + case FFELEX_typeCONCAT: + case FFELEX_typeOPEN_ANGLE: + case FFELEX_typeCLOSE_ANGLE: + case FFELEX_typeREL_EQ: + case FFELEX_typeREL_NE: + case FFELEX_typeREL_GE: + case FFELEX_typeREL_LE: + return (ffelexHandler) ffeexpr_nil_rhs_; + + case FFELEX_typePERIOD: + return (ffelexHandler) ffeexpr_nil_binary_period_; + + default: + return (ffelexHandler) ffeexpr_nil_finished_ (t); + } + } + + static ffelexHandler + ffeexpr_nil_binary_period_ (ffelexToken t) + { + switch (ffelex_token_type (t)) + { + case FFELEX_typeNAME: + case FFELEX_typeNAMES: + ffeexpr_current_dotdot_ = ffeexpr_dotdot_ (t); + switch (ffeexpr_current_dotdot_) + { + case FFEEXPR_dotdotTRUE_: + case FFEEXPR_dotdotFALSE_: + case FFEEXPR_dotdotNOT_: + return (ffelexHandler) ffeexpr_nil_binary_sw_per_; + + default: + return (ffelexHandler) ffeexpr_nil_binary_end_per_; + } + break; /* Nothing really reaches here. */ + + default: + return (ffelexHandler) ffeexpr_nil_binary_ (t); + } + } + + static ffelexHandler + ffeexpr_nil_binary_end_per_ (ffelexToken t) + { + if (ffelex_token_type (t) != FFELEX_typePERIOD) + return (ffelexHandler) ffeexpr_nil_rhs_ (t); + return (ffelexHandler) ffeexpr_nil_rhs_; + } + + static ffelexHandler + ffeexpr_nil_binary_sw_per_ (ffelexToken t) + { + if (ffelex_token_type (t) != FFELEX_typePERIOD) + return (ffelexHandler) ffeexpr_nil_binary_ (t); + return (ffelexHandler) ffeexpr_nil_binary_; + } + + static ffelexHandler + ffeexpr_nil_quote_ (ffelexToken t) + { + if (ffelex_token_type (t) != FFELEX_typeNUMBER) + return (ffelexHandler) ffeexpr_nil_rhs_ (t); + return (ffelexHandler) ffeexpr_nil_binary_; + } + + static ffelexHandler + ffeexpr_nil_apostrophe_ (ffelexToken t) + { + assert (ffelex_token_type (t) == FFELEX_typeCHARACTER); + return (ffelexHandler) ffeexpr_nil_apos_char_; + } + + static ffelexHandler + ffeexpr_nil_apos_char_ (ffelexToken t) + { + char c; + + if ((ffelex_token_type (t) == FFELEX_typeNAME) + || (ffelex_token_type (t) == FFELEX_typeNAMES)) + { + if ((ffelex_token_length (t) == 1) + && (ffesrc_char_match_init ((c = ffelex_token_text (t)[0]), + 'B', 'b') + || ffesrc_char_match_init (c, 'O', 'o') + || ffesrc_char_match_init (c, 'X', 'x') + || ffesrc_char_match_init (c, 'Z', 'z'))) + return (ffelexHandler) ffeexpr_nil_binary_; + } + if ((ffelex_token_type (t) == FFELEX_typeNAME) + || (ffelex_token_type (t) == FFELEX_typeNAMES)) + return (ffelexHandler) ffeexpr_nil_rhs_ (t); + return (ffelexHandler) ffeexpr_nil_substrp_ (t); + } + + static ffelexHandler + ffeexpr_nil_name_rhs_ (ffelexToken t) + { + switch (ffelex_token_type (t)) + { + case FFELEX_typeQUOTE: + case FFELEX_typeAPOSTROPHE: + ffelex_set_hexnum (TRUE); + return (ffelexHandler) ffeexpr_nil_name_apos_; + + case FFELEX_typeOPEN_PAREN: + ++ffeexpr_find_.level; + return (ffelexHandler) ffeexpr_nil_rhs_; + + default: + return (ffelexHandler) ffeexpr_nil_binary_ (t); + } + } + + static ffelexHandler + ffeexpr_nil_name_apos_ (ffelexToken t) + { + if (ffelex_token_type (t) == FFELEX_typeNAME) + return (ffelexHandler) ffeexpr_nil_name_apos_name_; + return (ffelexHandler) ffeexpr_nil_binary_ (t); + } + + static ffelexHandler + ffeexpr_nil_name_apos_name_ (ffelexToken t) + { + switch (ffelex_token_type (t)) + { + case FFELEX_typeAPOSTROPHE: + case FFELEX_typeQUOTE: + return (ffelexHandler) ffeexpr_nil_finished_; + + default: + return (ffelexHandler) ffeexpr_nil_finished_ (t); + } + } + + static ffelexHandler + ffeexpr_nil_percent_ (ffelexToken t) + { + switch (ffelex_token_type (t)) + { + case FFELEX_typeNAME: + case FFELEX_typeNAMES: + ffeexpr_stack_->percent = ffeexpr_percent_ (t); + ffeexpr_find_.t = ffelex_token_use (t); + return (ffelexHandler) ffeexpr_nil_percent_name_; + + default: + return (ffelexHandler) ffeexpr_nil_rhs_ (t); + } + } + + /* Expects ffeexpr_find_.t. */ + + static ffelexHandler + ffeexpr_nil_percent_name_ (ffelexToken t) + { + ffelexHandler nexthandler; + + if (ffelex_token_type (t) != FFELEX_typeOPEN_PAREN) + { + nexthandler + = (ffelexHandler) ffeexpr_nil_rhs_ (ffeexpr_find_.t); + ffelex_token_kill (ffeexpr_find_.t); + return (ffelexHandler) (*nexthandler) (t); + } + + ffelex_token_kill (ffeexpr_find_.t); + ++ffeexpr_find_.level; + return (ffelexHandler) ffeexpr_nil_rhs_; + } + + static ffelexHandler + ffeexpr_nil_substrp_ (ffelexToken t) + { + if (ffelex_token_type (t) != FFELEX_typeOPEN_PAREN) + return (ffelexHandler) ffeexpr_nil_binary_ (t); + + ++ffeexpr_find_.level; + return (ffelexHandler) ffeexpr_nil_rhs_; + } + /* ffeexpr_finished_ -- Reduce expression stack to one expr, finish *************** ffeexpr_token_real_ (ffelexToken t) *** 12565,12580 **** char d; char *p; - char c; if (((ffelex_token_type (t) != FFELEX_typeNAME) && (ffelex_token_type (t) != FFELEX_typeNAMES)) ! || (!ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))), 'D', ! 'd') ! && !ffesrc_char_match_init (d, 'E', 'e') ! && !ffesrc_char_match_init (d, 'Q', 'q'))) { ! ! make_basic_constant: /* :::::::::::::::::::: */ ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'), NULL, ffeexpr_tokens_[0], ffeexpr_tokens_[1], --- 13210,13241 ---- char d; char *p; if (((ffelex_token_type (t) != FFELEX_typeNAME) && (ffelex_token_type (t) != FFELEX_typeNAMES)) ! || !(((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))), ! 'D', 'd') ! || ffesrc_char_match_init (d, 'E', 'e') ! || ffesrc_char_match_init (d, 'Q', 'q'))) ! && ffeexpr_isdigits_ (++p))) { ! #if 0 ! /* This code has been removed because it seems inconsistent to ! produce a diagnostic in this case, but not all of the other ! ones that look for an exponent and cannot recognize one. */ ! if (((ffelex_token_type (t) == FFELEX_typeNAME) ! || (ffelex_token_type (t) == FFELEX_typeNAMES)) ! && ffest_ffebad_start (FFEBAD_INVALID_EXPONENT)) ! { ! char bad[2]; + ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); + ffebad_here (1, ffelex_token_where_line (ffeexpr_tokens_[0]), + ffelex_token_where_column (ffeexpr_tokens_[0])); + bad[0] = *(p - 1); + bad[1] = '\0'; + ffebad_string (bad); + ffebad_finish (); + } + #endif ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'), NULL, ffeexpr_tokens_[0], ffeexpr_tokens_[1], *************** ffeexpr_token_real_ (ffelexToken t) *** 12589,12593 **** surely be next, followed by a NUMBER token. */ ! if ((c = *(++p)) == '\0') { ffeexpr_tokens_[2] = ffelex_token_use (t); --- 13250,13254 ---- surely be next, followed by a NUMBER token. */ ! if (*p == '\0') { ffeexpr_tokens_[2] = ffelex_token_use (t); *************** ffeexpr_token_real_ (ffelexToken t) *** 12595,12622 **** } - /* Make sure all characters following D, E, or Q are decimal digits, else - issue an error and ignore the exponent token entirely. */ - - do - { - if (!isdigit (c)) - { - if (ffest_ffebad_start (FFEBAD_INVALID_EXPONENT)) - { - char bad[2]; - - ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); - ffebad_here (1, ffelex_token_where_line (ffeexpr_tokens_[0]), - ffelex_token_where_column (ffeexpr_tokens_[0])); - bad[0] = c; - bad[1] = '\0'; - ffebad_string (bad); - ffebad_finish (); - } - goto make_basic_constant; /* :::::::::::::::::::: */ - } - } - while ((c = *(++p)) != '\0'); - ffeexpr_make_float_const_ (d, NULL, ffeexpr_tokens_[0], ffeexpr_tokens_[1], t, NULL, NULL); --- 13256,13259 ---- *************** ffeexpr_token_number_ (ffelexToken t) *** 12730,12734 **** char d; char *p; - char c; if (ffeexpr_hollerith_count_ > 0) --- 13367,13370 ---- *************** ffeexpr_token_number_ (ffelexToken t) *** 12742,12749 **** case FFELEX_typeNAME: case FFELEX_typeNAMES: ! if (ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))), 'D', ! 'd') ! || ffesrc_char_match_init (d, 'E', 'e') ! || ffesrc_char_match_init (d, 'Q', 'q')) { --- 13378,13386 ---- case FFELEX_typeNAME: case FFELEX_typeNAMES: ! if ((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))), ! 'D', 'd') ! || ffesrc_char_match_init (d, 'E', 'e') ! || ffesrc_char_match_init (d, 'Q', 'q')) ! && ffeexpr_isdigits_ (++p)) { *************** ffeexpr_token_number_ (ffelexToken t) *** 12751,12755 **** must surely be next, followed by a NUMBER token. */ ! if ((c = *(++p)) == '\0') { ffeexpr_tokens_[1] = ffelex_token_use (t); --- 13388,13392 ---- must surely be next, followed by a NUMBER token. */ ! if (*p == '\0') { ffeexpr_tokens_[1] = ffelex_token_use (t); *************** ffeexpr_token_number_ (ffelexToken t) *** 12756,12771 **** return (ffelexHandler) ffeexpr_token_number_exponent_; } - - /* Make sure all characters following D, E, or Q are decimal - digits, else assume user meant for it to be an integer and let - binary handle the error. */ - - do - { - if (!isdigit (c)) - goto make_integer; /* :::::::::::::::::::: */ - } - while ((c = *(++p)) != '\0'); - ffeexpr_make_float_const_ (d, ffeexpr_tokens_[0], NULL, NULL, t, NULL, NULL); --- 13393,13396 ---- *************** ffeexpr_token_number_ (ffelexToken t) *** 12799,12804 **** current token to the binary state. */ - make_integer: /* :::::::::::::::::::: */ - e = ffeexpr_expr_new_ (); e->type = FFEEXPR_exprtypeOPERAND_; --- 13424,13427 ---- *************** make_integer: /* :::::::::::::::::::: *** 12822,12826 **** Ensures this token is PLUS or MINUS, preserves it, goes to final state for real number (exponent digits). Else treats number as integer, passes ! name to binary, passes current token to subsequent handler. */ static ffelexHandler --- 13445,13449 ---- Ensures this token is PLUS or MINUS, preserves it, goes to final state for real number (exponent digits). Else treats number as integer, passes ! name to binary, passes current token to subsequent handler. */ static ffelexHandler *************** ffeexpr_token_number_period_ (ffelexToke *** 12909,12913 **** char *p; char d; - char c; switch (ffelex_token_type (t)) --- 13532,13535 ---- *************** ffeexpr_token_number_period_ (ffelexToke *** 12915,12922 **** case FFELEX_typeNAME: case FFELEX_typeNAMES: ! if (ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))), 'D', ! 'd') ! || ffesrc_char_match_init (d, 'E', 'e') ! || ffesrc_char_match_init (d, 'Q', 'q')) { --- 13537,13545 ---- case FFELEX_typeNAME: case FFELEX_typeNAMES: ! if ((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))), ! 'D', 'd') ! || ffesrc_char_match_init (d, 'E', 'e') ! || ffesrc_char_match_init (d, 'Q', 'q')) ! && ffeexpr_isdigits_ (++p)) { *************** ffeexpr_token_number_period_ (ffelexToke *** 12924,12928 **** must surely be next, followed by a NUMBER token. */ ! if ((c = *(++p)) == '\0') { ffeexpr_tokens_[2] = ffelex_token_use (t); --- 13547,13551 ---- must surely be next, followed by a NUMBER token. */ ! if (*p == '\0') { ffeexpr_tokens_[2] = ffelex_token_use (t); *************** ffeexpr_token_number_period_ (ffelexToke *** 12929,12946 **** return (ffelexHandler) ffeexpr_token_number_per_exp_; } - - /* Make sure all characters following D, E, or Q are decimal - digits, else assume user meant for it to be an integer and let - binary handle the error. */ - - do - { - if (!isdigit (c)) - goto not_exponent; /* :::::::::::::::::::: */ - } - while ((c = *(++p)) != '\0'); - ffeexpr_make_float_const_ (d, ffeexpr_tokens_[0], ! ffeexpr_tokens_[1], NULL, t, NULL, NULL); ffelex_token_kill (ffeexpr_tokens_[0]); --- 13552,13558 ---- return (ffelexHandler) ffeexpr_token_number_per_exp_; } ffeexpr_make_float_const_ (d, ffeexpr_tokens_[0], ! ffeexpr_tokens_[1], NULL, t, NULL, ! NULL); ffelex_token_kill (ffeexpr_tokens_[0]); *************** ffeexpr_token_number_period_ (ffelexToke *** 12952,12956 **** state and the current token to the resulting state. */ - not_exponent: /* :::::::::::::::::::: */ e = ffeexpr_expr_new_ (); e->type = FFEEXPR_exprtypeOPERAND_; --- 13564,13567 ---- *************** ffeexpr_token_number_real_ (ffelexToken *** 13038,13053 **** char d; char *p; - char c; if (((ffelex_token_type (t) != FFELEX_typeNAME) && (ffelex_token_type (t) != FFELEX_typeNAMES)) ! || (!ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))), 'D', ! 'd') ! && !ffesrc_char_match_init (d, 'E', 'e') ! && !ffesrc_char_match_init (d, 'Q', 'q'))) { ! ! make_basic_constant: /* :::::::::::::::::::: */ ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'), ffeexpr_tokens_[0], ffeexpr_tokens_[1], --- 13649,13680 ---- char d; char *p; if (((ffelex_token_type (t) != FFELEX_typeNAME) && (ffelex_token_type (t) != FFELEX_typeNAMES)) ! || !(((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))), ! 'D', 'd') ! || ffesrc_char_match_init (d, 'E', 'e') ! || ffesrc_char_match_init (d, 'Q', 'q'))) ! && ffeexpr_isdigits_ (++p))) { ! #if 0 ! /* This code has been removed because it seems inconsistent to ! produce a diagnostic in this case, but not all of the other ! ones that look for an exponent and cannot recognize one. */ ! if (((ffelex_token_type (t) == FFELEX_typeNAME) ! || (ffelex_token_type (t) == FFELEX_typeNAMES)) ! && ffest_ffebad_start (FFEBAD_INVALID_EXPONENT)) ! { ! char bad[2]; + ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); + ffebad_here (1, ffelex_token_where_line (ffeexpr_tokens_[0]), + ffelex_token_where_column (ffeexpr_tokens_[0])); + bad[0] = *(p - 1); + bad[1] = '\0'; + ffebad_string (bad); + ffebad_finish (); + } + #endif ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'), ffeexpr_tokens_[0], ffeexpr_tokens_[1], *************** ffeexpr_token_number_real_ (ffelexToken *** 13063,13067 **** surely be next, followed by a NUMBER token. */ ! if ((c = *(++p)) == '\0') { ffeexpr_tokens_[3] = ffelex_token_use (t); --- 13690,13694 ---- surely be next, followed by a NUMBER token. */ ! if (*p == '\0') { ffeexpr_tokens_[3] = ffelex_token_use (t); *************** ffeexpr_token_number_real_ (ffelexToken *** 13069,13096 **** } - /* Make sure all characters following D, E, or Q are decimal digits, else - issue an error and ignore the exponent token entirely. */ - - do - { - if (!isdigit (c)) - { - if (ffest_ffebad_start (FFEBAD_INVALID_EXPONENT)) - { - char bad[2]; - - ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); - ffebad_here (1, ffelex_token_where_line (ffeexpr_tokens_[0]), - ffelex_token_where_column (ffeexpr_tokens_[0])); - bad[0] = c; - bad[1] = '\0'; - ffebad_string (bad); - ffebad_finish (); - } - goto make_basic_constant; /* :::::::::::::::::::: */ - } - } - while ((c = *(++p)) != '\0'); - ffeexpr_make_float_const_ (d, ffeexpr_tokens_[0], ffeexpr_tokens_[1], ffeexpr_tokens_[2], t, NULL, NULL); --- 13696,13699 ---- *************** ffeexpr_token_apos_char_ (ffelexToken t) *** 13807,13819 **** ffelex_token_kill (ffeexpr_tokens_[1]); ffeexpr_exprstack_push_operand_ (e); ! if (((ffelex_token_type (t) == FFELEX_typeNAME) ! || (ffelex_token_type (t) == FFELEX_typeNAMES)) ! && ffest_ffebad_start (FFEBAD_INVALID_RADIX_SPECIFIER)) { ! 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 (ffeexpr_tokens_[0]), ! ffelex_token_where_column (ffeexpr_tokens_[0])); ! ffebad_finish (); e = ffeexpr_expr_new_ (); e->type = FFEEXPR_exprtypeBINARY_; --- 14410,14424 ---- ffelex_token_kill (ffeexpr_tokens_[1]); ffeexpr_exprstack_push_operand_ (e); ! if ((ffelex_token_type (t) == FFELEX_typeNAME) ! || (ffelex_token_type (t) == FFELEX_typeNAMES)) { ! if (ffest_ffebad_start (FFEBAD_INVALID_RADIX_SPECIFIER)) ! { ! 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 (ffeexpr_tokens_[0]), ! ffelex_token_where_column (ffeexpr_tokens_[0])); ! ffebad_finish (); ! } e = ffeexpr_expr_new_ (); e->type = FFEEXPR_exprtypeBINARY_; *************** ffeexpr_token_name_apos_name_ (ffelexTok *** 14508,14512 **** ffelex_token_kill (ffeexpr_tokens_[2]); - e->u.operand = ffebld_new_any (); e->type = FFEEXPR_exprtypeOPERAND_; e->u.operand = ffebld_new_any (); --- 15113,15116 ---- *************** ffeexpr_token_name_apos_name_ (ffelexTok *** 14515,14519 **** ffeexpr_exprstack_push_operand_ (e); ! return (ffelexHandler) ffeexpr_token_binary_ (t); } --- 15119,15131 ---- ffeexpr_exprstack_push_operand_ (e); ! switch (ffelex_token_type (t)) ! { ! case FFELEX_typeAPOSTROPHE: ! case FFELEX_typeQUOTE: ! return (ffelexHandler) ffeexpr_token_binary_; ! ! default: ! return (ffelexHandler) ffeexpr_token_binary_ (t); ! } } *************** ffeexpr_declare_unadorned_ (ffelexToken *** 15058,15062 **** /* Have FOO in DATA (XYZ(FOO),...)/.../ or DATA (...,XYZ=FOO,BAR,BLETCH). ! Could be found via the "statment-function" name space (in which case it should become an iterator) or the local name space (in which case it should be either a named constant, or a variable that will have an --- 15670,15674 ---- /* Have FOO in DATA (XYZ(FOO),...)/.../ or DATA (...,XYZ=FOO,BAR,BLETCH). ! Could be found via the "statement-function" name space (in which case it should become an iterator) or the local name space (in which case it should be either a named constant, or a variable that will have an *************** ffeexpr_sym_impdoitem_ (ffesymbol sp, ff *** 15136,15143 **** sa = ffesymbol_attrs (sp); ! if ((ss == FFESYMBOL_stateNONE) && ffest_seen_first_exec ()) { assert (sa == FFESYMBOL_attrsetNONE); ffesymbol_signal_change (sp); ffesymbol_resolve_intrin (sp); if (ffeimplic_establish_symbol (sp)) --- 15748,15757 ---- sa = ffesymbol_attrs (sp); ! if (ffesymbol_state_is_specable (ss) ! && ffest_seen_first_exec ()) { assert (sa == FFESYMBOL_attrsetNONE); ffesymbol_signal_change (sp); + ffesymbol_set_state (sp, FFESYMBOL_stateSEEN); ffesymbol_resolve_intrin (sp); if (ffeimplic_establish_symbol (sp)) *************** ffeexpr_sym_impdoitem_ (ffesymbol sp, ff *** 15150,15154 **** PROGRAM/BLOCKDATA program unit). */ ! s = ffecom_sym_exec_transition (sp); sa = ffesymbol_attrs (sp); ss = ffesymbol_state (sp); --- 15764,15768 ---- PROGRAM/BLOCKDATA program unit). */ ! sp = ffecom_sym_exec_transition (sp); sa = ffesymbol_attrs (sp); ss = ffesymbol_state (sp); *************** ffeexpr_token_arguments_ (ffelexToken ft *** 17292,17296 **** ffelex_token_kill (ffeexpr_stack_->tokens[0]); ffeexpr_is_substr_ok_ = FALSE;/* Nobody likes "FUNC(3)(1:1)".... */ ! return (ffelexHandler) ffeexpr_token_substrp_ (t); } --- 17906,17913 ---- ffelex_token_kill (ffeexpr_stack_->tokens[0]); ffeexpr_is_substr_ok_ = FALSE;/* Nobody likes "FUNC(3)(1:1)".... */ ! return ! (ffelexHandler) ffeexpr_find_close_paren_ (t, ! (ffelexHandler) ! ffeexpr_token_substrp_); } *************** ffeexpr_token_elements_ (ffelexToken ft, *** 17558,17562 **** } ffelex_token_kill (ffeexpr_stack_->tokens[0]); ! return (ffelexHandler) ffeexpr_token_substrp_ (t); } --- 18175,18182 ---- } ffelex_token_kill (ffeexpr_stack_->tokens[0]); ! return ! (ffelexHandler) ffeexpr_find_close_paren_ (t, ! (ffelexHandler) ! ffeexpr_token_substrp_); } *************** ffeexpr_token_substring_1_ (ffelexToken *** 17901,17905 **** ffelex_token_kill (ffeexpr_stack_->tokens[0]); ffeexpr_is_substr_ok_ = FALSE;/* Nobody likes "FOO(3:5)(1:1)".... */ ! return (ffelexHandler) ffeexpr_token_substrp_ (t); } --- 18521,18528 ---- ffelex_token_kill (ffeexpr_stack_->tokens[0]); ffeexpr_is_substr_ok_ = FALSE;/* Nobody likes "FOO(3:5)(1:1)".... */ ! return ! (ffelexHandler) ffeexpr_find_close_paren_ (t, ! (ffelexHandler) ! ffeexpr_token_substrp_); } diff -rcp2N g77-0.5.12/f/lex.c g77-0.5.13/f/lex.c *** g77-0.5.12/f/lex.c Tue Feb 21 13:38:23 1995 --- g77-0.5.13/f/lex.c Sat Feb 25 18:30:34 1995 *************** ffelex_image_char_ (int c, ffewhereColum *** 3374,3377 **** --- 3374,3378 ---- case '\t': + ffelex_saw_tab_ = TRUE; ffelex_card_image_[column++] = ' '; while ((column & 7) != 0) *************** ffelex_image_char_ (int c, ffewhereColum *** 3380,3384 **** default: - ffelex_saw_tab_ = TRUE; ffelex_card_image_[column++] = c; break; --- 3381,3384 ---- diff -rcp2N g77-0.5.12/f/stc.c g77-0.5.13/f/stc.c *** g77-0.5.12/f/stc.c Wed Feb 15 16:58:38 1995 --- g77-0.5.13/f/stc.c Sat Feb 25 18:30:35 1995 *************** ffestc_R501_attrib (ffestpAttrib attrib, *** 6222,6230 **** case FFESTV_savestateALL: ! ffebad_start (FFEBAD_CONFLICTING_SAVES); ! ffebad_here (0, ffestv_save_line_, ffestv_save_col_); ! ffebad_here (1, ffelex_token_where_line (attribt), ! ffelex_token_where_column (attribt)); ! ffebad_finish (); ffestv_save_state_ = FFESTV_savestateANY; break; --- 6222,6233 ---- case FFESTV_savestateALL: ! if (ffe_is_pedantic ()) ! { ! ffebad_start (FFEBAD_CONFLICTING_SAVES); ! ffebad_here (0, ffestv_save_line_, ffestv_save_col_); ! ffebad_here (1, ffelex_token_where_line (attribt), ! ffelex_token_where_column (attribt)); ! ffebad_finish (); ! } ffestv_save_state_ = FFESTV_savestateANY; break; *************** ffestc_R522 () *** 6925,6934 **** case FFESTV_savestateSPECIFIC: case FFESTV_savestateALL: ! ffebad_start (FFEBAD_CONFLICTING_SAVES); ! ffebad_here (0, ffestv_save_line_, ffestv_save_col_); ! ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]), ! ffelex_token_where_column (ffesta_tokens[0])); ! ffebad_finish (); ! ffestv_save_state_ = FFESTV_savestateANY; break; --- 6928,6940 ---- case FFESTV_savestateSPECIFIC: case FFESTV_savestateALL: ! if (ffe_is_pedantic ()) ! { ! ffebad_start (FFEBAD_CONFLICTING_SAVES); ! ffebad_here (0, ffestv_save_line_, ffestv_save_col_); ! ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]), ! ffelex_token_where_column (ffesta_tokens[0])); ! ffebad_finish (); ! } ! ffestv_save_state_ = FFESTV_savestateALL; break; *************** ffestc_R522start () *** 6975,6983 **** case FFESTV_savestateALL: ! ffebad_start (FFEBAD_CONFLICTING_SAVES); ! ffebad_here (0, ffestv_save_line_, ffestv_save_col_); ! ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]), ! ffelex_token_where_column (ffesta_tokens[0])); ! ffebad_finish (); ffestv_save_state_ = FFESTV_savestateANY; break; --- 6981,6992 ---- case FFESTV_savestateALL: ! if (ffe_is_pedantic ()) ! { ! ffebad_start (FFEBAD_CONFLICTING_SAVES); ! ffebad_here (0, ffestv_save_line_, ffestv_save_col_); ! ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]), ! ffelex_token_where_column (ffesta_tokens[0])); ! ffebad_finish (); ! } ffestv_save_state_ = FFESTV_savestateANY; break; *************** ffestc_R537_item (ffebld dest, ffelexTok *** 7660,7663 **** --- 7669,7679 ---- || (ffebld_op (source) == FFEBLD_opANY)) { + if (ffebld_op (dest) == FFEBLD_opSYMTER) + { + s = ffebld_symter (dest); + ffesymbol_set_init (s, ffebld_new_any ()); + ffebld_set_info (ffesymbol_init (s), ffeinfo_new_any ()); + ffesymbol_signal_unreported (s); + } ffestd_R537_item (dest, source); return; diff -rcp2N g77-0.5.12/f/ste.c g77-0.5.13/f/ste.c *** g77-0.5.12/f/ste.c Thu Feb 23 13:33:23 1995 --- g77-0.5.13/f/ste.c Sat Feb 25 18:30:36 1995 *************** ffeste_R1212 (ffebld expr) *** 4739,4744 **** push_momentary (); /* In case of many labels, keep 'em cleared out. */ ! caseno = 1; ! do { value = build_int_2 (caseno, 0); --- 4739,4745 ---- push_momentary (); /* In case of many labels, keep 'em cleared out. */ ! for (caseno = 1; ! labels != NULL; ! ++caseno, labels = ffebld_trail (labels)) { value = build_int_2 (caseno, 0); *************** ffeste_R1212 (ffebld expr) *** 4755,4763 **** expand_goto (tlabel); clear_momentary (); - - ++caseno; - labels = ffebld_trail (labels); } - while (labels != NULL); pop_momentary (); --- 4756,4760 ---- diff -rcp2N g77-0.5.12/f/zzz.c g77-0.5.13/f/zzz.c *** g77-0.5.12/f/zzz.c Thu Feb 23 13:33:23 1995 --- g77-0.5.13/f/zzz.c Sat Feb 25 18:30:36 1995 *************** the Free Software Foundation, 675 Mass A *** 36,40 **** /* Externals defined here. */ ! char *ffezzz_version_string = "0.5.12"; char *ffezzz_date = __DATE__; char *ffezzz_time = __TIME__; --- 36,40 ---- /* Externals defined here. */ ! char *ffezzz_version_string = "0.5.13"; char *ffezzz_date = __DATE__; char *ffezzz_time = __TIME__;