/* YACC parser for Fortran expressions, for GDB.
- Copyright 1986, 1989, 1990, 1991, 1993, 1994, 1995, 1996, 2000, 2001
- Free Software Foundation, Inc.
+ Copyright (C) 1986-2013 Free Software Foundation, Inc.
Contributed by Motorola. Adapted from the C parser by Farooq Butt
(fmbutt@engage.sps.mot.com).
-This file is part of GDB.
+ This file is part of GDB.
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3 of the License, or
+ (at your option) any later version.
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ 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. */
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see <http://www.gnu.org/licenses/>. */
/* This was blantantly ripped off the C expression parser, please
be aware of that as you look at its basic structure -FMB */
#include "bfd.h" /* Required by objfiles.h. */
#include "symfile.h" /* Required by objfiles.h. */
#include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
+#include "block.h"
#include <ctype.h>
+#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
produced by yacc. If other parser generators (bison, byacc, etc) produce
additional global names that conflict at link time, then those parser
- generators need to be fixed instead of adding those names to this list. */
+ generators need to be fixed instead of adding those names to this list. */
#define yymaxdepth f_maxdepth
#define yyparse f_parse
#define yygindex f_yygindex
#define yytable f_yytable
#define yycheck f_yycheck
+#define yyss f_yyss
+#define yysslim f_yysslim
+#define yyssp f_yyssp
+#define yystacksize f_yystacksize
+#define yyvs f_yyvs
+#define yyvsp f_yyvsp
#ifndef YYDEBUG
#define YYDEBUG 1 /* Default to yydebug support */
%token <tsym> TYPENAME
%type <sval> name
%type <ssym> name_not_typename
-%type <tsym> 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.
/* Special type cases, put in to allow the parser to distinguish different
legal basetypes. */
%token INT_KEYWORD INT_S2_KEYWORD LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD
+%token LOGICAL_S8_KEYWORD
%token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD
%token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD
%token BOOL_AND BOOL_OR BOOL_NOT
%left LSH RSH
%left '@'
%left '+' '-'
-%left '*' '/' '%'
+%left '*' '/'
+%right STARSTAR
+%right '%'
%right UNARY
%right '('
{ 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
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); }
;
{ write_exp_elt_opcode (BINOP_DIV); }
;
-exp : exp '%' exp
- { write_exp_elt_opcode (BINOP_REM); }
- ;
-
exp : exp '+' exp
{ write_exp_elt_opcode (BINOP_ADD); }
;
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); }
;
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); }
{
if (symbol_read_needs_frame (sym))
{
- if (innermost_block == 0 ||
- contained_in (block_found,
- innermost_block))
+ if (innermost_block == 0
+ || contained_in (block_found,
+ innermost_block))
innermost_block = block_found;
}
write_exp_elt_opcode (OP_VAR_VALUE);
}
else
{
- struct minimal_symbol *msymbol;
- register char *arg = copy_name ($1.stoken);
+ struct bound_minimal_symbol msymbol;
+ char *arg = copy_name ($1.stoken);
msymbol =
- lookup_minimal_symbol (arg, NULL, NULL);
- if (msymbol != NULL)
- {
- write_exp_msymbol (msymbol,
- lookup_function_type (builtin_type_int),
- builtin_type_int);
- }
+ lookup_bound_minimal_symbol (arg);
+ if (msymbol.minsym != NULL)
+ write_exp_msymbol (msymbol);
else if (!have_full_symbols () && !have_partial_symbols ())
- error ("No symbol table is loaded. Use the \"file\" command.");
+ error (_("No symbol table is loaded. Use the \"file\" command."));
else
- error ("No symbol \"%s\" in current context.",
+ error (_("No symbol \"%s\" in current context."),
copy_name ($1.stoken));
}
}
{
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);
func_mod: '(' ')'
{ $$ = 0; }
| '(' nonempty_typelist ')'
- { free ((PTR)$2); $$ = 0; }
+ { free ($2); $$ = 0; }
;
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_S8_KEYWORD
+ { $$ = parse_f_type->builtin_logical_s8; }
| 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
;
name : NAME
- { $$ = $1.stoken; }
- | TYPENAME
- { $$ = $1.stoken; }
- | NAME_OR_INT
- { $$ = $1.stoken; }
+ { $$ = $1.stoken; }
;
name_not_typename : NAME
/*** Needs some error checking for the float case ***/
static int
-parse_number (p, len, parsed_float, putithere)
- register char *p;
- register int len;
- int parsed_float;
- YYSTYPE *putithere;
+parse_number (char *p, int len, int parsed_float, YYSTYPE *putithere)
{
- register LONGEST n = 0;
- register LONGEST prevn = 0;
- register int c;
- register int base = input_radix;
+ LONGEST n = 0;
+ LONGEST prevn = 0;
+ int c;
+ int base = input_radix;
int unsigned_p = 0;
int long_p = 0;
ULONGEST high_bit;
if (RANGE_CHECK && n != 0)
{
if ((unsigned_p && (unsigned)prevn >= (unsigned)n))
- range_error("Overflow on numeric constant.");
+ range_error (_("Overflow on numeric constant."));
}
prevn = n;
}
/* If the number is too big to be an int, or it's got an l suffix
then it's a long. Work out if this has to be a long by
- shifting right and and seeing if anything remains, and the
+ shifting right and seeing if anything remains, and the
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;
/* If the high bit of the worked out type is set then this number
- has to be unsigned. */
+ has to be unsigned. */
if (unsigned_p || (n & high_bit))
putithere->typed_val.type = unsigned_type;
{ "integer_2", INT_S2_KEYWORD, BINOP_END },
{ "logical_1", LOGICAL_S1_KEYWORD, BINOP_END },
{ "logical_2", LOGICAL_S2_KEYWORD, BINOP_END },
+ { "logical_8", LOGICAL_S8_KEYWORD, BINOP_END },
{ "complex_8", COMPLEX_S8_KEYWORD, BINOP_END },
{ "integer", INT_KEYWORD, BINOP_END },
{ "logical", LOGICAL_KEYWORD, BINOP_END },
/* Implementation of a dynamically expandable buffer for processing input
characters acquired through lexptr and building a value to return in
- yylval. Ripped off from ch-exp.y */
+ yylval. Ripped off from ch-exp.y */
static char *tempbuf; /* Current buffer contents */
static int tempbufsize; /* Size of allocated buffer */
} while (0);
-/* Grow the static temp buffer if necessary, including allocating the first one
- on demand. */
+/* Grow the static temp buffer if necessary, including allocating the
+ first one on demand. */
static void
-growbuf_by_size (count)
- int count;
+growbuf_by_size (int count)
{
int growby;
}
/* Blatantly ripped off from ch-exp.y. This routine recognizes F77
- string-literals.
+ string-literals.
Recognize a string literal. A string literal is a nonzero sequence
of characters enclosed in matching single quotes, except that
a string, it is simply doubled (I.E. 'this''is''one''string') */
static int
-match_string_literal ()
+match_string_literal (void)
{
char *tokptr = lexptr;
/* Read one token, getting characters through lexptr. */
static int
-yylex ()
+yylex (void)
{
int c;
int namelen;
{
for (i = 0; boolean_values[i].name != NULL; i++)
{
- if STREQN (tokstart, boolean_values[i].name,
- strlen (boolean_values[i].name))
+ if (strncmp (tokstart, boolean_values[i].name,
+ strlen (boolean_values[i].name)) == 0)
{
lexptr += strlen (boolean_values[i].name);
yylval.lval = boolean_values[i].value;
}
}
- /* 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 (STREQN (tokstart, dot_ops[i].operator, strlen (dot_ops[i].operator)))
+ if (strncmp (tokstart, dot_ops[i].operator,
+ strlen (dot_ops[i].operator)) == 0)
{
lexptr += strlen (dot_ops[i].operator);
yylval.opcode = dot_ops[i].opcode;
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:
case '.':
/* Might be a floating point number. */
if (lexptr[1] < '0' || lexptr[1] > '9')
- goto symbol; /* Nope, must be a symbol. */
+ goto symbol; /* Nope, must be a symbol. */
/* FALL THRU into number case. */
case '0':
{
/* It's a number. */
int got_dot = 0, got_e = 0, got_d = 0, toktype;
- register char *p = tokstart;
+ char *p = tokstart;
int hex = input_radix > 10;
if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
p += 2;
hex = 1;
}
- else if (c == '0' && (p[1]=='t' || p[1]=='T' || p[1]=='d' || p[1]=='D'))
+ else if (c == '0' && (p[1]=='t' || p[1]=='T'
+ || p[1]=='d' || p[1]=='D'))
{
p += 2;
hex = 0;
memcpy (err_copy, tokstart, p - tokstart);
err_copy[p - tokstart] = 0;
- error ("Invalid number \"%s\".", err_copy);
+ error (_("Invalid number \"%s\"."), err_copy);
}
lexptr = p;
return toktype;
return c;
}
- if (!(c == '_' || c == '$'
+ if (!(c == '_' || c == '$' || c ==':'
|| (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
/* We must have come across a bad character (e.g. ';'). */
- error ("Invalid character '%c' in expression.", c);
+ error (_("Invalid character '%c' in expression."), c);
namelen = 0;
for (c = tokstart[namelen];
- (c == '_' || c == '$' || (c >= '0' && c <= '9')
+ (c == '_' || c == '$' || c == ':' || (c >= '0' && c <= '9')
|| (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
c = tokstart[++namelen]);
/* Catch specific keywords. */
for (i = 0; f77_keywords[i].operator != NULL; i++)
- if (STREQN(tokstart, f77_keywords[i].operator,
- strlen(f77_keywords[i].operator)))
+ if (strlen (f77_keywords[i].operator) == namelen
+ && strncmp (tokstart, f77_keywords[i].operator, namelen) == 0)
{
/* lexptr += strlen(f77_keywords[i].operator); */
yylval.opcode = f77_keywords[i].opcode;
{
char *tmp = copy_name (yylval.sval);
struct symbol *sym;
- int is_a_field_of_this = 0;
+ struct field_of_this_result is_a_field_of_this;
int hextype;
+ /* Initialize this in case we *don't* use it in this call; that
+ way we can refer to it unconditionally below. */
+ memset (&is_a_field_of_this, 0, sizeof (is_a_field_of_this));
+
sym = lookup_symbol (tmp, expression_context_block,
- VAR_NAMESPACE,
- current_language->la_language == language_cplus
- ? &is_a_field_of_this : NULL,
- NULL);
+ VAR_DOMAIN,
+ 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,
if (hextype == INT)
{
yylval.ssym.sym = sym;
- yylval.ssym.is_a_field_of_this = is_a_field_of_this;
+ yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
return NAME_OR_INT;
}
}
/* Any other kind of symbol */
yylval.ssym.sym = sym;
- yylval.ssym.is_a_field_of_this = is_a_field_of_this;
+ yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
return NAME;
}
}
void
-yyerror (msg)
- char *msg;
+yyerror (char *msg)
{
if (prev_lexptr)
lexptr = prev_lexptr;
- error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
+ error (_("A %s in expression, near `%s'."), (msg ? msg : "error"), lexptr);
}
projects / deliverable / binutils-gdb.git / blobdiff