/* YACC parser for Fortran expressions, for GDB.
- Copyright 1986, 1989, 1990, 1991, 1993, 1994
- Free Software Foundation, Inc.
+ Copyright (C) 1986, 1989, 1990, 1991, 1993, 1994, 1995, 1996, 2000, 2001,
+ 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
+ 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 yylloc f_lloc
#define yyreds f_reds /* With YYDEBUG defined */
#define yytoks f_toks /* With YYDEBUG defined */
+#define yyname f_name /* With YYDEBUG defined */
+#define yyrule f_rule /* With YYDEBUG defined */
#define yylhs f_yylhs
#define yylen f_yylen
#define yydefred f_yydefred
#define yycheck f_yycheck
#ifndef YYDEBUG
-#define YYDEBUG 1 /* Default to no yydebug support */
+#define YYDEBUG 1 /* Default to yydebug support */
#endif
-int yyparse PARAMS ((void));
+#define YYFPRINTF parser_fprintf
+
+int yyparse (void);
+
+static int yylex (void);
+
+void yyerror (char *);
-static int yylex PARAMS ((void));
+static void growbuf_by_size (int);
-void yyerror PARAMS ((char *));
+static int match_string_literal (void);
%}
%{
/* YYSTYPE gets defined by %union */
-static int parse_number PARAMS ((char *, int, int, YYSTYPE *));
+static int parse_number (char *, int, int, YYSTYPE *);
%}
%type <voidval> exp type_exp start variable
%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 '('
/* Expressions, not including the comma operator. */
exp : '*' exp %prec UNARY
{ write_exp_elt_opcode (UNOP_IND); }
+ ;
exp : '&' exp %prec UNARY
{ write_exp_elt_opcode (UNOP_ADDR); }
+ ;
exp : '-' exp %prec UNARY
{ write_exp_elt_opcode (UNOP_NEG); }
{ 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);
+ 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);
- }
+ 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
static int
parse_number (p, len, parsed_float, putithere)
- register char *p;
- register int len;
+ char *p;
+ int len;
int parsed_float;
YYSTYPE *putithere;
{
- register LONGEST n = 0;
- register LONGEST prevn = 0;
- register int i;
- 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;
- unsigned LONGEST high_bit;
+ ULONGEST high_bit;
struct type *signed_type;
struct type *unsigned_type;
/* [dD] is not understood as an exponent by atof, change it to 'e'. */
char *tmp, *tmp2;
- tmp = strsave (p);
+ tmp = xstrdup (p);
for (tmp2 = tmp; *tmp2; ++tmp2)
if (*tmp2 == 'd' || *tmp2 == 'D')
*tmp2 = 'e';
while (len-- > 0)
{
c = *p++;
- if (c >= 'A' && c <= 'Z')
- c += 'a' - 'A';
- if (c != 'l' && c != 'u')
- n *= base;
- if (c >= '0' && c <= '9')
- n += i = c - '0';
+ if (isupper (c))
+ c = tolower (c);
+ if (len == 0 && c == 'l')
+ long_p = 1;
+ else if (len == 0 && c == 'u')
+ unsigned_p = 1;
else
{
- if (base > 10 && c >= 'a' && c <= 'f')
- n += i = c - 'a' + 10;
- else if (len == 0 && c == 'l')
- long_p = 1;
- else if (len == 0 && c == 'u')
- unsigned_p = 1;
+ int i;
+ if (c >= '0' && c <= '9')
+ i = c - '0';
+ else if (c >= 'a' && c <= 'f')
+ i = c - 'a' + 10;
else
return ERROR; /* Char not a digit */
+ if (i >= base)
+ return ERROR; /* Invalid digit in this base */
+ n *= base;
+ n += i;
}
- if (i >= base)
- return ERROR; /* Invalid digit in this base */
-
/* Portably test for overflow (only works for nonzero values, so make
a second check for zero). */
if ((prevn >= n) && n != 0)
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 = ((unsigned LONGEST)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 = ((unsigned LONGEST)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)
}
/* 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;
char *tokstart;
retry:
-
+
+ prev_lexptr = lexptr;
+
tokstart = lexptr;
/* First of all, let us make sure we are not dealing with the
{
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;
int hextype;
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,
yyerror (msg)
char *msg;
{
- error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
+ if (prev_lexptr)
+ lexptr = prev_lexptr;
+
+ error (_("A %s in expression, near `%s'."), (msg ? msg : "error"), lexptr);
}
projects / deliverable / binutils-gdb.git / blobdiff