[BACK]Return to cgram.y CVS log [TXT][DIR] Up to [cvs.NetBSD.org] / src / usr.bin / xlint / lint1

Annotation of src/usr.bin/xlint/lint1/cgram.y, Revision 1.249

1.2       cgd         1: %{
1.249   ! rillig      2: /* $NetBSD: cgram.y,v 1.248 2021/06/29 05:41:45 rillig Exp $ */
1.2       cgd         3:
1.1       cgd         4: /*
1.9       cgd         5:  * Copyright (c) 1996 Christopher G. Demetriou.  All Rights Reserved.
1.1       cgd         6:  * Copyright (c) 1994, 1995 Jochen Pohl
                      7:  * All Rights Reserved.
                      8:  *
                      9:  * Redistribution and use in source and binary forms, with or without
                     10:  * modification, are permitted provided that the following conditions
                     11:  * are met:
                     12:  * 1. Redistributions of source code must retain the above copyright
                     13:  *    notice, this list of conditions and the following disclaimer.
                     14:  * 2. Redistributions in binary form must reproduce the above copyright
                     15:  *    notice, this list of conditions and the following disclaimer in the
                     16:  *    documentation and/or other materials provided with the distribution.
                     17:  * 3. All advertising materials mentioning features or use of this software
                     18:  *    must display the following acknowledgement:
                     19:  *      This product includes software developed by Jochen Pohl for
                     20:  *     The NetBSD Project.
                     21:  * 4. The name of the author may not be used to endorse or promote products
                     22:  *    derived from this software without specific prior written permission.
                     23:  *
                     24:  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
                     25:  * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
                     26:  * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
                     27:  * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
                     28:  * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
                     29:  * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
                     30:  * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
                     31:  * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
                     32:  * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
                     33:  * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
                     34:  */
                     35:
1.13      christos   36: #include <sys/cdefs.h>
1.23      tv         37: #if defined(__RCSID) && !defined(lint)
1.249   ! rillig     38: __RCSID("$NetBSD: cgram.y,v 1.248 2021/06/29 05:41:45 rillig Exp $");
1.1       cgd        39: #endif
                     40:
1.108     rillig     41: #include <limits.h>
1.1       cgd        42: #include <stdlib.h>
1.12      cjs        43: #include <string.h>
1.1       cgd        44:
                     45: #include "lint1.h"
                     46:
1.41      christos   47: extern char *yytext;
1.132     rillig     48:
1.1       cgd        49: /*
1.148     rillig     50:  * Contains the level of current declaration, used for symbol table entries.
                     51:  * 0 is the top-level, > 0 is inside a function body.
1.1       cgd        52:  */
1.171     rillig     53: int    block_level;
1.1       cgd        54:
                     55: /*
1.171     rillig     56:  * level for memory allocation. Normally the same as block_level.
1.49      wiz        57:  * An exception is the declaration of arguments in prototypes. Memory
1.1       cgd        58:  * for these can't be freed after the declaration, but symbols must
                     59:  * be removed from the symbol table after the declaration.
                     60:  */
1.171     rillig     61: int    mem_block_level;
1.1       cgd        62:
1.15      christos   63: /*
                     64:  * Save the no-warns state and restore it to avoid the problem where
                     65:  * if (expr) { stmt } / * NOLINT * / stmt;
                     66:  */
1.55      christos   67: static int olwarn = LWARN_BAD;
1.15      christos   68:
1.174     rillig     69: static void    cgram_declare(sym_t *, bool, sbuf_t *);
1.148     rillig     70: static void    ignore_up_to_rparen(void);
1.75      christos   71: static sym_t   *symbolrename(sym_t *, sbuf_t *);
                     72:
1.1       cgd        73:
1.15      christos   74: #ifdef DEBUG
1.148     rillig     75: static void
                     76: CLEAR_WARN_FLAGS(const char *file, size_t line)
1.15      christos   77: {
1.190     rillig     78:        printf("%s:%d: %s:%zu: clearing flags\n",
                     79:            curr_pos.p_file, curr_pos.p_line, file, line);
1.148     rillig     80:        clear_warn_flags();
1.55      christos   81:        olwarn = LWARN_BAD;
1.15      christos   82: }
                     83:
1.148     rillig     84: static void
                     85: SAVE_WARN_FLAGS(const char *file, size_t line)
1.15      christos   86: {
1.149     rillig     87:        lint_assert(olwarn == LWARN_BAD);
1.190     rillig     88:        printf("%s:%d: %s:%zu: saving flags %d\n",
                     89:            curr_pos.p_file, curr_pos.p_line, file, line, lwarn);
1.55      christos   90:        olwarn = lwarn;
1.15      christos   91: }
                     92:
1.148     rillig     93: static void
                     94: RESTORE_WARN_FLAGS(const char *file, size_t line)
1.15      christos   95: {
1.55      christos   96:        if (olwarn != LWARN_BAD) {
                     97:                lwarn = olwarn;
1.190     rillig     98:                printf("%s:%d: %s:%zu: restoring flags %d\n",
                     99:                    curr_pos.p_file, curr_pos.p_line, file, line, lwarn);
1.55      christos  100:                olwarn = LWARN_BAD;
1.15      christos  101:        } else
1.148     rillig    102:                CLEAR_WARN_FLAGS(file, line);
1.15      christos  103: }
1.117     rillig    104: #define cgram_debug(fmt, args...) printf("cgram_debug: " fmt "\n", ##args)
1.15      christos  105: #else
1.190     rillig    106: #define CLEAR_WARN_FLAGS(f, l) clear_warn_flags(), olwarn = LWARN_BAD
1.148     rillig    107: #define SAVE_WARN_FLAGS(f, l)  olwarn = lwarn
                    108: #define RESTORE_WARN_FLAGS(f, l) \
                    109:        (void)(olwarn == LWARN_BAD ? (clear_warn_flags(), 0) : (lwarn = olwarn))
1.176     rillig    110: #define cgram_debug(fmt, args...) do { } while (false)
1.15      christos  111: #endif
1.73      christos  112:
1.190     rillig    113: #define clear_warning_flags()  CLEAR_WARN_FLAGS(__FILE__, __LINE__)
                    114: #define save_warning_flags()   SAVE_WARN_FLAGS(__FILE__, __LINE__)
                    115: #define restore_warning_flags()        RESTORE_WARN_FLAGS(__FILE__, __LINE__)
1.187     rillig    116:
1.73      christos  117: /* unbind the anonymous struct members from the struct */
                    118: static void
                    119: anonymize(sym_t *s)
                    120: {
1.219     rillig    121:        for ( ; s != NULL; s = s->s_next)
1.73      christos  122:                s->s_styp = NULL;
                    123: }
1.1       cgd       124: %}
                    125:
1.230     rillig    126: %expect 182
1.40      christos  127:
1.1       cgd       128: %union {
                    129:        val_t   *y_val;
                    130:        sbuf_t  *y_sb;
                    131:        sym_t   *y_sym;
                    132:        op_t    y_op;
                    133:        scl_t   y_scl;
                    134:        tspec_t y_tspec;
                    135:        tqual_t y_tqual;
                    136:        type_t  *y_type;
                    137:        tnode_t *y_tnode;
1.35      christos  138:        range_t y_range;
1.121     rillig    139:        strg_t  *y_string;
1.243     rillig    140:        qual_ptr *y_qual_ptr;
1.219     rillig    141:        bool    y_seen_statement;
1.237     rillig    142:        struct generic_association_types *y_types;
1.1       cgd       143: };
                    144:
1.126     rillig    145: %token                 T_LBRACE T_RBRACE T_LBRACK T_RBRACK T_LPAREN T_RPAREN
1.230     rillig    146: %token                 T_POINT T_ARROW
1.150     rillig    147: %token <y_op>          T_UNARY
1.1       cgd       148: %token <y_op>          T_INCDEC
                    149: %token                 T_SIZEOF
1.94      christos  150: %token                 T_BUILTIN_OFFSETOF
1.58      christos  151: %token                 T_TYPEOF
                    152: %token                 T_EXTENSION
1.199     christos  153: %token                 T_ALIGNAS
1.44      christos  154: %token                 T_ALIGNOF
1.189     rillig    155: %token                 T_ASTERISK
1.150     rillig    156: %token <y_op>          T_MULTIPLICATIVE
                    157: %token <y_op>          T_ADDITIVE
                    158: %token <y_op>          T_SHIFT
                    159: %token <y_op>          T_RELATIONAL
                    160: %token <y_op>          T_EQUALITY
1.189     rillig    161: %token                 T_AMPER
1.191     rillig    162: %token                 T_BITXOR
1.189     rillig    163: %token                 T_BITOR
                    164: %token                 T_LOGAND
                    165: %token                 T_LOGOR
1.1       cgd       166: %token                 T_QUEST
                    167: %token                 T_COLON
1.189     rillig    168: %token                 T_ASSIGN
1.150     rillig    169: %token <y_op>          T_OPASSIGN
1.1       cgd       170: %token                 T_COMMA
                    171: %token                 T_SEMI
1.147     rillig    172: %token                 T_ELLIPSIS
1.41      christos  173: %token                 T_REAL
                    174: %token                 T_IMAG
1.81      christos  175: %token                 T_GENERIC
1.95      christos  176: %token                 T_NORETURN
1.1       cgd       177:
                    178: /* storage classes (extern, static, auto, register and typedef) */
                    179: %token <y_scl>         T_SCLASS
                    180:
1.152     rillig    181: /*
                    182:  * predefined type keywords (char, int, short, long, unsigned, signed,
                    183:  * float, double, void); see T_TYPENAME
                    184:  */
1.1       cgd       185: %token <y_tspec>       T_TYPE
                    186:
1.152     rillig    187: /* qualifiers (const, volatile, restrict, _Thread_local) */
1.1       cgd       188: %token <y_tqual>       T_QUAL
                    189:
                    190: /* struct or union */
1.152     rillig    191: %token <y_tspec>       T_STRUCT_OR_UNION
1.1       cgd       192:
                    193: /* remaining keywords */
1.153     rillig    194: %token                 T_ASM
                    195: %token                 T_BREAK
1.1       cgd       196: %token                 T_CASE
1.153     rillig    197: %token                 T_CONTINUE
1.1       cgd       198: %token                 T_DEFAULT
1.153     rillig    199: %token                 T_DO
1.1       cgd       200: %token                 T_ELSE
1.153     rillig    201: %token                 T_ENUM
1.1       cgd       202: %token                 T_FOR
                    203: %token                 T_GOTO
1.153     rillig    204: %token                 T_IF
                    205: %token                 T_PACKED
1.1       cgd       206: %token                 T_RETURN
1.153     rillig    207: %token                 T_SWITCH
1.11      cgd       208: %token                 T_SYMBOLRENAME
1.153     rillig    209: %token                 T_WHILE
1.45      christos  210: /* Type Attributes */
                    211: %token <y_type>                T_ATTRIBUTE
1.86      christos  212: %token <y_type>                T_AT_ALIAS
1.153     rillig    213: %token <y_type>                T_AT_ALIGNED
1.101     christos  214: %token <y_type>                T_AT_ALLOC_SIZE
1.85      christos  215: %token <y_type>                T_AT_ALWAYS_INLINE
1.89      christos  216: %token <y_type>                T_AT_BOUNDED
1.91      christos  217: %token <y_type>                T_AT_BUFFER
1.84      christos  218: %token <y_type>                T_AT_COLD
1.220     christos  219: %token <y_type>                T_AT_COMMON
1.84      christos  220: %token <y_type>                T_AT_CONSTRUCTOR
1.45      christos  221: %token <y_type>                T_AT_DEPRECATED
1.100     christos  222: %token <y_type>                T_AT_DESTRUCTOR
1.212     christos  223: %token <y_type>                T_AT_FALLTHROUGH
1.84      christos  224: %token <y_type>                T_AT_FORMAT
                    225: %token <y_type>                T_AT_FORMAT_ARG
1.102     christos  226: %token <y_type>                T_AT_FORMAT_GNU_PRINTF
1.84      christos  227: %token <y_type>                T_AT_FORMAT_PRINTF
                    228: %token <y_type>                T_AT_FORMAT_SCANF
