From 454abcd55d12d4ef15ec29c89b2ad4d47f3c82d1 Mon Sep 17 00:00:00 2001 From: Jason Downs Date: Wed, 9 Apr 1997 13:44:52 +0000 Subject: Revert to older (working) version of gcc, plus recent changes. --- gnu/usr.bin/gcc/f/stc.c | 67 ++++++++++++++++++++----------------------------- 1 file changed, 27 insertions(+), 40 deletions(-) (limited to 'gnu/usr.bin/gcc/f/stc.c') diff --git a/gnu/usr.bin/gcc/f/stc.c b/gnu/usr.bin/gcc/f/stc.c index bc803e67e82..5512bcbab6b 100644 --- a/gnu/usr.bin/gcc/f/stc.c +++ b/gnu/usr.bin/gcc/f/stc.c @@ -1,5 +1,5 @@ /* stc.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995-1997 Free Software Foundation, Inc. + Copyright (C) 1995 Free Software Foundation, Inc. Contributed by James Craig Burley (burley@gnu.ai.mit.edu). This file is part of GNU Fortran. @@ -2686,16 +2686,16 @@ ffestc_order_entry_ () goto recurse; /* :::::::::::::::::::: */ case FFESTV_stateSUBROUTINE0: - ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE1); + case FFESTV_stateSUBROUTINE1: + ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE2); break; case FFESTV_stateFUNCTION0: - ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION1); + case FFESTV_stateFUNCTION1: + ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION2); break; - case FFESTV_stateSUBROUTINE1: case FFESTV_stateSUBROUTINE2: - case FFESTV_stateFUNCTION1: case FFESTV_stateFUNCTION2: case FFESTV_stateSUBROUTINE3: case FFESTV_stateFUNCTION3: @@ -2848,25 +2848,25 @@ ffestc_order_format_ () goto recurse; /* :::::::::::::::::::: */ case FFESTV_statePROGRAM0: + case FFESTV_statePROGRAM1: ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM1); + ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM2); return FFESTC_orderOK_; case FFESTV_stateSUBROUTINE0: + case FFESTV_stateSUBROUTINE1: ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE1); + ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE2); return FFESTC_orderOK_; case FFESTV_stateFUNCTION0: + case FFESTV_stateFUNCTION1: ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION1); + ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION2); return FFESTC_orderOK_; - case FFESTV_statePROGRAM1: case FFESTV_statePROGRAM2: - case FFESTV_stateSUBROUTINE1: case FFESTV_stateSUBROUTINE2: - case FFESTV_stateFUNCTION1: case FFESTV_stateFUNCTION2: case FFESTV_statePROGRAM3: case FFESTV_stateSUBROUTINE3: @@ -6309,7 +6309,6 @@ ffestc_R501_item (ffelexToken name, ffebld kind, ffelexToken kindt, ffestpDimtype nd; bool is_init = (init != NULL) || clist; bool is_assumed; - bool is_ugly_assumed; ffeinfoRank rank; ffestc_check_item_ (); @@ -6336,11 +6335,7 @@ ffestc_R501_item (ffelexToken name, ffebld kind, ffelexToken kindt, if (is_assumed) na |= FFESYMBOL_attrsANYLEN; - is_ugly_assumed = (ffe_is_ugly_assumed () - && ((sa & FFESYMBOL_attrsDUMMY) - || (ffesymbol_where (s) == FFEINFO_whereDUMMY))); - - nd = ffestt_dimlist_type (dims, is_ugly_assumed); + nd = ffestt_dimlist_type (dims); switch (nd) { case FFESTP_dimtypeNONE: @@ -6461,8 +6456,7 @@ ffestc_R501_item (ffelexToken name, ffebld kind, ffelexToken kindt, { ffesymbol_set_dims (s, ffestt_dimlist_as_expr (dims, &rank, &array_size, - &extents, - is_ugly_assumed)); + &extents)); ffesymbol_set_arraysize (s, array_size); ffesymbol_set_extents (s, extents); if (!(0 && ffe_is_90 ()) @@ -7212,7 +7206,6 @@ ffestc_R524_item (ffelexToken name, ffesttDimList dims) ffesymbolAttrs na; ffestpDimtype nd; ffeinfoRank rank; - bool is_ugly_assumed; ffestc_check_item_ (); assert (name != NULL); @@ -7228,11 +7221,7 @@ ffestc_R524_item (ffelexToken name, ffesttDimList dims) /* First figure out what kind of object this is based solely on the current object situation (dimension list). */ - is_ugly_assumed = (ffe_is_ugly_assumed () - && ((sa & FFESYMBOL_attrsDUMMY) - || (ffesymbol_where (s) == FFEINFO_whereDUMMY))); - - nd = ffestt_dimlist_type (dims, is_ugly_assumed); + nd = ffestt_dimlist_type (dims); switch (nd) { case FFESTP_dimtypeKNOWN: @@ -7301,8 +7290,7 @@ ffestc_R524_item (ffelexToken name, ffesttDimList dims) ffesymbol_set_state (s, FFESYMBOL_stateSEEN); ffesymbol_set_dims (s, ffestt_dimlist_as_expr (dims, &rank, &array_size, - &extents, - is_ugly_assumed)); + &extents)); ffesymbol_set_arraysize (s, array_size); ffesymbol_set_extents (s, extents); if (!(0 && ffe_is_90 ()) @@ -8233,7 +8221,6 @@ ffestc_R547_item_object (ffelexToken name, ffesttDimList dims) ffestpDimtype nd; ffebld e; ffeinfoRank rank; - bool is_ugly_assumed; if (ffestc_parent_ok_ && (ffestc_local_.common.symbol == NULL)) ffestc_R547_item_cblock (NULL); /* As if "COMMON [//] ...". */ @@ -8252,11 +8239,7 @@ ffestc_R547_item_object (ffelexToken name, ffesttDimList dims) /* First figure out what kind of object this is based solely on the current object situation (dimension list). */ - is_ugly_assumed = (ffe_is_ugly_assumed () - && ((sa & FFESYMBOL_attrsDUMMY) - || (ffesymbol_where (s) == FFEINFO_whereDUMMY))); - - nd = ffestt_dimlist_type (dims, is_ugly_assumed); + nd = ffestt_dimlist_type (dims); switch (nd) { case FFESTP_dimtypeNONE: @@ -8342,8 +8325,7 @@ ffestc_R547_item_object (ffelexToken name, ffesttDimList dims) { ffesymbol_set_dims (s, ffestt_dimlist_as_expr (dims, &rank, &array_size, - &extents, - is_ugly_assumed)); + &extents)); ffesymbol_set_arraysize (s, array_size); ffesymbol_set_extents (s, extents); if (!(0 && ffe_is_90 ()) @@ -11829,7 +11811,6 @@ ffestc_R1207_item (ffelexToken name) ffesymbol_set_attrs (s, na); ffesymbol_set_state (s, FFESYMBOL_stateSEEN); ffesymbol_set_explicitwhere (s, TRUE); - ffesymbol_globalize (s); ffesymbol_signal_unreported (s); } @@ -11889,6 +11870,7 @@ ffestc_R1208_item (ffelexToken name) ffeintrinGen gen; ffeintrinSpec spec; ffeintrinImp imp; + ffeinfoKind kind; ffestc_check_item_ (); assert (name != NULL); @@ -11908,7 +11890,7 @@ ffestc_R1208_item (ffelexToken name) else if (!(sa & ~FFESYMBOL_attrsTYPE)) { if (ffeintrin_is_intrinsic (ffelex_token_text (name), name, TRUE, - &gen, &spec, &imp) + &gen, &spec, &imp, &kind) && ((imp == FFEINTRIN_impNONE) #if 0 /* Don't bother with this for now. */ || ((ffeintrin_basictype (spec) @@ -11920,6 +11902,13 @@ ffestc_R1208_item (ffelexToken name) #endif || !(sa & FFESYMBOL_attrsTYPE))) na = sa | FFESYMBOL_attrsINTRINSIC; + else if (kind == FFEINFO_kindANY) + { /* Already diagnosed. */ + na = sa | FFESYMBOL_attrsINTRINSIC | FFESYMBOL_attrsANY; + ffesymbol_set_attrs (s, na); + ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD); + ffesymbol_set_info (s, ffeinfo_new_any ()); + } else na = FFESYMBOL_attrsetNONE; } @@ -11943,7 +11932,7 @@ ffestc_R1208_item (ffelexToken name) ffeinfo_new (FFEINFO_basictypeNONE, FFEINFO_kindtypeNONE, 0, - FFEINFO_kindNONE, + kind, FFEINFO_whereINTRINSIC, FFETARGET_charactersizeNONE)); ffesymbol_set_explicitwhere (s, TRUE); @@ -12363,7 +12352,6 @@ ffestc_R1226 (ffelexToken entryname, ffesttTokenList args, switch (ffestw_state (ffestw_stack_top ())) { - case FFESTV_stateFUNCTION1: case FFESTV_stateFUNCTION2: case FFESTV_stateFUNCTION3: in_func = TRUE; @@ -12375,7 +12363,6 @@ ffestc_R1226 (ffelexToken entryname, ffesttTokenList args, in_spec = FALSE; break; - case FFESTV_stateSUBROUTINE1: case FFESTV_stateSUBROUTINE2: case FFESTV_stateSUBROUTINE3: in_func = FALSE; -- cgit v1.2.3