* linux-low.c (usr_store_inferior_registers): Declare local `pid'
[deliverable/binutils-gdb.git] / gdb / p-exp.y
index 8cde6d561ae7b87ac5b46efd426d58728dd96974..dff9b97b99dcf3ca8f1ba1c90054804d19998d4f 100644 (file)
@@ -1,22 +1,20 @@
 /* YACC parser for Pascal expressions, for GDB.
-   Copyright (C) 2000
-   Free Software Foundation, Inc.
+   Copyright (C) 2000, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
 
-This file is part of GDB.
+   This file is part of GDB.
 
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
 
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-GNU General Public License for more details.
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
 
-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.  */
+   You should have received a copy of the GNU General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
 
 /* This file is derived from c-exp.y */
 
@@ -37,8 +35,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
    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
@@ -57,6 +54,9 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
 #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
@@ -94,6 +94,8 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
 #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
@@ -105,9 +107,11 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
 #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);
@@ -151,9 +155,15 @@ static char * uptok (char *, int);
 /* YYSTYPE gets defined by %union */
 static int
 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;
 %}
 
-%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 */
 
@@ -171,7 +181,8 @@ parse_number (char *, int, int, YYSTYPE *);
    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
@@ -195,7 +206,7 @@ parse_number (char *, int, int, YYSTYPE *);
 
 /* Object pascal */
 %token THIS
-%token <lval> TRUE FALSE
+%token <lval> TRUEKEYWORD FALSEKEYWORD
 
 %left ','
 %left ABOVE_COMMA
@@ -212,6 +223,7 @@ parse_number (char *, int, int, YYSTYPE *);
 %left '*' '/'
 %right UNARY INCREMENT DECREMENT
 %right ARROW '.' '[' '('
+%left '^'
 %token <ssym> BLOCKNAME
 %type <bval> block
 %left COLONCOLON
@@ -219,15 +231,23 @@ parse_number (char *, int, int, YYSTYPE *);
 \f
 %%
 
-start   :      exp1
+start   :      { current_type = NULL;
+                 search_field = 0;
+                 leftdiv_is_integer = 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
@@ -237,10 +257,16 @@ 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); }
@@ -258,24 +284,59 @@ exp       :       DECREMENT  '(' exp ')'   %prec UNARY
                        { 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 ();
+                         if (current_type)
+                           current_type = TYPE_TARGET_TYPE (current_type);
+                       }
        ;
 
 arglist        :
@@ -286,9 +347,18 @@ 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 ')'
@@ -301,8 +371,24 @@ exp        :       exp '*' exp
                        { 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
@@ -330,27 +416,39 @@ exp       :       exp RSH 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
@@ -369,21 +467,24 @@ exp       :       exp ASSIGN 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); }
        ;
@@ -393,6 +494,7 @@ exp :       NAME_OR_INT
                          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);
                        }
@@ -402,6 +504,7 @@ exp :       NAME_OR_INT
 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); }
        ;
@@ -415,7 +518,7 @@ exp :       VARIABLE
 
 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); }
@@ -431,12 +534,12 @@ exp       :       STRING
                          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);
@@ -447,8 +550,28 @@ exp        :       STRING
 
 /* 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.  */
@@ -473,8 +596,7 @@ block       :       BLOCKNAME
 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));
@@ -484,8 +606,7 @@ block       :       block COLONCOLON name
 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));
@@ -521,8 +642,7 @@ variable:   qualified_name
 
                          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);
@@ -534,16 +654,11 @@ variable: qualified_name
 
                          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);
                        }
        ;
 
@@ -554,9 +669,9 @@ variable:   name_not_typename
                            {
                              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;
                                }
 
@@ -567,34 +682,45 @@ variable: name_not_typename
                              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.  */
-                             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);
                              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 = value_type (this_val);
+                             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);
                              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
@@ -617,12 +743,12 @@ ptype     :       typebase
    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),
@@ -662,20 +788,20 @@ 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;
 {
   /* 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.  */
@@ -696,23 +822,8 @@ parse_number (p, len, parsed_float, putithere)
       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;
@@ -721,11 +832,11 @@ parse_number (p, len, parsed_float, putithere)
       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;
 
@@ -824,16 +935,16 @@ parse_number (p, len, parsed_float, putithere)
      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,
@@ -841,28 +952,28 @@ parse_number (p, len, parsed_float, putithere)
         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
     {
-      high_bit = (((ULONGEST)1)
-                 << (TARGET_LONG_LONG_BIT - 32 - 1)
-                 << 16
-                 << 16);
-      if (high_bit == 0)
+      int shift;
+      if (sizeof (ULONGEST) * HOST_CHAR_BIT
+         < gdbarch_long_long_bit (parse_gdbarch))
        /* A long long does not fit in a LONGEST.  */
-       high_bit =
-         (ULONGEST)1 << (sizeof (LONGEST) * HOST_CHAR_BIT - 1);
-      unsigned_type = builtin_type_unsigned_long_long;
-      signed_type = builtin_type_long_long;
+       shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
+      else
+       shift = (gdbarch_long_long_bit (parse_gdbarch) - 1);
+      high_bit = (ULONGEST) 1 << shift;
+      unsigned_type = parse_type->builtin_unsigned_long_long;
+      signed_type = parse_type->builtin_long_long;
     }
 
    putithere->typed_val_int.val = n;
@@ -882,6 +993,38 @@ parse_number (p, len, parsed_float, putithere)
    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;
+      free (tp);
+    }
+}
+
 struct token
 {
   char *operator;
@@ -908,8 +1051,8 @@ static const struct token tokentab2[] =
     {"<>", 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 */
@@ -948,12 +1091,14 @@ yylex ()
 
  retry:
 
+  prev_lexptr = lexptr;
+
   tokstart = lexptr;
   explen = strlen (lexptr);
   /* See if it is a special token of length 3.  */
   if (explen > 2)
     for (i = 0; i < sizeof (tokentab3) / sizeof (tokentab3[0]); i++)
-      if (strnicmp (tokstart, tokentab3[i].operator, 3) == 0
+      if (strncasecmp (tokstart, tokentab3[i].operator, 3) == 0
           && (!isalpha (tokentab3[i].operator[0]) || explen == 3
               || (!isalpha (tokstart[3]) && !isdigit (tokstart[3]) && tokstart[3] != '_')))
         {
@@ -965,7 +1110,7 @@ yylex ()
   /* See if it is a special token of length 2.  */
   if (explen > 1)
   for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
-      if (strnicmp (tokstart, tokentab2[i].operator, 2) == 0
+      if (strncasecmp (tokstart, tokentab2[i].operator, 2) == 0
           && (!isalpha (tokentab2[i].operator[0]) || explen == 2
               || (!isalpha (tokstart[2]) && !isdigit (tokstart[2]) && tokstart[2] != '_')))
         {
@@ -997,7 +1142,7 @@ yylex ()
        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 != '\'')
@@ -1054,7 +1199,7 @@ yylex ()
       {
        /* 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'))
@@ -1148,6 +1293,7 @@ yylex ()
          {
            tempbuf = (char *) realloc (tempbuf, tempbufsize += 64);
          }
+
        switch (*tokptr)
          {
          case '\0':
@@ -1222,6 +1368,7 @@ yylex ()
      removed from the input stream.  */
   if (namelen == 2 && uptokstart[0] == 'I' && uptokstart[1] == 'F')
     {
+      free (uptokstart);
       return 0;
     }
 
@@ -1233,39 +1380,54 @@ yylex ()
   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[] =
-                                { /* 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,
-                            (struct symtab **) NULL))
-           return THIS;
+                            VAR_DOMAIN, (int *) NULL))
+           {
+             free (uptokstart);
+             return THIS;
+           }
        }
       break;
     default:
@@ -1282,6 +1444,7 @@ yylex ()
         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;
     }
 
@@ -1294,36 +1457,92 @@ yylex ()
     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);
+    /* 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);
+       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);
+       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; 
+       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)
@@ -1388,8 +1607,7 @@ yylex ()
                      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)
@@ -1414,17 +1632,24 @@ yylex ()
 #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);
@@ -1432,6 +1657,7 @@ yylex ()
          {
            yylval.ssym.sym = sym;
            yylval.ssym.is_a_field_of_this = is_a_field_of_this;
+           free (uptokstart);
            return NAME_OR_INT;
          }
       }
@@ -1448,5 +1674,8 @@ void
 yyerror (msg)
      char *msg;
 {
+  if (prev_lexptr)
+    lexptr = prev_lexptr;
+
   error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
 }
This page took 0.036737 seconds and 4 git commands to generate.