2007-11-07 Markus Deuling <deuling@de.ibm.com>
[deliverable/binutils-gdb.git] / gdb / p-exp.y
index cf521afb364b93c62f2074741b4e5de904846481..622c4028327a5fedd511d9db7617b3484c159e62 100644 (file)
@@ -1,6 +1,5 @@
 /* YACC parser for Pascal expressions, for GDB.
-   Copyright 2000
-   Free Software Foundation, Inc.
+   Copyright (C) 2000, 2006, 2007 Free Software Foundation, Inc.
 
 This file is part of GDB.
 
@@ -16,7 +15,8 @@ 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.  */
+Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
 
 /* This file is derived from c-exp.y */
 
@@ -56,6 +56,7 @@ 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"
 
 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
    as well as gratuitiously global symbol names, so we can have multiple
@@ -157,8 +158,8 @@ parse_number (char *, int, int, YYSTYPE *);
 
 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;
 %}
 
@@ -205,7 +206,7 @@ static int search_field;
 
 /* Object pascal */
 %token THIS
-%token <lval> TRUE FALSE
+%token <lval> TRUEKEYWORD FALSEKEYWORD
 
 %left ','
 %left ABOVE_COMMA
@@ -293,7 +294,7 @@ exp :       exp '.' { search_field = 1; }
                            { 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 */
@@ -342,7 +343,15 @@ 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; }
@@ -426,13 +435,13 @@ 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);
                          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); }
@@ -504,8 +513,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.  */
@@ -530,7 +559,7 @@ block       :       BLOCKNAME
 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.",
@@ -541,7 +570,7 @@ block       :       block COLONCOLON name
 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.",
@@ -578,7 +607,7 @@ variable:   qualified_name
 
                          sym =
                            lookup_symbol (name, (const struct block *) NULL,
-                                          VAR_NAMESPACE, (int *) NULL,
+                                          VAR_DOMAIN, (int *) NULL,
                                           (struct symtab **) NULL);
                          if (sym)
                            {
@@ -611,9 +640,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;
                                }
 
@@ -632,8 +661,9 @@ variable:   name_not_typename
                              /* 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);
@@ -643,20 +673,20 @@ variable: name_not_typename
                              /* 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,
-                                 copy_name($1.stoken), 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);
@@ -688,12 +718,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),
@@ -733,20 +763,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.  */
@@ -767,23 +797,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;
@@ -895,16 +910,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 (current_gdbarch) - 2)) == 0)
     {
-      high_bit = ((ULONGEST)1) << (TARGET_INT_BIT-1);
+      high_bit = ((ULONGEST)1) << (gdbarch_int_bit (current_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,
@@ -916,20 +931,21 @@ parse_number (p, len, parsed_float, putithere)
       signed_type = builtin_type_int;
     }
   else if (long_p <= 1
-          && (un >> (TARGET_LONG_BIT - 2)) == 0)
+          && (un >> (gdbarch_long_bit (current_gdbarch) - 2)) == 0)
     {
-      high_bit = ((ULONGEST)1) << (TARGET_LONG_BIT-1);
+      high_bit = ((ULONGEST)1) << (gdbarch_long_bit (current_gdbarch) - 1);
       unsigned_type = builtin_type_unsigned_long;
       signed_type = builtin_type_long;
     }
   else
     {
       int shift;
-      if (sizeof (ULONGEST) * HOST_CHAR_BIT < TARGET_LONG_LONG_BIT)
+      if (sizeof (ULONGEST) * HOST_CHAR_BIT
+         < gdbarch_long_long_bit (current_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 (current_gdbarch) - 1);
       high_bit = (ULONGEST) 1 << shift;
       unsigned_type = builtin_type_unsigned_long_long;
       signed_type = builtin_type_long_long;
@@ -961,7 +977,8 @@ struct type_push
 
 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));
@@ -971,7 +988,8 @@ static void push_current_type ()
   tp_top = tpnew; 
 }
 
-static void pop_current_type ()
+static void
+pop_current_type (void)
 {
   struct type_push *tp = tp_top;
   if (tp)
@@ -1156,7 +1174,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'))
@@ -1325,6 +1343,7 @@ yylex ()
      removed from the input stream.  */
   if (namelen == 2 && uptokstart[0] == 'I' && uptokstart[1] == 'F')
     {
+      free (uptokstart);
       return 0;
     }
 
@@ -1336,38 +1355,55 @@ 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[] = "this";
 
          if (lookup_symbol (this_name, expression_context_block,
-                            VAR_NAMESPACE, (int *) NULL,
+                            VAR_DOMAIN, (int *) NULL,
                             (struct symtab **) NULL))
-           return THIS;
+           {
+             free (uptokstart);
+             return THIS;
+           }
        }
       break;
     default:
@@ -1384,6 +1420,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;
     }
 
@@ -1406,7 +1443,7 @@ yylex ()
       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).  */
@@ -1423,7 +1460,7 @@ yylex ()
         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)
@@ -1453,7 +1490,7 @@ yylex ()
         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)
@@ -1476,16 +1513,18 @@ yylex ()
        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)
@@ -1550,7 +1589,7 @@ yylex ()
                      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)
                        {
@@ -1576,17 +1615,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 (current_language,
+                                               current_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);
@@ -1594,6 +1640,7 @@ yylex ()
          {
            yylval.ssym.sym = sym;
            yylval.ssym.is_a_field_of_this = is_a_field_of_this;
+           free (uptokstart);
            return NAME_OR_INT;
          }
       }
This page took 0.032526 seconds and 4 git commands to generate.