1.90      christos  229: %token <y_type>                T_AT_FORMAT_STRFMON
1.84      christos  230: %token <y_type>                T_AT_FORMAT_STRFTIME
1.96      christos  231: %token <y_type>                T_AT_FORMAT_SYSLOG
1.77      christos  232: %token <y_type>                T_AT_GNU_INLINE
1.101     christos  233: %token <y_type>                T_AT_MALLOC
1.45      christos  234: %token <y_type>                T_AT_MAY_ALIAS
1.89      christos  235: %token <y_type>                T_AT_MINBYTES
1.84      christos  236: %token <y_type>                T_AT_MODE
1.97      christos  237: %token <y_type>                T_AT_NOINLINE
1.90      christos  238: %token <y_type>                T_AT_NONNULL
1.223     christos  239: %token <y_type>                T_AT_NONSTRING
1.84      christos  240: %token <y_type>                T_AT_NORETURN
1.101     christos  241: %token <y_type>                T_AT_NOTHROW
1.84      christos  242: %token <y_type>                T_AT_NO_INSTRUMENT_FUNCTION
1.105     christos  243: %token <y_type>                T_AT_OPTIMIZE
1.45      christos  244: %token <y_type>                T_AT_PACKED
1.92      christos  245: %token <y_type>                T_AT_PCS
1.61      christos  246: %token <y_type>                T_AT_PURE
1.84      christos  247: %token <y_type>                T_AT_RETURNS_TWICE
                    248: %token <y_type>                T_AT_SECTION
                    249: %token <y_type>                T_AT_SENTINEL
1.89      christos  250: %token <y_type>                T_AT_STRING
1.104     christos  251: %token <y_type>                T_AT_TLS_MODEL
1.45      christos  252: %token <y_type>                T_AT_TUNION
                    253: %token <y_type>                T_AT_UNUSED
1.84      christos  254: %token <y_type>                T_AT_USED
                    255: %token <y_type>                T_AT_VISIBILITY
1.99      christos  256: %token <y_type>                T_AT_WARN_UNUSED_RESULT
1.76      christos  257: %token <y_type>                T_AT_WEAK
1.1       cgd       258:
                    259: %left  T_COMMA
1.150     rillig    260: %right T_ASSIGN T_OPASSIGN
1.1       cgd       261: %right T_QUEST T_COLON
                    262: %left  T_LOGOR
                    263: %left  T_LOGAND
1.150     rillig    264: %left  T_BITOR
1.191     rillig    265: %left  T_BITXOR
1.145     rillig    266: %left  T_AMPER
1.150     rillig    267: %left  T_EQUALITY
                    268: %left  T_RELATIONAL
                    269: %left  T_SHIFT
                    270: %left  T_ADDITIVE
                    271: %left  T_ASTERISK T_MULTIPLICATIVE
1.192     rillig    272: %right T_UNARY T_INCDEC T_SIZEOF T_REAL T_IMAG
1.230     rillig    273: %left  T_LPAREN T_LBRACK T_POINT T_ARROW
1.1       cgd       274:
                    275: %token <y_sb>          T_NAME
                    276: %token <y_sb>          T_TYPENAME
                    277: %token <y_val>         T_CON
1.121     rillig    278: %token <y_string>      T_STRING
1.1       cgd       279:
                    280: %type  <y_sym>         func_decl
                    281: %type  <y_sym>         notype_decl
                    282: %type  <y_sym>         type_decl
                    283: %type  <y_type>        typespec
                    284: %type  <y_type>        clrtyp_typespec
                    285: %type  <y_type>        notype_typespec
                    286: %type  <y_type>        struct_spec
                    287: %type  <y_type>        enum_spec
                    288: %type  <y_sym>         struct_tag
                    289: %type  <y_sym>         enum_tag
                    290: %type  <y_tspec>       struct
                    291: %type  <y_sym>         struct_declaration
                    292: %type  <y_sb>          identifier
                    293: %type  <y_sym>         member_declaration_list_with_rbrace
                    294: %type  <y_sym>         member_declaration_list
                    295: %type  <y_sym>         member_declaration
                    296: %type  <y_sym>         notype_member_decls
                    297: %type  <y_sym>         type_member_decls
                    298: %type  <y_sym>         notype_member_decl
                    299: %type  <y_sym>         type_member_decl
1.168     rillig    300: %type  <y_tnode>       constant_expr
1.214     christos  301: %type  <y_tnode>       array_size
1.1       cgd       302: %type  <y_sym>         enum_declaration
                    303: %type  <y_sym>         enums_with_opt_comma
                    304: %type  <y_sym>         enums
                    305: %type  <y_sym>         enumerator
1.135     rillig    306: %type  <y_sym>         enumeration_constant
1.1       cgd       307: %type  <y_sym>         notype_direct_decl
                    308: %type  <y_sym>         type_direct_decl
1.243     rillig    309: %type  <y_qual_ptr>    pointer
                    310: %type  <y_qual_ptr>    asterisk
1.1       cgd       311: %type  <y_sym>         param_decl
                    312: %type  <y_sym>         param_list
1.155     rillig    313: %type  <y_sym>         abstract_decl_param_list
1.1       cgd       314: %type  <y_sym>         direct_param_decl
                    315: %type  <y_sym>         notype_param_decl
                    316: %type  <y_sym>         direct_notype_param_decl
1.245     rillig    317: %type  <y_qual_ptr>    type_qualifier_list_opt
1.243     rillig    318: %type  <y_qual_ptr>    type_qualifier_list
                    319: %type  <y_qual_ptr>    type_qualifier
1.1       cgd       320: %type  <y_sym>         identifier_list
1.246     rillig    321: %type  <y_sym>         abstract_declarator
                    322: %type  <y_sym>         direct_abstract_declarator
1.1       cgd       323: %type  <y_sym>         vararg_parameter_type_list
                    324: %type  <y_sym>         parameter_type_list
                    325: %type  <y_sym>         parameter_declaration
                    326: %type  <y_tnode>       expr
1.238     rillig    327: %type  <y_tnode>       assignment_expression
1.226     rillig    328: %type  <y_tnode>       gcc_statement_expr_list
                    329: %type  <y_tnode>       gcc_statement_expr_item
1.1       cgd       330: %type  <y_tnode>       term
1.235     rillig    331: %type  <y_tnode>       generic_selection
1.1       cgd       332: %type  <y_tnode>       func_arg_list
                    333: %type  <y_op>          point_or_arrow
                    334: %type  <y_type>        type_name
                    335: %type  <y_sym>         abstract_declaration
                    336: %type  <y_tnode>       do_while_expr
1.241     rillig    337: %type  <y_tnode>       expr_opt
1.121     rillig    338: %type  <y_string>      string
                    339: %type  <y_string>      string2
1.241     rillig    340: %type  <y_sb>          asm_or_symbolrename_opt
1.35      christos  341: %type  <y_range>       range
1.185     rillig    342: %type  <y_seen_statement> block_item_list
                    343: %type  <y_seen_statement> block_item
1.237     rillig    344: %type  <y_types>       generic_assoc_list
                    345: %type  <y_types>       generic_association
1.1       cgd       346:
                    347:
                    348: %%
                    349:
                    350: program:
                    351:          /* empty */ {
                    352:                if (sflag) {
                    353:                        /* empty translation unit */
                    354:                        error(272);
                    355:                } else if (!tflag) {
                    356:                        /* empty translation unit */
                    357:                        warning(272);
                    358:                }
                    359:          }
                    360:        | translation_unit
                    361:        ;
                    362:
1.134     rillig    363: translation_unit:              /* C99 6.9 */
                    364:          external_declaration
                    365:        | translation_unit external_declaration
1.1       cgd       366:        ;
                    367:
1.134     rillig    368: external_declaration:          /* C99 6.9 */
1.133     rillig    369:          asm_statement
1.134     rillig    370:        | function_definition {
1.183     rillig    371:                global_clean_up_decl(false);
1.187     rillig    372:                clear_warning_flags();
1.1       cgd       373:          }
1.193     rillig    374:        | top_level_declaration {
1.183     rillig    375:                global_clean_up_decl(false);
1.187     rillig    376:                clear_warning_flags();
1.1       cgd       377:          }
                    378:        ;
                    379:
1.193     rillig    380: /*
                    381:  * On the top level, lint allows several forms of declarations that it doesn't
                    382:  * allow in functions.  For example, a single ';' is an empty declaration and
                    383:  * is supported by some compilers, but in a function it would be an empty
                    384:  * statement, not a declaration.  This makes a difference in C90 mode, where
                    385:  * a statement must not be followed by a declaration.
                    386:  *
                    387:  * See 'declaration' for all other declarations.
                    388:  */
                    389: top_level_declaration:         /* C99 6.9 calls this 'declaration' */
1.1       cgd       390:          T_SEMI {
                    391:                if (sflag) {
1.123     rillig    392:                        /* empty declaration */
1.1       cgd       393:                        error(0);
                    394:                } else if (!tflag) {
1.123     rillig    395:                        /* empty declaration */
1.1       cgd       396:                        warning(0);
                    397:                }
                    398:          }
                    399:        | clrtyp deftyp notype_init_decls T_SEMI {
                    400:                if (sflag) {
1.159     rillig    401:                        /* old style declaration; add 'int' */
1.1       cgd       402:                        error(1);
                    403:                } else if (!tflag) {
1.159     rillig    404:                        /* old style declaration; add 'int' */
1.1       cgd       405:                        warning(1);
                    406:                }
                    407:          }
                    408:        | declmods deftyp T_SEMI {
1.3       jpo       409:                if (dcs->d_scl == TYPEDEF) {
1.1       cgd       410:                        /* typedef declares no type name */
                    411:                        warning(72);
                    412:                } else {
                    413:                        /* empty declaration */
                    414:                        warning(2);
                    415:                }
                    416:          }
                    417:        | declmods deftyp notype_init_decls T_SEMI
1.194     rillig    418:        | declaration_specifiers deftyp T_SEMI {
1.3       jpo       419:                if (dcs->d_scl == TYPEDEF) {
1.1       cgd       420:                        /* typedef declares no type name */
                    421:                        warning(72);
1.195     rillig    422:                } else if (!dcs->d_nonempty_decl) {
1.1       cgd       423:                        /* empty declaration */
                    424:                        warning(2);
                    425:                }
                    426:          }
1.194     rillig    427:        | declaration_specifiers deftyp type_init_decls T_SEMI
1.1       cgd       428:        | error T_SEMI {
1.114     rillig    429:                global_clean_up();
1.1       cgd       430:          }
                    431:        | error T_RBRACE {
1.114     rillig    432:                global_clean_up();
1.1       cgd       433:          }
                    434:        ;
                    435:
1.134     rillig    436: function_definition:           /* C99 6.9.1 */
1.1       cgd       437:          func_decl {
                    438:                if ($1->s_type->t_tspec != FUNC) {
1.123     rillig    439:                        /* syntax error '%s' */
1.41      christos  440:                        error(249, yytext);
1.1       cgd       441:                        YYERROR;
                    442:                }
                    443:                if ($1->s_type->t_typedef) {
                    444:                        /* ()-less function definition */
                    445:                        error(64);
                    446:                        YYERROR;
                    447:                }
                    448:                funcdef($1);
1.171     rillig    449:                block_level++;
1.202     rillig    450:                begin_declaration_level(ARG);
1.55      christos  451:                if (lwarn == LWARN_NONE)
1.140     rillig    452:                        $1->s_used = true;
1.134     rillig    453:          } arg_declaration_list_opt {
1.202     rillig    454:                end_declaration_level();
1.171     rillig    455:                block_level--;
1.122     rillig    456:                check_func_lint_directives();
                    457:                check_func_old_style_arguments();
1.203     rillig    458:                begin_control_statement(CS_FUNCTION_BODY);
1.133     rillig    459:          } compound_statement {
1.1       cgd       460:                funcend();
1.203     rillig    461:                end_control_statement(CS_FUNCTION_BODY);
1.1       cgd       462:          }
                    463:        ;
                    464:
                    465: func_decl:
                    466:          clrtyp deftyp notype_decl {
                    467:                $$ = $3;
                    468:          }
                    469:        | declmods deftyp notype_decl {
                    470:                $$ = $3;
                    471:          }
1.194     rillig    472:        | declaration_specifiers deftyp type_decl {
1.1       cgd       473:                $$ = $3;
                    474:          }
                    475:        ;
                    476:
1.193     rillig    477: arg_declaration_list_opt:      /* C99 6.9.1p13 example 1 */
1.1       cgd       478:          /* empty */
                    479:        | arg_declaration_list
                    480:        ;
                    481:
1.193     rillig    482: arg_declaration_list:          /* C99 6.9.1p13 example 1 */
1.1       cgd       483:          arg_declaration
                    484:        | arg_declaration_list arg_declaration
                    485:        /* XXX or better "arg_declaration error" ? */
                    486:        | error
                    487:        ;
                    488:
                    489: /*
                    490:  * "arg_declaration" is separated from "declaration" because it
                    491:  * needs other error handling.
                    492:  */
                    493: arg_declaration:
                    494:          declmods deftyp T_SEMI {
                    495:                /* empty declaration */
                    496:                warning(2);
                    497:          }
                    498:        | declmods deftyp notype_init_decls T_SEMI
