X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fc-parse.in;h=6811b45b98ef46f68b541c71b5c26f718bb829af;hb=20f0a040ddc6a91c13ce35a4cb42facfb61200c8;hp=a40dbfe089fa484a184ee75fc7d2e633c657c954;hpb=f408fde2eeba0bb7252237626f4d369dd76103c9;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/c-parse.in b/gcc/c-parse.in index a40dbfe089f..6811b45b98e 100644 --- a/gcc/c-parse.in +++ b/gcc/c-parse.in @@ -1,5 +1,5 @@ /* YACC parser for C syntax and for Objective C. -*-c-*- - Copyright (C) 1987, 1988, 1989, 1992 Free Software Foundation, Inc. + Copyright (C) 1987, 88, 89, 92-98, 1999 Free Software Foundation, Inc. This file is part of GNU CC. @@ -15,51 +15,39 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU CC; see the file COPYING. If not, write to -the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ +the Free Software Foundation, 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ /* This file defines the grammar of C and that of Objective C. ifobjc ... end ifobjc conditionals contain code for Objective C only. ifc ... end ifc conditionals contain code for C only. - The awk script cond.awk is used to convert this file into + Sed commands in Makefile.in are used to convert this file into c-parse.y and into objc-parse.y. */ /* To whomever it may concern: I have heard that such a thing was once -written by AT&T, but I have never seen it. */ + written by AT&T, but I have never seen it. */ ifobjc -%expect 56 +%expect 74 end ifobjc ifc -%expect 8 - -/* These are the 8 conflicts you should get in parse.output; - the state numbers may vary if minor changes in the grammar are made. - -State 41 contains 1 shift/reduce conflict. (Two ways to recover from error.) -State 92 contains 1 shift/reduce conflict. (Two ways to recover from error.) -State 99 contains 1 shift/reduce conflict. (Two ways to recover from error.) -State 103 contains 1 shift/reduce conflict. (Two ways to recover from error.) -State 119 contains 1 shift/reduce conflict. (See comment at component_decl.) -State 183 contains 1 shift/reduce conflict. (Two ways to recover from error.) -State 193 contains 1 shift/reduce conflict. (Two ways to recover from error.) -State 199 contains 1 shift/reduce conflict. (Two ways to recover from error.) -*/ +%expect 53 end ifc %{ -#include -#include -#include - #include "config.h" +#include "system.h" +#include #include "tree.h" #include "input.h" #include "c-lex.h" #include "c-tree.h" #include "flags.h" - +#include "output.h" +#include "toplev.h" +#include "ggc.h" + #ifdef MULTIBYTE_CHARS -#include #include #endif @@ -67,11 +55,14 @@ ifobjc #include "objc-act.h" end ifobjc -#ifndef errno -extern int errno; -#endif - -void yyerror (); +/* Since parsers are distinct for each language, put the language string + definition here. */ +ifobjc +const char * const language_string = "GNU Obj-C"; +end ifobjc +ifc +const char * const language_string = "GNU C"; +end ifc /* Like YYERROR but do call yyerror. */ #define YYERROR1 { yyerror ("syntax error"); YYERROR; } @@ -83,7 +74,7 @@ void yyerror (); %start program %union {long itype; tree ttype; enum tree_code code; - char *filename; int lineno; } + char *filename; int lineno; int ends_in_label; } /* All identifiers that are not reserved words and are not declared typedefs in the current block */ @@ -102,7 +93,7 @@ void yyerror (); yylval contains an IDENTIFIER_NODE which indicates which one. */ %token TYPESPEC -/* Reserved words that qualify type: "const" or "volatile". +/* Reserved words that qualify type: "const", "volatile", or "restrict". yylval contains an IDENTIFIER_NODE which indicates which one. */ %token TYPE_QUAL @@ -120,8 +111,12 @@ void yyerror (); /* the reserved words */ /* SCO include files test "ASM", so use something else. */ %token SIZEOF ENUM STRUCT UNION IF ELSE WHILE DO FOR SWITCH CASE DEFAULT -%token BREAK CONTINUE RETURN GOTO ASM_KEYWORD TYPEOF ALIGNOF ALIGN +%token BREAK CONTINUE RETURN GOTO ASM_KEYWORD TYPEOF ALIGNOF %token ATTRIBUTE EXTENSION LABEL +%token REALPART IMAGPART VA_ARG + +/* Used in c-lex.c for parsing pragmas. */ +%token END_OF_LINE /* Add precedence rules to solve dangling else s/r conflict */ %nonassoc IF @@ -150,7 +145,11 @@ void yyerror (); /* The Objective-C keywords. These are included in C and in Objective C, so that the token codes are the same in both. */ %token INTERFACE IMPLEMENTATION END SELECTOR DEFS ENCODE -%token CLASSNAME PUBLIC +%token CLASSNAME PUBLIC PRIVATE PROTECTED PROTOCOL OBJECTNAME CLASS ALIAS + +/* Objective-C string constants in raw form. + yylval is an OBJC_STRING_CST node. */ +%token OBJC_STRING %type unop @@ -160,13 +159,16 @@ void yyerror (); %type typed_declspecs reserved_declspecs %type typed_typespecs reserved_typespecquals %type declmods typespec typespecqual_reserved +%type typed_declspecs_no_prefix_attr reserved_declspecs_no_prefix_attr +%type declmods_no_prefix_attr %type SCSPEC TYPESPEC TYPE_QUAL nonempty_type_quals maybe_type_qual %type initdecls notype_initdecls initdcl notype_initdcl -%type init initlist maybeasm +%type init maybeasm %type asm_operands nonnull_asm_operands asm_operand asm_clobbers -%type maybe_attribute attribute_list attrib +%type maybe_attribute attributes attribute attribute_list attrib +%type any_word -%type compstmt +%type compstmt compstmt_nostart compstmt_primary_start %type declarator %type notype_declarator after_type_declarator @@ -175,6 +177,7 @@ void yyerror (); %type structsp component_decl_list component_decl_list2 %type component_decl components component_declarator %type enumlist enumerator +%type struct_head union_head enum_head %type typename absdcl absdcl1 type_quals %type xexpr parms parm identifiers @@ -182,8 +185,12 @@ void yyerror (); %type parmlist_or_identifiers parmlist_or_identifiers_1 %type identifiers_or_typenames +%type extension + %type setspecs +%type lineno_stmt_or_label lineno_stmt_or_labels stmt_or_label + %type save_filename %type save_lineno @@ -196,27 +203,41 @@ ifobjc %type keywordexpr keywordarglist keywordarg %type myparms myparm optparmlist reservedwords objcselectorexpr %type selectorarg keywordnamelist keywordname objcencodeexpr -%type CLASSNAME +%type objc_string non_empty_protocolrefs protocolrefs identifier_list objcprotocolexpr + +%type CLASSNAME OBJC_STRING OBJECTNAME end ifobjc %{ -/* Number of statements (loosely speaking) seen so far. */ +/* Number of statements (loosely speaking) and compound statements + seen so far. */ static int stmt_count; - +static int compstmt_count; + /* Input file and line number of the end of the body of last simple_if; used by the stmt-rule immediately after simple_if returns. */ static char *if_stmt_file; static int if_stmt_line; /* List of types and structure classes of the current declaration. */ -static tree current_declspecs; +static tree current_declspecs = NULL_TREE; +static tree prefix_attributes = NULL_TREE; -/* Stack of saved values of current_declspecs. */ +/* Stack of saved values of current_declspecs and prefix_attributes. */ static tree declspec_stack; /* 1 if we explained undeclared var errors. */ static int undeclared_variable_notice; +/* For __extension__, save/restore the warning flags which are + controlled by __extension__. */ +#define SAVE_WARN_FLAGS() (pedantic | (warn_pointer_arith << 1)) +#define RESTORE_WARN_FLAGS(val) \ + do { \ + pedantic = val & 1; \ + warn_pointer_arith = (val >> 1) & 1; \ + } while (0) + ifobjc /* Objective-C specific information */ @@ -234,22 +255,32 @@ end ifobjc /* Tell yyparse how to print a token's value, if yydebug is set. */ #define YYPRINT(FILE,YYCHAR,YYLVAL) yyprint(FILE,YYCHAR,YYLVAL) -extern void yyprint (); +extern void yyprint PROTO ((FILE *, int, YYSTYPE)); + +/* Add GC roots for variables local to this file. */ +void +c_parse_init () +{ + ggc_add_tree_root (&declspec_stack, 1); + ggc_add_tree_root (¤t_declspecs, 1); + ggc_add_tree_root (&prefix_attributes, 1); +} + %} %% program: /* empty */ { if (pedantic) pedwarn ("ANSI C forbids an empty source file"); -ifobjc - objc_finish (); -end ifobjc + finish_file (); } | extdefs { -ifobjc - objc_finish (); -end ifobjc + /* In case there were missing closebraces, + get us back to the global binding level. */ + while (! global_bindings_p ()) + poplevel (0, 0, 0); + finish_file (); } ; @@ -276,6 +307,8 @@ end ifobjc assemble_asm ($3); else error ("argument of `asm' is not a constant string"); } + | extension extdef + { RESTORE_WARN_FLAGS ($1); } ; datadef: @@ -283,11 +316,22 @@ datadef: { if (pedantic) error ("ANSI C forbids data definition with no type or storage class"); else if (!flag_traditional) - warning ("data definition has no type or storage class"); } + warning ("data definition has no type or storage class"); + + current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); + declspec_stack = TREE_CHAIN (declspec_stack); + resume_momentary ($1); } | declmods setspecs notype_initdecls ';' - {} + { current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); + declspec_stack = TREE_CHAIN (declspec_stack); + resume_momentary ($2); } | typed_declspecs setspecs initdecls ';' - {} + { current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); + declspec_stack = TREE_CHAIN (declspec_stack); + resume_momentary ($2); } | declmods ';' { pedwarn ("empty declaration"); } | typed_declspecs ';' @@ -301,43 +345,67 @@ datadef: fndef: typed_declspecs setspecs declarator - { if (! start_function ($1, $3, 0)) + { if (! start_function (current_declspecs, $3, + prefix_attributes, NULL_TREE, 0)) YYERROR1; reinit_parse_for_function (); } - xdecls + old_style_parm_decls { store_parm_decls (); } compstmt_or_error - { finish_function (0); } + { finish_function (0); + current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); + declspec_stack = TREE_CHAIN (declspec_stack); + resume_momentary ($2); } | typed_declspecs setspecs declarator error - { } + { current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); + declspec_stack = TREE_CHAIN (declspec_stack); + resume_momentary ($2); } | declmods setspecs notype_declarator - { if (! start_function ($1, $3, 0)) + { if (! start_function (current_declspecs, $3, + prefix_attributes, NULL_TREE, 0)) YYERROR1; reinit_parse_for_function (); } - xdecls + old_style_parm_decls { store_parm_decls (); } compstmt_or_error - { finish_function (0); } + { finish_function (0); + current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); + declspec_stack = TREE_CHAIN (declspec_stack); + resume_momentary ($2); } | declmods setspecs notype_declarator error - { } + { current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); + declspec_stack = TREE_CHAIN (declspec_stack); + resume_momentary ($2); } | setspecs notype_declarator - { if (! start_function (NULL_TREE, $2, 0)) + { if (! start_function (NULL_TREE, $2, + prefix_attributes, NULL_TREE, 0)) YYERROR1; reinit_parse_for_function (); } - xdecls + old_style_parm_decls { store_parm_decls (); } compstmt_or_error - { finish_function (0); } + { finish_function (0); + current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); + declspec_stack = TREE_CHAIN (declspec_stack); + resume_momentary ($1); } | setspecs notype_declarator error - { } + { current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); + declspec_stack = TREE_CHAIN (declspec_stack); + resume_momentary ($1); } ; identifier: IDENTIFIER | TYPENAME ifobjc + | OBJECTNAME | CLASSNAME - { $$ = CLASS_NAME ($1); } end ifobjc ; @@ -379,17 +447,17 @@ unary_expr: | '*' cast_expr %prec UNARY { $$ = build_indirect_ref ($2, "unary *"); } /* __extension__ turns off -pedantic for following primary. */ - | EXTENSION - { $1 = pedantic; - pedantic = 0; } - cast_expr %prec UNARY - { $$ = $3; - pedantic = $1; } + | extension cast_expr %prec UNARY + { $$ = $2; + RESTORE_WARN_FLAGS ($1); } | unop cast_expr %prec UNARY - { $$ = build_unary_op ($1, $2, 0); } + { $$ = build_unary_op ($1, $2, 0); + overflow_warning ($$); } /* Refer to the address of a label as a pointer. */ | ANDAND identifier { tree label = lookup_label ($2); + if (pedantic) + pedwarn ("ANSI C forbids `&&'"); if (label == 0) $$ = null_pointer_node; else @@ -414,17 +482,35 @@ unary_expr: $$ = build_unary_op (ADDR_EXPR, $$, 0); } } */ - | SIZEOF unary_expr %prec UNARY - { if (TREE_CODE ($2) == COMPONENT_REF - && DECL_BIT_FIELD (TREE_OPERAND ($2, 1))) + | sizeof unary_expr %prec UNARY + { skip_evaluation--; + if (TREE_CODE ($2) == COMPONENT_REF + && DECL_C_BIT_FIELD (TREE_OPERAND ($2, 1))) error ("`sizeof' applied to a bit-field"); $$ = c_sizeof (TREE_TYPE ($2)); } - | SIZEOF '(' typename ')' %prec HYPERUNARY - { $$ = c_sizeof (groktypename ($3)); } - | ALIGNOF unary_expr %prec UNARY - { $$ = c_alignof_expr ($2); } - | ALIGNOF '(' typename ')' %prec HYPERUNARY - { $$ = c_alignof (groktypename ($3)); } + | sizeof '(' typename ')' %prec HYPERUNARY + { skip_evaluation--; + $$ = c_sizeof (groktypename ($3)); } + | alignof unary_expr %prec UNARY + { skip_evaluation--; + $$ = c_alignof_expr ($2); } + | alignof '(' typename ')' %prec HYPERUNARY + { skip_evaluation--; + $$ = c_alignof (groktypename ($3)); } + | REALPART cast_expr %prec UNARY + { $$ = build_unary_op (REALPART_EXPR, $2, 0); } + | IMAGPART cast_expr %prec UNARY + { $$ = build_unary_op (IMAGPART_EXPR, $2, 0); } + | VA_ARG '(' expr_no_commas ',' typename ')' + { $$ = build_va_arg ($3, groktypename ($5)); } + ; + +sizeof: + SIZEOF { skip_evaluation++; } + ; + +alignof: + ALIGNOF { skip_evaluation++; } ; cast_expr: @@ -432,10 +518,17 @@ cast_expr: | '(' typename ')' cast_expr %prec UNARY { tree type = groktypename ($2); $$ = build_c_cast (type, $4); } - | '(' typename ')' '{' initlist maybecomma '}' %prec UNARY - { tree type = groktypename ($2); - char *name; - if (pedantic) + | '(' typename ')' '{' + { start_init (NULL_TREE, NULL, 0); + $2 = groktypename ($2); + really_start_incremental_init ($2); } + initlist_maybe_comma '}' %prec UNARY + { const char *name; + tree result = pop_init_level (0); + tree type = $2; + finish_init (); + + if (pedantic && ! flag_isoc9x) pedwarn ("ANSI C forbids constructor expressions"); if (TYPE_NAME (type) != 0) { @@ -446,8 +539,7 @@ cast_expr: } else name = ""; - $$ = digest_init (type, build_nt (CONSTRUCTOR, NULL_TREE, nreverse ($5)), - NULL_PTR, 0, 0, name); + $$ = result; if (TREE_CODE (type) == ARRAY_TYPE && TYPE_SIZE (type) == 0) { int failure = complete_array_type (type, $$, 1); @@ -483,25 +575,59 @@ expr_no_commas: { $$ = parser_build_binary_op ($2, $1, $3); } | expr_no_commas '^' expr_no_commas { $$ = parser_build_binary_op ($2, $1, $3); } - | expr_no_commas ANDAND expr_no_commas - { $$ = parser_build_binary_op (TRUTH_ANDIF_EXPR, $1, $3); } - | expr_no_commas OROR expr_no_commas - { $$ = parser_build_binary_op (TRUTH_ORIF_EXPR, $1, $3); } - | expr_no_commas '?' xexpr ':' expr_no_commas - { $$ = build_conditional_expr ($1, $3, $5); } + | expr_no_commas ANDAND + { $1 = truthvalue_conversion (default_conversion ($1)); + skip_evaluation += $1 == boolean_false_node; } + expr_no_commas + { skip_evaluation -= $1 == boolean_false_node; + $$ = parser_build_binary_op (TRUTH_ANDIF_EXPR, $1, $4); } + | expr_no_commas OROR + { $1 = truthvalue_conversion (default_conversion ($1)); + skip_evaluation += $1 == boolean_true_node; } + expr_no_commas + { skip_evaluation -= $1 == boolean_true_node; + $$ = parser_build_binary_op (TRUTH_ORIF_EXPR, $1, $4); } + | expr_no_commas '?' + { $1 = truthvalue_conversion (default_conversion ($1)); + skip_evaluation += $1 == boolean_false_node; } + expr ':' + { skip_evaluation += (($1 == boolean_true_node) + - ($1 == boolean_false_node)); } + expr_no_commas + { skip_evaluation -= $1 == boolean_true_node; + $$ = build_conditional_expr ($1, $4, $7); } + | expr_no_commas '?' + { if (pedantic) + pedwarn ("ANSI C forbids omitting the middle term of a ?: expression"); + /* Make sure first operand is calculated only once. */ + $2 = save_expr ($1); + $1 = truthvalue_conversion (default_conversion ($2)); + skip_evaluation += $1 == boolean_true_node; } + ':' expr_no_commas + { skip_evaluation -= $1 == boolean_true_node; + $$ = build_conditional_expr ($1, $2, $5); } | expr_no_commas '=' expr_no_commas - { $$ = build_modify_expr ($1, NOP_EXPR, $3); - C_SET_EXP_ORIGINAL_CODE ($$, MODIFY_EXPR); } + { char class; + $$ = build_modify_expr ($1, NOP_EXPR, $3); + class = TREE_CODE_CLASS (TREE_CODE ($$)); + if (class == 'e' || class == '1' + || class == '2' || class == '<') + C_SET_EXP_ORIGINAL_CODE ($$, MODIFY_EXPR); + } | expr_no_commas ASSIGN expr_no_commas - { $$ = build_modify_expr ($1, $2, $3); - C_SET_EXP_ORIGINAL_CODE ($$, MODIFY_EXPR); } + { char class; + $$ = build_modify_expr ($1, $2, $3); + /* This inhibits warnings in truthvalue_conversion. */ + class = TREE_CODE_CLASS (TREE_CODE ($$)); + if (class == 'e' || class == '1' + || class == '2' || class == '<') + C_SET_EXP_ORIGINAL_CODE ($$, ERROR_MARK); + } ; primary: IDENTIFIER { - tree context; - $$ = lastiddecl; if (!$$ || $$ == error_mark_node) { @@ -510,14 +636,21 @@ primary: if (yychar == '(') { ifobjc + tree decl; + if (objc_receiver_context && ! (objc_receiver_context && strcmp (IDENTIFIER_POINTER ($1), "super"))) /* we have a message to super */ $$ = get_super_receiver (); else if (objc_method_context - && is_ivar (objc_ivar_chain, $1)) - $$ = build_ivar_reference ($1); + && (decl = is_ivar (objc_ivar_chain, $1))) + { + if (is_private (decl)) + $$ = error_mark_node; + else + $$ = build_ivar_reference ($1); + } else end ifobjc { @@ -529,27 +662,34 @@ end ifobjc } else if (current_function_decl == 0) { - error ("`%s' undeclared, outside of functions", + error ("`%s' undeclared here (not in a function)", IDENTIFIER_POINTER ($1)); $$ = error_mark_node; } else { ifobjc + tree decl; + if (objc_receiver_context && ! strcmp (IDENTIFIER_POINTER ($1), "super")) /* we have a message to super */ $$ = get_super_receiver (); else if (objc_method_context - && is_ivar (objc_ivar_chain, $1)) - $$ = build_ivar_reference ($1); + && (decl = is_ivar (objc_ivar_chain, $1))) + { + if (is_private (decl)) + $$ = error_mark_node; + else + $$ = build_ivar_reference ($1); + } else end ifobjc { if (IDENTIFIER_GLOBAL_VALUE ($1) != error_mark_node || IDENTIFIER_ERROR_LOCUS ($1) != current_function_decl) { - error ("`%s' undeclared (first use this function)", + error ("`%s' undeclared (first use in this function)", IDENTIFIER_POINTER ($1)); if (! undeclared_variable_notice) @@ -622,14 +762,21 @@ ifobjc || (objc_receiver_context && strcmp (IDENTIFIER_POINTER ($1), "super"))) { + tree decl; + if (objc_method_context - && is_ivar (objc_ivar_chain, $1)) + && (decl = is_ivar (objc_ivar_chain, $1))) { if (IDENTIFIER_LOCAL_VALUE ($1)) warning ("local declaration of `%s' hides instance variable", IDENTIFIER_POINTER ($1)); else - $$ = build_ivar_reference ($1); + { + if (is_private (decl)) + $$ = error_mark_node; + else + $$ = build_ivar_reference ($1); + } } } else /* we have a message to super */ @@ -657,35 +804,37 @@ end ifobjc $$ = $2; } | '(' error ')' { $$ = error_mark_node; } - | '(' - { if (current_function_decl == 0) - { - error ("braced-group within expression allowed only inside a function"); - YYERROR; - } - /* We must force a BLOCK for this level - so that, if it is not expanded later, - there is a way to turn off the entire subtree of blocks - that are contained in it. */ - keep_next_level (); - push_label_level (); - $$ = expand_start_stmt_expr (); } - compstmt ')' + | compstmt_primary_start compstmt_nostart ')' { tree rtl_exp; if (pedantic) pedwarn ("ANSI C forbids braced-groups within expressions"); + pop_iterator_stack (); pop_label_level (); - rtl_exp = expand_end_stmt_expr ($2); + rtl_exp = expand_end_stmt_expr ($1); /* The statements have side effects, so the group does. */ TREE_SIDE_EFFECTS (rtl_exp) = 1; - /* Make a BIND_EXPR for the BLOCK already made. */ - $$ = build (BIND_EXPR, TREE_TYPE (rtl_exp), - NULL_TREE, rtl_exp, $3); - /* Remove the block from the tree at this point. - It gets put back at the proper place - when the BIND_EXPR is expanded. */ - delete_block ($3); + if (TREE_CODE ($2) == BLOCK) + { + /* Make a BIND_EXPR for the BLOCK already made. */ + $$ = build (BIND_EXPR, TREE_TYPE (rtl_exp), + NULL_TREE, rtl_exp, $2); + /* Remove the block from the tree at this point. + It gets put back at the proper place + when the BIND_EXPR is expanded. */ + delete_block ($2); + } + else + $$ = $2; + } + | compstmt_primary_start error ')' + { + /* Make sure we call expand_end_stmt_expr. Otherwise + we are likely to lose sequences and crash later. */ + pop_iterator_stack (); + pop_label_level (); + expand_end_stmt_expr ($1); + $$ = error_mark_node; } | primary '(' exprlist ')' %prec '.' { $$ = build_function_call ($1, $3); } @@ -730,8 +879,12 @@ ifobjc { $$ = build_message_expr ($1); } | objcselectorexpr { $$ = build_selector_expr ($1); } + | objcprotocolexpr + { $$ = build_protocol_expr ($1); } | objcencodeexpr { $$ = build_encode_expr ($1); } + | objc_string + { $$ = build_objc_string_object ($1); } end ifobjc ; @@ -742,7 +895,17 @@ string: { $$ = chainon ($1, $2); } ; -xdecls: +ifobjc +/* Produces an OBJC_STRING_CST with perhaps more OBJC_STRING_CSTs chained + onto it. */ +objc_string: + OBJC_STRING + | objc_string OBJC_STRING + { $$ = chainon ($1, $2); } + ; +end ifobjc + +old_style_parm_decls: /* empty */ | datadecls | datadecls ELLIPSIS @@ -767,19 +930,25 @@ datadecls: | lineno_datadecl errstmt ; +/* We don't allow prefix attributes here because they cause reduce/reduce + conflicts: we can't know whether we're parsing a function decl with + attribute suffix, or function defn with attribute prefix on first old + style parm. */ datadecl: - typed_declspecs setspecs initdecls ';' + typed_declspecs_no_prefix_attr setspecs initdecls ';' { current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); declspec_stack = TREE_CHAIN (declspec_stack); resume_momentary ($2); } - | declmods setspecs notype_initdecls ';' - { current_declspecs = TREE_VALUE (declspec_stack); + | declmods_no_prefix_attr setspecs notype_initdecls ';' + { current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); declspec_stack = TREE_CHAIN (declspec_stack); resume_momentary ($2); } - | typed_declspecs ';' + | typed_declspecs_no_prefix_attr ';' { shadow_tag_warned ($1, 1); pedwarn ("empty declaration"); } - | declmods ';' + | declmods_no_prefix_attr ';' { pedwarn ("empty declaration"); } ; @@ -806,37 +975,51 @@ decls: setspecs: /* empty */ { $$ = suspend_momentary (); pending_xref_error (); - declspec_stack = tree_cons (NULL_TREE, current_declspecs, + declspec_stack = tree_cons (prefix_attributes, + current_declspecs, declspec_stack); - current_declspecs = $0; } + split_specs_attrs ($0, + ¤t_declspecs, &prefix_attributes); } + ; + +/* ??? Yuck. See after_type_declarator. */ +setattrs: /* empty */ + { prefix_attributes = chainon (prefix_attributes, $0); } ; decl: typed_declspecs setspecs initdecls ';' { current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); declspec_stack = TREE_CHAIN (declspec_stack); resume_momentary ($2); } | declmods setspecs notype_initdecls ';' { current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); declspec_stack = TREE_CHAIN (declspec_stack); resume_momentary ($2); } | typed_declspecs setspecs nested_function { current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); declspec_stack = TREE_CHAIN (declspec_stack); resume_momentary ($2); } | declmods setspecs notype_nested_function { current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); declspec_stack = TREE_CHAIN (declspec_stack); resume_momentary ($2); } | typed_declspecs ';' { shadow_tag ($1); } | declmods ';' { pedwarn ("empty declaration"); } + | extension decl + { RESTORE_WARN_FLAGS ($1); } ; /* Declspecs which contain at least one type specifier or typedef name. (Just `const' or `volatile' is not enough.) - A typedef'd name following these is taken as a name to be declared. */ + A typedef'd name following these is taken as a name to be declared. + Declspecs have a non-NULL TREE_VALUE, attributes do not. */ typed_declspecs: typespec reserved_declspecs @@ -854,22 +1037,55 @@ reserved_declspecs: /* empty */ warning ("`%s' is not at beginning of declaration", IDENTIFIER_POINTER ($2)); $$ = tree_cons (NULL_TREE, $2, $1); } + | reserved_declspecs attributes + { $$ = tree_cons ($2, NULL_TREE, $1); } + ; + +typed_declspecs_no_prefix_attr: + typespec reserved_declspecs_no_prefix_attr + { $$ = tree_cons (NULL_TREE, $1, $2); } + | declmods_no_prefix_attr typespec reserved_declspecs_no_prefix_attr + { $$ = chainon ($3, tree_cons (NULL_TREE, $2, $1)); } ; -/* List of just storage classes and type modifiers. +reserved_declspecs_no_prefix_attr: + /* empty */ + { $$ = NULL_TREE; } + | reserved_declspecs_no_prefix_attr typespecqual_reserved + { $$ = tree_cons (NULL_TREE, $2, $1); } + | reserved_declspecs_no_prefix_attr SCSPEC + { if (extra_warnings) + warning ("`%s' is not at beginning of declaration", + IDENTIFIER_POINTER ($2)); + $$ = tree_cons (NULL_TREE, $2, $1); } + ; + +/* List of just storage classes, type modifiers, and prefix attributes. A declaration can start with just this, but then it cannot be used - to redeclare a typedef-name. */ + to redeclare a typedef-name. + Declspecs have a non-NULL TREE_VALUE, attributes do not. */ declmods: + declmods_no_prefix_attr + { $$ = $1; } + | attributes + { $$ = tree_cons ($1, NULL_TREE, NULL_TREE); } + | declmods declmods_no_prefix_attr + { $$ = chainon ($2, $1); } + | declmods attributes + { $$ = tree_cons ($2, NULL_TREE, $1); } + ; + +declmods_no_prefix_attr: TYPE_QUAL { $$ = tree_cons (NULL_TREE, $1, NULL_TREE); TREE_STATIC ($$) = 1; } | SCSPEC { $$ = tree_cons (NULL_TREE, $1, NULL_TREE); } - | declmods TYPE_QUAL + | declmods_no_prefix_attr TYPE_QUAL { $$ = tree_cons (NULL_TREE, $2, $1); TREE_STATIC ($$) = 1; } - | declmods SCSPEC + | declmods_no_prefix_attr SCSPEC { if (extra_warnings && TREE_STATIC ($1)) warning ("`%s' is not at beginning of declaration", IDENTIFIER_POINTER ($2)); @@ -906,8 +1122,15 @@ typespec: TYPESPEC In case of `foo foo, bar;'. */ $$ = lookup_name ($1); } ifobjc - | CLASSNAME - { $$ = get_static_reference ($1); } + | CLASSNAME protocolrefs + { $$ = get_static_reference ($1, $2); } + | OBJECTNAME protocolrefs + { $$ = get_object_reference ($2); } + +/* Make "" equivalent to "id " + - nisse@lysator.liu.se */ + | non_empty_protocolrefs + { $$ = get_object_reference ($1); } end ifobjc | TYPEOF '(' expr ')' { $$ = TREE_TYPE ($3); } @@ -943,141 +1166,175 @@ maybeasm: initdcl: declarator maybeasm maybe_attribute '=' - { $$ = start_decl ($1, current_declspecs, 1); } + { $$ = start_decl ($1, current_declspecs, 1, + $3, prefix_attributes); + start_init ($$, $2, global_bindings_p ()); } init /* Note how the declaration of the variable is in effect while its init is parsed! */ - { decl_attributes ($5, $3); + { finish_init (); finish_decl ($5, $6, $2); } | declarator maybeasm maybe_attribute - { tree d = start_decl ($1, current_declspecs, 0); - decl_attributes (d, $3); - finish_decl (d, NULL_TREE, $2); } + { tree d = start_decl ($1, current_declspecs, 0, + $3, prefix_attributes); + finish_decl (d, NULL_TREE, $2); + } ; notype_initdcl: notype_declarator maybeasm maybe_attribute '=' - { $$ = start_decl ($1, current_declspecs, 1); } + { $$ = start_decl ($1, current_declspecs, 1, + $3, prefix_attributes); + start_init ($$, $2, global_bindings_p ()); } init /* Note how the declaration of the variable is in effect while its init is parsed! */ - { decl_attributes ($5, $3); + { finish_init (); + decl_attributes ($5, $3, prefix_attributes); finish_decl ($5, $6, $2); } | notype_declarator maybeasm maybe_attribute - { tree d = start_decl ($1, current_declspecs, 0); - decl_attributes (d, $3); + { tree d = start_decl ($1, current_declspecs, 0, + $3, prefix_attributes); finish_decl (d, NULL_TREE, $2); } ; /* the * rules are dummies to accept the Apollo extended syntax so that the header files compile. */ maybe_attribute: + /* empty */ + { $$ = NULL_TREE; } + | attributes + { $$ = $1; } + ; + +attributes: + attribute + { $$ = $1; } + | attributes attribute + { $$ = chainon ($1, $2); } + ; + +attribute: + ATTRIBUTE '(' '(' attribute_list ')' ')' + { $$ = $4; } + ; + +attribute_list: + attrib + { $$ = $1; } + | attribute_list ',' attrib + { $$ = chainon ($1, $3); } + ; + +attrib: /* empty */ { $$ = NULL_TREE; } - | ATTRIBUTE '(' '(' attribute_list ')' ')' - { $$ = $4; } - ; - -attribute_list - : attrib - { $$ = tree_cons (NULL_TREE, $1, NULL_TREE); } - | attribute_list ',' attrib - { $$ = tree_cons (NULL_TREE, $3, $1); } - ; - -attrib - : IDENTIFIER - { if (strcmp (IDENTIFIER_POINTER ($1), "packed")) - warning ("`%s' attribute directive ignored", - IDENTIFIER_POINTER ($1)); - $$ = $1; } - | IDENTIFIER '(' IDENTIFIER ')' - { /* If not "mode (m)", then issue warning. */ - if (strcmp (IDENTIFIER_POINTER ($1), "mode") != 0) - { - warning ("`%s' attribute directive ignored", - IDENTIFIER_POINTER ($1)); - $$ = $1; - } - else - $$ = tree_cons ($1, $3, NULL_TREE); } - | IDENTIFIER '(' CONSTANT ')' - { /* if not "aligned(n)", then issue warning */ - if (strcmp (IDENTIFIER_POINTER ($1), "aligned") != 0 - || TREE_CODE ($3) != INTEGER_CST) - { - warning ("`%s' attribute directive ignored", - IDENTIFIER_POINTER ($1)); - $$ = $1; - } - else - $$ = tree_cons ($1, $3, NULL_TREE); } - | IDENTIFIER '(' IDENTIFIER ',' CONSTANT ',' CONSTANT ')' - { /* if not "format(...)", then issue warning */ - if (strcmp (IDENTIFIER_POINTER ($1), "format") != 0 - || TREE_CODE ($5) != INTEGER_CST - || TREE_CODE ($7) != INTEGER_CST) - { - warning ("`%s' attribute directive ignored", - IDENTIFIER_POINTER ($1)); - $$ = $1; - } - else - $$ = tree_cons ($1, - tree_cons ($3, - tree_cons ($5, $7, NULL_TREE), - NULL_TREE), - NULL_TREE); } - ; + | any_word + { $$ = build_tree_list ($1, NULL_TREE); } + | any_word '(' IDENTIFIER ')' + { $$ = build_tree_list ($1, build_tree_list (NULL_TREE, $3)); } + | any_word '(' IDENTIFIER ',' nonnull_exprlist ')' + { $$ = build_tree_list ($1, tree_cons (NULL_TREE, $3, $5)); } + | any_word '(' exprlist ')' + { $$ = build_tree_list ($1, $3); } + ; + +/* This still leaves out most reserved keywords, + shouldn't we include them? */ + +any_word: + identifier + | SCSPEC + | TYPESPEC + | TYPE_QUAL + ; + +/* Initializers. `init' is the entry point. */ init: expr_no_commas - | '{' '}' - { $$ = build_nt (CONSTRUCTOR, NULL_TREE, NULL_TREE); - if (pedantic) + | '{' + { really_start_incremental_init (NULL_TREE); + /* Note that the call to clear_momentary + is in process_init_element. */ + push_momentary (); } + initlist_maybe_comma '}' + { $$ = pop_init_level (0); + if ($$ == error_mark_node + && ! (yychar == STRING || yychar == CONSTANT)) + pop_momentary (); + else + pop_momentary_nofree (); } + + | error + { $$ = error_mark_node; } + ; + +/* `initlist_maybe_comma' is the guts of an initializer in braces. */ +initlist_maybe_comma: + /* empty */ + { if (pedantic) pedwarn ("ANSI C forbids empty initializer braces"); } - | '{' initlist '}' - { $$ = build_nt (CONSTRUCTOR, NULL_TREE, nreverse ($2)); } - | '{' initlist ',' '}' - { $$ = build_nt (CONSTRUCTOR, NULL_TREE, nreverse ($2)); } + | initlist1 maybecomma + ; + +initlist1: + initelt + | initlist1 ',' initelt + ; + +/* `initelt' is a single element of an initializer. + It may use braces. */ +initelt: + designator_list '=' initval + | designator initval + | identifier ':' + { set_init_label ($1); } + initval + | initval + ; + +initval: + '{' + { push_init_level (0); } + initlist_maybe_comma '}' + { process_init_element (pop_init_level (0)); } + | expr_no_commas + { process_init_element ($1); } | error - { $$ = NULL_TREE; } ; -/* This chain is built in reverse order, - and put in forward order where initlist is used. */ -initlist: - init - { $$ = build_tree_list (NULL_TREE, $1); } - | initlist ',' init - { $$ = tree_cons (NULL_TREE, $3, $1); } - /* These are for labeled elements. */ - | '[' expr_no_commas ELLIPSIS expr_no_commas ']' init - { $$ = build_tree_list (tree_cons ($2, NULL_TREE, - build_tree_list ($4, NULL_TREE)), - $6); } - | initlist ',' '[' expr_no_commas ELLIPSIS expr_no_commas ']' init - { $$ = tree_cons (tree_cons ($4, NULL_TREE, - build_tree_list ($6, NULL_TREE)), - $8, - $1); } - | '[' expr_no_commas ']' init - { $$ = build_tree_list ($2, $4); } - | initlist ',' '[' expr_no_commas ']' init - { $$ = tree_cons ($4, $6, $1); } - | identifier ':' init - { $$ = build_tree_list ($1, $3); } - | initlist ',' identifier ':' init - { $$ = tree_cons ($3, $5, $1); } +designator_list: + designator + | designator_list designator ; +designator: + '.' identifier + { set_init_label ($2); } + /* These are for labeled elements. The syntax for an array element + initializer conflicts with the syntax for an Objective-C message, + so don't include these productions in the Objective-C grammar. */ +ifc + | '[' expr_no_commas ELLIPSIS expr_no_commas ']' + { set_init_index ($2, $4); } + | '[' expr_no_commas ']' + { set_init_index ($2, NULL_TREE); } +end ifc + ; + nested_function: declarator - { push_c_function_context (); - if (! start_function (current_declspecs, $1, 1)) + { if (pedantic) + pedwarn ("ANSI C forbids nested functions"); + + push_function_context (); + if (! start_function (current_declspecs, $1, + prefix_attributes, NULL_TREE, 1)) { - pop_c_function_context (); + pop_function_context (); YYERROR1; } - reinit_parse_for_function (); - store_parm_decls (); } + reinit_parse_for_function (); } + old_style_parm_decls + { store_parm_decls (); } /* This used to use compstmt_or_error. That caused a bug with input `f(g) int g {}', where the use of YYERROR1 above caused an error @@ -1086,19 +1343,24 @@ nested_function: which called YYERROR1 again, and so on. */ compstmt { finish_function (1); - pop_c_function_context (); } + pop_function_context (); } ; notype_nested_function: notype_declarator - { push_c_function_context (); - if (! start_function (current_declspecs, $1, 1)) + { if (pedantic) + pedwarn ("ANSI C forbids nested functions"); + + push_function_context (); + if (! start_function (current_declspecs, $1, + prefix_attributes, NULL_TREE, 1)) { - pop_c_function_context (); + pop_function_context (); YYERROR1; } - reinit_parse_for_function (); - store_parm_decls (); } + reinit_parse_for_function (); } + old_style_parm_decls + { store_parm_decls (); } /* This used to use compstmt_or_error. That caused a bug with input `f(g) int g {}', where the use of YYERROR1 above caused an error @@ -1107,7 +1369,7 @@ notype_nested_function: which called YYERROR1 again, and so on. */ compstmt { finish_function (1); - pop_c_function_context (); } + pop_function_context (); } ; /* Any kind of declarator (thus, all declarators allowed @@ -1134,7 +1396,17 @@ after_type_declarator: { $$ = build_nt (ARRAY_REF, $1, NULL_TREE); } | '*' type_quals after_type_declarator %prec UNARY { $$ = make_pointer_declarator ($2, $3); } + /* ??? Yuck. setattrs is a quick hack. We can't use + prefix_attributes because $1 only applies to this + declarator. We assume setspecs has already been done. + setattrs also avoids 5 reduce/reduce conflicts (otherwise multiple + attributes could be recognized here or in `attributes'). */ + | attributes setattrs after_type_declarator + { $$ = $3; } | TYPENAME +ifobjc + | OBJECTNAME +end ifobjc ; /* Kinds of declarator that can appear in a parameter list @@ -1148,12 +1420,26 @@ parm_declarator: /* | parm_declarator '(' error ')' %prec '.' { $$ = build_nt (CALL_EXPR, $1, NULL_TREE, NULL_TREE); poplevel (0, 0, 0); } */ +ifc + | parm_declarator '[' '*' ']' %prec '.' + { $$ = build_nt (ARRAY_REF, $1, NULL_TREE); + if (! flag_isoc9x) + error ("`[*]' in parameter declaration only allowed in ISO C 9x"); + } +end ifc | parm_declarator '[' expr ']' %prec '.' { $$ = build_nt (ARRAY_REF, $1, $3); } | parm_declarator '[' ']' %prec '.' { $$ = build_nt (ARRAY_REF, $1, NULL_TREE); } | '*' type_quals parm_declarator %prec UNARY { $$ = make_pointer_declarator ($2, $3); } + /* ??? Yuck. setattrs is a quick hack. We can't use + prefix_attributes because $1 only applies to this + declarator. We assume setspecs has already been done. + setattrs also avoids 5 reduce/reduce conflicts (otherwise multiple + attributes could be recognized here or in `attributes'). */ + | attributes setattrs parm_declarator + { $$ = $3; } | TYPENAME ; @@ -1170,49 +1456,84 @@ notype_declarator: { $$ = $2; } | '*' type_quals notype_declarator %prec UNARY { $$ = make_pointer_declarator ($2, $3); } +ifc + | notype_declarator '[' '*' ']' %prec '.' + { $$ = build_nt (ARRAY_REF, $1, NULL_TREE); + if (! flag_isoc9x) + error ("`[*]' in parameter declaration only allowed in ISO C 9x"); + } +end ifc | notype_declarator '[' expr ']' %prec '.' { $$ = build_nt (ARRAY_REF, $1, $3); } | notype_declarator '[' ']' %prec '.' { $$ = build_nt (ARRAY_REF, $1, NULL_TREE); } + /* ??? Yuck. setattrs is a quick hack. We can't use + prefix_attributes because $1 only applies to this + declarator. We assume setspecs has already been done. + setattrs also avoids 5 reduce/reduce conflicts (otherwise multiple + attributes could be recognized here or in `attributes'). */ + | attributes setattrs notype_declarator + { $$ = $3; } | IDENTIFIER ; +struct_head: + STRUCT + { $$ = NULL_TREE; } + | STRUCT attributes + { $$ = $2; } + ; + +union_head: + UNION + { $$ = NULL_TREE; } + | UNION attributes + { $$ = $2; } + ; + +enum_head: + ENUM + { $$ = NULL_TREE; } + | ENUM attributes + { $$ = $2; } + ; + structsp: - STRUCT identifier '{' + struct_head identifier '{' { $$ = start_struct (RECORD_TYPE, $2); /* Start scope of tag before parsing components. */ } - component_decl_list '}' - { $$ = finish_struct ($4, $5); - /* Really define the structure. */ - } - | STRUCT '{' component_decl_list '}' + component_decl_list '}' maybe_attribute + { $$ = finish_struct ($4, $5, chainon ($1, $7)); } + | struct_head '{' component_decl_list '}' maybe_attribute { $$ = finish_struct (start_struct (RECORD_TYPE, NULL_TREE), - $3); } - | STRUCT identifier + $3, chainon ($1, $5)); + } + | struct_head identifier { $$ = xref_tag (RECORD_TYPE, $2); } - | UNION identifier '{' + | union_head identifier '{' { $$ = start_struct (UNION_TYPE, $2); } - component_decl_list '}' - { $$ = finish_struct ($4, $5); } - | UNION '{' component_decl_list '}' + component_decl_list '}' maybe_attribute + { $$ = finish_struct ($4, $5, chainon ($1, $7)); } + | union_head '{' component_decl_list '}' maybe_attribute { $$ = finish_struct (start_struct (UNION_TYPE, NULL_TREE), - $3); } - | UNION identifier + $3, chainon ($1, $5)); + } + | union_head identifier { $$ = xref_tag (UNION_TYPE, $2); } - | ENUM identifier '{' + | enum_head identifier '{' { $3 = suspend_momentary (); $$ = start_enum ($2); } - enumlist maybecomma_warn '}' - { $$ = finish_enum ($4, nreverse ($5)); + enumlist maybecomma_warn '}' maybe_attribute + { $$= finish_enum ($4, nreverse ($5), chainon ($1, $8)); resume_momentary ($3); } - | ENUM '{' + | enum_head '{' { $2 = suspend_momentary (); $$ = start_enum (NULL_TREE); } - enumlist maybecomma_warn '}' - { $$ = finish_enum ($3, nreverse ($4)); + enumlist maybecomma_warn '}' maybe_attribute + { $$= finish_enum ($3, nreverse ($4), chainon ($1, $7)); resume_momentary ($2); } - | ENUM identifier + | enum_head identifier { $$ = xref_tag (ENUMERAL_TYPE, $2); } ; @@ -1224,7 +1545,8 @@ maybecomma: maybecomma_warn: /* empty */ | ',' - { if (pedantic) pedwarn ("comma at end of enumerator list"); } + { if (pedantic && ! flag_isoc9x) + pedwarn ("comma at end of enumerator list"); } ; component_decl_list: @@ -1245,7 +1567,18 @@ component_decl_list2: /* empty */ ifobjc /* foo(sizeof(struct{ @defs(ClassName)})); */ | DEFS '(' CLASSNAME ')' - { $$ = get_class_ivars ($3); } + { + tree interface = lookup_interface ($3); + + if (interface) + $$ = get_class_ivars (interface); + else + { + error ("Cannot find interface declaration for `%s'", + IDENTIFIER_POINTER ($3)); + $$ = NULL_TREE; + } + } end ifobjc ; @@ -1262,16 +1595,27 @@ component_decl: typed_typespecs setspecs components { $$ = $3; current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); declspec_stack = TREE_CHAIN (declspec_stack); resume_momentary ($2); } - | typed_typespecs - { if (pedantic) - pedwarn ("ANSI C forbids member declarations with no members"); - shadow_tag($1); - $$ = NULL_TREE; } - | nonempty_type_quals setspecs components + | typed_typespecs setspecs save_filename save_lineno maybe_attribute + { + /* Support for unnamed structs or unions as members of + structs or unions (which is [a] useful and [b] supports + MS P-SDK). */ + if (pedantic) + pedwarn ("ANSI C doesn't support unnamed structs/unions"); + + $$ = grokfield($3, $4, NULL, current_declspecs, NULL_TREE); + current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); + declspec_stack = TREE_CHAIN (declspec_stack); + resume_momentary ($2); + } + | nonempty_type_quals setspecs components { $$ = $3; current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); declspec_stack = TREE_CHAIN (declspec_stack); resume_momentary ($2); } | nonempty_type_quals @@ -1281,6 +1625,9 @@ component_decl: $$ = NULL_TREE; } | error { $$ = NULL_TREE; } + | extension component_decl + { $$ = $2; + RESTORE_WARN_FLAGS ($1); } ; components: @@ -1292,14 +1639,14 @@ components: component_declarator: save_filename save_lineno declarator maybe_attribute { $$ = grokfield ($1, $2, $3, current_declspecs, NULL_TREE); - decl_attributes ($$, $4); } + decl_attributes ($$, $4, prefix_attributes); } | save_filename save_lineno declarator ':' expr_no_commas maybe_attribute { $$ = grokfield ($1, $2, $3, current_declspecs, $5); - decl_attributes ($$, $6); } + decl_attributes ($$, $6, prefix_attributes); } | save_filename save_lineno ':' expr_no_commas maybe_attribute { $$ = grokfield ($1, $2, NULL_TREE, current_declspecs, $4); - decl_attributes ($$, $5); } + decl_attributes ($$, $5, prefix_attributes); } ; /* We chain the enumerators in reverse order. @@ -1310,7 +1657,12 @@ component_declarator: enumlist: enumerator | enumlist ',' enumerator - { $$ = chainon ($3, $1); } + { if ($1 == error_mark_node) + $$ = $1; + else + $$ = chainon ($3, $1); } + | error + { $$ = error_mark_node; } ; @@ -1368,6 +1720,10 @@ absdcl1: /* a nonempty absolute declarator */ { $$ = build_nt (ARRAY_REF, NULL_TREE, $2); } | '[' ']' %prec '.' { $$ = build_nt (ARRAY_REF, NULL_TREE, NULL_TREE); } + /* ??? It appears we have to support attributes here, however + using prefix_attributes is wrong. */ + | attributes setattrs absdcl1 + { $$ = $3; } ; /* at least one statement, the first of which parses without error. */ @@ -1375,9 +1731,19 @@ absdcl1: /* a nonempty absolute declarator */ is actually regarded as an invalid decl and part of the decls. */ stmts: + lineno_stmt_or_labels + { + if (pedantic && $1) + pedwarn ("ANSI C forbids label at end of compound statement"); + } + ; + +lineno_stmt_or_labels: lineno_stmt_or_label - | stmts lineno_stmt_or_label - | stmts errstmt + | lineno_stmt_or_labels lineno_stmt_or_label + { $$ = $2; } + | lineno_stmt_or_labels errstmt + { $$ = 0; } ; xstmts: @@ -1435,30 +1801,63 @@ compstmt_or_error: | error compstmt ; -compstmt: '{' '}' +compstmt_start: '{' { compstmt_count++; } + +compstmt_nostart: '}' { $$ = convert (void_type_node, integer_zero_node); } - | '{' pushlevel maybe_label_decls decls xstmts '}' + | pushlevel maybe_label_decls decls xstmts '}' { emit_line_note (input_filename, lineno); expand_end_bindings (getdecls (), 1, 0); $$ = poplevel (1, 1, 0); - pop_momentary (); } - | '{' pushlevel maybe_label_decls error '}' + if (yychar == CONSTANT || yychar == STRING) + pop_momentary_nofree (); + else + pop_momentary (); } + | pushlevel maybe_label_decls error '}' { emit_line_note (input_filename, lineno); expand_end_bindings (getdecls (), kept_level_p (), 0); $$ = poplevel (kept_level_p (), 0, 0); - pop_momentary (); } - | '{' pushlevel maybe_label_decls stmts '}' + if (yychar == CONSTANT || yychar == STRING) + pop_momentary_nofree (); + else + pop_momentary (); } + | pushlevel maybe_label_decls stmts '}' { emit_line_note (input_filename, lineno); expand_end_bindings (getdecls (), kept_level_p (), 0); $$ = poplevel (kept_level_p (), 0, 0); - pop_momentary (); } + if (yychar == CONSTANT || yychar == STRING) + pop_momentary_nofree (); + else + pop_momentary (); } + ; + +compstmt_primary_start: + '(' '{' + { if (current_function_decl == 0) + { + error ("braced-group within expression allowed only inside a function"); + YYERROR; + } + /* We must force a BLOCK for this level + so that, if it is not expanded later, + there is a way to turn off the entire subtree of blocks + that are contained in it. */ + keep_next_level (); + push_iterator_stack (); + push_label_level (); + $$ = expand_start_stmt_expr (); + compstmt_count++; + } + +compstmt: compstmt_start compstmt_nostart + { $$ = $2; } ; /* Value is number of statements counted as of the closeparen. */ simple_if: if_prefix lineno_labeled_stmt -/* Make sure expand_end_cond is run once - for each call to expand_start_cond. +/* Make sure c_expand_end_cond is run once + for each call to c_expand_start_cond. Otherwise a crash is likely. */ | if_prefix error ; @@ -1466,8 +1865,9 @@ simple_if: if_prefix: IF '(' expr ')' { emit_line_note ($-1, $0); - expand_start_cond (truthvalue_conversion ($3), 0); - $1 = stmt_count; + c_expand_start_cond (truthvalue_conversion ($3), 0, + compstmt_count); + $$ = stmt_count; if_stmt_file = $-1; if_stmt_line = $0; position_after_white_space (); } @@ -1479,6 +1879,7 @@ if_prefix: do_stmt_start: DO { stmt_count++; + compstmt_count++; emit_line_note ($-1, $0); /* See comment in `while' alternative, above. */ emit_nop (); @@ -1508,48 +1909,60 @@ lineno_labeled_stmt: lineno_stmt_or_label: save_filename save_lineno stmt_or_label - { } + { $$ = $3; } ; stmt_or_label: stmt + { $$ = 0; } | label - { int next; - position_after_white_space (); - next = getc (finput); - ungetc (next, finput); - if (pedantic && next == '}') - pedwarn ("ANSI C forbids label at end of compound statement"); - } + { $$ = 1; } ; /* Parse a single real statement, not including any labels. */ stmt: compstmt { stmt_count++; } + | all_iter_stmt | expr ';' { stmt_count++; emit_line_note ($-1, $0); - c_expand_expr_stmt ($1); +/* It appears that this should not be done--that a non-lvalue array + shouldn't get an error if the value isn't used. + Section 3.2.2.1 says that an array lvalue gets converted to a pointer + if it appears as a top-level expression, + but says nothing about non-lvalue arrays. */ +#if 0 + /* Call default_conversion to get an error + on referring to a register array if pedantic. */ + if (TREE_CODE (TREE_TYPE ($1)) == ARRAY_TYPE + || TREE_CODE (TREE_TYPE ($1)) == FUNCTION_TYPE) + $1 = default_conversion ($1); +#endif + iterator_expand ($1); clear_momentary (); } | simple_if ELSE - { expand_start_else (); + { c_expand_start_else (); $1 = stmt_count; position_after_white_space (); } lineno_labeled_stmt - { expand_end_cond (); + { c_expand_end_cond (); if (extra_warnings && stmt_count == $1) warning ("empty body in an else-statement"); } | simple_if %prec IF - { expand_end_cond (); - if (extra_warnings && stmt_count == $1) + { c_expand_end_cond (); + /* This warning is here instead of in simple_if, because we + do not want a warning if an empty if is followed by an + else statement. Increment stmt_count so we don't + give a second error if this is a nested `if'. */ + if (extra_warnings && stmt_count++ == $1) warning_with_file_and_line (if_stmt_file, if_stmt_line, "empty body in an if-statement"); } -/* Make sure expand_end_cond is run once - for each call to expand_start_cond. +/* Make sure c_expand_end_cond is run once + for each call to c_expand_start_cond. Otherwise a crash is likely. */ | simple_if ELSE error - { expand_end_cond (); } + { c_expand_end_cond (); } | WHILE { stmt_count++; emit_line_note ($-1, $0); @@ -1620,7 +2033,10 @@ stmt: expand_loop_continue_here (); if ($9) c_expand_expr_stmt ($9); - pop_momentary (); + if (yychar == CONSTANT || yychar == STRING) + pop_momentary_nofree (); + else + pop_momentary (); expand_end_loop (); } | SWITCH '(' expr ')' { stmt_count++; @@ -1632,7 +2048,10 @@ stmt: position_after_white_space (); } lineno_labeled_stmt { expand_end_case ($3); - pop_momentary (); } + if (yychar == CONSTANT || yychar == STRING) + pop_momentary_nofree (); + else + pop_momentary (); } | BREAK ';' { stmt_count++; emit_line_note ($-1, $0); @@ -1695,12 +2114,72 @@ stmt: } } | GOTO '*' expr ';' - { stmt_count++; + { if (pedantic) + pedwarn ("ANSI C forbids `goto *expr;'"); + stmt_count++; emit_line_note ($-1, $0); expand_computed_goto (convert (ptr_type_node, $3)); } | ';' ; +all_iter_stmt: + all_iter_stmt_simple +/* | all_iter_stmt_with_decl */ + ; + +all_iter_stmt_simple: + FOR '(' primary ')' + { + /* The value returned by this action is */ + /* 1 if everything is OK */ + /* 0 in case of error or already bound iterator */ + + $$ = 0; + if (TREE_CODE ($3) != VAR_DECL) + error ("invalid `for (ITERATOR)' syntax"); + else if (! ITERATOR_P ($3)) + error ("`%s' is not an iterator", + IDENTIFIER_POINTER (DECL_NAME ($3))); + else if (ITERATOR_BOUND_P ($3)) + error ("`for (%s)' inside expansion of same iterator", + IDENTIFIER_POINTER (DECL_NAME ($3))); + else + { + $$ = 1; + iterator_for_loop_start ($3); + } + } + lineno_labeled_stmt + { + if ($5) + iterator_for_loop_end ($3); + } + +/* This really should allow any kind of declaration, + for generality. Fix it before turning it back on. + +all_iter_stmt_with_decl: + FOR '(' ITERATOR pushlevel setspecs iterator_spec ')' + { +*/ /* The value returned by this action is */ + /* 1 if everything is OK */ + /* 0 in case of error or already bound iterator */ +/* + iterator_for_loop_start ($6); + } + lineno_labeled_stmt + { + iterator_for_loop_end ($6); + emit_line_note (input_filename, lineno); + expand_end_bindings (getdecls (), 1, 0); + $$ = poplevel (1, 1, 0); + if (yychar == CONSTANT || yychar == STRING) + pop_momentary_nofree (); + else + pop_momentary (); + } +*/ + /* Any kind of label, including jump labels and case labels. ANSI C accepts labels only before statements, but we allow them also at the end of a compound statement. */ @@ -1715,7 +2194,14 @@ label: CASE expr_no_commas ':' if (value != error_mark_node) { tree duplicate; - int success = pushcase (value, label, &duplicate); + int success; + + if (pedantic && ! INTEGRAL_TYPE_P (TREE_TYPE (value))) + pedwarn ("label must have integral type in ANSI C"); + + success = pushcase (value, convert_and_check, + label, &duplicate); + if (success == 1) error ("case label not within a switch statement"); else if (success == 2) @@ -1735,12 +2221,15 @@ label: CASE expr_no_commas ':' register tree label = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE); + if (pedantic) + pedwarn ("ANSI C forbids case ranges"); stmt_count++; if (value1 != error_mark_node && value2 != error_mark_node) { tree duplicate; - int success = pushcase_range (value1, value2, label, + int success = pushcase_range (value1, value2, + convert_and_check, label, &duplicate); if (success == 1) error ("case label not within a switch statement"); @@ -1762,7 +2251,7 @@ label: CASE expr_no_commas ':' tree duplicate; register tree label = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE); - int success = pushcase (NULL_TREE, label, &duplicate); + int success = pushcase (NULL_TREE, 0, label, &duplicate); stmt_count++; if (success == 1) error ("default label not within a switch statement"); @@ -1772,12 +2261,15 @@ label: CASE expr_no_commas ':' error_with_decl (duplicate, "this is the first default label"); } position_after_white_space (); } - | identifier ':' + | identifier ':' maybe_attribute { tree label = define_label (input_filename, lineno, $1); stmt_count++; emit_nop (); if (label) - expand_label (label); + { + expand_label (label); + decl_attributes (label, $3, NULL_TREE); + } position_after_white_space (); } ; @@ -1785,7 +2277,8 @@ label: CASE expr_no_commas ':' maybe_type_qual: /* empty */ - { emit_line_note (input_filename, lineno); } + { emit_line_note (input_filename, lineno); + $$ = NULL_TREE; } | TYPE_QUAL { emit_line_note (input_filename, lineno); } ; @@ -1855,8 +2348,13 @@ parmlist_2: /* empty */ { $$ = get_parm_info (0); } | ELLIPSIS { $$ = get_parm_info (0); - if (pedantic) - pedwarn ("ANSI C requires a named argument before `...'"); + /* Gcc used to allow this as an extension. However, it does + not work for all targets, and thus has been disabled. + Also, since func (...) and func () are indistinguishable, + it caused problems with the code in expand_builtin which + tries to verify that BUILT_IN_NEXT_ARG is being used + correctly. */ + error ("ANSI C requires a named argument before `...'"); } | parms { $$ = get_parm_info (1); } @@ -1874,16 +2372,52 @@ parms: /* A single parameter declaration or parameter type name, as found in a parmlist. */ parm: - typed_declspecs parm_declarator - { $$ = build_tree_list ($1, $2) ; } - | typed_declspecs notype_declarator - { $$ = build_tree_list ($1, $2) ; } - | typed_declspecs absdcl - { $$ = build_tree_list ($1, $2); } - | declmods notype_declarator - { $$ = build_tree_list ($1, $2) ; } - | declmods absdcl - { $$ = build_tree_list ($1, $2); } + typed_declspecs setspecs parm_declarator maybe_attribute + { $$ = build_tree_list (build_tree_list (current_declspecs, + $3), + build_tree_list (prefix_attributes, + $4)); + current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); + declspec_stack = TREE_CHAIN (declspec_stack); + resume_momentary ($2); } + | typed_declspecs setspecs notype_declarator maybe_attribute + { $$ = build_tree_list (build_tree_list (current_declspecs, + $3), + build_tree_list (prefix_attributes, + $4)); + current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); + declspec_stack = TREE_CHAIN (declspec_stack); + resume_momentary ($2); } + | typed_declspecs setspecs absdcl maybe_attribute + { $$ = build_tree_list (build_tree_list (current_declspecs, + $3), + build_tree_list (prefix_attributes, + $4)); + current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); + declspec_stack = TREE_CHAIN (declspec_stack); + resume_momentary ($2); } + | declmods setspecs notype_declarator maybe_attribute + { $$ = build_tree_list (build_tree_list (current_declspecs, + $3), + build_tree_list (prefix_attributes, + $4)); + current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); + declspec_stack = TREE_CHAIN (declspec_stack); + resume_momentary ($2); } + + | declmods setspecs absdcl maybe_attribute + { $$ = build_tree_list (build_tree_list (current_declspecs, + $3), + build_tree_list (prefix_attributes, + $4)); + current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); + declspec_stack = TREE_CHAIN (declspec_stack); + resume_momentary ($2); } ; /* This is used in a function definition @@ -1924,12 +2458,22 @@ identifiers_or_typenames: | identifiers_or_typenames ',' identifier { $$ = chainon ($1, build_tree_list (NULL_TREE, $3)); } ; + +extension: + EXTENSION + { $$ = SAVE_WARN_FLAGS(); + pedantic = 0; + warn_pointer_arith = 0; } + ; ifobjc /* Objective-C productions. */ objcdef: classdef + | classdecl + | aliasdecl + | protocoldef | methoddef | END { @@ -1944,11 +2488,31 @@ objcdef: } ; +/* A nonempty list of identifiers. */ +identifier_list: + identifier + { $$ = build_tree_list (NULL_TREE, $1); } + | identifier_list ',' identifier + { $$ = chainon ($1, build_tree_list (NULL_TREE, $3)); } + ; + +classdecl: + CLASS identifier_list ';' + { + objc_declare_class ($2); + } + +aliasdecl: + ALIAS identifier identifier ';' + { + objc_declare_alias ($2, $3); + } + classdef: - INTERFACE identifier '{' + INTERFACE identifier protocolrefs '{' { objc_interface_context = objc_ivar_context - = start_class (INTERFACE_TYPE, $2, NULL_TREE); + = start_class (CLASS_INTERFACE_TYPE, $2, NULL_TREE, $3); objc_public_flag = 0; } ivar_decl_list '}' @@ -1962,10 +2526,10 @@ classdef: objc_interface_context = NULL_TREE; } - | INTERFACE identifier + | INTERFACE identifier protocolrefs { objc_interface_context - = start_class (INTERFACE_TYPE, $2, NULL_TREE); + = start_class (CLASS_INTERFACE_TYPE, $2, NULL_TREE, $3); continue_class (objc_interface_context); } methodprotolist @@ -1975,10 +2539,10 @@ classdef: objc_interface_context = NULL_TREE; } - | INTERFACE identifier ':' identifier '{' + | INTERFACE identifier ':' identifier protocolrefs '{' { objc_interface_context = objc_ivar_context - = start_class (INTERFACE_TYPE, $2, $4); + = start_class (CLASS_INTERFACE_TYPE, $2, $4, $5); objc_public_flag = 0; } ivar_decl_list '}' @@ -1992,10 +2556,10 @@ classdef: objc_interface_context = NULL_TREE; } - | INTERFACE identifier ':' identifier + | INTERFACE identifier ':' identifier protocolrefs { objc_interface_context - = start_class (INTERFACE_TYPE, $2, $4); + = start_class (CLASS_INTERFACE_TYPE, $2, $4, $5); continue_class (objc_interface_context); } methodprotolist @@ -2008,7 +2572,7 @@ classdef: | IMPLEMENTATION identifier '{' { objc_implementation_context = objc_ivar_context - = start_class (IMPLEMENTATION_TYPE, $2, NULL_TREE); + = start_class (CLASS_IMPLEMENTATION_TYPE, $2, NULL_TREE, NULL_TREE); objc_public_flag = 0; } ivar_decl_list '}' @@ -2020,7 +2584,7 @@ classdef: | IMPLEMENTATION identifier { objc_implementation_context - = start_class (IMPLEMENTATION_TYPE, $2, NULL_TREE); + = start_class (CLASS_IMPLEMENTATION_TYPE, $2, NULL_TREE, NULL_TREE); objc_ivar_chain = continue_class (objc_implementation_context); } @@ -2028,7 +2592,7 @@ classdef: | IMPLEMENTATION identifier ':' identifier '{' { objc_implementation_context = objc_ivar_context - = start_class (IMPLEMENTATION_TYPE, $2, $4); + = start_class (CLASS_IMPLEMENTATION_TYPE, $2, $4, NULL_TREE); objc_public_flag = 0; } ivar_decl_list '}' @@ -2040,15 +2604,15 @@ classdef: | IMPLEMENTATION identifier ':' identifier { objc_implementation_context - = start_class (IMPLEMENTATION_TYPE, $2, $4); + = start_class (CLASS_IMPLEMENTATION_TYPE, $2, $4, NULL_TREE); objc_ivar_chain = continue_class (objc_implementation_context); } - | INTERFACE identifier '(' identifier ')' + | INTERFACE identifier '(' identifier ')' protocolrefs { objc_interface_context - = start_class (PROTOCOL_TYPE, $2, $4); + = start_class (CATEGORY_INTERFACE_TYPE, $2, $4, $6); continue_class (objc_interface_context); } methodprotolist @@ -2061,17 +2625,56 @@ classdef: | IMPLEMENTATION identifier '(' identifier ')' { objc_implementation_context - = start_class (CATEGORY_TYPE, $2, $4); + = start_class (CATEGORY_IMPLEMENTATION_TYPE, $2, $4, NULL_TREE); objc_ivar_chain = continue_class (objc_implementation_context); } ; +protocoldef: + PROTOCOL identifier protocolrefs + { + remember_protocol_qualifiers (); + objc_interface_context + = start_protocol(PROTOCOL_INTERFACE_TYPE, $2, $3); + } + methodprotolist END + { + forget_protocol_qualifiers(); + finish_protocol(objc_interface_context); + objc_interface_context = NULL_TREE; + } + ; + +protocolrefs: + /* empty */ + { + $$ = NULL_TREE; + } + | non_empty_protocolrefs + ; + +non_empty_protocolrefs: + ARITHCOMPARE identifier_list ARITHCOMPARE + { + if ($1 == LT_EXPR && $3 == GT_EXPR) + $$ = $2; + else + YYERROR1; + } + ; + ivar_decl_list: - ivar_decls PUBLIC { objc_public_flag = 1; } ivar_decls + ivar_decl_list visibility_spec ivar_decls | ivar_decls ; +visibility_spec: + PRIVATE { objc_public_flag = 2; } + | PROTECTED { objc_public_flag = 0; } + | PUBLIC { objc_public_flag = 1; } + ; + ivar_decls: /* empty */ { @@ -2081,7 +2684,7 @@ ivar_decls: | ivar_decls ';' { if (pedantic) - warning ("extra semicolon in struct or union specified"); + pedwarn ("extra semicolon in struct or union specified"); } ; @@ -2097,15 +2700,17 @@ ivar_decls: ivar_decl: typed_typespecs setspecs ivars - { - $$ = $3; - resume_momentary ($2); - } + { $$ = $3; + current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); + declspec_stack = TREE_CHAIN (declspec_stack); + resume_momentary ($2); } | nonempty_type_quals setspecs ivars - { - $$ = $3; - resume_momentary ($2); - } + { $$ = $3; + current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); + declspec_stack = TREE_CHAIN (declspec_stack); + resume_momentary ($2); } | error { $$ = NULL_TREE; } ; @@ -2143,6 +2748,7 @@ ivar_declarator: methoddef: '+' { + remember_protocol_qualifiers (); if (objc_implementation_context) objc_inherit_code = CLASS_METHOD_DECL; else @@ -2150,6 +2756,7 @@ methoddef: } methoddecl { + forget_protocol_qualifiers (); add_class_method (objc_implementation_context, $3); start_method_def ($3); objc_method_context = $3; @@ -2166,6 +2773,7 @@ methoddef: | '-' { + remember_protocol_qualifiers (); if (objc_implementation_context) objc_inherit_code = INSTANCE_METHOD_DECL; else @@ -2173,6 +2781,7 @@ methoddef: } methoddecl { + forget_protocol_qualifiers (); add_instance_method (objc_implementation_context, $3); start_method_def ($3); objc_method_context = $3; @@ -2212,20 +2821,28 @@ semi_or_error: methodproto: '+' { + /* Remember protocol qualifiers in prototypes. */ + remember_protocol_qualifiers (); objc_inherit_code = CLASS_METHOD_DECL; } methoddecl { + /* Forget protocol qualifiers here. */ + forget_protocol_qualifiers (); add_class_method (objc_interface_context, $3); } semi_or_error | '-' { + /* Remember protocol qualifiers in prototypes. */ + remember_protocol_qualifiers (); objc_inherit_code = INSTANCE_METHOD_DECL; } methoddecl { + /* Forget protocol qualifiers here. */ + forget_protocol_qualifiers (); add_instance_method (objc_interface_context, $3); } semi_or_error @@ -2278,7 +2895,10 @@ mydecls: mydecl: typed_declspecs setspecs myparms ';' - { resume_momentary ($2); } + { current_declspecs = TREE_VALUE (declspec_stack); + prefix_attributes = TREE_PURPOSE (declspec_stack); + declspec_stack = TREE_CHAIN (declspec_stack); + resume_momentary ($2); } | typed_declspecs ';' { shadow_tag ($1); } | declmods ';' @@ -2296,12 +2916,21 @@ myparms: as found in a parmlist. DOES NOT ALLOW AN INITIALIZER OR ASMSPEC */ myparm: - parm_declarator - { $$ = build_tree_list (current_declspecs, $1) ; } - | notype_declarator - { $$ = build_tree_list (current_declspecs, $1) ; } - | absdcl - { $$ = build_tree_list (current_declspecs, $1) ; } + parm_declarator maybe_attribute + { $$ = build_tree_list (build_tree_list (current_declspecs, + $1), + build_tree_list (prefix_attributes, + $2)); } + | notype_declarator maybe_attribute + { $$ = build_tree_list (build_tree_list (current_declspecs, + $1), + build_tree_list (prefix_attributes, + $2)); } + | absdcl maybe_attribute + { $$ = build_tree_list (build_tree_list (current_declspecs, + $1), + build_tree_list (prefix_attributes, + $2)); } ; optparmlist: @@ -2342,6 +2971,7 @@ keywordselector: selector: IDENTIFIER | TYPENAME + | OBJECTNAME | reservedwords ; @@ -2477,6 +3107,13 @@ objcselectorexpr: } ; +objcprotocolexpr: + PROTOCOL '(' identifier ')' + { + $$ = $3; + } + ; + /* extension to support C-structures in the archiver */ objcencodeexpr: @@ -2488,44 +3125,3 @@ objcencodeexpr: end ifobjc %% -ifobjc - -/* If STRING is the name of an Objective C @-keyword - (not including the @), return the token type for that keyword. - Otherwise return 0. */ - -int -recognize_objc_keyword (string) - char *string; -{ - switch (string[0]) - { - case 'd': - if (!strcmp (string, "defs")) - return DEFS; - break; - case 'e': - if (!strcmp (string, "end")) - return END; - if (!strcmp (string, "encode")) - return ENCODE; - break; - case 'i': - if (!strcmp (string, "interface")) - return INTERFACE; - if (!strcmp (string, "implementation")) - return IMPLEMENTATION; - break; - case 'p': - if (!strcmp (string, "public")) - return PUBLIC; - break; - case 's': - if (!strcmp (string, "selector")) - return SELECTOR; - break; - } - return 0; -} - -end ifobjc