/* YACC parser for Fortran expressions, for GDB.
- Copyright 1986, 1989, 1990, 1991, 1993, 1994, 2001 Free Software
- Foundation, Inc.
+ Copyright (C) 1986, 1989, 1990, 1991, 1993, 1994, 1995, 1996, 2000, 2001,
+ 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
Contributed by Motorola. Adapted from the C parser by Farooq Butt
(fmbutt@engage.sps.mot.com).
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 */
#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>
/* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
#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
+#define YYFPRINTF parser_fprintf
+
int yyparse (void);
static int yylex (void);
%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.
%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
{ }
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); }
;
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);
func_mod: '(' ')'
{ $$ = 0; }
| '(' nonempty_typelist ')'
- { free ((PTR)$2); $$ = 0; }
+ { free ($2); $$ = 0; }
;
typebase /* Implements (approximately): (type-qualifier)* type-specifier */
{ $$ = builtin_type_f_complex_s32;}
;
-typename: TYPENAME
- ;
-
nonempty_typelist
: type
{ $$ = (struct type **) malloc (sizeof (struct type *) * 2);
;
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 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;
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 (current_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 (current_gdbarch) != gdbarch_long_bit (current_gdbarch)
+ && ((n >> 2)
+ >> (gdbarch_int_bit (current_gdbarch)-2))) /* Avoid shift warning */
|| long_p)
{
- high_bit = ((ULONGEST)1) << (TARGET_LONG_BIT-1);
+ high_bit = ((ULONGEST)1) << (gdbarch_long_bit (current_gdbarch)-1);
unsigned_type = builtin_type_unsigned_long;
signed_type = builtin_type_long;
}
else
{
- high_bit = ((ULONGEST)1) << (TARGET_INT_BIT-1);
+ high_bit = ((ULONGEST)1) << (gdbarch_int_bit (current_gdbarch)-1);
unsigned_type = builtin_type_unsigned_int;
signed_type = builtin_type_int;
}
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:
{
/* 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'))
/* 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 (strncmp (tokstart, f77_keywords[i].operator,
+ strlen(f77_keywords[i].operator)) == 0)
{
/* lexptr += strlen(f77_keywords[i].operator); */
yylval.opcode = f77_keywords[i].opcode;
int hextype;
sym = lookup_symbol (tmp, expression_context_block,
- VAR_NAMESPACE,
+ VAR_DOMAIN,
current_language->la_language == language_cplus
? &is_a_field_of_this : NULL,
NULL);
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 (current_language,
+ current_gdbarch, tmp);
+ if (yylval.tsym.type != NULL)
return TYPENAME;
/* Input names that aren't symbols but ARE valid hex numbers,
yyerror (msg)
char *msg;
{
+ if (prev_lexptr)
+ lexptr = prev_lexptr;
+
error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
}
projects / deliverable / binutils-gdb.git / blobdiff