1.194     rillig    499:        | declaration_specifiers deftyp T_SEMI {
1.195     rillig    500:                if (!dcs->d_nonempty_decl) {
1.1       cgd       501:                        /* empty declaration */
                    502:                        warning(2);
                    503:                } else {
1.158     rillig    504:                        /* '%s' declared in argument declaration list */
                    505:                        warning(3, type_name(dcs->d_type));
1.1       cgd       506:                }
                    507:          }
1.194     rillig    508:        | declaration_specifiers deftyp type_init_decls T_SEMI {
1.195     rillig    509:                if (dcs->d_nonempty_decl) {
1.158     rillig    510:                        /* '%s' declared in argument declaration list */
                    511:                        warning(3, type_name(dcs->d_type));
1.1       cgd       512:                }
                    513:          }
                    514:        | declmods error
1.194     rillig    515:        | declaration_specifiers error
1.1       cgd       516:        ;
                    517:
1.193     rillig    518: declaration:                   /* C99 6.7 */
1.1       cgd       519:          declmods deftyp T_SEMI {
1.3       jpo       520:                if (dcs->d_scl == TYPEDEF) {
1.1       cgd       521:                        /* typedef declares no type name */
                    522:                        warning(72);
                    523:                } else {
                    524:                        /* empty declaration */
                    525:                        warning(2);
                    526:                }
                    527:          }
                    528:        | declmods deftyp notype_init_decls T_SEMI
1.194     rillig    529:        | declaration_specifiers deftyp T_SEMI {
1.3       jpo       530:                if (dcs->d_scl == TYPEDEF) {
1.1       cgd       531:                        /* typedef declares no type name */
                    532:                        warning(72);
1.195     rillig    533:                } else if (!dcs->d_nonempty_decl) {
1.1       cgd       534:                        /* empty declaration */
                    535:                        warning(2);
                    536:                }
                    537:          }
1.194     rillig    538:        | declaration_specifiers deftyp type_init_decls T_SEMI
1.1       cgd       539:        | error T_SEMI
                    540:        ;
                    541:
1.61      christos  542: type_attribute_format_type:
1.102     christos  543:          T_AT_FORMAT_GNU_PRINTF
                    544:        | T_AT_FORMAT_PRINTF
1.61      christos  545:        | T_AT_FORMAT_SCANF
1.84      christos  546:        | T_AT_FORMAT_STRFMON
1.61      christos  547:        | T_AT_FORMAT_STRFTIME
1.96      christos  548:        | T_AT_FORMAT_SYSLOG
1.61      christos  549:        ;
                    550:
1.91      christos  551: type_attribute_bounded_type:
                    552:          T_AT_MINBYTES
                    553:        | T_AT_STRING
                    554:        | T_AT_BUFFER
                    555:        ;
                    556:
1.98      christos  557:
1.45      christos  558: type_attribute_spec:
1.109     rillig    559:          /* empty */
1.225     rillig    560:        | T_AT_ALWAYS_INLINE
                    561:        | T_AT_ALIAS T_LPAREN string T_RPAREN
1.168     rillig    562:        | T_AT_ALIGNED T_LPAREN constant_expr T_RPAREN
1.225     rillig    563:        | T_AT_ALIGNED
1.168     rillig    564:        | T_AT_ALLOC_SIZE T_LPAREN constant_expr T_COMMA constant_expr T_RPAREN
                    565:        | T_AT_ALLOC_SIZE T_LPAREN constant_expr T_RPAREN
1.126     rillig    566:        | T_AT_BOUNDED T_LPAREN type_attribute_bounded_type
1.168     rillig    567:          T_COMMA constant_expr T_COMMA constant_expr T_RPAREN
1.225     rillig    568:        | T_AT_COLD
                    569:        | T_AT_COMMON
1.222     christos  570:        | T_AT_CONSTRUCTOR T_LPAREN constant_expr T_RPAREN
1.109     rillig    571:        | T_AT_CONSTRUCTOR
1.225     rillig    572:        | T_AT_DEPRECATED T_LPAREN string T_RPAREN
                    573:        | T_AT_DEPRECATED
1.222     christos  574:        | T_AT_DESTRUCTOR T_LPAREN constant_expr T_RPAREN
1.109     rillig    575:        | T_AT_DESTRUCTOR
1.225     rillig    576:        | T_AT_FALLTHROUGH {
                    577:                fallthru(1);
                    578:        }
                    579:        | T_AT_FORMAT T_LPAREN type_attribute_format_type T_COMMA
                    580:            constant_expr T_COMMA constant_expr T_RPAREN
                    581:        | T_AT_FORMAT_ARG T_LPAREN constant_expr T_RPAREN
                    582:        | T_AT_GNU_INLINE
1.101     christos  583:        | T_AT_MALLOC
1.45      christos  584:        | T_AT_MAY_ALIAS
1.225     rillig    585:        | T_AT_MODE T_LPAREN T_NAME T_RPAREN
1.97      christos  586:        | T_AT_NOINLINE
1.225     rillig    587:        | T_AT_NONNULL T_LPAREN constant_expr_list_opt T_RPAREN
                    588:        | T_AT_NONNULL
                    589:        | T_AT_NONSTRING
1.61      christos  590:        | T_AT_NORETURN
1.101     christos  591:        | T_AT_NOTHROW
1.225     rillig    592:        | T_AT_NO_INSTRUMENT_FUNCTION
                    593:        | T_AT_OPTIMIZE T_LPAREN string T_RPAREN
1.45      christos  594:        | T_AT_PACKED {
                    595:                addpacked();
1.130     rillig    596:          }
1.225     rillig    597:        | T_AT_PCS T_LPAREN string T_RPAREN
1.61      christos  598:        | T_AT_PURE
1.225     rillig    599:        | T_AT_RETURNS_TWICE
                    600:        | T_AT_SECTION T_LPAREN string T_RPAREN
                    601:        | T_AT_SENTINEL T_LPAREN constant_expr T_RPAREN
                    602:        | T_AT_SENTINEL
                    603:        | T_AT_TLS_MODEL T_LPAREN string T_RPAREN
1.45      christos  604:        | T_AT_TUNION
1.225     rillig    605:        | T_AT_UNUSED {
1.114     rillig    606:                add_attr_used();
1.130     rillig    607:          }
1.225     rillig    608:        | T_AT_USED {
1.114     rillig    609:                add_attr_used();
1.130     rillig    610:          }
1.225     rillig    611:        | T_AT_VISIBILITY T_LPAREN constant_expr T_RPAREN
1.99      christos  612:        | T_AT_WARN_UNUSED_RESULT
1.76      christos  613:        | T_AT_WEAK
1.62      christos  614:        | T_QUAL {
1.109     rillig    615:                if ($1 != CONST)
1.62      christos  616:                        yyerror("Bad attribute");
1.130     rillig    617:          }
1.45      christos  618:        ;
                    619:
1.84      christos  620: type_attribute_spec_list:
                    621:          type_attribute_spec
                    622:        | type_attribute_spec_list T_COMMA type_attribute_spec
                    623:        ;
                    624:
1.199     christos  625: align_as:
                    626:          typespec
                    627:        | constant_expr
                    628:        ;
                    629:
1.45      christos  630: type_attribute:
1.126     rillig    631:          T_ATTRIBUTE T_LPAREN T_LPAREN {
1.140     rillig    632:            attron = true;
1.130     rillig    633:          } type_attribute_spec_list {
1.140     rillig    634:            attron = false;
1.130     rillig    635:          } T_RPAREN T_RPAREN
1.199     christos  636:        | T_ALIGNAS T_LPAREN align_as T_RPAREN {
                    637:          }
1.45      christos  638:        | T_PACKED {
                    639:                addpacked();
1.130     rillig    640:          }
1.95      christos  641:        | T_NORETURN {
1.130     rillig    642:          }
1.45      christos  643:        ;
                    644:
1.87      christos  645: type_attribute_list:
                    646:          type_attribute
                    647:        | type_attribute_list type_attribute
                    648:        ;
                    649:
1.1       cgd       650: clrtyp:
1.110     rillig    651:          /* empty */ {
1.1       cgd       652:                clrtyp();
                    653:          }
                    654:        ;
                    655:
                    656: deftyp:
                    657:          /* empty */ {
                    658:                deftyp();
                    659:          }
                    660:        ;
                    661:
1.194     rillig    662: declaration_specifiers:                /* C99 6.7 */
1.1       cgd       663:          clrtyp_typespec {
1.114     rillig    664:                add_type($1);
1.1       cgd       665:          }
                    666:        | declmods typespec {
1.114     rillig    667:                add_type($2);
1.1       cgd       668:          }
1.194     rillig    669:        | type_attribute declaration_specifiers
                    670:        | declaration_specifiers declmod
                    671:        | declaration_specifiers notype_typespec {
1.114     rillig    672:                add_type($2);
1.1       cgd       673:          }
                    674:        ;
                    675:
                    676: declmods:
                    677:          clrtyp T_QUAL {
1.114     rillig    678:                add_qualifier($2);
1.1       cgd       679:          }
                    680:        | clrtyp T_SCLASS {
1.114     rillig    681:                add_storage_class($2);
1.1       cgd       682:          }
                    683:        | declmods declmod
                    684:        ;
                    685:
                    686: declmod:
                    687:          T_QUAL {
1.114     rillig    688:                add_qualifier($1);
1.1       cgd       689:          }
                    690:        | T_SCLASS {
1.114     rillig    691:                add_storage_class($1);
1.1       cgd       692:          }
1.87      christos  693:        | type_attribute_list
1.1       cgd       694:        ;
                    695:
                    696: clrtyp_typespec:
                    697:          clrtyp notype_typespec {
                    698:                $$ = $2;
                    699:          }
                    700:        | T_TYPENAME clrtyp {
                    701:                $$ = getsym($1)->s_type;
                    702:          }
                    703:        ;
                    704:
                    705: typespec:
1.240     rillig    706:          notype_typespec
1.1       cgd       707:        | T_TYPENAME {
                    708:                $$ = getsym($1)->s_type;
                    709:          }
                    710:        ;
                    711:
                    712: notype_typespec:
                    713:          T_TYPE {
                    714:                $$ = gettyp($1);
                    715:          }
1.60      christos  716:        | T_TYPEOF term {
                    717:                $$ = $2->tn_type;
1.58      christos  718:          }
1.1       cgd       719:        | struct_spec {
1.202     rillig    720:                end_declaration_level();
1.1       cgd       721:                $$ = $1;
                    722:          }
                    723:        | enum_spec {
1.202     rillig    724:                end_declaration_level();
1.1       cgd       725:                $$ = $1;
                    726:          }
                    727:        ;
                    728:
                    729: struct_spec:
                    730:          struct struct_tag {
                    731:                /*
                    732:                 * STDC requires that "struct a;" always introduces
                    733:                 * a new tag if "a" is not declared at current level
                    734:                 *
1.110     rillig    735:                 * yychar is valid because otherwise the parser would not
                    736:                 * have been able to decide if it must shift or reduce
1.1       cgd       737:                 */
1.183     rillig    738:                $$ = mktag($2, $1, false, yychar == T_SEMI);
1.1       cgd       739:          }
                    740:        | struct struct_tag {
1.183     rillig    741:                dcs->d_tagtyp = mktag($2, $1, true, false);
1.1       cgd       742:          } struct_declaration {
1.116     rillig    743:                $$ = complete_tag_struct_or_union(dcs->d_tagtyp, $4);
1.1       cgd       744:          }
                    745:        | struct {
1.183     rillig    746:                dcs->d_tagtyp = mktag(NULL, $1, true, false);
1.1       cgd       747:          } struct_declaration {
1.116     rillig    748:                $$ = complete_tag_struct_or_union(dcs->d_tagtyp, $3);
1.1       cgd       749:          }
                    750:        | struct error {
                    751:                symtyp = FVFT;
                    752:                $$ = gettyp(INT);
                    753:          }
                    754:        ;
                    755:
                    756: struct:
