/* YACC parser for Pascal expressions, for GDB.
- Copyright (C) 2000, 2006, 2007, 2008 Free Software Foundation, Inc.
+ Copyright (C) 2000, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
This file is part of GDB.
#include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
#include "block.h"
+#define parse_type builtin_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
parse_number (char *, int, int, YYSTYPE *);
static struct type *current_type;
-
+static int leftdiv_is_integer;
static void push_current_type (void);
static void pop_current_type (void);
static int search_field;
start : { current_type = NULL;
search_field = 0;
+ leftdiv_is_integer = 0;
}
normal_start {}
;
{ write_exp_elt_opcode (OP_FUNCALL);
write_exp_elt_longcst ((LONGEST) end_arglist ());
write_exp_elt_opcode (OP_FUNCALL);
- pop_current_type (); }
+ pop_current_type ();
+ if (current_type)
+ current_type = TYPE_TARGET_TYPE (current_type);
+ }
;
arglist :
{ write_exp_elt_opcode (BINOP_MUL); }
;
-exp : exp '/' exp
- { write_exp_elt_opcode (BINOP_DIV); }
+exp : exp '/' {
+ if (current_type && is_integral_type (current_type))
+ leftdiv_is_integer = 1;
+ }
+ exp
+ {
+ if (leftdiv_is_integer && current_type
+ && is_integral_type (current_type))
+ {
+ write_exp_elt_opcode (UNOP_CAST);
+ write_exp_elt_type (parse_type->builtin_long_double);
+ current_type = parse_type->builtin_long_double;
+ write_exp_elt_opcode (UNOP_CAST);
+ leftdiv_is_integer = 0;
+ }
+
+ write_exp_elt_opcode (BINOP_DIV);
+ }
;
exp : exp DIV exp
;
exp : exp '=' exp
- { write_exp_elt_opcode (BINOP_EQUAL); }
+ { write_exp_elt_opcode (BINOP_EQUAL);
+ current_type = parse_type->builtin_bool;
+ }
;
exp : exp NOTEQUAL exp
- { write_exp_elt_opcode (BINOP_NOTEQUAL); }
+ { write_exp_elt_opcode (BINOP_NOTEQUAL);
+ current_type = parse_type->builtin_bool;
+ }
;
exp : exp LEQ exp
- { write_exp_elt_opcode (BINOP_LEQ); }
+ { write_exp_elt_opcode (BINOP_LEQ);
+ current_type = parse_type->builtin_bool;
+ }
;
exp : exp GEQ exp
- { write_exp_elt_opcode (BINOP_GEQ); }
+ { write_exp_elt_opcode (BINOP_GEQ);
+ current_type = parse_type->builtin_bool;
+ }
;
exp : exp '<' exp
- { write_exp_elt_opcode (BINOP_LESS); }
+ { write_exp_elt_opcode (BINOP_LESS);
+ current_type = parse_type->builtin_bool;
+ }
;
exp : exp '>' exp
- { write_exp_elt_opcode (BINOP_GTR); }
+ { write_exp_elt_opcode (BINOP_GTR);
+ current_type = parse_type->builtin_bool;
+ }
;
exp : exp ANDAND exp
exp : TRUEKEYWORD
{ write_exp_elt_opcode (OP_BOOL);
write_exp_elt_longcst ((LONGEST) $1);
+ current_type = parse_type->builtin_bool;
write_exp_elt_opcode (OP_BOOL); }
;
exp : FALSEKEYWORD
{ write_exp_elt_opcode (OP_BOOL);
write_exp_elt_longcst ((LONGEST) $1);
+ current_type = parse_type->builtin_bool;
write_exp_elt_opcode (OP_BOOL); }
;
exp : INT
{ write_exp_elt_opcode (OP_LONG);
write_exp_elt_type ($1.type);
+ current_type = $1.type;
write_exp_elt_longcst ((LONGEST)($1.val));
write_exp_elt_opcode (OP_LONG); }
;
parse_number ($1.stoken.ptr, $1.stoken.length, 0, &val);
write_exp_elt_opcode (OP_LONG);
write_exp_elt_type (val.typed_val_int.type);
+ current_type = val.typed_val_int.type;
write_exp_elt_longcst ((LONGEST)val.typed_val_int.val);
write_exp_elt_opcode (OP_LONG);
}
exp : FLOAT
{ write_exp_elt_opcode (OP_DOUBLE);
write_exp_elt_type ($1.type);
+ current_type = $1.type;
write_exp_elt_dblcst ($1.dval);
write_exp_elt_opcode (OP_DOUBLE); }
;
exp : SIZEOF '(' type ')' %prec UNARY
{ write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (builtin_type_int);
+ write_exp_elt_type (parse_type->builtin_int);
CHECK_TYPEDEF ($3);
write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
write_exp_elt_opcode (OP_LONG); }
while (count-- > 0)
{
write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (builtin_type_char);
+ write_exp_elt_type (parse_type->builtin_char);
write_exp_elt_longcst ((LONGEST)(*sp++));
write_exp_elt_opcode (OP_LONG);
}
write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (builtin_type_char);
+ write_exp_elt_type (parse_type->builtin_char);
write_exp_elt_longcst ((LONGEST)'\0');
write_exp_elt_opcode (OP_LONG);
write_exp_elt_opcode (OP_ARRAY);
block : block COLONCOLON name
{ struct symbol *tem
= lookup_symbol (copy_name ($3), $1,
- VAR_DOMAIN, (int *) NULL,
- (struct symtab **) NULL);
+ VAR_DOMAIN, (int *) NULL);
if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
error ("No function \"%s\" in specified context.",
copy_name ($3));
variable: block COLONCOLON name
{ struct symbol *sym;
sym = lookup_symbol (copy_name ($3), $1,
- VAR_DOMAIN, (int *) NULL,
- (struct symtab **) NULL);
+ VAR_DOMAIN, (int *) NULL);
if (sym == 0)
error ("No symbol \"%s\" in specified context.",
copy_name ($3));
sym =
lookup_symbol (name, (const struct block *) NULL,
- VAR_DOMAIN, (int *) NULL,
- (struct symtab **) NULL);
+ VAR_DOMAIN, (int *) NULL);
if (sym)
{
write_exp_elt_opcode (OP_VAR_VALUE);
msymbol = lookup_minimal_symbol (name, 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
- if (!have_full_symbols () && !have_partial_symbols ())
- error ("No symbol table is loaded. Use the \"file\" command.");
- else
- error ("No symbol \"%s\" in current context.", name);
+ error ("No symbol \"%s\" in current context.", name);
}
;
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
c = tolower (p[len - 1]);
if (c == 'f')
- putithere->typed_val_float.type = builtin_type_float;
+ putithere->typed_val_float.type = parse_type->builtin_float;
else if (c == 'l')
- putithere->typed_val_float.type = builtin_type_long_double;
+ putithere->typed_val_float.type = parse_type->builtin_long_double;
else if (isdigit (c) || c == '.')
- putithere->typed_val_float.type = builtin_type_double;
+ putithere->typed_val_float.type = parse_type->builtin_double;
else
return ERROR;
un = (ULONGEST)n >> 2;
if (long_p == 0
- && (un >> (gdbarch_int_bit (current_gdbarch) - 2)) == 0)
+ && (un >> (gdbarch_int_bit (parse_gdbarch) - 2)) == 0)
{
- high_bit = ((ULONGEST)1) << (gdbarch_int_bit (current_gdbarch) - 1);
+ high_bit = ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch) - 1);
/* A large decimal (not hex or octal) constant (between INT_MAX
and UINT_MAX) is a long or unsigned long, according to ANSI,
int. This probably should be fixed. GCC gives a warning on
such constants. */
- unsigned_type = builtin_type_unsigned_int;
- signed_type = builtin_type_int;
+ unsigned_type = parse_type->builtin_unsigned_int;
+ signed_type = parse_type->builtin_int;
}
else if (long_p <= 1
- && (un >> (gdbarch_long_bit (current_gdbarch) - 2)) == 0)
+ && (un >> (gdbarch_long_bit (parse_gdbarch) - 2)) == 0)
{
- high_bit = ((ULONGEST)1) << (gdbarch_long_bit (current_gdbarch) - 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
{
int shift;
if (sizeof (ULONGEST) * HOST_CHAR_BIT
- < gdbarch_long_long_bit (current_gdbarch))
+ < gdbarch_long_long_bit (parse_gdbarch))
/* A long long does not fit in a LONGEST. */
shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
else
- shift = (gdbarch_long_long_bit (current_gdbarch) - 1);
+ shift = (gdbarch_long_long_bit (parse_gdbarch) - 1);
high_bit = (ULONGEST) 1 << shift;
- unsigned_type = builtin_type_unsigned_long_long;
- signed_type = builtin_type_long_long;
+ unsigned_type = parse_type->builtin_unsigned_long_long;
+ signed_type = parse_type->builtin_long_long;
}
putithere->typed_val_int.val = n;
{
current_type = tp->stored;
tp_top = tp->next;
- xfree (tp);
+ free (tp);
}
}
error ("Empty character constant.");
yylval.typed_val_int.val = c;
- yylval.typed_val_int.type = builtin_type_char;
+ yylval.typed_val_int.type = parse_type->builtin_char;
c = *lexptr++;
if (c != '\'')
static const char this_name[] = "this";
if (lookup_symbol (this_name, expression_context_block,
- VAR_DOMAIN, (int *) NULL,
- (struct symtab **) NULL))
+ VAR_DOMAIN, (int *) NULL))
{
free (uptokstart);
return THIS;
sym = NULL;
else
sym = lookup_symbol (tmp, expression_context_block,
- VAR_DOMAIN,
- &is_a_field_of_this,
- (struct symtab **) NULL);
+ VAR_DOMAIN, &is_a_field_of_this);
/* second chance uppercased (as Free Pascal does). */
if (!sym && !is_a_field_of_this && !is_a_field)
{
sym = NULL;
else
sym = lookup_symbol (tmp, expression_context_block,
- VAR_DOMAIN,
- &is_a_field_of_this,
- (struct symtab **) NULL);
+ VAR_DOMAIN, &is_a_field_of_this);
if (sym || is_a_field_of_this || is_a_field)
for (i = 0; i <= namelen; i++)
{
sym = NULL;
else
sym = lookup_symbol (tmp, expression_context_block,
- VAR_DOMAIN,
- &is_a_field_of_this,
- (struct symtab **) NULL);
+ VAR_DOMAIN, &is_a_field_of_this);
if (sym || is_a_field_of_this || is_a_field)
for (i = 0; i <= namelen; i++)
{
memcpy (tmp1, namestart, p - namestart);
tmp1[p - namestart] = '\0';
cur_sym = lookup_symbol (ncopy, expression_context_block,
- VAR_DOMAIN, (int *) NULL,
- (struct symtab **) NULL);
+ VAR_DOMAIN, (int *) NULL);
if (cur_sym)
{
if (SYMBOL_CLASS (cur_sym) == LOC_TYPEDEF)
return TYPENAME;
}
yylval.tsym.type
- = language_lookup_primitive_type_by_name (current_language,
- current_gdbarch, tmp);
+ = language_lookup_primitive_type_by_name (parse_language,
+ parse_gdbarch, tmp);
if (yylval.tsym.type != NULL)
{
free (uptokstart);