/* YACC parser for Pascal expressions, for GDB.
- Copyright 2000
- Free Software Foundation, Inc.
+ Copyright (C) 2000, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
This file is part of GDB.
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 file is derived from c-exp.y */
#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"
+
+#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
parse_number (char *, int, int, YYSTYPE *);
static struct type *current_type;
-
-static void push_current_type ();
-static void pop_current_type ();
+static int leftdiv_is_integer;
+static void push_current_type (void);
+static void pop_current_type (void);
static int search_field;
%}
/* Object pascal */
%token THIS
-%token <lval> TRUE FALSE
+%token <lval> TRUEKEYWORD FALSEKEYWORD
%left ','
%left ABOVE_COMMA
start : { current_type = NULL;
search_field = 0;
+ leftdiv_is_integer = 0;
}
normal_start {}
;
{ while (TYPE_CODE (current_type) == TYPE_CODE_PTR)
current_type = TYPE_TARGET_TYPE (current_type);
current_type = lookup_struct_elt_type (
- current_type, $4.ptr, false); };
+ current_type, $4.ptr, 0); };
} ;
exp : exp '['
/* We need to save the current_type value */
{ 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 :
;
exp : type '(' exp ')' %prec UNARY
- { write_exp_elt_opcode (UNOP_CAST);
+ { if (current_type)
+ {
+ /* Allow automatic dereference of classes. */
+ if ((TYPE_CODE (current_type) == TYPE_CODE_PTR)
+ && (TYPE_CODE (TYPE_TARGET_TYPE (current_type)) == TYPE_CODE_CLASS)
+ && (TYPE_CODE ($1) == TYPE_CODE_CLASS))
+ write_exp_elt_opcode (UNOP_IND);
+ }
+ write_exp_elt_opcode (UNOP_CAST);
write_exp_elt_type ($1);
write_exp_elt_opcode (UNOP_CAST);
current_type = $1; }
{ 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
{ write_exp_elt_opcode (BINOP_ASSIGN); }
;
-exp : TRUE
+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 : FALSE
+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);
/* Object pascal */
exp : THIS
- { write_exp_elt_opcode (OP_THIS);
- write_exp_elt_opcode (OP_THIS); }
+ {
+ struct value * this_val;
+ struct type * this_type;
+ write_exp_elt_opcode (OP_THIS);
+ write_exp_elt_opcode (OP_THIS);
+ /* we need type of this */
+ this_val = value_of_this (0);
+ if (this_val)
+ this_type = value_type (this_val);
+ else
+ this_type = NULL;
+ if (this_type)
+ {
+ if (TYPE_CODE (this_type) == TYPE_CODE_PTR)
+ {
+ this_type = TYPE_TARGET_TYPE (this_type);
+ write_exp_elt_opcode (UNOP_IND);
+ }
+ }
+
+ current_type = this_type;
+ }
;
/* end of object pascal. */
block : block COLONCOLON name
{ struct symbol *tem
= lookup_symbol (copy_name ($3), $1,
- VAR_NAMESPACE, (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_NAMESPACE, (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_NAMESPACE, (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);
}
;
{
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;
}
/* Object pascal: it hangs off of `this'. Must
not inadvertently convert from a method call
to data ref. */
- 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_THIS);
write_exp_elt_opcode (OP_THIS);
/* we need type of this */
this_val = value_of_this (0);
if (this_val)
- this_type = this_val->type;
+ this_type = value_type (this_val);
else
this_type = NULL;
if (this_type)
current_type = lookup_struct_elt_type (
this_type,
- $1.stoken.ptr, false);
+ copy_name ($1.stoken), 0);
else
current_type = NULL;
}
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.");
else
is a pointer to member type. Stroustrup loses again! */
type : ptype
- | typebase COLONCOLON '*'
- { $$ = lookup_member_type (builtin_type_int, $1); }
;
typebase /* Implements (approximately): (type-qualifier)* type-specifier */
- : TYPENAME
+ : '^' typebase
+ { $$ = lookup_pointer_type ($2); }
+ | TYPENAME
{ $$ = $1.type; }
| STRUCT name
{ $$ = lookup_struct (copy_name ($2),
static int
parse_number (p, len, parsed_float, putithere)
- register char *p;
- register int len;
+ char *p;
+ int len;
int parsed_float;
YYSTYPE *putithere;
{
/* FIXME: Shouldn't these be unsigned? We don't deal with negative values
here, and we do kind of silly things like cast to unsigned. */
- register LONGEST n = 0;
- register LONGEST prevn = 0;
+ LONGEST n = 0;
+ LONGEST prevn = 0;
ULONGEST un;
- register int i = 0;
- register int c;
- register int base = input_radix;
+ int i = 0;
+ int c;
+ int base = input_radix;
int unsigned_p = 0;
/* Number of "L" suffixes encountered. */
char saved_char = p[len];
p[len] = 0; /* null-terminate the token */
- if (sizeof (putithere->typed_val_float.dval) <= sizeof (float))
- num = sscanf (p, "%g%c", (float *) &putithere->typed_val_float.dval,&c);
- else if (sizeof (putithere->typed_val_float.dval) <= sizeof (double))
- num = sscanf (p, "%lg%c", (double *) &putithere->typed_val_float.dval,&c);
- else
- {
-#ifdef SCANF_HAS_LONG_DOUBLE
- num = sscanf (p, "%Lg%c", &putithere->typed_val_float.dval,&c);
-#else
- /* Scan it into a double, then assign it to the long double.
- This at least wins with values representable in the range
- of doubles. */
- double temp;
- num = sscanf (p, "%lg%c", &temp,&c);
- putithere->typed_val_float.dval = temp;
-#endif
- }
+ num = sscanf (p, "%" DOUBLEST_SCAN_FORMAT "%c",
+ &putithere->typed_val_float.dval, &c);
p[len] = saved_char; /* restore the input stream */
if (num != 1) /* check scanf found ONLY a float ... */
return ERROR;
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;
shift it right and see whether anything remains. Note that we
can't shift sizeof (LONGEST) * HOST_CHAR_BIT bits or more in one
operation, because many compilers will warn about such a shift
- (which always produces a zero result). Sometimes TARGET_INT_BIT
- or TARGET_LONG_BIT will be that big, sometimes not. To deal with
+ (which always produces a zero result). Sometimes gdbarch_int_bit
+ or gdbarch_long_bit will be that big, sometimes not. To deal with
the case where it is we just always shift the value more than
once, with fewer bits each time. */
un = (ULONGEST)n >> 2;
if (long_p == 0
- && (un >> (TARGET_INT_BIT - 2)) == 0)
+ && (un >> (gdbarch_int_bit (parse_gdbarch) - 2)) == 0)
{
- high_bit = ((ULONGEST)1) << (TARGET_INT_BIT-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 >> (TARGET_LONG_BIT - 2)) == 0)
+ && (un >> (gdbarch_long_bit (parse_gdbarch) - 2)) == 0)
{
- 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
{
int shift;
- if (sizeof (ULONGEST) * HOST_CHAR_BIT < TARGET_LONG_LONG_BIT)
+ if (sizeof (ULONGEST) * HOST_CHAR_BIT
+ < gdbarch_long_long_bit (parse_gdbarch))
/* A long long does not fit in a LONGEST. */
shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
else
- shift = (TARGET_LONG_LONG_BIT - 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;
static struct type_push *tp_top = NULL;
-static void push_current_type ()
+static void
+push_current_type (void)
{
struct type_push *tpnew;
tpnew = (struct type_push *) malloc (sizeof (struct type_push));
tp_top = tpnew;
}
-static void pop_current_type ()
+static void
+pop_current_type (void)
{
struct type_push *tp = tp_top;
if (tp)
{
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 != '\'')
{
/* It's a number. */
int got_dot = 0, got_e = 0, toktype;
- register char *p = tokstart;
+ char *p = tokstart;
int hex = input_radix > 10;
if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
removed from the input stream. */
if (namelen == 2 && uptokstart[0] == 'I' && uptokstart[1] == 'F')
{
+ free (uptokstart);
return 0;
}
switch (namelen)
{
case 6:
- if (STREQ (uptokstart, "OBJECT"))
- return CLASS;
- if (STREQ (uptokstart, "RECORD"))
- return STRUCT;
- if (STREQ (uptokstart, "SIZEOF"))
- return SIZEOF;
+ if (strcmp (uptokstart, "OBJECT") == 0)
+ {
+ free (uptokstart);
+ return CLASS;
+ }
+ if (strcmp (uptokstart, "RECORD") == 0)
+ {
+ free (uptokstart);
+ return STRUCT;
+ }
+ if (strcmp (uptokstart, "SIZEOF") == 0)
+ {
+ free (uptokstart);
+ return SIZEOF;
+ }
break;
case 5:
- if (STREQ (uptokstart, "CLASS"))
- return CLASS;
- if (STREQ (uptokstart, "FALSE"))
+ if (strcmp (uptokstart, "CLASS") == 0)
+ {
+ free (uptokstart);
+ return CLASS;
+ }
+ if (strcmp (uptokstart, "FALSE") == 0)
{
yylval.lval = 0;
- return FALSE;
+ free (uptokstart);
+ return FALSEKEYWORD;
}
break;
case 4:
- if (STREQ (uptokstart, "TRUE"))
+ if (strcmp (uptokstart, "TRUE") == 0)
{
yylval.lval = 1;
- return TRUE;
+ free (uptokstart);
+ return TRUEKEYWORD;
}
- if (STREQ (uptokstart, "SELF"))
+ if (strcmp (uptokstart, "SELF") == 0)
{
/* here we search for 'this' like
inserted in FPC stabs debug info */
static const char this_name[] = "this";
if (lookup_symbol (this_name, expression_context_block,
- VAR_NAMESPACE, (int *) NULL,
- (struct symtab **) NULL))
- return THIS;
+ VAR_DOMAIN, (int *) NULL))
+ {
+ free (uptokstart);
+ return THIS;
+ }
}
break;
default:
so in expression to enter hexadecimal values
we still need to use C syntax with 0xff */
write_dollar_variable (yylval.sval);
+ free (uptokstart);
return VARIABLE;
}
sym = NULL;
else
sym = lookup_symbol (tmp, expression_context_block,
- VAR_NAMESPACE,
- &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_NAMESPACE,
- &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_NAMESPACE,
- &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++)
{
strncpy (tempbuf, tokstart, namelen); tempbuf [namelen] = 0;
yylval.sval.ptr = tempbuf;
yylval.sval.length = namelen;
+ free (uptokstart);
return FIELDNAME;
}
/* Call lookup_symtab, not lookup_partial_symtab, in case there are
no psymtabs (coff, xcoff, or some future change to blow away the
psymtabs once once symbols are read). */
- if ((sym && SYMBOL_CLASS (sym) == LOC_BLOCK) ||
- lookup_symtab (tmp))
+ if ((sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
+ || lookup_symtab (tmp))
{
yylval.ssym.sym = sym;
yylval.ssym.is_a_field_of_this = is_a_field_of_this;
+ free (uptokstart);
return BLOCKNAME;
}
if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
memcpy (tmp1, namestart, p - namestart);
tmp1[p - namestart] = '\0';
cur_sym = lookup_symbol (ncopy, expression_context_block,
- VAR_NAMESPACE, (int *) NULL,
- (struct symtab **) NULL);
+ VAR_DOMAIN, (int *) NULL);
if (cur_sym)
{
if (SYMBOL_CLASS (cur_sym) == LOC_TYPEDEF)
#else /* not 0 */
yylval.tsym.type = SYMBOL_TYPE (sym);
#endif /* not 0 */
+ free (uptokstart);
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)
+ {
+ free (uptokstart);
return TYPENAME;
+ }
/* Input names that aren't symbols but ARE valid hex numbers,
when the input radix permits them, can be names or numbers
depending on the parse. Note we support radixes > 16 here. */
- if (!sym &&
- ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10) ||
- (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
+ if (!sym
+ && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
+ || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
{
YYSTYPE newlval; /* Its value is ignored. */
hextype = parse_number (tokstart, namelen, 0, &newlval);
{
yylval.ssym.sym = sym;
yylval.ssym.is_a_field_of_this = is_a_field_of_this;
+ free (uptokstart);
return NAME_OR_INT;
}
}