1.46      christos  757:          struct type_attribute
1.152     rillig    758:        | T_STRUCT_OR_UNION {
1.1       cgd       759:                symtyp = FTAG;
1.202     rillig    760:                begin_declaration_level($1 == STRUCT ? MOS : MOU);
1.3       jpo       761:                dcs->d_offset = 0;
1.136     rillig    762:                dcs->d_stralign = CHAR_SIZE;
1.1       cgd       763:                $$ = $1;
                    764:          }
                    765:        ;
                    766:
                    767: struct_tag:
                    768:          identifier {
                    769:                $$ = getsym($1);
                    770:          }
                    771:        ;
                    772:
                    773: struct_declaration:
                    774:          struct_decl_lbrace member_declaration_list_with_rbrace {
                    775:                $$ = $2;
                    776:          }
                    777:        ;
                    778:
                    779: struct_decl_lbrace:
                    780:          T_LBRACE {
                    781:                symtyp = FVFT;
                    782:          }
                    783:        ;
                    784:
                    785: member_declaration_list_with_rbrace:
1.240     rillig    786:          member_declaration_list T_SEMI T_RBRACE
1.1       cgd       787:        | member_declaration_list T_RBRACE {
                    788:                if (sflag) {
1.123     rillig    789:                        /* syntax req. ';' after last struct/union member */
1.1       cgd       790:                        error(66);
                    791:                } else {
1.123     rillig    792:                        /* syntax req. ';' after last struct/union member */
1.1       cgd       793:                        warning(66);
                    794:                }
                    795:                $$ = $1;
                    796:          }
                    797:        | T_RBRACE {
                    798:                $$ = NULL;
                    799:          }
                    800:        ;
                    801:
1.241     rillig    802: type_attribute_opt:
1.91      christos  803:          /* empty */
1.83      christos  804:        | type_attribute
                    805:        ;
                    806:
1.1       cgd       807: member_declaration_list:
1.240     rillig    808:          member_declaration
1.1       cgd       809:        | member_declaration_list T_SEMI member_declaration {
                    810:                $$ = lnklst($1, $3);
                    811:          }
                    812:        ;
                    813:
                    814: member_declaration:
                    815:          noclass_declmods deftyp {
                    816:                /* too late, i know, but getsym() compensates it */
1.120     rillig    817:                symtyp = FMEMBER;
1.241     rillig    818:          } notype_member_decls type_attribute_opt {
1.1       cgd       819:                symtyp = FVFT;
                    820:                $$ = $4;
                    821:          }
                    822:        | noclass_declspecs deftyp {
1.120     rillig    823:                symtyp = FMEMBER;
1.241     rillig    824:          } type_member_decls type_attribute_opt {
1.1       cgd       825:                symtyp = FVFT;
                    826:                $$ = $4;
                    827:          }
1.241     rillig    828:        | noclass_declmods deftyp type_attribute_opt {
1.74      christos  829:                symtyp = FVFT;
1.1       cgd       830:                /* struct or union member must be named */
1.73      christos  831:                if (!Sflag)
1.127     rillig    832:                        /* anonymous struct/union members is a C9X feature */
1.73      christos  833:                        warning(49);
                    834:                /* add all the members of the anonymous struct/union */
1.249   ! rillig    835:                lint_assert(is_struct_or_union(dcs->d_type->t_tspec));
1.161     rillig    836:                $$ = dcs->d_type->t_str->sou_first_member;
1.73      christos  837:                anonymize($$);
1.1       cgd       838:          }
1.241     rillig    839:        | noclass_declspecs deftyp type_attribute_opt {
1.74      christos  840:                symtyp = FVFT;
1.1       cgd       841:                /* struct or union member must be named */
1.73      christos  842:                if (!Sflag)
1.127     rillig    843:                        /* anonymous struct/union members is a C9X feature */
1.73      christos  844:                        warning(49);
1.228     rillig    845:                if (is_struct_or_union(dcs->d_type->t_tspec)) {
                    846:                        $$ = dcs->d_type->t_str->sou_first_member;
                    847:                        /* add all the members of the anonymous struct/union */
                    848:                        anonymize($$);
                    849:                } else {
                    850:                        /* syntax error '%s' */
                    851:                        error(249, "unnamed member");
1.232     rillig    852:                        $$ = NULL;
1.228     rillig    853:                }
1.1       cgd       854:          }
                    855:        | error {
                    856:                symtyp = FVFT;
                    857:                $$ = NULL;
                    858:          }
                    859:        ;
                    860:
                    861: noclass_declspecs:
                    862:          clrtyp_typespec {
1.114     rillig    863:                add_type($1);
1.1       cgd       864:          }
1.63      christos  865:        | type_attribute noclass_declspecs
1.1       cgd       866:        | noclass_declmods typespec {
1.114     rillig    867:                add_type($2);
1.1       cgd       868:          }
                    869:        | noclass_declspecs T_QUAL {
1.114     rillig    870:                add_qualifier($2);
1.1       cgd       871:          }
                    872:        | noclass_declspecs notype_typespec {
1.114     rillig    873:                add_type($2);
1.1       cgd       874:          }
1.48      christos  875:        | noclass_declspecs type_attribute
1.1       cgd       876:        ;
                    877:
                    878: noclass_declmods:
                    879:          clrtyp T_QUAL {
1.114     rillig    880:                add_qualifier($2);
1.1       cgd       881:          }
                    882:        | noclass_declmods T_QUAL {
1.114     rillig    883:                add_qualifier($2);
1.1       cgd       884:          }
                    885:        ;
                    886:
                    887: notype_member_decls:
                    888:          notype_member_decl {
1.111     rillig    889:                $$ = declarator_1_struct_union($1);
1.1       cgd       890:          }
                    891:        | notype_member_decls {
1.120     rillig    892:                symtyp = FMEMBER;
1.1       cgd       893:          } T_COMMA type_member_decl {
1.111     rillig    894:                $$ = lnklst($1, declarator_1_struct_union($4));
1.1       cgd       895:          }
                    896:        ;
                    897:
                    898: type_member_decls:
                    899:          type_member_decl {
1.111     rillig    900:                $$ = declarator_1_struct_union($1);
1.1       cgd       901:          }
                    902:        | type_member_decls {
1.120     rillig    903:                symtyp = FMEMBER;
1.1       cgd       904:          } T_COMMA type_member_decl {
1.111     rillig    905:                $$ = lnklst($1, declarator_1_struct_union($4));
1.1       cgd       906:          }
                    907:        ;
                    908:
                    909: notype_member_decl:
1.240     rillig    910:          notype_decl
1.168     rillig    911:        | notype_decl T_COLON constant_expr {           /* C99 6.7.2.1 */
1.175     rillig    912:                $$ = bitfield($1, to_int_constant($3, true));
1.1       cgd       913:          }
                    914:        | {
                    915:                symtyp = FVFT;
1.168     rillig    916:          } T_COLON constant_expr {                     /* C99 6.7.2.1 */
1.175     rillig    917:                $$ = bitfield(NULL, to_int_constant($3, true));
1.1       cgd       918:          }
                    919:        ;
                    920:
                    921: type_member_decl:
1.240     rillig    922:          type_decl
1.168     rillig    923:        | type_decl T_COLON constant_expr {
1.175     rillig    924:                $$ = bitfield($1, to_int_constant($3, true));
1.1       cgd       925:          }
                    926:        | {
                    927:                symtyp = FVFT;
1.168     rillig    928:          } T_COLON constant_expr {
1.175     rillig    929:                $$ = bitfield(NULL, to_int_constant($3, true));
1.1       cgd       930:          }
                    931:        ;
                    932:
                    933: enum_spec:
                    934:          enum enum_tag {
1.183     rillig    935:                $$ = mktag($2, ENUM, false, false);
1.1       cgd       936:          }
                    937:        | enum enum_tag {
1.183     rillig    938:                dcs->d_tagtyp = mktag($2, ENUM, true, false);
1.1       cgd       939:          } enum_declaration {
1.116     rillig    940:                $$ = complete_tag_enum(dcs->d_tagtyp, $4);
1.1       cgd       941:          }
                    942:        | enum {
1.183     rillig    943:                dcs->d_tagtyp = mktag(NULL, ENUM, true, false);
1.1       cgd       944:          } enum_declaration {
1.116     rillig    945:                $$ = complete_tag_enum(dcs->d_tagtyp, $3);
1.1       cgd       946:          }
                    947:        | enum error {
                    948:                symtyp = FVFT;
                    949:                $$ = gettyp(INT);
                    950:          }
                    951:        ;
                    952:
                    953: enum:
                    954:          T_ENUM {
                    955:                symtyp = FTAG;
1.202     rillig    956:                begin_declaration_level(CTCONST);
1.1       cgd       957:          }
                    958:        ;
                    959:
                    960: enum_tag:
                    961:          identifier {
                    962:                $$ = getsym($1);
                    963:          }
                    964:        ;
                    965:
                    966: enum_declaration:
                    967:          enum_decl_lbrace enums_with_opt_comma T_RBRACE {
                    968:                $$ = $2;
                    969:          }
                    970:        ;
                    971:
                    972: enum_decl_lbrace:
                    973:          T_LBRACE {
                    974:                symtyp = FVFT;
                    975:                enumval = 0;
                    976:          }
                    977:        ;
                    978:
                    979: enums_with_opt_comma:
1.240     rillig    980:          enums
1.1       cgd       981:        | enums T_COMMA {
                    982:                if (sflag) {
1.123     rillig    983:                        /* trailing ',' prohibited in enum declaration */
1.1       cgd       984:                        error(54);
                    985:                } else {
1.123     rillig    986:                        /* trailing ',' prohibited in enum declaration */
1.51      njoly     987:                        c99ism(54);
1.1       cgd       988:                }
                    989:                $$ = $1;
                    990:          }
                    991:        ;
                    992:
                    993: enums:
1.240     rillig    994:          enumerator
1.1       cgd       995:        | enums T_COMMA enumerator {
                    996:                $$ = lnklst($1, $3);
                    997:          }
                    998:        | error {
                    999:                $$ = NULL;
                   1000:          }
                   1001:        ;
                   1002:
                   1003: enumerator:
1.135     rillig   1004:          enumeration_constant {
1.183     rillig   1005:                $$ = enumeration_constant($1, enumval, true);
1.1       cgd      1006:          }
1.168     rillig   1007:        | enumeration_constant T_ASSIGN constant_expr {
1.183     rillig   1008:                $$ = enumeration_constant($1, to_int_constant($3, true), false);
1.1       cgd      1009:          }
                   1010:        ;
                   1011:
1.135     rillig   1012: enumeration_constant:          /* C99 6.4.4.3 */
1.1       cgd      1013:          identifier {
                   1014:                $$ = getsym($1);
                   1015:          }
                   1016:        ;
                   1017:
                   1018:
                   1019: notype_init_decls:
                   1020:          notype_init_decl
                   1021:        | notype_init_decls T_COMMA type_init_decl
                   1022:        ;
                   1023:
                   1024: type_init_decls:
                   1025:          type_init_decl
                   1026:        | type_init_decls T_COMMA type_init_decl
                   1027:        ;
                   1028:
                   1029: notype_init_decl:
1.241     rillig   1030:          notype_decl asm_or_symbolrename_opt {
1.174     rillig   1031:                cgram_declare($1, false, $2);
1.111     rillig   1032:                check_size($1);
1.1       cgd      1033:          }
1.241     rillig   1034:        | notype_decl asm_or_symbolrename_opt {
1.198     rillig   1035:                begin_initialization($1);
1.174     rillig   1036:                cgram_declare($1, true, $2);
1.198     rillig   1037:          } T_ASSIGN initializer {
1.111     rillig   1038:                check_size($1);
1.198     rillig   1039:                end_initialization();
1.1       cgd      1040:          }
                   1041:        ;
                   1042:
                   1043: type_init_decl:
1.241     rillig   1044:          type_decl asm_or_symbolrename_opt {
1.174     rillig   1045:                cgram_declare($1, false, $2);
1.111     rillig   1046:                check_size($1);
1.1       cgd      1047:          }
1.241     rillig   1048:        | type_decl asm_or_symbolrename_opt {
1.198     rillig   1049:                begin_initialization($1);
1.174     rillig   1050:                cgram_declare($1, true, $2);
1.198     rillig   1051:          } T_ASSIGN initializer {
1.111     rillig   1052:                check_size($1);
1.198     rillig   1053:                end_initialization();
1.1       cgd      1054:          }
                   1055:        ;
                   1056:
                   1057: notype_decl:
1.240     rillig   1058:          notype_direct_decl
1.1       cgd      1059:        | pointer notype_direct_decl {
1.111     rillig   1060:                $$ = add_pointer($2, $1);
1.1       cgd      1061:          }
                   1062:        ;
                   1063:
