X-Git-Url: http://git.efficios.com/?a=blobdiff_plain;f=gdb%2Ff-exp.y;h=d91c413bed618133b1993227c67cc9c87b5cd07f;hb=4c1d29734e9ca4e8921c9962e0f342bcc9e95c16;hp=adff33b4dd3dbb568c1fe889d62296007b514673;hpb=bf896cb059775f7c8a68e13a733191755fdc1a85;p=deliverable%2Fbinutils-gdb.git diff --git a/gdb/f-exp.y b/gdb/f-exp.y index adff33b4dd..d91c413bed 100644 --- a/gdb/f-exp.y +++ b/gdb/f-exp.y @@ -1,5 +1,6 @@ /* YACC parser for Fortran expressions, for GDB. - Copyright 1986, 1989, 1990, 1991, 1993, 1994, 1995, 1996, 2000, 2001 + Copyright (C) 1986, 1989, 1990, 1991, 1993, 1994, 1995, 1996, 2000, 2001, + 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Motorola. Adapted from the C parser by Farooq Butt @@ -19,7 +20,8 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software -Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ +Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ /* This was blantantly ripped off the C expression parser, please be aware of that as you look at its basic structure -FMB */ @@ -56,6 +58,9 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ #include "block.h" #include +#define parse_type builtin_type (parse_gdbarch) +#define parse_f_type builtin_f_type (parse_gdbarch) + /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc), as well as gratuitiously global symbol names, so we can have multiple yacc generated parsers in gdb. Note that these are only the variables @@ -179,7 +184,6 @@ static int parse_number (char *, int, int, YYSTYPE *); %token TYPENAME %type name %type name_not_typename -%type typename /* A NAME_OR_INT is a symbol which is not known in the symbol table, but which would parse as a valid number in the current input radix. @@ -218,7 +222,9 @@ static int parse_number (char *, int, int, YYSTYPE *); %left LSH RSH %left '@' %left '+' '-' -%left '*' '/' '%' +%left '*' '/' +%right STARSTAR +%right '%' %right UNARY %right '(' @@ -284,25 +290,48 @@ arglist : exp { arglist_len = 1; } ; -arglist : substring - { arglist_len = 2;} +arglist : subrange + { arglist_len = 1; } ; arglist : arglist ',' exp %prec ABOVE_COMMA { arglist_len++; } ; -substring: exp ':' exp %prec ABOVE_COMMA - { } +/* There are four sorts of subrange types in F90. */ + +subrange: exp ':' exp %prec ABOVE_COMMA + { write_exp_elt_opcode (OP_F90_RANGE); + write_exp_elt_longcst (NONE_BOUND_DEFAULT); + write_exp_elt_opcode (OP_F90_RANGE); } + ; + +subrange: exp ':' %prec ABOVE_COMMA + { write_exp_elt_opcode (OP_F90_RANGE); + write_exp_elt_longcst (HIGH_BOUND_DEFAULT); + write_exp_elt_opcode (OP_F90_RANGE); } ; +subrange: ':' exp %prec ABOVE_COMMA + { write_exp_elt_opcode (OP_F90_RANGE); + write_exp_elt_longcst (LOW_BOUND_DEFAULT); + write_exp_elt_opcode (OP_F90_RANGE); } + ; + +subrange: ':' %prec ABOVE_COMMA + { write_exp_elt_opcode (OP_F90_RANGE); + write_exp_elt_longcst (BOTH_BOUND_DEFAULT); + write_exp_elt_opcode (OP_F90_RANGE); } + ; complexnum: exp ',' exp { } ; exp : '(' complexnum ')' - { write_exp_elt_opcode(OP_COMPLEX); } + { write_exp_elt_opcode(OP_COMPLEX); + write_exp_elt_type (parse_f_type->builtin_complex_s16); + write_exp_elt_opcode(OP_COMPLEX); } ; exp : '(' type ')' exp %prec UNARY @@ -311,12 +340,22 @@ exp : '(' type ')' exp %prec UNARY write_exp_elt_opcode (UNOP_CAST); } ; +exp : exp '%' name + { write_exp_elt_opcode (STRUCTOP_STRUCT); + write_exp_string ($3); + write_exp_elt_opcode (STRUCTOP_STRUCT); } + ; + /* Binary operators in order of decreasing precedence. */ exp : exp '@' exp { write_exp_elt_opcode (BINOP_REPEAT); } ; +exp : exp STARSTAR exp + { write_exp_elt_opcode (BINOP_EXP); } + ; + exp : exp '*' exp { write_exp_elt_opcode (BINOP_MUL); } ; @@ -325,10 +364,6 @@ exp : exp '/' exp { write_exp_elt_opcode (BINOP_DIV); } ; -exp : exp '%' exp - { write_exp_elt_opcode (BINOP_REM); } - ; - exp : exp '+' exp { write_exp_elt_opcode (BINOP_ADD); } ; @@ -418,7 +453,7 @@ exp : NAME_OR_INT exp : FLOAT { write_exp_elt_opcode (OP_DOUBLE); - write_exp_elt_type (builtin_type_f_real_s8); + write_exp_elt_type (parse_f_type->builtin_real_s8); write_exp_elt_dblcst ($1); write_exp_elt_opcode (OP_DOUBLE); } ; @@ -431,7 +466,7 @@ exp : VARIABLE exp : SIZEOF '(' type ')' %prec UNARY { write_exp_elt_opcode (OP_LONG); - write_exp_elt_type (builtin_type_f_integer); + write_exp_elt_type (parse_f_type->builtin_integer); CHECK_TYPEDEF ($3); write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3)); write_exp_elt_opcode (OP_LONG); } @@ -481,11 +516,7 @@ variable: name_not_typename msymbol = lookup_minimal_symbol (arg, NULL, NULL); if (msymbol != NULL) - { - write_exp_msymbol (msymbol, - lookup_function_type (builtin_type_int), - builtin_type_int); - } + write_exp_msymbol (msymbol); else if (!have_full_symbols () && !have_partial_symbols ()) error ("No symbol table is loaded. Use the \"file\" command."); else @@ -526,8 +557,8 @@ ptype : typebase { range_type = create_range_type ((struct type *) NULL, - builtin_type_f_integer, 0, - array_size - 1); + parse_f_type->builtin_integer, + 0, array_size - 1); follow_type = create_array_type ((struct type *) NULL, follow_type, range_type); @@ -572,32 +603,29 @@ typebase /* Implements (approximately): (type-qualifier)* type-specifier */ : TYPENAME { $$ = $1.type; } | INT_KEYWORD - { $$ = builtin_type_f_integer; } + { $$ = parse_f_type->builtin_integer; } | INT_S2_KEYWORD - { $$ = builtin_type_f_integer_s2; } + { $$ = parse_f_type->builtin_integer_s2; } | CHARACTER - { $$ = builtin_type_f_character; } + { $$ = parse_f_type->builtin_character; } | LOGICAL_KEYWORD - { $$ = builtin_type_f_logical;} + { $$ = parse_f_type->builtin_logical; } | LOGICAL_S2_KEYWORD - { $$ = builtin_type_f_logical_s2;} + { $$ = parse_f_type->builtin_logical_s2; } | LOGICAL_S1_KEYWORD - { $$ = builtin_type_f_logical_s1;} + { $$ = parse_f_type->builtin_logical_s1; } | REAL_KEYWORD - { $$ = builtin_type_f_real;} + { $$ = parse_f_type->builtin_real; } | REAL_S8_KEYWORD - { $$ = builtin_type_f_real_s8;} + { $$ = parse_f_type->builtin_real_s8; } | REAL_S16_KEYWORD - { $$ = builtin_type_f_real_s16;} + { $$ = parse_f_type->builtin_real_s16; } | COMPLEX_S8_KEYWORD - { $$ = builtin_type_f_complex_s8;} + { $$ = parse_f_type->builtin_complex_s8; } | COMPLEX_S16_KEYWORD - { $$ = builtin_type_f_complex_s16;} + { $$ = parse_f_type->builtin_complex_s16; } | COMPLEX_S32_KEYWORD - { $$ = builtin_type_f_complex_s32;} - ; - -typename: TYPENAME + { $$ = parse_f_type->builtin_complex_s32; } ; nonempty_typelist @@ -614,11 +642,7 @@ nonempty_typelist ; name : NAME - { $$ = $1.stoken; } - | TYPENAME - { $$ = $1.stoken; } - | NAME_OR_INT - { $$ = $1.stoken; } + { $$ = $1.stoken; } ; name_not_typename : NAME @@ -744,25 +768,26 @@ parse_number (p, len, parsed_float, putithere) target int size is different to the target long size. In the expression below, we could have tested - (n >> TARGET_INT_BIT) + (n >> gdbarch_int_bit (parse_gdbarch)) to see if it was zero, but too many compilers warn about that, when ints and longs are the same size. So we shift it twice, with fewer bits each time, for the same result. */ - if ((TARGET_INT_BIT != TARGET_LONG_BIT - && ((n >> 2) >> (TARGET_INT_BIT-2))) /* Avoid shift warning */ + if ((gdbarch_int_bit (parse_gdbarch) != gdbarch_long_bit (parse_gdbarch) + && ((n >> 2) + >> (gdbarch_int_bit (parse_gdbarch)-2))) /* Avoid shift warning */ || long_p) { - high_bit = ((ULONGEST)1) << (TARGET_LONG_BIT-1); - unsigned_type = builtin_type_unsigned_long; - signed_type = builtin_type_long; + high_bit = ((ULONGEST)1) << (gdbarch_long_bit (parse_gdbarch)-1); + unsigned_type = parse_type->builtin_unsigned_long; + signed_type = parse_type->builtin_long; } else { - high_bit = ((ULONGEST)1) << (TARGET_INT_BIT-1); - unsigned_type = builtin_type_unsigned_int; - signed_type = builtin_type_int; + high_bit = ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch)-1); + unsigned_type = parse_type->builtin_unsigned_int; + signed_type = parse_type->builtin_int; } putithere->typed_val.val = n; @@ -954,7 +979,7 @@ yylex () } } - /* See if it is a special .foo. operator */ + /* See if it is a special .foo. operator. */ for (i = 0; dot_ops[i].operator != NULL; i++) if (strncmp (tokstart, dot_ops[i].operator, strlen (dot_ops[i].operator)) == 0) @@ -964,6 +989,15 @@ yylex () return dot_ops[i].token; } + /* See if it is an exponentiation operator. */ + + if (strncmp (tokstart, "**", 2) == 0) + { + lexptr += 2; + yylval.opcode = BINOP_EXP; + return STARSTAR; + } + switch (c = *tokstart) { case 0: @@ -1142,15 +1176,17 @@ yylex () sym = lookup_symbol (tmp, expression_context_block, VAR_DOMAIN, - current_language->la_language == language_cplus - ? &is_a_field_of_this : NULL, - NULL); + parse_language->la_language == language_cplus + ? &is_a_field_of_this : NULL); if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF) { yylval.tsym.type = SYMBOL_TYPE (sym); return TYPENAME; } - if ((yylval.tsym.type = lookup_primitive_typename (tmp)) != 0) + yylval.tsym.type + = language_lookup_primitive_type_by_name (parse_language, + parse_gdbarch, tmp); + if (yylval.tsym.type != NULL) return TYPENAME; /* Input names that aren't symbols but ARE valid hex numbers,