#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"
/* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
as well as gratuitiously global symbol names, so we can have multiple
#define yylloc pascal_lloc
#define yyreds pascal_reds /* With YYDEBUG defined */
#define yytoks pascal_toks /* With YYDEBUG defined */
+#define yyname pascal_name /* With YYDEBUG defined */
+#define yyrule pascal_rule /* With YYDEBUG defined */
#define yylhs pascal_yylhs
#define yylen pascal_yylen
#define yydefred pascal_yydefred
#define yycheck pascal_yycheck
#ifndef YYDEBUG
-#define YYDEBUG 0 /* Default to no yydebug support */
+#define YYDEBUG 1 /* Default to yydebug support */
#endif
+#define YYFPRINTF parser_fprintf
+
int yyparse (void);
static int yylex (void);
static struct type *current_type;
-static void push_current_type ();
-static void pop_current_type ();
+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;
}
- normal_start;
+ normal_start {}
+ ;
normal_start :
exp1
{ write_exp_elt_opcode (UNOP_IND);
if (current_type)
current_type = TYPE_TARGET_TYPE (current_type); }
+ ;
exp : '@' exp %prec UNARY
{ write_exp_elt_opcode (UNOP_ADDR);
if (current_type)
current_type = TYPE_POINTER_TYPE (current_type); }
+ ;
exp : '-' exp %prec UNARY
{ write_exp_elt_opcode (UNOP_NEG); }
{ 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 (BINOP_SUBSCRIPT);
if (current_type)
current_type = TYPE_TARGET_TYPE (current_type); }
+ ;
exp : exp '('
/* This is to save the value of arglist_len
;
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_ASSIGN); }
;
-exp : TRUE
+exp : TRUEKEYWORD
{ write_exp_elt_opcode (OP_BOOL);
write_exp_elt_longcst ((LONGEST) $1);
write_exp_elt_opcode (OP_BOOL); }
;
-exp : FALSE
+exp : FALSEKEYWORD
{ write_exp_elt_opcode (OP_BOOL);
write_exp_elt_longcst ((LONGEST) $1);
write_exp_elt_opcode (OP_BOOL); }
/* 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 = this_val->type;
+ 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,
+ VAR_DOMAIN, (int *) NULL,
(struct symtab **) NULL);
if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
error ("No function \"%s\" in specified context.",
variable: block COLONCOLON name
{ struct symbol *sym;
sym = lookup_symbol (copy_name ($3), $1,
- VAR_NAMESPACE, (int *) NULL,
+ VAR_DOMAIN, (int *) NULL,
(struct symtab **) NULL);
if (sym == 0)
error ("No symbol \"%s\" in specified context.",
sym =
lookup_symbol (name, (const struct block *) NULL,
- VAR_NAMESPACE, (int *) NULL,
+ VAR_DOMAIN, (int *) NULL,
(struct symtab **) NULL);
if (sym)
{
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);
;
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. */
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)
{
/* 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'))
switch (namelen)
{
case 6:
- if (STREQ (uptokstart, "OBJECT"))
+ if (DEPRECATED_STREQ (uptokstart, "OBJECT"))
return CLASS;
- if (STREQ (uptokstart, "RECORD"))
+ if (DEPRECATED_STREQ (uptokstart, "RECORD"))
return STRUCT;
- if (STREQ (uptokstart, "SIZEOF"))
+ if (DEPRECATED_STREQ (uptokstart, "SIZEOF"))
return SIZEOF;
break;
case 5:
- if (STREQ (uptokstart, "CLASS"))
+ if (DEPRECATED_STREQ (uptokstart, "CLASS"))
return CLASS;
- if (STREQ (uptokstart, "FALSE"))
+ if (DEPRECATED_STREQ (uptokstart, "FALSE"))
{
yylval.lval = 0;
- return FALSE;
+ return FALSEKEYWORD;
}
break;
case 4:
- if (STREQ (uptokstart, "TRUE"))
+ if (DEPRECATED_STREQ (uptokstart, "TRUE"))
{
yylval.lval = 1;
- return TRUE;
+ return TRUEKEYWORD;
}
- if (STREQ (uptokstart, "SELF"))
+ if (DEPRECATED_STREQ (uptokstart, "SELF"))
{
/* here we search for 'this' like
inserted in FPC stabs debug info */
- static const char this_name[] =
- { /* CPLUS_MARKER,*/ 't', 'h', 'i', 's', '\0' };
+ static const char this_name[] = "this";
if (lookup_symbol (this_name, expression_context_block,
- VAR_NAMESPACE, (int *) NULL,
+ VAR_DOMAIN, (int *) NULL,
(struct symtab **) NULL))
return THIS;
}
sym = NULL;
else
sym = lookup_symbol (tmp, expression_context_block,
- VAR_NAMESPACE,
+ VAR_DOMAIN,
&is_a_field_of_this,
(struct symtab **) NULL);
/* second chance uppercased (as Free Pascal does). */
sym = NULL;
else
sym = lookup_symbol (tmp, expression_context_block,
- VAR_NAMESPACE,
+ VAR_DOMAIN,
&is_a_field_of_this,
(struct symtab **) NULL);
if (sym || is_a_field_of_this || is_a_field)
sym = NULL;
else
sym = lookup_symbol (tmp, expression_context_block,
- VAR_NAMESPACE,
+ VAR_DOMAIN,
&is_a_field_of_this,
(struct symtab **) NULL);
if (sym || is_a_field_of_this || is_a_field)
memcpy (tmp1, namestart, p - namestart);
tmp1[p - namestart] = '\0';
cur_sym = lookup_symbol (ncopy, expression_context_block,
- VAR_NAMESPACE, (int *) NULL,
+ VAR_DOMAIN, (int *) NULL,
(struct symtab **) NULL);
if (cur_sym)
{
#endif /* not 0 */
return TYPENAME;
}
- if ((yylval.tsym.type = lookup_primitive_typename (tmp)) != 0)
- return TYPENAME;
+ 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,
when the input radix permits them, can be names or numbers