1.239     rillig   1064: type_decl:
1.240     rillig   1065:          type_direct_decl
1.239     rillig   1066:        | pointer type_direct_decl {
                   1067:                $$ = add_pointer($2, $1);
                   1068:          }
                   1069:        ;
                   1070:
1.1       cgd      1071: notype_direct_decl:
                   1072:          T_NAME {
1.111     rillig   1073:                $$ = declarator_name(getsym($1));
1.1       cgd      1074:          }
1.126     rillig   1075:        | T_LPAREN type_decl T_RPAREN {
1.1       cgd      1076:                $$ = $2;
                   1077:          }
1.63      christos 1078:        | type_attribute notype_direct_decl {
                   1079:                $$ = $2;
1.130     rillig   1080:          }
1.1       cgd      1081:        | notype_direct_decl T_LBRACK T_RBRACK {
1.183     rillig   1082:                $$ = add_array($1, false, 0);
1.1       cgd      1083:          }
1.214     christos 1084:        | notype_direct_decl T_LBRACK array_size T_RBRACK {
1.183     rillig   1085:                $$ = add_array($1, true, to_int_constant($3, false));
1.1       cgd      1086:          }
1.241     rillig   1087:        | notype_direct_decl param_list asm_or_symbolrename_opt {
1.111     rillig   1088:                $$ = add_function(symbolrename($1, $3), $2);
1.202     rillig   1089:                end_declaration_level();
1.171     rillig   1090:                block_level--;
1.1       cgd      1091:          }
1.87      christos 1092:        | notype_direct_decl type_attribute_list
1.1       cgd      1093:        ;
                   1094:
                   1095: type_direct_decl:
                   1096:          identifier {
1.111     rillig   1097:                $$ = declarator_name(getsym($1));
1.1       cgd      1098:          }
1.126     rillig   1099:        | T_LPAREN type_decl T_RPAREN {
1.1       cgd      1100:                $$ = $2;
                   1101:          }
1.63      christos 1102:        | type_attribute type_direct_decl {
                   1103:                $$ = $2;
1.130     rillig   1104:          }
1.1       cgd      1105:        | type_direct_decl T_LBRACK T_RBRACK {
1.183     rillig   1106:                $$ = add_array($1, false, 0);
1.1       cgd      1107:          }
1.214     christos 1108:        | type_direct_decl T_LBRACK array_size T_RBRACK {
1.183     rillig   1109:                $$ = add_array($1, true, to_int_constant($3, false));
1.1       cgd      1110:          }
1.241     rillig   1111:        | type_direct_decl param_list asm_or_symbolrename_opt {
1.111     rillig   1112:                $$ = add_function(symbolrename($1, $3), $2);
1.202     rillig   1113:                end_declaration_level();
1.171     rillig   1114:                block_level--;
1.1       cgd      1115:          }
1.87      christos 1116:        | type_direct_decl type_attribute_list
1.1       cgd      1117:        ;
                   1118:
                   1119: /*
                   1120:  * param_decl and notype_param_decl exist to avoid a conflict in
                   1121:  * argument lists. A typename enclosed in parens should always be
                   1122:  * treated as a typename, not an argument.
                   1123:  * "typedef int a; f(int (a));" is  "typedef int a; f(int foo(a));"
                   1124:  *                             not "typedef int a; f(int a);"
                   1125:  */
                   1126: param_decl:
1.240     rillig   1127:          direct_param_decl
1.1       cgd      1128:        | pointer direct_param_decl {
1.111     rillig   1129:                $$ = add_pointer($2, $1);
1.1       cgd      1130:          }
                   1131:        ;
                   1132:
1.214     christos 1133: array_size:
1.241     rillig   1134:          type_qualifier_list_opt T_SCLASS constant_expr {
1.216     rillig   1135:                /* C11 6.7.6.3p7 */
1.217     christos 1136:                if ($2 != STATIC)
1.214     christos 1137:                        yyerror("Bad attribute");
1.216     rillig   1138:                /* static array size is a C11 extension */
                   1139:                c11ism(343);
1.217     christos 1140:                $$ = $3;
1.215     rillig   1141:          }
1.240     rillig   1142:        | constant_expr
1.214     christos 1143:        ;
                   1144:
1.1       cgd      1145: direct_param_decl:
1.87      christos 1146:          identifier type_attribute_list {
1.111     rillig   1147:                $$ = declarator_name(getsym($1));
1.78      christos 1148:          }
                   1149:        | identifier {
1.111     rillig   1150:                $$ = declarator_name(getsym($1));
1.1       cgd      1151:          }
1.126     rillig   1152:        | T_LPAREN notype_param_decl T_RPAREN {
1.1       cgd      1153:                $$ = $2;
                   1154:          }
                   1155:        | direct_param_decl T_LBRACK T_RBRACK {
1.183     rillig   1156:                $$ = add_array($1, false, 0);
1.1       cgd      1157:          }
1.214     christos 1158:        | direct_param_decl T_LBRACK array_size T_RBRACK {
1.183     rillig   1159:                $$ = add_array($1, true, to_int_constant($3, false));
1.1       cgd      1160:          }
1.241     rillig   1161:        | direct_param_decl param_list asm_or_symbolrename_opt {
1.111     rillig   1162:                $$ = add_function(symbolrename($1, $3), $2);
1.202     rillig   1163:                end_declaration_level();
1.171     rillig   1164:                block_level--;
1.1       cgd      1165:          }
                   1166:        ;
                   1167:
                   1168: notype_param_decl:
1.240     rillig   1169:          direct_notype_param_decl
1.1       cgd      1170:        | pointer direct_notype_param_decl {
1.111     rillig   1171:                $$ = add_pointer($2, $1);
1.1       cgd      1172:          }
                   1173:        ;
                   1174:
                   1175: direct_notype_param_decl:
1.68      christos 1176:          identifier {
1.111     rillig   1177:                $$ = declarator_name(getsym($1));
1.1       cgd      1178:          }
1.126     rillig   1179:        | T_LPAREN notype_param_decl T_RPAREN {
1.1       cgd      1180:                $$ = $2;
                   1181:          }
                   1182:        | direct_notype_param_decl T_LBRACK T_RBRACK {
1.183     rillig   1183:                $$ = add_array($1, false, 0);
1.1       cgd      1184:          }
1.214     christos 1185:        | direct_notype_param_decl T_LBRACK array_size T_RBRACK {
1.183     rillig   1186:                $$ = add_array($1, true, to_int_constant($3, false));
1.1       cgd      1187:          }
1.241     rillig   1188:        | direct_notype_param_decl param_list asm_or_symbolrename_opt {
1.111     rillig   1189:                $$ = add_function(symbolrename($1, $3), $2);
1.202     rillig   1190:                end_declaration_level();
1.171     rillig   1191:                block_level--;
1.1       cgd      1192:          }
                   1193:        ;
                   1194:
1.244     rillig   1195: pointer:                       /* C99 6.7.5 */
1.245     rillig   1196:          asterisk type_qualifier_list_opt {
1.243     rillig   1197:                $$ = merge_qualified_pointer($1, $2);
1.1       cgd      1198:          }
1.245     rillig   1199:        | asterisk type_qualifier_list_opt pointer {
1.243     rillig   1200:                $$ = merge_qualified_pointer($1, $2);
                   1201:                $$ = merge_qualified_pointer($$, $3);
1.1       cgd      1202:          }
                   1203:        ;
                   1204:
                   1205: asterisk:
1.132     rillig   1206:          T_ASTERISK {
1.211     rillig   1207:                $$ = xcalloc(1, sizeof(*$$));
1.231     rillig   1208:                $$->p_pointer = true;
1.1       cgd      1209:          }
                   1210:        ;
                   1211:
1.245     rillig   1212: type_qualifier_list_opt:
                   1213:          /* empty */ {
                   1214:                $$ = NULL;
                   1215:          }
                   1216:        | type_qualifier_list
                   1217:        ;
                   1218:
                   1219: type_qualifier_list:           /* C99 6.7.5 */
1.240     rillig   1220:          type_qualifier
1.1       cgd      1221:        | type_qualifier_list type_qualifier {
1.243     rillig   1222:                $$ = merge_qualified_pointer($1, $2);
1.1       cgd      1223:          }
                   1224:        ;
                   1225:
                   1226: type_qualifier:
                   1227:          T_QUAL {
1.211     rillig   1228:                $$ = xcalloc(1, sizeof(*$$));
1.5       jpo      1229:                if ($1 == CONST) {
1.140     rillig   1230:                        $$->p_const = true;
1.151     rillig   1231:                } else if ($1 == VOLATILE) {
                   1232:                        $$->p_volatile = true;
1.1       cgd      1233:                } else {
1.151     rillig   1234:                        lint_assert($1 == RESTRICT || $1 == THREAD);
1.1       cgd      1235:                }
                   1236:          }
                   1237:        ;
                   1238:
                   1239: param_list:
1.170     rillig   1240:          id_list_lparen identifier_list T_RPAREN {
1.1       cgd      1241:                $$ = $2;
                   1242:          }
1.240     rillig   1243:        | abstract_decl_param_list
1.1       cgd      1244:        ;
                   1245:
1.170     rillig   1246: id_list_lparen:
1.126     rillig   1247:          T_LPAREN {
1.171     rillig   1248:                block_level++;
1.202     rillig   1249:                begin_declaration_level(PROTO_ARG);
1.1       cgd      1250:          }
                   1251:        ;
                   1252:
                   1253: identifier_list:
                   1254:          T_NAME {
1.111     rillig   1255:                $$ = old_style_function_name(getsym($1));
1.1       cgd      1256:          }
                   1257:        | identifier_list T_COMMA T_NAME {
1.111     rillig   1258:                $$ = lnklst($1, old_style_function_name(getsym($3)));
1.1       cgd      1259:          }
1.240     rillig   1260:        | identifier_list error
1.1       cgd      1261:        ;
                   1262:
1.155     rillig   1263: abstract_decl_param_list:
1.241     rillig   1264:          abstract_decl_lparen T_RPAREN type_attribute_opt {
1.1       cgd      1265:                $$ = NULL;
                   1266:          }
1.241     rillig   1267:        | abstract_decl_lparen vararg_parameter_type_list T_RPAREN type_attribute_opt {
1.140     rillig   1268:                dcs->d_proto = true;
1.1       cgd      1269:                $$ = $2;
                   1270:          }
1.241     rillig   1271:        | abstract_decl_lparen error T_RPAREN type_attribute_opt {
1.1       cgd      1272:                $$ = NULL;
                   1273:          }
                   1274:        ;
                   1275:
1.170     rillig   1276: abstract_decl_lparen:
1.126     rillig   1277:          T_LPAREN {
1.171     rillig   1278:                block_level++;
1.202     rillig   1279:                begin_declaration_level(PROTO_ARG);
1.1       cgd      1280:          }
                   1281:        ;
                   1282:
                   1283: vararg_parameter_type_list:
1.240     rillig   1284:          parameter_type_list
1.147     rillig   1285:        | parameter_type_list T_COMMA T_ELLIPSIS {
1.140     rillig   1286:                dcs->d_vararg = true;
1.1       cgd      1287:                $$ = $1;
                   1288:          }
1.147     rillig   1289:        | T_ELLIPSIS {
1.1       cgd      1290:                if (sflag) {
1.123     rillig   1291:                        /* ANSI C requires formal parameter before '...' */
1.1       cgd      1292:                        error(84);
                   1293:                } else if (!tflag) {
1.123     rillig   1294:                        /* ANSI C requires formal parameter before '...' */
1.1       cgd      1295:                        warning(84);
                   1296:                }
1.140     rillig   1297:                dcs->d_vararg = true;
1.1       cgd      1298:                $$ = NULL;
                   1299:          }
                   1300:        ;
                   1301:
                   1302: parameter_type_list:
1.240     rillig   1303:          parameter_declaration
1.11      cgd      1304:        | parameter_type_list T_COMMA parameter_declaration {
1.1       cgd      1305:                $$ = lnklst($1, $3);
                   1306:          }
                   1307:        ;
                   1308:
                   1309: parameter_declaration:
                   1310:          declmods deftyp {
1.183     rillig   1311:                $$ = declare_argument(abstract_name(), false);
1.1       cgd      1312:          }
1.194     rillig   1313:        | declaration_specifiers deftyp {
1.183     rillig   1314:                $$ = declare_argument(abstract_name(), false);
1.1       cgd      1315:          }
                   1316:        | declmods deftyp notype_param_decl {
1.183     rillig   1317:                $$ = declare_argument($3, false);
1.1       cgd      1318:          }
                   1319:        /*
                   1320:         * param_decl is needed because of following conflict:
                   1321:         * "typedef int a; f(int (a));" could be parsed as
                   1322:         * "function with argument a of type int", or
                   1323:         * "function with an abstract argument of type function".
                   1324:         * This grammar realizes the second case.
                   1325:         */
