/* YACC parser for Pascal expressions, for GDB.
- Copyright (C) 2000
+ Copyright 2000
Free Software Foundation, Inc.
This file is part of GDB.
too messy, particularly when such includes can be inserted at random
times by the parser generator. */
-/* FIXME: there are still 21 shift/reduce conflicts
- Other known bugs or limitations:
+/* Known bugs or limitations:
- pascal string operations are not supported at all.
- there are some problems with boolean types.
- Pascal type hexadecimal constants are not supported
#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);
/* YYSTYPE gets defined by %union */
static int
parse_number (char *, int, int, YYSTYPE *);
+
+static struct type *current_type;
+
+static void push_current_type (void);
+static void pop_current_type (void);
+static int search_field;
%}
-%type <voidval> exp exp1 type_exp start variable qualified_name
+%type <voidval> exp exp1 type_exp start normal_start variable qualified_name
%type <tval> type typebase
/* %type <bval> block */
Contexts where this distinction is not important can use the
nonterminal "name", which matches either NAME or TYPENAME. */
-%token <sval> STRING
+%token <sval> STRING
+%token <sval> FIELDNAME
%token <ssym> NAME /* BLOCKNAME defined below to give it higher precedence. */
%token <tsym> TYPENAME
%type <sval> name
/* Object pascal */
%token THIS
-%token <lval> TRUE FALSE
+%token <lval> TRUEKEYWORD FALSEKEYWORD
%left ','
%left ABOVE_COMMA
%left '*' '/'
%right UNARY INCREMENT DECREMENT
%right ARROW '.' '[' '('
+%left '^'
%token <ssym> BLOCKNAME
%type <bval> block
%left COLONCOLON
\f
%%
-start : exp1
+start : { current_type = NULL;
+ search_field = 0;
+ }
+ normal_start {}
+ ;
+
+normal_start :
+ exp1
| type_exp
;
type_exp: type
{ write_exp_elt_opcode(OP_TYPE);
write_exp_elt_type($1);
- write_exp_elt_opcode(OP_TYPE);}
- ;
+ write_exp_elt_opcode(OP_TYPE);
+ current_type = $1; } ;
/* Expressions, including the comma operator. */
exp1 : exp
/* Expressions, not including the comma operator. */
exp : exp '^' %prec UNARY
- { write_exp_elt_opcode (UNOP_IND); }
+ { 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); }
+ { 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); }
{ write_exp_elt_opcode (UNOP_PREDECREMENT); }
;
-exp : exp '.' name
+exp : exp '.' { search_field = 1; }
+ FIELDNAME
+ /* name */
{ write_exp_elt_opcode (STRUCTOP_STRUCT);
- write_exp_string ($3);
- write_exp_elt_opcode (STRUCTOP_STRUCT); }
- ;
-
-exp : exp '[' exp1 ']'
- { write_exp_elt_opcode (BINOP_SUBSCRIPT); }
+ write_exp_string ($4);
+ write_exp_elt_opcode (STRUCTOP_STRUCT);
+ search_field = 0;
+ if (current_type)
+ { 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, 0); };
+ } ;
+exp : exp '['
+ /* We need to save the current_type value */
+ { char *arrayname;
+ int arrayfieldindex;
+ arrayfieldindex = is_pascal_string_type (
+ current_type, NULL, NULL,
+ NULL, NULL, &arrayname);
+ if (arrayfieldindex)
+ {
+ struct stoken stringsval;
+ stringsval.ptr = alloca (strlen (arrayname) + 1);
+ stringsval.length = strlen (arrayname);
+ strcpy (stringsval.ptr, arrayname);
+ current_type = TYPE_FIELD_TYPE (current_type,
+ arrayfieldindex - 1);
+ write_exp_elt_opcode (STRUCTOP_STRUCT);
+ write_exp_string (stringsval);
+ write_exp_elt_opcode (STRUCTOP_STRUCT);
+ }
+ push_current_type (); }
+ exp1 ']'
+ { pop_current_type ();
+ 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
being accumulated by an outer function call. */
- { start_arglist (); }
+ { push_current_type ();
+ start_arglist (); }
arglist ')' %prec ARROW
{ write_exp_elt_opcode (OP_FUNCALL);
write_exp_elt_longcst ((LONGEST) end_arglist ());
- write_exp_elt_opcode (OP_FUNCALL); }
+ write_exp_elt_opcode (OP_FUNCALL);
+ pop_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); }
+ write_exp_elt_opcode (UNOP_CAST);
+ current_type = $1; }
;
exp : '(' exp1 ')'
{ 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)
{
write_exp_elt_block (NULL);
write_exp_elt_sym (sym);
write_exp_elt_opcode (OP_VAR_VALUE);
- }
+ current_type = sym->type; }
else if ($1.is_a_field_of_this)
{
+ struct value * this_val;
+ struct type * this_type;
/* Object pascal: it hangs off of `this'. Must
not inadvertently convert from a method call
to data ref. */
write_exp_elt_opcode (STRUCTOP_PTR);
write_exp_string ($1.stoken);
write_exp_elt_opcode (STRUCTOP_PTR);
+ /* 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)
+ current_type = lookup_struct_elt_type (
+ this_type,
+ 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. */
}
else
{
- high_bit = (((ULONGEST)1)
- << (TARGET_LONG_LONG_BIT - 32 - 1)
- << 16
- << 16);
- if (high_bit == 0)
+ int shift;
+ if (sizeof (ULONGEST) * HOST_CHAR_BIT < TARGET_LONG_LONG_BIT)
/* A long long does not fit in a LONGEST. */
- high_bit =
- (ULONGEST)1 << (sizeof (LONGEST) * HOST_CHAR_BIT - 1);
+ shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
+ else
+ shift = (TARGET_LONG_LONG_BIT - 1);
+ high_bit = (ULONGEST) 1 << shift;
unsigned_type = builtin_type_unsigned_long_long;
signed_type = builtin_type_long_long;
}
return INT;
}
+
+struct type_push
+{
+ struct type *stored;
+ struct type_push *next;
+};
+
+static struct type_push *tp_top = NULL;
+
+static void
+push_current_type (void)
+{
+ struct type_push *tpnew;
+ tpnew = (struct type_push *) malloc (sizeof (struct type_push));
+ tpnew->next = tp_top;
+ tpnew->stored = current_type;
+ current_type = NULL;
+ tp_top = tpnew;
+}
+
+static void
+pop_current_type (void)
+{
+ struct type_push *tp = tp_top;
+ if (tp)
+ {
+ current_type = tp->stored;
+ tp_top = tp->next;
+ xfree (tp);
+ }
+}
+
struct token
{
char *operator;
{"<>", NOTEQUAL, BINOP_END},
{"<=", LEQ, BINOP_END},
{">=", GEQ, BINOP_END},
- {":=", ASSIGN, BINOP_END}
- };
+ {":=", ASSIGN, BINOP_END},
+ {"::", COLONCOLON, BINOP_END} };
/* Allocate uppercased var */
/* make an uppercased copy of tokstart */
char *uptokstart;
char *tokptr;
char *p;
- int tempbufindex;
+ int explen, tempbufindex;
static char *tempbuf;
static int tempbufsize;
retry:
+ prev_lexptr = lexptr;
+
tokstart = lexptr;
+ explen = strlen (lexptr);
/* See if it is a special token of length 3. */
- for (i = 0; i < sizeof tokentab3 / sizeof tokentab3[0]; i++)
- if (STREQN (tokstart, tokentab3[i].operator, 3))
- {
- lexptr += 3;
- yylval.opcode = tokentab3[i].opcode;
- return tokentab3[i].token;
- }
+ if (explen > 2)
+ for (i = 0; i < sizeof (tokentab3) / sizeof (tokentab3[0]); i++)
+ if (strncasecmp (tokstart, tokentab3[i].operator, 3) == 0
+ && (!isalpha (tokentab3[i].operator[0]) || explen == 3
+ || (!isalpha (tokstart[3]) && !isdigit (tokstart[3]) && tokstart[3] != '_')))
+ {
+ lexptr += 3;
+ yylval.opcode = tokentab3[i].opcode;
+ return tokentab3[i].token;
+ }
/* See if it is a special token of length 2. */
- for (i = 0; i < sizeof tokentab2 / sizeof tokentab2[0]; i++)
- if (STREQN (tokstart, tokentab2[i].operator, 2))
- {
- lexptr += 2;
- yylval.opcode = tokentab2[i].opcode;
- return tokentab2[i].token;
- }
+ if (explen > 1)
+ for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
+ if (strncasecmp (tokstart, tokentab2[i].operator, 2) == 0
+ && (!isalpha (tokentab2[i].operator[0]) || explen == 2
+ || (!isalpha (tokstart[2]) && !isdigit (tokstart[2]) && tokstart[2] != '_')))
+ {
+ lexptr += 2;
+ yylval.opcode = tokentab2[i].opcode;
+ return tokentab2[i].token;
+ }
switch (c = *tokstart)
{
{
/* 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'))
{
tempbuf = (char *) realloc (tempbuf, tempbufsize += 64);
}
+
switch (*tokptr)
{
case '\0':
if (STREQ (uptokstart, "FALSE"))
{
yylval.lval = 0;
- return FALSE;
+ return FALSEKEYWORD;
}
break;
case 4:
if (STREQ (uptokstart, "TRUE"))
{
yylval.lval = 1;
- return TRUE;
+ return TRUEKEYWORD;
}
if (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;
}
char *tmp = copy_name (yylval.sval);
struct symbol *sym;
int is_a_field_of_this = 0;
+ int is_a_field = 0;
int hextype;
- sym = lookup_symbol (tmp, expression_context_block,
- VAR_NAMESPACE,
- &is_a_field_of_this,
- (struct symtab **) NULL);
- /* second chance uppercased ! */
- if (!sym)
+
+ if (search_field && current_type)
+ is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
+ if (is_a_field)
+ sym = NULL;
+ else
+ sym = lookup_symbol (tmp, expression_context_block,
+ VAR_DOMAIN,
+ &is_a_field_of_this,
+ (struct symtab **) NULL);
+ /* second chance uppercased (as Free Pascal does). */
+ if (!sym && !is_a_field_of_this && !is_a_field)
{
- for (i = 0;i <= namelen;i++)
+ for (i = 0; i <= namelen; i++)
{
- if ((tmp[i]>='a' && tmp[i]<='z'))
+ if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
tmp[i] -= ('a'-'A');
- /* I am not sure that copy_name gives excatly the same result ! */
- if ((tokstart[i]>='a' && tokstart[i]<='z'))
- tokstart[i] -= ('a'-'A');
}
- sym = lookup_symbol (tmp, expression_context_block,
- VAR_NAMESPACE,
- &is_a_field_of_this,
- (struct symtab **) NULL);
+ if (search_field && current_type)
+ is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
+ if (is_a_field)
+ sym = NULL;
+ else
+ sym = lookup_symbol (tmp, expression_context_block,
+ VAR_DOMAIN,
+ &is_a_field_of_this,
+ (struct symtab **) NULL);
+ if (sym || is_a_field_of_this || is_a_field)
+ for (i = 0; i <= namelen; i++)
+ {
+ if ((tokstart[i] >= 'a' && tokstart[i] <= 'z'))
+ tokstart[i] -= ('a'-'A');
+ }
}
+ /* Third chance Capitalized (as GPC does). */
+ if (!sym && !is_a_field_of_this && !is_a_field)
+ {
+ for (i = 0; i <= namelen; i++)
+ {
+ if (i == 0)
+ {
+ if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
+ tmp[i] -= ('a'-'A');
+ }
+ else
+ if ((tmp[i] >= 'A' && tmp[i] <= 'Z'))
+ tmp[i] -= ('A'-'a');
+ }
+ if (search_field && current_type)
+ is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
+ if (is_a_field)
+ sym = NULL;
+ else
+ sym = lookup_symbol (tmp, expression_context_block,
+ VAR_DOMAIN,
+ &is_a_field_of_this,
+ (struct symtab **) NULL);
+ if (sym || is_a_field_of_this || is_a_field)
+ for (i = 0; i <= namelen; i++)
+ {
+ if (i == 0)
+ {
+ if ((tokstart[i] >= 'a' && tokstart[i] <= 'z'))
+ tokstart[i] -= ('a'-'A');
+ }
+ else
+ if ((tokstart[i] >= 'A' && tokstart[i] <= 'Z'))
+ tokstart[i] -= ('A'-'a');
+ }
+ }
+
+ if (is_a_field)
+ {
+ tempbuf = (char *) realloc (tempbuf, namelen + 1);
+ strncpy (tempbuf, tokstart, namelen); tempbuf [namelen] = 0;
+ yylval.sval.ptr = tempbuf;
+ yylval.sval.length = namelen;
+ 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). */
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)
{
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