1.194     rillig   1326:        | declaration_specifiers deftyp param_decl {
1.183     rillig   1327:                $$ = declare_argument($3, false);
1.1       cgd      1328:          }
1.246     rillig   1329:        | declmods deftyp abstract_declarator {
1.183     rillig   1330:                $$ = declare_argument($3, false);
1.1       cgd      1331:          }
1.246     rillig   1332:        | declaration_specifiers deftyp abstract_declarator {
1.183     rillig   1333:                $$ = declare_argument($3, false);
1.1       cgd      1334:          }
                   1335:        ;
                   1336:
1.241     rillig   1337: asm_or_symbolrename_opt:               /* expect only one */
1.11      cgd      1338:          /* empty */ {
                   1339:                $$ = NULL;
                   1340:          }
1.126     rillig   1341:        | T_ASM T_LPAREN T_STRING T_RPAREN {
1.6       jpo      1342:                freeyyv(&$3, T_STRING);
1.11      cgd      1343:                $$ = NULL;
                   1344:          }
1.126     rillig   1345:        | T_SYMBOLRENAME T_LPAREN T_NAME T_RPAREN {
1.11      cgd      1346:                $$ = $3;
1.6       jpo      1347:          }
                   1348:        ;
                   1349:
1.179     rillig   1350: initializer:                   /* C99 6.7.8 "Initialization" */
1.79      dholland 1351:          expr                          %prec T_COMMA {
1.207     rillig   1352:                init_expr($1);
1.1       cgd      1353:          }
1.178     rillig   1354:        | init_lbrace init_rbrace {
                   1355:                /* XXX: Empty braces are not covered by C99 6.7.8. */
                   1356:          }
1.182     rillig   1357:        | init_lbrace initializer_list comma_opt init_rbrace
1.1       cgd      1358:        | error
                   1359:        ;
                   1360:
1.179     rillig   1361: initializer_list:              /* C99 6.7.8 "Initialization" */
1.192     rillig   1362:          initializer_list_item
1.180     rillig   1363:        | initializer_list T_COMMA initializer_list_item
                   1364:        ;
                   1365:
                   1366: initializer_list_item:
                   1367:          designation initializer
                   1368:        | initializer
1.1       cgd      1369:        ;
                   1370:
1.239     rillig   1371: designation:                   /* C99 6.7.8 "Initialization" */
                   1372:          designator_list T_ASSIGN
                   1373:        | identifier T_COLON {
                   1374:                /* GCC style struct or union member name in initializer */
                   1375:                gnuism(315);
                   1376:                add_designator_member($1);
1.35      christos 1377:          }
1.239     rillig   1378:        ;
                   1379:
                   1380: designator_list:               /* C99 6.7.8 "Initialization" */
                   1381:          designator
                   1382:        | designator_list designator
1.35      christos 1383:        ;
                   1384:
1.167     rillig   1385: designator:                    /* C99 6.7.8 "Initialization" */
1.71      christos 1386:          T_LBRACK range T_RBRACK {
1.205     rillig   1387:                add_designator_subscript($2);
1.34      yamt     1388:                if (!Sflag)
1.127     rillig   1389:                        /* array initializer with des.s is a C9X feature */
1.34      yamt     1390:                        warning(321);
                   1391:          }
1.230     rillig   1392:        | T_POINT identifier {
1.26      christos 1393:                if (!Sflag)
1.127     rillig   1394:                        /* struct or union member name in initializer is ... */
1.26      christos 1395:                        warning(313);
1.205     rillig   1396:                add_designator_member($2);
1.26      christos 1397:          }
1.71      christos 1398:        ;
                   1399:
1.239     rillig   1400: range:
                   1401:          constant_expr {
                   1402:                $$.lo = to_int_constant($1, true);
                   1403:                $$.hi = $$.lo;
                   1404:          }
                   1405:        | constant_expr T_ELLIPSIS constant_expr {
                   1406:                $$.lo = to_int_constant($1, true);
                   1407:                $$.hi = to_int_constant($3, true);
                   1408:                /* initialization with '[a...b]' is a GNU extension */
                   1409:                gnuism(340);
1.26      christos 1410:          }
                   1411:        ;
                   1412:
1.1       cgd      1413: init_lbrace:
                   1414:          T_LBRACE {
1.114     rillig   1415:                init_lbrace();
1.1       cgd      1416:          }
                   1417:        ;
                   1418:
                   1419: init_rbrace:
                   1420:          T_RBRACE {
1.114     rillig   1421:                init_rbrace();
1.1       cgd      1422:          }
                   1423:        ;
                   1424:
1.246     rillig   1425: type_name:                     /* C99 6.7.6 */
1.110     rillig   1426:          {
1.202     rillig   1427:                begin_declaration_level(ABSTRACT);
1.1       cgd      1428:          } abstract_declaration {
1.202     rillig   1429:                end_declaration_level();
1.1       cgd      1430:                $$ = $2->s_type;
                   1431:          }
                   1432:        ;
                   1433:
                   1434: abstract_declaration:
                   1435:          noclass_declmods deftyp {
1.111     rillig   1436:                $$ = declare_1_abstract(abstract_name());
1.1       cgd      1437:          }
                   1438:        | noclass_declspecs deftyp {
1.111     rillig   1439:                $$ = declare_1_abstract(abstract_name());
1.1       cgd      1440:          }
1.246     rillig   1441:        | noclass_declmods deftyp abstract_declarator {
1.111     rillig   1442:                $$ = declare_1_abstract($3);
1.1       cgd      1443:          }
1.246     rillig   1444:        | noclass_declspecs deftyp abstract_declarator {
1.111     rillig   1445:                $$ = declare_1_abstract($3);
1.1       cgd      1446:          }
                   1447:        ;
                   1448:
1.246     rillig   1449: abstract_declarator:           /* C99 6.7.6 */
1.1       cgd      1450:          pointer {
1.111     rillig   1451:                $$ = add_pointer(abstract_name(), $1);
1.1       cgd      1452:          }
1.246     rillig   1453:        | direct_abstract_declarator
                   1454:        | pointer direct_abstract_declarator {
1.111     rillig   1455:                $$ = add_pointer($2, $1);
1.1       cgd      1456:          }
1.246     rillig   1457:        | T_TYPEOF term {       /* GCC extension */
1.94      christos 1458:                $$ = mktempsym($2->tn_type);
                   1459:          }
1.1       cgd      1460:        ;
                   1461:
1.247     rillig   1462: direct_abstract_declarator:            /* C99 6.7.6 */
1.246     rillig   1463:          T_LPAREN abstract_declarator T_RPAREN {
1.1       cgd      1464:                $$ = $2;
                   1465:          }
                   1466:        | T_LBRACK T_RBRACK {
1.183     rillig   1467:                $$ = add_array(abstract_name(), false, 0);
1.1       cgd      1468:          }
1.214     christos 1469:        | T_LBRACK array_size T_RBRACK {
1.183     rillig   1470:                $$ = add_array(abstract_name(), true, to_int_constant($2, false));
1.1       cgd      1471:          }
1.246     rillig   1472:        | type_attribute direct_abstract_declarator {
1.63      christos 1473:                $$ = $2;
1.130     rillig   1474:          }
1.246     rillig   1475:        | direct_abstract_declarator T_LBRACK T_RBRACK {
1.183     rillig   1476:                $$ = add_array($1, false, 0);
1.1       cgd      1477:          }
1.247     rillig   1478:        | direct_abstract_declarator T_LBRACK T_ASTERISK T_RBRACK { /* C99 */
                   1479:                $$ = add_array($1, false, 0);
                   1480:          }
1.246     rillig   1481:        | direct_abstract_declarator T_LBRACK array_size T_RBRACK {
1.183     rillig   1482:                $$ = add_array($1, true, to_int_constant($3, false));
1.1       cgd      1483:          }
1.241     rillig   1484:        | abstract_decl_param_list asm_or_symbolrename_opt {
1.111     rillig   1485:                $$ = add_function(symbolrename(abstract_name(), $2), $1);
1.202     rillig   1486:                end_declaration_level();
1.171     rillig   1487:                block_level--;
1.1       cgd      1488:          }
1.246     rillig   1489:        | direct_abstract_declarator abstract_decl_param_list asm_or_symbolrename_opt {
1.111     rillig   1490:                $$ = add_function(symbolrename($1, $3), $2);
1.202     rillig   1491:                end_declaration_level();
1.171     rillig   1492:                block_level--;
1.1       cgd      1493:          }
1.246     rillig   1494:        | direct_abstract_declarator type_attribute_list
1.1       cgd      1495:        ;
                   1496:
1.133     rillig   1497: non_expr_statement:
1.212     christos 1498:          type_attribute T_SEMI
                   1499:        | labeled_statement
1.133     rillig   1500:        | compound_statement
                   1501:        | selection_statement
                   1502:        | iteration_statement
                   1503:        | jump_statement {
1.188     rillig   1504:                seen_fallthrough = false;
1.1       cgd      1505:          }
1.133     rillig   1506:        | asm_statement
1.212     christos 1507:        ;
1.32      christos 1508:
1.134     rillig   1509: statement:                     /* C99 6.8 */
1.133     rillig   1510:          expr_statement
                   1511:        | non_expr_statement
1.1       cgd      1512:        ;
                   1513:
1.134     rillig   1514: labeled_statement:             /* C99 6.8.1 */
1.241     rillig   1515:          label type_attribute_opt statement
1.1       cgd      1516:        ;
                   1517:
                   1518: label:
1.53      christos 1519:          T_NAME T_COLON {
1.120     rillig   1520:                symtyp = FLABEL;
1.125     rillig   1521:                named_label(getsym($1));
1.1       cgd      1522:          }
1.168     rillig   1523:        | T_CASE constant_expr T_COLON {
1.125     rillig   1524:                case_label($2);
1.188     rillig   1525:                seen_fallthrough = true;
1.130     rillig   1526:          }
1.168     rillig   1527:        | T_CASE constant_expr T_ELLIPSIS constant_expr T_COLON {
1.40      christos 1528:                /* XXX: We don't fill all cases */
1.125     rillig   1529:                case_label($2);
1.188     rillig   1530:                seen_fallthrough = true;
1.130     rillig   1531:          }
1.1       cgd      1532:        | T_DEFAULT T_COLON {
1.125     rillig   1533:                default_label();
1.188     rillig   1534:                seen_fallthrough = true;
1.1       cgd      1535:          }
                   1536:        ;
                   1537:
1.134     rillig   1538: compound_statement:            /* C99 6.8.2 */
1.133     rillig   1539:          compound_statement_lbrace compound_statement_rbrace
1.186     rillig   1540:        | compound_statement_lbrace block_item_list compound_statement_rbrace
1.1       cgd      1541:        ;
                   1542:
1.133     rillig   1543: compound_statement_lbrace:
1.1       cgd      1544:          T_LBRACE {
1.171     rillig   1545:                block_level++;
                   1546:                mem_block_level++;
1.202     rillig   1547:                begin_declaration_level(AUTO);
1.1       cgd      1548:          }
                   1549:        ;
                   1550:
1.133     rillig   1551: compound_statement_rbrace:
1.1       cgd      1552:          T_RBRACE {
1.202     rillig   1553:                end_declaration_level();
1.1       cgd      1554:                freeblk();
1.171     rillig   1555:                mem_block_level--;
                   1556:                block_level--;
1.188     rillig   1557:                seen_fallthrough = false;
1.1       cgd      1558:          }
                   1559:        ;
                   1560:
1.185     rillig   1561: block_item_list:
                   1562:          block_item
                   1563:        | block_item_list block_item {
                   1564:                if (!Sflag && $1 && !$2)
                   1565:                        /* declarations after statements is a C99 feature */
                   1566:                        c99ism(327);
1.234     rillig   1567:                $$ = $1 || $2;
1.185     rillig   1568:        }
                   1569:        ;
                   1570:
                   1571: block_item:
                   1572:          statement {
                   1573:                $$ = true;
1.187     rillig   1574:                restore_warning_flags();
1.185     rillig   1575:          }
                   1576:        | declaration {
                   1577:                $$ = false;
1.187     rillig   1578:                restore_warning_flags();
1.7       jpo      1579:          }
1.1       cgd      1580:        ;
                   1581:
1.133     rillig   1582: expr_statement:
1.1       cgd      1583:          expr T_SEMI {
1.160     rillig   1584:                expr($1, false, false, false, false);
1.188     rillig   1585:                seen_fallthrough = false;
1.1       cgd      1586:          }
                   1587:        | T_SEMI {
1.188     rillig   1588:                seen_fallthrough = false;
1.1       cgd      1589:          }
                   1590:        ;
                   1591:
1.134     rillig   1592: selection_statement:           /* C99 6.8.4 */
1.1       cgd      1593:          if_without_else {
1.187     rillig   1594:                save_warning_flags();
1.1       cgd      1595:                if2();
1.183     rillig   1596:                if3(false);
1.1       cgd      1597:          }
                   1598:        | if_without_else T_ELSE {
1.187     rillig   1599:                save_warning_flags();
1.1       cgd      1600:                if2();
1.133     rillig   1601:          } statement {
1.187     rillig   1602:                clear_warning_flags();
1.183     rillig   1603:                if3(true);
1.1       cgd      1604:          }
                   1605:        | if_without_else T_ELSE error {
1.187     rillig   1606:                clear_warning_flags();
1.183     rillig   1607:                if3(false);
1.1       cgd      1608:          }
1.133     rillig   1609:        | switch_expr statement {
1.187     rillig   1610:                clear_warning_flags();
1.1       cgd      1611:                switch2();
                   1612:          }
                   1613:        | switch_expr error {
1.187     rillig   1614:                clear_warning_flags();
1.1       cgd      1615:                switch2();
                   1616:          }
                   1617:        ;
                   1618:
                   1619: if_without_else:
1.133     rillig   1620:          if_expr statement
1.1       cgd      1621:        | if_expr error
                   1622:        ;
                   1623:
                   1624: if_expr:
1.126     rillig   1625:          T_IF T_LPAREN expr T_RPAREN {
1.1       cgd      1626:                if1($3);
1.187     rillig   1627:                clear_warning_flags();
1.1       cgd      1628:          }
                   1629:        ;
                   1630:
                   1631: switch_expr:
1.126     rillig   1632:          T_SWITCH T_LPAREN expr T_RPAREN {
1.1       cgd      1633:                switch1($3);
1.187     rillig   1634:                clear_warning_flags();
1.1       cgd      1635:          }
                   1636:        ;
                   1637:
1.235     rillig   1638: generic_selection:             /* C11 6.5.1.1 */
1.238     rillig   1639:          T_GENERIC T_LPAREN assignment_expression T_COMMA
                   1640:            generic_assoc_list T_RPAREN {
1.236     rillig   1641:                /* generic selection requires C11 or later */
                   1642:                c11ism(345);
1.237     rillig   1643:                $$ = build_generic_selection($3, $5);
1.235     rillig   1644:          }
1.81      christos 1645:        ;
                   1646:
1.235     rillig   1647: generic_assoc_list:            /* C11 6.5.1.1 */
                   1648:          generic_association
1.237     rillig   1649:        | generic_assoc_list T_COMMA generic_association {
                   1650:                $3->gat_prev = $1;
                   1651:                $$ = $3;
                   1652:          }
1.81      christos 1653:        ;
                   1654:
1.235     rillig   1655: generic_association:           /* C11 6.5.1.1 */
1.242     rillig   1656:          type_name T_COLON assignment_expression {
1.237     rillig   1657:                $$ = getblk(sizeof(*$$));
                   1658:                $$->gat_arg = $1;
                   1659:                $$->gat_result = $3;
                   1660:          }
1.242     rillig   1661:        | T_DEFAULT T_COLON assignment_expression {
1.237     rillig   1662:                $$ = getblk(sizeof(*$$));
                   1663:                $$->gat_arg = NULL;
                   1664:                $$->gat_result = $3;
                   1665:          }
1.81      christos 1666:        ;
                   1667:
1.233     rillig   1668: do_statement:                  /* C99 6.8.5 */
1.133     rillig   1669:          do statement {
1.187     rillig   1670:                clear_warning_flags();
1.14      christos 1671:          }
                   1672:        ;
                   1673:
1.134     rillig   1674: iteration_statement:           /* C99 6.8.5 */
1.133     rillig   1675:          while_expr statement {
1.187     rillig   1676:                clear_warning_flags();
1.1       cgd      1677:                while2();
                   1678:          }
                   1679:        | while_expr error {
1.187     rillig   1680:                clear_warning_flags();
1.1       cgd      1681:                while2();
                   1682:          }
1.133     rillig   1683:        | do_statement do_while_expr {
1.14      christos 1684:                do2($2);
1.188     rillig   1685:                seen_fallthrough = false;
1.1       cgd      1686:          }
                   1687:        | do error {
1.187     rillig   1688:                clear_warning_flags();
1.1       cgd      1689:                do2(NULL);
                   1690:          }
1.133     rillig   1691:        | for_exprs statement {
1.187     rillig   1692:                clear_warning_flags();
1.1       cgd      1693:                for2();
1.202     rillig   1694:                end_declaration_level();
1.171     rillig   1695:                block_level--;
1.1       cgd      1696:          }
                   1697:        | for_exprs error {
1.187     rillig   1698:                clear_warning_flags();
1.1       cgd      1699:                for2();
1.202     rillig   1700:                end_declaration_level();
1.171     rillig   1701:                block_level--;
1.1       cgd      1702:          }
                   1703:        ;
                   1704:
                   1705: while_expr:
1.126     rillig   1706:          T_WHILE T_LPAREN expr T_RPAREN {
1.1       cgd      1707:                while1($3);
1.187     rillig   1708:                clear_warning_flags();
1.1       cgd      1709:          }
                   1710:        ;
                   1711:
                   1712: do:
                   1713:          T_DO {
                   1714:                do1();
                   1715:          }
                   1716:        ;
                   1717:
                   1718: do_while_expr:
1.126     rillig   1719:          T_WHILE T_LPAREN expr T_RPAREN T_SEMI {
1.1       cgd      1720:                $$ = $3;
                   1721:          }
                   1722:        ;
                   1723:
1.66      christos 1724: for_start:
1.126     rillig   1725:          T_FOR T_LPAREN {
1.202     rillig   1726:                begin_declaration_level(AUTO);
1.171     rillig   1727:                block_level++;
1.66      christos 1728:          }
                   1729:        ;
1.1       cgd      1730: for_exprs:
1.194     rillig   1731:          for_start declaration_specifiers deftyp notype_init_decls T_SEMI
1.241     rillig   1732:            expr_opt T_SEMI expr_opt T_RPAREN {
1.127     rillig   1733:                /* variable declaration in for loop */
1.43      christos 1734:                c99ism(325);
1.66      christos 1735:                for1(NULL, $6, $8);
1.187     rillig   1736:                clear_warning_flags();
1.43      christos 1737:            }
1.241     rillig   1738:          | for_start expr_opt T_SEMI expr_opt T_SEMI expr_opt T_RPAREN {
1.66      christos 1739:                for1($2, $4, $6);
1.187     rillig   1740:                clear_warning_flags();
1.1       cgd      1741:          }
                   1742:        ;
                   1743:
1.241     rillig   1744: expr_opt:
1.1       cgd      1745:          /* empty */ {
                   1746:                $$ = NULL;
                   1747:          }
1.240     rillig   1748:        | expr
1.1       cgd      1749:        ;
                   1750:
1.134     rillig   1751: jump_statement:                        /* C99 6.8.6 */
1.1       cgd      1752:          goto identifier T_SEMI {
1.196     rillig   1753:                do_goto(getsym($2));
1.1       cgd      1754:          }
                   1755:        | goto error T_SEMI {
                   1756:                symtyp = FVFT;
                   1757:          }
                   1758:        | T_CONTINUE T_SEMI {
1.196     rillig   1759:                do_continue();
1.1       cgd      1760:          }
                   1761:        | T_BREAK T_SEMI {
1.196     rillig   1762:                do_break();
1.1       cgd      1763:          }
                   1764:        | T_RETURN T_SEMI {
1.196     rillig   1765:                do_return(NULL);
1.1       cgd      1766:          }
                   1767:        | T_RETURN expr T_SEMI {
1.196     rillig   1768:                do_return($2);
1.1       cgd      1769:          }
                   1770:        ;
                   1771:
                   1772: goto:
                   1773:          T_GOTO {
1.120     rillig   1774:                symtyp = FLABEL;
1.1       cgd      1775:          }
                   1776:        ;
                   1777:
1.133     rillig   1778: asm_statement:
1.170     rillig   1779:          T_ASM T_LPAREN read_until_rparen T_SEMI {
1.8       jpo      1780:                setasm();
                   1781:          }
1.170     rillig   1782:        | T_ASM T_QUAL T_LPAREN read_until_rparen T_SEMI {
1.8       jpo      1783:                setasm();
                   1784:          }
                   1785:        | T_ASM error
1.6       jpo      1786:        ;
                   1787:
1.170     rillig   1788: read_until_rparen:
1.6       jpo      1789:          /* empty */ {
1.148     rillig   1790:                ignore_up_to_rparen();
1.6       jpo      1791:          }
                   1792:        ;
                   1793:
1.224     rillig   1794: constant_expr_list_opt:
                   1795:          /* empty */
                   1796:        | constant_expr_list
                   1797:        ;
                   1798:
                   1799: constant_expr_list:
                   1800:          constant_expr
                   1801:        | constant_expr_list T_COMMA constant_expr
                   1802:        ;
                   1803:
1.169     rillig   1804: constant_expr:                 /* C99 6.6 */
1.240     rillig   1805:          expr %prec T_ASSIGN
1.1       cgd      1806:        ;
                   1807:
                   1808: expr:
1.132     rillig   1809:          expr T_ASTERISK expr {
1.1       cgd      1810:                $$ = build(MULT, $1, $3);
                   1811:          }
1.150     rillig   1812:        | expr T_MULTIPLICATIVE expr {
1.1       cgd      1813:                $$ = build($2, $1, $3);
                   1814:          }
1.150     rillig   1815:        | expr T_ADDITIVE expr {
1.1       cgd      1816:                $$ = build($2, $1, $3);
                   1817:          }
1.150     rillig   1818:        | expr T_SHIFT expr {
1.1       cgd      1819:                $$ = build($2, $1, $3);
                   1820:          }
1.150     rillig   1821:        | expr T_RELATIONAL expr {
1.1       cgd      1822:                $$ = build($2, $1, $3);
                   1823:          }
1.150     rillig   1824:        | expr T_EQUALITY expr {
1.1       cgd      1825:                $$ = build($2, $1, $3);
                   1826:          }
1.145     rillig   1827:        | expr T_AMPER expr {
1.144     rillig   1828:                $$ = build(BITAND, $1, $3);
1.1       cgd      1829:          }
1.191     rillig   1830:        | expr T_BITXOR expr {
1.144     rillig   1831:                $$ = build(BITXOR, $1, $3);
1.1       cgd      1832:          }
1.150     rillig   1833:        | expr T_BITOR expr {
1.144     rillig   1834:                $$ = build(BITOR, $1, $3);
1.1       cgd      1835:          }
                   1836:        | expr T_LOGAND expr {
                   1837:                $$ = build(LOGAND, $1, $3);
                   1838:          }
                   1839:        | expr T_LOGOR expr {
                   1840:                $$ = build(LOGOR, $1, $3);
                   1841:          }
                   1842:        | expr T_QUEST expr T_COLON expr {
                   1843:                $$ = build(QUEST, $1, build(COLON, $3, $5));
                   1844:          }
                   1845:        | expr T_ASSIGN expr {
                   1846:                $$ = build(ASSIGN, $1, $3);
                   1847:          }
1.150     rillig   1848:        | expr T_OPASSIGN expr {
1.1       cgd      1849:                $$ = build($2, $1, $3);
                   1850:          }
                   1851:        | expr T_COMMA expr {
                   1852:                $$ = build(COMMA, $1, $3);
                   1853:          }
1.240     rillig   1854:        | term
                   1855:        | generic_selection
1.1       cgd      1856:        ;
                   1857:
1.238     rillig   1858: assignment_expression:         /* C99 6.5.16 */
                   1859:          expr %prec T_ASSIGN
                   1860:        ;
                   1861:
1.1       cgd      1862: term:
                   1863:          T_NAME {
1.21      wiz      1864:                /* XXX really necessary? */
1.1       cgd      1865:                if (yychar < 0)
                   1866:                        yychar = yylex();
1.128     rillig   1867:                $$ = new_name_node(getsym($1), yychar);
1.1       cgd      1868:          }
                   1869:        | string {
1.128     rillig   1870:                $$ = new_string_node($1);
1.1       cgd      1871:          }
                   1872:        | T_CON {
1.209     rillig   1873:                $$ = expr_new_constant(gettyp($1->v_tspec), $1);
1.1       cgd      1874:          }
1.126     rillig   1875:        | T_LPAREN expr T_RPAREN {
1.1       cgd      1876:                if ($2 != NULL)
1.140     rillig   1877:                        $2->tn_parenthesized = true;
1.1       cgd      1878:                $$ = $2;
                   1879:          }
1.226     rillig   1880:        | T_LPAREN compound_statement_lbrace gcc_statement_expr_list {
1.171     rillig   1881:                block_level--;
                   1882:                mem_block_level--;
1.226     rillig   1883:                begin_initialization(mktempsym(dup_type($3->tn_type)));
1.171     rillig   1884:                mem_block_level++;
                   1885:                block_level++;
1.127     rillig   1886:                /* ({ }) is a GCC extension */
1.29      christos 1887:                gnuism(320);
1.133     rillig   1888:         } compound_statement_rbrace T_RPAREN {
1.197     rillig   1889:                $$ = new_name_node(*current_initsym(), 0);
1.198     rillig   1890:                end_initialization();
1.130     rillig   1891:         }
1.1       cgd      1892:        | term T_INCDEC {
                   1893:                $$ = build($2 == INC ? INCAFT : DECAFT, $1, NULL);
                   1894:          }
                   1895:        | T_INCDEC term {
                   1896:                $$ = build($1 == INC ? INCBEF : DECBEF, $2, NULL);
                   1897:          }
1.132     rillig   1898:        | T_ASTERISK term {
1.143     rillig   1899:                $$ = build(INDIR, $2, NULL);
1.1       cgd      1900:          }
1.145     rillig   1901:        | T_AMPER term {
1.142     rillig   1902:                $$ = build(ADDR, $2, NULL);
1.1       cgd      1903:          }
1.150     rillig   1904:        | T_UNARY term {
1.1       cgd      1905:                $$ = build($1, $2, NULL);
                   1906:          }
1.150     rillig   1907:        | T_ADDITIVE term {
1.1       cgd      1908:                if (tflag && $1 == PLUS) {
                   1909:                        /* unary + is illegal in traditional C */
                   1910:                        warning(100);
                   1911:                }
                   1912:                $$ = build($1 == PLUS ? UPLUS : UMINUS, $2, NULL);
                   1913:          }
                   1914:        | term T_LBRACK expr T_RBRACK {
1.143     rillig   1915:                $$ = build(INDIR, build(PLUS, $1, $3), NULL);
1.1       cgd      1916:          }
1.126     rillig   1917:        | term T_LPAREN T_RPAREN {
1.129     rillig   1918:                $$ = new_function_call_node($1, NULL);
1.1       cgd      1919:          }
1.126     rillig   1920:        | term T_LPAREN func_arg_list T_RPAREN {
1.129     rillig   1921:                $$ = new_function_call_node($1, $3);
1.1       cgd      1922:          }
                   1923:        | term point_or_arrow T_NAME {
                   1924:                if ($1 != NULL) {
                   1925:                        sym_t   *msym;
1.114     rillig   1926:                        /*
                   1927:                         * XXX struct_or_union_member should be integrated
                   1928:                         * in build()
                   1929:                         */
1.1       cgd      1930:                        if ($2 == ARROW) {
1.114     rillig   1931:                                /*
                   1932:                                 * must do this before struct_or_union_member
                   1933:                                 * is called
                   1934:                                 */
1.1       cgd      1935:                                $1 = cconv($1);
                   1936:                        }
1.114     rillig   1937:                        msym = struct_or_union_member($1, $2, getsym($3));
1.128     rillig   1938:                        $$ = build($2, $1, new_name_node(msym, 0));
1.1       cgd      1939:                } else {
                   1940:                        $$ = NULL;
                   1941:                }
                   1942:          }
1.41      christos 1943:        | T_REAL term {
                   1944:                $$ = build(REAL, $2, NULL);
                   1945:          }
                   1946:        | T_IMAG term {
                   1947:                $$ = build(IMAG, $2, NULL);
                   1948:          }
1.60      christos 1949:        | T_EXTENSION term {
                   1950:                $$ = $2;
                   1951:          }
1.126     rillig   1952:        | T_REAL T_LPAREN term T_RPAREN {
1.41      christos 1953:                $$ = build(REAL, $3, NULL);
                   1954:          }
1.126     rillig   1955:        | T_IMAG T_LPAREN term T_RPAREN {
1.41      christos 1956:                $$ = build(IMAG, $3, NULL);
                   1957:          }
1.192     rillig   1958:        | T_BUILTIN_OFFSETOF T_LPAREN type_name T_COMMA identifier T_RPAREN {
1.120     rillig   1959:                symtyp = FMEMBER;
1.114     rillig   1960:                $$ = build_offsetof($3, getsym($5));
1.94      christos 1961:          }
1.192     rillig   1962:        | T_SIZEOF term {
1.114     rillig   1963:                $$ = $2 == NULL ? NULL : build_sizeof($2->tn_type);
                   1964:                if ($$ != NULL)
1.183     rillig   1965:                        check_expr_misc($2, false, false, false, false, false, true);
1.1       cgd      1966:          }
1.126     rillig   1967:        | T_SIZEOF T_LPAREN type_name T_RPAREN          %prec T_SIZEOF {
1.114     rillig   1968:                $$ = build_sizeof($3);
1.1       cgd      1969:          }
1.192     rillig   1970:        | T_ALIGNOF T_LPAREN type_name T_RPAREN {
1.114     rillig   1971:                $$ = build_alignof($3);
1.44      christos 1972:          }
1.150     rillig   1973:        | T_LPAREN type_name T_RPAREN term              %prec T_UNARY {
1.1       cgd      1974:                $$ = cast($4, $2);
                   1975:          }
1.201     rillig   1976:        | T_LPAREN type_name T_RPAREN { /* C99 6.5.2.5 "Compound literals" */
1.28      christos 1977:                sym_t *tmp = mktempsym($2);
1.198     rillig   1978:                begin_initialization(tmp);
1.174     rillig   1979:                cgram_declare(tmp, true, NULL);
1.180     rillig   1980:          } init_lbrace initializer_list comma_opt init_rbrace {
1.28      christos 1981:                if (!Sflag)
1.127     rillig   1982:                         /* compound literals are a C9X/GCC extension */
                   1983:                         gnuism(319);
1.197     rillig   1984:                $$ = new_name_node(*current_initsym(), 0);
1.198     rillig   1985:                end_initialization();
1.28      christos 1986:          }
1.1       cgd      1987:        ;
                   1988:
1.226     rillig   1989: /*
                   1990:  * The inner part of a GCC statement-expression of the form ({ ... }).
                   1991:  *
                   1992:  * https://gcc.gnu.org/onlinedocs/gcc/Statement-Exprs.html
                   1993:  */
                   1994: gcc_statement_expr_list:
                   1995:          gcc_statement_expr_item
                   1996:        | gcc_statement_expr_list gcc_statement_expr_item {
                   1997:                $$ = $2;
                   1998:          }
                   1999:        ;
                   2000:
                   2001: gcc_statement_expr_item:
                   2002:          declaration {
                   2003:                clear_warning_flags();
                   2004:                $$ = NULL;
                   2005:          }
                   2006:        | non_expr_statement {
                   2007:                $$ = expr_zalloc_tnode();
                   2008:                $$->tn_type = gettyp(VOID);
                   2009:          }
                   2010:        | expr T_SEMI {
1.229     rillig   2011:                if ($1 == NULL) {       /* in case of syntax errors */
                   2012:                        $$ = expr_zalloc_tnode();
                   2013:                        $$->tn_type = gettyp(VOID);
                   2014:                } else {
                   2015:                        /* XXX: do that only on the last name */
                   2016:                        if ($1->tn_op == NAME)
                   2017:                                $1->tn_sym->s_used = true;
                   2018:                        $$ = $1;
                   2019:                        expr($1, false, false, false, false);
                   2020:                        seen_fallthrough = false;
                   2021:                }
1.233     rillig   2022:          }
1.226     rillig   2023:        ;
                   2024:
1.1       cgd      2025: string:
1.240     rillig   2026:          T_STRING
1.1       cgd      2027:        | T_STRING string2 {
1.114     rillig   2028:                $$ = cat_strings($1, $2);
1.1       cgd      2029:          }
                   2030:        ;
                   2031:
                   2032: string2:
1.110     rillig   2033:          T_STRING {
1.1       cgd      2034:                if (tflag) {
                   2035:                        /* concatenated strings are illegal in traditional C */
                   2036:                        warning(219);
                   2037:                }
                   2038:                $$ = $1;
                   2039:          }
                   2040:        | string2 T_STRING {
1.114     rillig   2041:                $$ = cat_strings($1, $2);
1.1       cgd      2042:          }
                   2043:        ;
                   2044:
                   2045: func_arg_list:
                   2046:          expr                                          %prec T_COMMA {
1.129     rillig   2047:                $$ = new_function_argument_node(NULL, $1);
1.1       cgd      2048:          }
                   2049:        | func_arg_list T_COMMA expr {
1.129     rillig   2050:                $$ = new_function_argument_node($1, $3);
1.1       cgd      2051:          }
                   2052:        ;
                   2053:
                   2054: point_or_arrow:
1.230     rillig   2055:          T_POINT {
1.120     rillig   2056:                symtyp = FMEMBER;
1.230     rillig   2057:                $$ = POINT;
1.26      christos 2058:          }
1.230     rillig   2059:        | T_ARROW {
                   2060:                symtyp = FMEMBER;
                   2061:                $$ = ARROW;
1.1       cgd      2062:          }
                   2063:        ;
                   2064:
1.168     rillig   2065: identifier:                    /* C99 6.4.2.1 */
1.1       cgd      2066:          T_NAME {
                   2067:                $$ = $1;
1.117     rillig   2068:                cgram_debug("name '%s'", $$->sb_name);
1.1       cgd      2069:          }
                   2070:        | T_TYPENAME {
                   2071:                $$ = $1;
1.117     rillig   2072:                cgram_debug("typename '%s'", $$->sb_name);
1.1       cgd      2073:          }
                   2074:        ;
                   2075:
1.180     rillig   2076: comma_opt:
                   2077:          T_COMMA
                   2078:        | /* empty */
                   2079:        ;
1.1       cgd      2080: %%
                   2081:
                   2082: /* ARGSUSED */
                   2083: int
1.42      dholland 2084: yyerror(const char *msg)
1.1       cgd      2085: {
1.127     rillig   2086:        /* syntax error '%s' */
1.41      christos 2087:        error(249, yytext);
1.1       cgd      2088:        if (++sytxerr >= 5)
                   2089:                norecover();
1.112     rillig   2090:        return 0;
1.1       cgd      2091: }
                   2092:
                   2093: static void
1.174     rillig   2094: cgram_declare(sym_t *decl, bool initflg, sbuf_t *renaming)
1.1       cgd      2095: {
1.174     rillig   2096:        declare(decl, initflg, renaming);
                   2097:        if (renaming != NULL)
                   2098:                freeyyv(&renaming, T_NAME);
1.6       jpo      2099: }
                   2100:
                   2101: /*
                   2102:  * Discard all input tokens up to and including the next
                   2103:  * unmatched right paren
                   2104:  */
1.22      thorpej  2105: static void
1.148     rillig   2106: ignore_up_to_rparen(void)
1.6       jpo      2107: {
                   2108:        int     level;
                   2109:
                   2110:        if (yychar < 0)
                   2111:                yychar = yylex();
                   2112:        freeyyv(&yylval, yychar);
                   2113:
                   2114:        level = 1;
1.126     rillig   2115:        while (yychar != T_RPAREN || --level > 0) {
                   2116:                if (yychar == T_LPAREN) {
1.6       jpo      2117:                        level++;
                   2118:                } else if (yychar <= 0) {
                   2119:                        break;
                   2120:                }
                   2121:                freeyyv(&yylval, yychar = yylex());
                   2122:        }
                   2123:
                   2124:        yyclearin;
1.1       cgd      2125: }
1.75      christos 2126:
                   2127: static sym_t *
                   2128: symbolrename(sym_t *s, sbuf_t *sb)
                   2129: {
1.219     rillig   2130:        if (sb != NULL)
1.75      christos 2131:                s->s_rename = sb->sb_name;
                   2132:        return s;
                   2133: }

CVSweb <webmaster@jp.NetBSD.org>