gdb/p-exp.y

   1 /* YACC parser for Pascal expressions, for GDB.
   2    Copyright (C) 2000-2021 Free Software Foundation, Inc.
   3
   4    This file is part of GDB.
   5
   6    This program is free software; you can redistribute it and/or modify
   7    it under the terms of the GNU General Public License as published by
   8    the Free Software Foundation; either version 3 of the License, or
   9    (at your option) any later version.
  10
  11    This program is distributed in the hope that it will be useful,
  12    but WITHOUT ANY WARRANTY; without even the implied warranty of
  13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14    GNU General Public License for more details.
  15
  16    You should have received a copy of the GNU General Public License
  17    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  18
  19 /* This file is derived from c-exp.y */
  20
  21 /* Parse a Pascal expression from text in a string,
  22    and return the result as a  struct expression  pointer.
  23    That structure contains arithmetic operations in reverse polish,
  24    with constants represented by operations that are followed by special data.
  25    See expression.h for the details of the format.
  26    What is important here is that it can be built up sequentially
  27    during the process of parsing; the lower levels of the tree always
  28    come first in the result.
  29
  30    Note that malloc's and realloc's in this file are transformed to
  31    xmalloc and xrealloc respectively by the same sed command in the
  32    makefile that remaps any other malloc/realloc inserted by the parser
  33    generator.  Doing this with #defines and trying to control the interaction
  34    with include files (<malloc.h> and <stdlib.h> for example) just became
  35    too messy, particularly when such includes can be inserted at random
  36    times by the parser generator.  */
  37
  38 /* Known bugs or limitations:
  39     - pascal string operations are not supported at all.
  40     - there are some problems with boolean types.
  41     - Pascal type hexadecimal constants are not supported
  42       because they conflict with the internal variables format.
  43    Probably also lots of other problems, less well defined PM.  */
  44 %{
  45
  46 #include "defs.h"
  47 #include <ctype.h>
  48 #include "expression.h"
  49 #include "value.h"
  50 #include "parser-defs.h"
  51 #include "language.h"
  52 #include "p-lang.h"
  53 #include "bfd.h" /* Required by objfiles.h.  */
  54 #include "symfile.h" /* Required by objfiles.h.  */
  55 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols.  */
  56 #include "block.h"
  57 #include "completer.h"
  58 #include "expop.h"
  59
  60 #define parse_type(ps) builtin_type (ps->gdbarch ())
  61
  62 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror,
  63    etc).  */
  64 #define GDB_YY_REMAP_PREFIX pascal_
  65 #include "yy-remap.h"
  66
  67 /* The state of the parser, used internally when we are parsing the
  68    expression.  */
  69
  70 static struct parser_state *pstate = NULL;
  71
  72 /* Depth of parentheses.  */
  73 static int paren_depth;
  74
  75 int yyparse (void);
  76
  77 static int yylex (void);
  78
  79 static void yyerror (const char *);
  80
  81 static char *uptok (const char *, int);
  82
  83 using namespace expr;
  84 %}
  85
  86 /* Although the yacc "value" of an expression is not used,
  87    since the result is stored in the structure being created,
  88    other node types do have values.  */
  89
  90 %union
  91   {
  92     LONGEST lval;
  93     struct {
  94       LONGEST val;
  95       struct type *type;
  96     } typed_val_int;
  97     struct {
  98       gdb_byte val[16];
  99       struct type *type;
 100     } typed_val_float;
 101     struct symbol *sym;
 102     struct type *tval;
 103     struct stoken sval;
 104     struct ttype tsym;
 105     struct symtoken ssym;
 106     int voidval;
 107     const struct block *bval;
 108     enum exp_opcode opcode;
 109     struct internalvar *ivar;
 110
 111     struct type **tvec;
 112     int *ivec;
 113   }
 114
 115 %{
 116 /* YYSTYPE gets defined by %union */
 117 static int parse_number (struct parser_state *,
 118                          const char *, int, int, YYSTYPE *);
 119
 120 static struct type *current_type;
 121 static int leftdiv_is_integer;
 122 static void push_current_type (void);
 123 static void pop_current_type (void);
 124 static int search_field;
 125 %}
 126
 127 %type <voidval> exp exp1 type_exp start normal_start variable qualified_name
 128 %type <tval> type typebase
 129 /* %type <bval> block */
 130
 131 /* Fancy type parsing.  */
 132 %type <tval> ptype
 133
 134 %token <typed_val_int> INT
 135 %token <typed_val_float> FLOAT
 136
 137 /* Both NAME and TYPENAME tokens represent symbols in the input,
 138    and both convey their data as strings.
 139    But a TYPENAME is a string that happens to be defined as a typedef
 140    or builtin type name (such as int or char)
 141    and a NAME is any other symbol.
 142    Contexts where this distinction is not important can use the
 143    nonterminal "name", which matches either NAME or TYPENAME.  */
 144
 145 %token <sval> STRING
 146 %token <sval> FIELDNAME
 147 %token <voidval> COMPLETE
 148 %token <ssym> NAME /* BLOCKNAME defined below to give it higher precedence.  */
 149 %token <tsym> TYPENAME
 150 %type <sval> name
 151 %type <ssym> name_not_typename
 152
 153 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
 154    but which would parse as a valid number in the current input radix.
 155    E.g. "c" when input_radix==16.  Depending on the parse, it will be
 156    turned into a name or into a number.  */
 157
 158 %token <ssym> NAME_OR_INT
 159
 160 %token STRUCT CLASS SIZEOF COLONCOLON
 161 %token ERROR
 162
 163 /* Special type cases, put in to allow the parser to distinguish different
 164    legal basetypes.  */
 165
 166 %token <sval> DOLLAR_VARIABLE
 167
 168
 169 /* Object pascal */
 170 %token THIS
 171 %token <lval> TRUEKEYWORD FALSEKEYWORD
 172
 173 %left ','
 174 %left ABOVE_COMMA
 175 %right ASSIGN
 176 %left NOT
 177 %left OR
 178 %left XOR
 179 %left ANDAND
 180 %left '=' NOTEQUAL
 181 %left '<' '>' LEQ GEQ
 182 %left LSH RSH DIV MOD
 183 %left '@'
 184 %left '+' '-'
 185 %left '*' '/'
 186 %right UNARY INCREMENT DECREMENT
 187 %right ARROW '.' '[' '('
 188 %left '^'
 189 %token <ssym> BLOCKNAME
 190 %type <bval> block
 191 %left COLONCOLON
 192
 193 \f
 194 %%
 195
 196 start   :       { current_type = NULL;
 197                   search_field = 0;
 198                   leftdiv_is_integer = 0;
 199                 }
 200                 normal_start {}
 201         ;
 202
 203 normal_start    :
 204                 exp1
 205         |       type_exp
 206         ;
 207
 208 type_exp:       type
 209                         {
 210                           pstate->push_new<type_operation> ($1);
 211                           current_type = $1; } ;
 212
 213 /* Expressions, including the comma operator.  */
 214 exp1    :       exp
 215         |       exp1 ',' exp
 216                         { pstate->wrap2<comma_operation> (); }
 217         ;
 218
 219 /* Expressions, not including the comma operator.  */
 220 exp     :       exp '^'   %prec UNARY
 221                         { pstate->wrap<unop_ind_operation> ();
 222                           if (current_type)
 223                             current_type = TYPE_TARGET_TYPE (current_type); }
 224         ;
 225
 226 exp     :       '@' exp    %prec UNARY
 227                         { pstate->wrap<unop_addr_operation> ();
 228                           if (current_type)
 229                             current_type = TYPE_POINTER_TYPE (current_type); }
 230         ;
 231
 232 exp     :       '-' exp    %prec UNARY
 233                         { pstate->wrap<unary_neg_operation> (); }
 234         ;
 235
 236 exp     :       NOT exp    %prec UNARY
 237                         { pstate->wrap<unary_logical_not_operation> (); }
 238         ;
 239
 240 exp     :       INCREMENT '(' exp ')'   %prec UNARY
 241                         { pstate->wrap<preinc_operation> (); }
 242         ;
 243
 244 exp     :       DECREMENT  '(' exp ')'   %prec UNARY
 245                         { pstate->wrap<predec_operation> (); }
 246         ;
 247
 248
 249 field_exp       :       exp '.' %prec UNARY
 250                         { search_field = 1; }
 251         ;
 252
 253 exp     :       field_exp FIELDNAME
 254                         {
 255                           pstate->push_new<structop_operation>
 256                             (pstate->pop (), copy_name ($2));
 257                           search_field = 0;
 258                           if (current_type)
 259                             {
 260                               while (current_type->code ()
 261                                      == TYPE_CODE_PTR)
 262                                 current_type =
 263                                   TYPE_TARGET_TYPE (current_type);
 264                               current_type = lookup_struct_elt_type (
 265                                 current_type, $2.ptr, 0);
 266                             }
 267                          }
 268         ;
 269
 270
 271 exp     :       field_exp name
 272                         {
 273                           pstate->push_new<structop_operation>
 274                             (pstate->pop (), copy_name ($2));
 275                           search_field = 0;
 276                           if (current_type)
 277                             {
 278                               while (current_type->code ()
 279                                      == TYPE_CODE_PTR)
 280                                 current_type =
 281                                   TYPE_TARGET_TYPE (current_type);
 282                               current_type = lookup_struct_elt_type (
 283                                 current_type, $2.ptr, 0);
 284                             }
 285                         }
 286         ;
 287 exp     :       field_exp  name COMPLETE
 288                         {
 289                           structop_base_operation *op
 290                             = new structop_ptr_operation (pstate->pop (),
 291                                                           copy_name ($2));
 292                           pstate->mark_struct_expression (op);
 293                           pstate->push (operation_up (op));
 294                         }
 295         ;
 296 exp     :       field_exp COMPLETE
 297                         {
 298                           structop_base_operation *op
 299                             = new structop_ptr_operation (pstate->pop (), "");
 300                           pstate->mark_struct_expression (op);
 301                           pstate->push (operation_up (op));
 302                         }
 303         ;
 304
 305 exp     :       exp '['
 306                         /* We need to save the current_type value.  */
 307                         { const char *arrayname;
 308                           int arrayfieldindex
 309                             = pascal_is_string_type (current_type, NULL, NULL,
 310                                                      NULL, NULL, &arrayname);
 311                           if (arrayfieldindex)
 312                             {
 313                               current_type
 314                                 = (current_type
 315                                    ->field (arrayfieldindex - 1).type ());
 316                               pstate->push_new<structop_operation>
 317                                 (pstate->pop (), arrayname);
 318                             }
 319                           push_current_type ();  }
 320                 exp1 ']'
 321                         { pop_current_type ();
 322                           pstate->wrap2<subscript_operation> ();
 323                           if (current_type)
 324                             current_type = TYPE_TARGET_TYPE (current_type); }
 325         ;
 326
 327 exp     :       exp '('
 328                         /* This is to save the value of arglist_len
 329                            being accumulated by an outer function call.  */
 330                         { push_current_type ();
 331                           pstate->start_arglist (); }
 332                 arglist ')'     %prec ARROW
 333                         {
 334                           std::vector<operation_up> args
 335                             = pstate->pop_vector (pstate->end_arglist ());
 336                           pstate->push_new<funcall_operation>
 337                             (pstate->pop (), std::move (args));
 338                           pop_current_type ();
 339                           if (current_type)
 340                             current_type = TYPE_TARGET_TYPE (current_type);
 341                         }
 342         ;
 343
 344 arglist :
 345          | exp
 346                         { pstate->arglist_len = 1; }
 347          | arglist ',' exp   %prec ABOVE_COMMA
 348                         { pstate->arglist_len++; }
 349         ;
 350
 351 exp     :       type '(' exp ')' %prec UNARY
 352                         { if (current_type)
 353                             {
 354                               /* Allow automatic dereference of classes.  */
 355                               if ((current_type->code () == TYPE_CODE_PTR)
 356                                   && (TYPE_TARGET_TYPE (current_type)->code () == TYPE_CODE_STRUCT)
 357                                   && (($1)->code () == TYPE_CODE_STRUCT))
 358                                 pstate->wrap<unop_ind_operation> ();
 359                             }
 360                           pstate->push_new<unop_cast_operation>
 361                             (pstate->pop (), $1);
 362                           current_type = $1; }
 363         ;
 364
 365 exp     :       '(' exp1 ')'
 366                         { }
 367         ;
 368
 369 /* Binary operators in order of decreasing precedence.  */
 370
 371 exp     :       exp '*' exp
 372                         { pstate->wrap2<mul_operation> (); }
 373         ;
 374
 375 exp     :       exp '/' {
 376                           if (current_type && is_integral_type (current_type))
 377                             leftdiv_is_integer = 1;
 378                         }
 379                 exp
 380                         {
 381                           if (leftdiv_is_integer && current_type
 382                               && is_integral_type (current_type))
 383                             {
 384                               pstate->push_new<unop_cast_operation>
 385                                 (pstate->pop (),
 386                                  parse_type (pstate)->builtin_long_double);
 387                               current_type
 388                                 = parse_type (pstate)->builtin_long_double;
 389                               leftdiv_is_integer = 0;
 390                             }
 391
 392                           pstate->wrap2<div_operation> ();
 393                         }
 394         ;
 395
 396 exp     :       exp DIV exp
 397                         { pstate->wrap2<intdiv_operation> (); }
 398         ;
 399
 400 exp     :       exp MOD exp
 401                         { pstate->wrap2<rem_operation> (); }
 402         ;
 403
 404 exp     :       exp '+' exp
 405                         { pstate->wrap2<add_operation> (); }
 406         ;
 407
 408 exp     :       exp '-' exp
 409                         { pstate->wrap2<sub_operation> (); }
 410         ;
 411
 412 exp     :       exp LSH exp
 413                         { pstate->wrap2<lsh_operation> (); }
 414         ;
 415
 416 exp     :       exp RSH exp
 417                         { pstate->wrap2<rsh_operation> (); }
 418         ;
 419
 420 exp     :       exp '=' exp
 421                         {
 422                           pstate->wrap2<equal_operation> ();
 423                           current_type = parse_type (pstate)->builtin_bool;
 424                         }
 425         ;
 426
 427 exp     :       exp NOTEQUAL exp
 428                         {
 429                           pstate->wrap2<notequal_operation> ();
 430                           current_type = parse_type (pstate)->builtin_bool;
 431                         }
 432         ;
 433
 434 exp     :       exp LEQ exp
 435                         {
 436                           pstate->wrap2<leq_operation> ();
 437                           current_type = parse_type (pstate)->builtin_bool;
 438                         }
 439         ;
 440
 441 exp     :       exp GEQ exp
 442                         {
 443                           pstate->wrap2<geq_operation> ();
 444                           current_type = parse_type (pstate)->builtin_bool;
 445                         }
 446         ;
 447
 448 exp     :       exp '<' exp
 449                         {
 450                           pstate->wrap2<less_operation> ();
 451                           current_type = parse_type (pstate)->builtin_bool;
 452                         }
 453         ;
 454
 455 exp     :       exp '>' exp
 456                         {
 457                           pstate->wrap2<gtr_operation> ();
 458                           current_type = parse_type (pstate)->builtin_bool;
 459                         }
 460         ;
 461
 462 exp     :       exp ANDAND exp
 463                         { pstate->wrap2<bitwise_and_operation> (); }
 464         ;
 465
 466 exp     :       exp XOR exp
 467                         { pstate->wrap2<bitwise_xor_operation> (); }
 468         ;
 469
 470 exp     :       exp OR exp
 471                         { pstate->wrap2<bitwise_ior_operation> (); }
 472         ;
 473
 474 exp     :       exp ASSIGN exp
 475                         { pstate->wrap2<assign_operation> (); }
 476         ;
 477
 478 exp     :       TRUEKEYWORD
 479                         {
 480                           pstate->push_new<bool_operation> ($1);
 481                           current_type = parse_type (pstate)->builtin_bool;
 482                         }
 483         ;
 484
 485 exp     :       FALSEKEYWORD
 486                         {
 487                           pstate->push_new<bool_operation> ($1);
 488                           current_type = parse_type (pstate)->builtin_bool;
 489                         }
 490         ;
 491
 492 exp     :       INT
 493                         {
 494                           pstate->push_new<long_const_operation>
 495                             ($1.type, $1.val);
 496                           current_type = $1.type;
 497                         }
 498         ;
 499
 500 exp     :       NAME_OR_INT
 501                         { YYSTYPE val;
 502                           parse_number (pstate, $1.stoken.ptr,
 503                                         $1.stoken.length, 0, &val);
 504                           pstate->push_new<long_const_operation>
 505                             (val.typed_val_int.type,
 506                              val.typed_val_int.val);
 507                           current_type = val.typed_val_int.type;
 508                         }
 509         ;
 510
 511
 512 exp     :       FLOAT
 513                         {
 514                           float_data data;
 515                           std::copy (std::begin ($1.val), std::end ($1.val),
 516                                      std::begin (data));
 517                           pstate->push_new<float_const_operation> ($1.type, data);
 518                         }
 519         ;
 520
 521 exp     :       variable
 522         ;
 523
 524 exp     :       DOLLAR_VARIABLE
 525                         {
 526                           pstate->push_dollar ($1);
 527
 528                           /* $ is the normal prefix for pascal
 529                              hexadecimal values but this conflicts
 530                              with the GDB use for debugger variables
 531                              so in expression to enter hexadecimal
 532                              values we still need to use C syntax with
 533                              0xff */
 534                           std::string tmp ($1.ptr, $1.length);
 535                           /* Handle current_type.  */
 536                           struct internalvar *intvar
 537                             = lookup_only_internalvar (tmp.c_str () + 1);
 538                           if (intvar != nullptr)
 539                             {
 540                               scoped_value_mark mark;
 541
 542                               value *val
 543                                 = value_of_internalvar (pstate->gdbarch (),
 544                                                         intvar);
 545                               current_type = value_type (val);
 546                             }
 547                         }
 548         ;
 549
 550 exp     :       SIZEOF '(' type ')'     %prec UNARY
 551                         {
 552                           current_type = parse_type (pstate)->builtin_int;
 553                           $3 = check_typedef ($3);
 554                           pstate->push_new<long_const_operation>
 555                             (parse_type (pstate)->builtin_int,
 556                              TYPE_LENGTH ($3)); }
 557         ;
 558
 559 exp     :       SIZEOF  '(' exp ')'      %prec UNARY
 560                         { pstate->wrap<unop_sizeof_operation> ();
 561                           current_type = parse_type (pstate)->builtin_int; }
 562
 563 exp     :       STRING
 564                         { /* C strings are converted into array constants with
 565                              an explicit null byte added at the end.  Thus
 566                              the array upper bound is the string length.
 567                              There is no such thing in C as a completely empty
 568                              string.  */
 569                           const char *sp = $1.ptr; int count = $1.length;
 570
 571                           std::vector<operation_up> args (count + 1);
 572                           for (int i = 0; i < count; ++i)
 573                             args[i] = (make_operation<long_const_operation>
 574                                        (parse_type (pstate)->builtin_char,
 575                                         *sp++));
 576                           args[count] = (make_operation<long_const_operation>
 577                                          (parse_type (pstate)->builtin_char,
 578                                           '\0'));
 579                           pstate->push_new<array_operation>
 580                             (0, $1.length, std::move (args));
 581                         }
 582         ;
 583
 584 /* Object pascal  */
 585 exp     :       THIS
 586                         {
 587                           struct value * this_val;
 588                           struct type * this_type;
 589                           pstate->push_new<op_this_operation> ();
 590                           /* We need type of this.  */
 591                           this_val
 592                             = value_of_this_silent (pstate->language ());
 593                           if (this_val)
 594                             this_type = value_type (this_val);
 595                           else
 596                             this_type = NULL;
 597                           if (this_type)
 598                             {
 599                               if (this_type->code () == TYPE_CODE_PTR)
 600                                 {
 601                                   this_type = TYPE_TARGET_TYPE (this_type);
 602                                   pstate->wrap<unop_ind_operation> ();
 603                                 }
 604                             }
 605
 606                           current_type = this_type;
 607                         }
 608         ;
 609
 610 /* end of object pascal.  */
 611
 612 block   :       BLOCKNAME
 613                         {
 614                           if ($1.sym.symbol != 0)
 615                               $$ = SYMBOL_BLOCK_VALUE ($1.sym.symbol);
 616                           else
 617                             {
 618                               std::string copy = copy_name ($1.stoken);
 619                               struct symtab *tem =
 620                                   lookup_symtab (copy.c_str ());
 621                               if (tem)
 622                                 $$ = BLOCKVECTOR_BLOCK (SYMTAB_BLOCKVECTOR (tem),
 623                                                         STATIC_BLOCK);
 624                               else
 625                                 error (_("No file or function \"%s\"."),
 626                                        copy.c_str ());
 627                             }
 628                         }
 629         ;
 630
 631 block   :       block COLONCOLON name
 632                         {
 633                           std::string copy = copy_name ($3);
 634                           struct symbol *tem
 635                             = lookup_symbol (copy.c_str (), $1,
 636                                              VAR_DOMAIN, NULL).symbol;
 637
 638                           if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
 639                             error (_("No function \"%s\" in specified context."),
 640                                    copy.c_str ());
 641                           $$ = SYMBOL_BLOCK_VALUE (tem); }
 642         ;
 643
 644 variable:       block COLONCOLON name
 645                         { struct block_symbol sym;
 646
 647                           std::string copy = copy_name ($3);
 648                           sym = lookup_symbol (copy.c_str (), $1,
 649                                                VAR_DOMAIN, NULL);
 650                           if (sym.symbol == 0)
 651                             error (_("No symbol \"%s\" in specified context."),
 652                                    copy.c_str ());
 653
 654                           pstate->push_new<var_value_operation> (sym);
 655                         }
 656         ;
 657
 658 qualified_name: typebase COLONCOLON name
 659                         {
 660                           struct type *type = $1;
 661
 662                           if (type->code () != TYPE_CODE_STRUCT
 663                               && type->code () != TYPE_CODE_UNION)
 664                             error (_("`%s' is not defined as an aggregate type."),
 665                                    type->name ());
 666
 667                           pstate->push_new<scope_operation>
 668                             (type, copy_name ($3));
 669                         }
 670         ;
 671
 672 variable:       qualified_name
 673         |       COLONCOLON name
 674                         {
 675                           std::string name = copy_name ($2);
 676
 677                           struct block_symbol sym
 678                             = lookup_symbol (name.c_str (), nullptr,
 679                                              VAR_DOMAIN, nullptr);
 680                           pstate->push_symbol (name.c_str (), sym);
 681                         }
 682         ;
 683
 684 variable:       name_not_typename
 685                         { struct block_symbol sym = $1.sym;
 686
 687                           if (sym.symbol)
 688                             {
 689                               if (symbol_read_needs_frame (sym.symbol))
 690                                 pstate->block_tracker->update (sym);
 691
 692                               pstate->push_new<var_value_operation> (sym);
 693                               current_type = sym.symbol->type; }
 694                           else if ($1.is_a_field_of_this)
 695                             {
 696                               struct value * this_val;
 697                               struct type * this_type;
 698                               /* Object pascal: it hangs off of `this'.  Must
 699                                  not inadvertently convert from a method call
 700                                  to data ref.  */
 701                               pstate->block_tracker->update (sym);
 702                               operation_up thisop
 703                                 = make_operation<op_this_operation> ();
 704                               pstate->push_new<structop_operation>
 705                                 (std::move (thisop), copy_name ($1.stoken));
 706                               /* We need type of this.  */
 707                               this_val
 708                                 = value_of_this_silent (pstate->language ());
 709                               if (this_val)
 710                                 this_type = value_type (this_val);
 711                               else
 712                                 this_type = NULL;
 713                               if (this_type)
 714                                 current_type = lookup_struct_elt_type (
 715                                   this_type,
 716                                   copy_name ($1.stoken).c_str (), 0);
 717                               else
 718                                 current_type = NULL;
 719                             }
 720                           else
 721                             {
 722                               struct bound_minimal_symbol msymbol;
 723                               std::string arg = copy_name ($1.stoken);
 724
 725                               msymbol =
 726                                 lookup_bound_minimal_symbol (arg.c_str ());
 727                               if (msymbol.minsym != NULL)
 728                                 pstate->push_new<var_msym_value_operation>
 729                                   (msymbol);
 730                               else if (!have_full_symbols ()
 731                                        && !have_partial_symbols ())
 732                                 error (_("No symbol table is loaded.  "
 733                                        "Use the \"file\" command."));
 734                               else
 735                                 error (_("No symbol \"%s\" in current context."),
 736                                        arg.c_str ());
 737                             }
 738                         }
 739         ;
 740
 741
 742 ptype   :       typebase
 743         ;
 744
 745 /* We used to try to recognize more pointer to member types here, but
 746    that didn't work (shift/reduce conflicts meant that these rules never
 747    got executed).  The problem is that
 748      int (foo::bar::baz::bizzle)
 749    is a function type but
 750      int (foo::bar::baz::bizzle::*)
 751    is a pointer to member type.  Stroustrup loses again!  */
 752
 753 type    :       ptype
 754         ;
 755
 756 typebase  /* Implements (approximately): (type-qualifier)* type-specifier */
 757         :       '^' typebase
 758                         { $$ = lookup_pointer_type ($2); }
 759         |       TYPENAME
 760                         { $$ = $1.type; }
 761         |       STRUCT name
 762                         { $$
 763                             = lookup_struct (copy_name ($2).c_str (),
 764                                              pstate->expression_context_block);
 765                         }
 766         |       CLASS name
 767                         { $$
 768                             = lookup_struct (copy_name ($2).c_str (),
 769                                              pstate->expression_context_block);
 770                         }
 771         /* "const" and "volatile" are curently ignored.  A type qualifier
 772            after the type is handled in the ptype rule.  I think these could
 773            be too.  */
 774         ;
 775
 776 name    :       NAME { $$ = $1.stoken; }
 777         |       BLOCKNAME { $$ = $1.stoken; }
 778         |       TYPENAME { $$ = $1.stoken; }
 779         |       NAME_OR_INT  { $$ = $1.stoken; }
 780         ;
 781
 782 name_not_typename :     NAME
 783         |       BLOCKNAME
 784 /* These would be useful if name_not_typename was useful, but it is just
 785    a fake for "variable", so these cause reduce/reduce conflicts because
 786    the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
 787    =exp) or just an exp.  If name_not_typename was ever used in an lvalue
 788    context where only a name could occur, this might be useful.
 789         |       NAME_OR_INT
 790  */
 791         ;
 792
 793 %%
 794
 795 /* Take care of parsing a number (anything that starts with a digit).
 796    Set yylval and return the token type; update lexptr.
 797    LEN is the number of characters in it.  */
 798
 799 /*** Needs some error checking for the float case ***/
 800
 801 static int
 802 parse_number (struct parser_state *par_state,
 803               const char *p, int len, int parsed_float, YYSTYPE *putithere)
 804 {
 805   /* FIXME: Shouldn't these be unsigned?  We don't deal with negative values
 806      here, and we do kind of silly things like cast to unsigned.  */
 807   LONGEST n = 0;
 808   LONGEST prevn = 0;
 809   ULONGEST un;
 810
 811   int i = 0;
 812   int c;
 813   int base = input_radix;
 814   int unsigned_p = 0;
 815
 816   /* Number of "L" suffixes encountered.  */
 817   int long_p = 0;
 818
 819   /* We have found a "L" or "U" suffix.  */
 820   int found_suffix = 0;
 821
 822   ULONGEST high_bit;
 823   struct type *signed_type;
 824   struct type *unsigned_type;
 825
 826   if (parsed_float)
 827     {
 828       /* Handle suffixes: 'f' for float, 'l' for long double.
 829          FIXME: This appears to be an extension -- do we want this?  */
 830       if (len >= 1 && tolower (p[len - 1]) == 'f')
 831         {
 832           putithere->typed_val_float.type
 833             = parse_type (par_state)->builtin_float;
 834           len--;
 835         }
 836       else if (len >= 1 && tolower (p[len - 1]) == 'l')
 837         {
 838           putithere->typed_val_float.type
 839             = parse_type (par_state)->builtin_long_double;
 840           len--;
 841         }
 842       /* Default type for floating-point literals is double.  */
 843       else
 844         {
 845           putithere->typed_val_float.type
 846             = parse_type (par_state)->builtin_double;
 847         }
 848
 849       if (!parse_float (p, len,
 850                         putithere->typed_val_float.type,
 851                         putithere->typed_val_float.val))
 852         return ERROR;
 853       return FLOAT;
 854     }
 855
 856   /* Handle base-switching prefixes 0x, 0t, 0d, 0.  */
 857   if (p[0] == '0')
 858     switch (p[1])
 859       {
 860       case 'x':
 861       case 'X':
 862         if (len >= 3)
 863           {
 864             p += 2;
 865             base = 16;
 866             len -= 2;
 867           }
 868         break;
 869
 870       case 't':
 871       case 'T':
 872       case 'd':
 873       case 'D':
 874         if (len >= 3)
 875           {
 876             p += 2;
 877             base = 10;
 878             len -= 2;
 879           }
 880         break;
 881
 882       default:
 883         base = 8;
 884         break;
 885       }
 886
 887   while (len-- > 0)
 888     {
 889       c = *p++;
 890       if (c >= 'A' && c <= 'Z')
 891         c += 'a' - 'A';
 892       if (c != 'l' && c != 'u')
 893         n *= base;
 894       if (c >= '0' && c <= '9')
 895         {
 896           if (found_suffix)
 897             return ERROR;
 898           n += i = c - '0';
 899         }
 900       else
 901         {
 902           if (base > 10 && c >= 'a' && c <= 'f')
 903             {
 904               if (found_suffix)
 905                 return ERROR;
 906               n += i = c - 'a' + 10;
 907             }
 908           else if (c == 'l')
 909             {
 910               ++long_p;
 911               found_suffix = 1;
 912             }
 913           else if (c == 'u')
 914             {
 915               unsigned_p = 1;
 916               found_suffix = 1;
 917             }
 918           else
 919             return ERROR;       /* Char not a digit */
 920         }
 921       if (i >= base)
 922         return ERROR;           /* Invalid digit in this base.  */
 923
 924       /* Portably test for overflow (only works for nonzero values, so make
 925          a second check for zero).  FIXME: Can't we just make n and prevn
 926          unsigned and avoid this?  */
 927       if (c != 'l' && c != 'u' && (prevn >= n) && n != 0)
 928         unsigned_p = 1;         /* Try something unsigned.  */
 929
 930       /* Portably test for unsigned overflow.
 931          FIXME: This check is wrong; for example it doesn't find overflow
 932          on 0x123456789 when LONGEST is 32 bits.  */
 933       if (c != 'l' && c != 'u' && n != 0)
 934         {
 935           if ((unsigned_p && (ULONGEST) prevn >= (ULONGEST) n))
 936             error (_("Numeric constant too large."));
 937         }
 938       prevn = n;
 939     }
 940
 941   /* An integer constant is an int, a long, or a long long.  An L
 942      suffix forces it to be long; an LL suffix forces it to be long
 943      long.  If not forced to a larger size, it gets the first type of
 944      the above that it fits in.  To figure out whether it fits, we
 945      shift it right and see whether anything remains.  Note that we
 946      can't shift sizeof (LONGEST) * HOST_CHAR_BIT bits or more in one
 947      operation, because many compilers will warn about such a shift
 948      (which always produces a zero result).  Sometimes gdbarch_int_bit
 949      or gdbarch_long_bit will be that big, sometimes not.  To deal with
 950      the case where it is we just always shift the value more than
 951      once, with fewer bits each time.  */
 952
 953   un = (ULONGEST)n >> 2;
 954   if (long_p == 0
 955       && (un >> (gdbarch_int_bit (par_state->gdbarch ()) - 2)) == 0)
 956     {
 957       high_bit
 958         = ((ULONGEST)1) << (gdbarch_int_bit (par_state->gdbarch ()) - 1);
 959
 960       /* A large decimal (not hex or octal) constant (between INT_MAX
 961          and UINT_MAX) is a long or unsigned long, according to ANSI,
 962          never an unsigned int, but this code treats it as unsigned
 963          int.  This probably should be fixed.  GCC gives a warning on
 964          such constants.  */
 965
 966       unsigned_type = parse_type (par_state)->builtin_unsigned_int;
 967       signed_type = parse_type (par_state)->builtin_int;
 968     }
 969   else if (long_p <= 1
 970            && (un >> (gdbarch_long_bit (par_state->gdbarch ()) - 2)) == 0)
 971     {
 972       high_bit
 973         = ((ULONGEST)1) << (gdbarch_long_bit (par_state->gdbarch ()) - 1);
 974       unsigned_type = parse_type (par_state)->builtin_unsigned_long;
 975       signed_type = parse_type (par_state)->builtin_long;
 976     }
 977   else
 978     {
 979       int shift;
 980       if (sizeof (ULONGEST) * HOST_CHAR_BIT
 981           < gdbarch_long_long_bit (par_state->gdbarch ()))
 982         /* A long long does not fit in a LONGEST.  */
 983         shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
 984       else
 985         shift = (gdbarch_long_long_bit (par_state->gdbarch ()) - 1);
 986       high_bit = (ULONGEST) 1 << shift;
 987       unsigned_type = parse_type (par_state)->builtin_unsigned_long_long;
 988       signed_type = parse_type (par_state)->builtin_long_long;
 989     }
 990
 991    putithere->typed_val_int.val = n;
 992
 993    /* If the high bit of the worked out type is set then this number
 994       has to be unsigned.  */
 995
 996    if (unsigned_p || (n & high_bit))
 997      {
 998        putithere->typed_val_int.type = unsigned_type;
 999      }
1000    else
1001      {
1002        putithere->typed_val_int.type = signed_type;
1003      }
1004
1005    return INT;
1006 }
1007
1008
1009 struct type_push
1010 {
1011   struct type *stored;
1012   struct type_push *next;
1013 };
1014
1015 static struct type_push *tp_top = NULL;
1016
1017 static void
1018 push_current_type (void)
1019 {
1020   struct type_push *tpnew;
1021   tpnew = (struct type_push *) malloc (sizeof (struct type_push));
1022   tpnew->next = tp_top;
1023   tpnew->stored = current_type;
1024   current_type = NULL;
1025   tp_top = tpnew;
1026 }
1027
1028 static void
1029 pop_current_type (void)
1030 {
1031   struct type_push *tp = tp_top;
1032   if (tp)
1033     {
1034       current_type = tp->stored;
1035       tp_top = tp->next;
1036       free (tp);
1037     }
1038 }
1039
1040 struct token
1041 {
1042   const char *oper;
1043   int token;
1044   enum exp_opcode opcode;
1045 };
1046
1047 static const struct token tokentab3[] =
1048   {
1049     {"shr", RSH, OP_NULL},
1050     {"shl", LSH, OP_NULL},
1051     {"and", ANDAND, OP_NULL},
1052     {"div", DIV, OP_NULL},
1053     {"not", NOT, OP_NULL},
1054     {"mod", MOD, OP_NULL},
1055     {"inc", INCREMENT, OP_NULL},
1056     {"dec", DECREMENT, OP_NULL},
1057     {"xor", XOR, OP_NULL}
1058   };
1059
1060 static const struct token tokentab2[] =
1061   {
1062     {"or", OR, OP_NULL},
1063     {"<>", NOTEQUAL, OP_NULL},
1064     {"<=", LEQ, OP_NULL},
1065     {">=", GEQ, OP_NULL},
1066     {":=", ASSIGN, OP_NULL},
1067     {"::", COLONCOLON, OP_NULL} };
1068
1069 /* Allocate uppercased var: */
1070 /* make an uppercased copy of tokstart.  */
1071 static char *
1072 uptok (const char *tokstart, int namelen)
1073 {
1074   int i;
1075   char *uptokstart = (char *)malloc(namelen+1);
1076   for (i = 0;i <= namelen;i++)
1077     {
1078       if ((tokstart[i]>='a' && tokstart[i]<='z'))
1079         uptokstart[i] = tokstart[i]-('a'-'A');
1080       else
1081         uptokstart[i] = tokstart[i];
1082     }
1083   uptokstart[namelen]='\0';
1084   return uptokstart;
1085 }
1086
1087 /* Read one token, getting characters through lexptr.  */
1088
1089 static int
1090 yylex (void)
1091 {
1092   int c;
1093   int namelen;
1094   const char *tokstart;
1095   char *uptokstart;
1096   const char *tokptr;
1097   int explen, tempbufindex;
1098   static char *tempbuf;
1099   static int tempbufsize;
1100
1101  retry:
1102
1103   pstate->prev_lexptr = pstate->lexptr;
1104
1105   tokstart = pstate->lexptr;
1106   explen = strlen (pstate->lexptr);
1107
1108   /* See if it is a special token of length 3.  */
1109   if (explen > 2)
1110     for (int i = 0; i < sizeof (tokentab3) / sizeof (tokentab3[0]); i++)
1111       if (strncasecmp (tokstart, tokentab3[i].oper, 3) == 0
1112           && (!isalpha (tokentab3[i].oper[0]) || explen == 3
1113               || (!isalpha (tokstart[3])
1114                   && !isdigit (tokstart[3]) && tokstart[3] != '_')))
1115         {
1116           pstate->lexptr += 3;
1117           yylval.opcode = tokentab3[i].opcode;
1118           return tokentab3[i].token;
1119         }
1120
1121   /* See if it is a special token of length 2.  */
1122   if (explen > 1)
1123   for (int i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
1124       if (strncasecmp (tokstart, tokentab2[i].oper, 2) == 0
1125           && (!isalpha (tokentab2[i].oper[0]) || explen == 2
1126               || (!isalpha (tokstart[2])
1127                   && !isdigit (tokstart[2]) && tokstart[2] != '_')))
1128         {
1129           pstate->lexptr += 2;
1130           yylval.opcode = tokentab2[i].opcode;
1131           return tokentab2[i].token;
1132         }
1133
1134   switch (c = *tokstart)
1135     {
1136     case 0:
1137       if (search_field && pstate->parse_completion)
1138         return COMPLETE;
1139       else
1140        return 0;
1141
1142     case ' ':
1143     case '\t':
1144     case '\n':
1145       pstate->lexptr++;
1146       goto retry;
1147
1148     case '\'':
1149       /* We either have a character constant ('0' or '\177' for example)
1150          or we have a quoted symbol reference ('foo(int,int)' in object pascal
1151          for example).  */
1152       pstate->lexptr++;
1153       c = *pstate->lexptr++;
1154       if (c == '\\')
1155         c = parse_escape (pstate->gdbarch (), &pstate->lexptr);
1156       else if (c == '\'')
1157         error (_("Empty character constant."));
1158
1159       yylval.typed_val_int.val = c;
1160       yylval.typed_val_int.type = parse_type (pstate)->builtin_char;
1161
1162       c = *pstate->lexptr++;
1163       if (c != '\'')
1164         {
1165           namelen = skip_quoted (tokstart) - tokstart;
1166           if (namelen > 2)
1167             {
1168               pstate->lexptr = tokstart + namelen;
1169               if (pstate->lexptr[-1] != '\'')
1170                 error (_("Unmatched single quote."));
1171               namelen -= 2;
1172               tokstart++;
1173               uptokstart = uptok(tokstart,namelen);
1174               goto tryname;
1175             }
1176           error (_("Invalid character constant."));
1177         }
1178       return INT;
1179
1180     case '(':
1181       paren_depth++;
1182       pstate->lexptr++;
1183       return c;
1184
1185     case ')':
1186       if (paren_depth == 0)
1187         return 0;
1188       paren_depth--;
1189       pstate->lexptr++;
1190       return c;
1191
1192     case ',':
1193       if (pstate->comma_terminates && paren_depth == 0)
1194         return 0;
1195       pstate->lexptr++;
1196       return c;
1197
1198     case '.':
1199       /* Might be a floating point number.  */
1200       if (pstate->lexptr[1] < '0' || pstate->lexptr[1] > '9')
1201         {
1202           goto symbol;          /* Nope, must be a symbol.  */
1203         }
1204
1205       /* FALL THRU.  */
1206
1207     case '0':
1208     case '1':
1209     case '2':
1210     case '3':
1211     case '4':
1212     case '5':
1213     case '6':
1214     case '7':
1215     case '8':
1216     case '9':
1217       {
1218         /* It's a number.  */
1219         int got_dot = 0, got_e = 0, toktype;
1220         const char *p = tokstart;
1221         int hex = input_radix > 10;
1222
1223         if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1224           {
1225             p += 2;
1226             hex = 1;
1227           }
1228         else if (c == '0' && (p[1]=='t' || p[1]=='T'
1229                               || p[1]=='d' || p[1]=='D'))
1230           {
1231             p += 2;
1232             hex = 0;
1233           }
1234
1235         for (;; ++p)
1236           {
1237             /* This test includes !hex because 'e' is a valid hex digit
1238                and thus does not indicate a floating point number when
1239                the radix is hex.  */
1240             if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1241               got_dot = got_e = 1;
1242             /* This test does not include !hex, because a '.' always indicates
1243                a decimal floating point number regardless of the radix.  */
1244             else if (!got_dot && *p == '.')
1245               got_dot = 1;
1246             else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
1247                      && (*p == '-' || *p == '+'))
1248               /* This is the sign of the exponent, not the end of the
1249                  number.  */
1250               continue;
1251             /* We will take any letters or digits.  parse_number will
1252                complain if past the radix, or if L or U are not final.  */
1253             else if ((*p < '0' || *p > '9')
1254                      && ((*p < 'a' || *p > 'z')
1255                                   && (*p < 'A' || *p > 'Z')))
1256               break;
1257           }
1258         toktype = parse_number (pstate, tokstart,
1259                                 p - tokstart, got_dot | got_e, &yylval);
1260         if (toktype == ERROR)
1261           {
1262             char *err_copy = (char *) alloca (p - tokstart + 1);
1263
1264             memcpy (err_copy, tokstart, p - tokstart);
1265             err_copy[p - tokstart] = 0;
1266             error (_("Invalid number \"%s\"."), err_copy);
1267           }
1268         pstate->lexptr = p;
1269         return toktype;
1270       }
1271
1272     case '+':
1273     case '-':
1274     case '*':
1275     case '/':
1276     case '|':
1277     case '&':
1278     case '^':
1279     case '~':
1280     case '!':
1281     case '@':
1282     case '<':
1283     case '>':
1284     case '[':
1285     case ']':
1286     case '?':
1287     case ':':
1288     case '=':
1289     case '{':
1290     case '}':
1291     symbol:
1292       pstate->lexptr++;
1293       return c;
1294
1295     case '"':
1296
1297       /* Build the gdb internal form of the input string in tempbuf,
1298          translating any standard C escape forms seen.  Note that the
1299          buffer is null byte terminated *only* for the convenience of
1300          debugging gdb itself and printing the buffer contents when
1301          the buffer contains no embedded nulls.  Gdb does not depend
1302          upon the buffer being null byte terminated, it uses the length
1303          string instead.  This allows gdb to handle C strings (as well
1304          as strings in other languages) with embedded null bytes.  */
1305
1306       tokptr = ++tokstart;
1307       tempbufindex = 0;
1308
1309       do {
1310         /* Grow the static temp buffer if necessary, including allocating
1311            the first one on demand.  */
1312         if (tempbufindex + 1 >= tempbufsize)
1313           {
1314             tempbuf = (char *) realloc (tempbuf, tempbufsize += 64);
1315           }
1316
1317         switch (*tokptr)
1318           {
1319           case '\0':
1320           case '"':
1321             /* Do nothing, loop will terminate.  */
1322             break;
1323           case '\\':
1324             ++tokptr;
1325             c = parse_escape (pstate->gdbarch (), &tokptr);
1326             if (c == -1)
1327               {
1328                 continue;
1329               }
1330             tempbuf[tempbufindex++] = c;
1331             break;
1332           default:
1333             tempbuf[tempbufindex++] = *tokptr++;
1334             break;
1335           }
1336       } while ((*tokptr != '"') && (*tokptr != '\0'));
1337       if (*tokptr++ != '"')
1338         {
1339           error (_("Unterminated string in expression."));
1340         }
1341       tempbuf[tempbufindex] = '\0';     /* See note above.  */
1342       yylval.sval.ptr = tempbuf;
1343       yylval.sval.length = tempbufindex;
1344       pstate->lexptr = tokptr;
1345       return (STRING);
1346     }
1347
1348   if (!(c == '_' || c == '$'
1349         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1350     /* We must have come across a bad character (e.g. ';').  */
1351     error (_("Invalid character '%c' in expression."), c);
1352
1353   /* It's a name.  See how long it is.  */
1354   namelen = 0;
1355   for (c = tokstart[namelen];
1356        (c == '_' || c == '$' || (c >= '0' && c <= '9')
1357         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c == '<');)
1358     {
1359       /* Template parameter lists are part of the name.
1360          FIXME: This mishandles `print $a<4&&$a>3'.  */
1361       if (c == '<')
1362         {
1363           int i = namelen;
1364           int nesting_level = 1;
1365           while (tokstart[++i])
1366             {
1367               if (tokstart[i] == '<')
1368                 nesting_level++;
1369               else if (tokstart[i] == '>')
1370                 {
1371                   if (--nesting_level == 0)
1372                     break;
1373                 }
1374             }
1375           if (tokstart[i] == '>')
1376             namelen = i;
1377           else
1378             break;
1379         }
1380
1381       /* do NOT uppercase internals because of registers !!!  */
1382       c = tokstart[++namelen];
1383     }
1384
1385   uptokstart = uptok(tokstart,namelen);
1386
1387   /* The token "if" terminates the expression and is NOT
1388      removed from the input stream.  */
1389   if (namelen == 2 && uptokstart[0] == 'I' && uptokstart[1] == 'F')
1390     {
1391       free (uptokstart);
1392       return 0;
1393     }
1394
1395   pstate->lexptr += namelen;
1396
1397   tryname:
1398
1399   /* Catch specific keywords.  Should be done with a data structure.  */
1400   switch (namelen)
1401     {
1402     case 6:
1403       if (strcmp (uptokstart, "OBJECT") == 0)
1404         {
1405           free (uptokstart);
1406           return CLASS;
1407         }
1408       if (strcmp (uptokstart, "RECORD") == 0)
1409         {
1410           free (uptokstart);
1411           return STRUCT;
1412         }
1413       if (strcmp (uptokstart, "SIZEOF") == 0)
1414         {
1415           free (uptokstart);
1416           return SIZEOF;
1417         }
1418       break;
1419     case 5:
1420       if (strcmp (uptokstart, "CLASS") == 0)
1421         {
1422           free (uptokstart);
1423           return CLASS;
1424         }
1425       if (strcmp (uptokstart, "FALSE") == 0)
1426         {
1427           yylval.lval = 0;
1428           free (uptokstart);
1429           return FALSEKEYWORD;
1430         }
1431       break;
1432     case 4:
1433       if (strcmp (uptokstart, "TRUE") == 0)
1434         {
1435           yylval.lval = 1;
1436           free (uptokstart);
1437           return TRUEKEYWORD;
1438         }
1439       if (strcmp (uptokstart, "SELF") == 0)
1440         {
1441           /* Here we search for 'this' like
1442              inserted in FPC stabs debug info.  */
1443           static const char this_name[] = "this";
1444
1445           if (lookup_symbol (this_name, pstate->expression_context_block,
1446                              VAR_DOMAIN, NULL).symbol)
1447             {
1448               free (uptokstart);
1449               return THIS;
1450             }
1451         }
1452       break;
1453     default:
1454       break;
1455     }
1456
1457   yylval.sval.ptr = tokstart;
1458   yylval.sval.length = namelen;
1459
1460   if (*tokstart == '$')
1461     {
1462       free (uptokstart);
1463       return DOLLAR_VARIABLE;
1464     }
1465
1466   /* Use token-type BLOCKNAME for symbols that happen to be defined as
1467      functions or symtabs.  If this is not so, then ...
1468      Use token-type TYPENAME for symbols that happen to be defined
1469      currently as names of types; NAME for other symbols.
1470      The caller is not constrained to care about the distinction.  */
1471   {
1472     std::string tmp = copy_name (yylval.sval);
1473     struct symbol *sym;
1474     struct field_of_this_result is_a_field_of_this;
1475     int is_a_field = 0;
1476     int hextype;
1477
1478     is_a_field_of_this.type = NULL;
1479     if (search_field && current_type)
1480       is_a_field = (lookup_struct_elt_type (current_type,
1481                                             tmp.c_str (), 1) != NULL);
1482     if (is_a_field)
1483       sym = NULL;
1484     else
1485       sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1486                            VAR_DOMAIN, &is_a_field_of_this).symbol;
1487     /* second chance uppercased (as Free Pascal does).  */
1488     if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
1489       {
1490        for (int i = 0; i <= namelen; i++)
1491          {
1492            if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1493              tmp[i] -= ('a'-'A');
1494          }
1495        if (search_field && current_type)
1496          is_a_field = (lookup_struct_elt_type (current_type,
1497                                                tmp.c_str (), 1) != NULL);
1498        if (is_a_field)
1499          sym = NULL;
1500        else
1501          sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1502                               VAR_DOMAIN, &is_a_field_of_this).symbol;
1503       }
1504     /* Third chance Capitalized (as GPC does).  */
1505     if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
1506       {
1507        for (int i = 0; i <= namelen; i++)
1508          {
1509            if (i == 0)
1510              {
1511               if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1512                 tmp[i] -= ('a'-'A');
1513              }
1514            else
1515            if ((tmp[i] >= 'A' && tmp[i] <= 'Z'))
1516              tmp[i] -= ('A'-'a');
1517           }
1518        if (search_field && current_type)
1519          is_a_field = (lookup_struct_elt_type (current_type,
1520                                                tmp.c_str (), 1) != NULL);
1521        if (is_a_field)
1522          sym = NULL;
1523        else
1524          sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1525                               VAR_DOMAIN, &is_a_field_of_this).symbol;
1526       }
1527
1528     if (is_a_field || (is_a_field_of_this.type != NULL))
1529       {
1530         tempbuf = (char *) realloc (tempbuf, namelen + 1);
1531         strncpy (tempbuf, tmp.c_str (), namelen);
1532         tempbuf [namelen] = 0;
1533         yylval.sval.ptr = tempbuf;
1534         yylval.sval.length = namelen;
1535         yylval.ssym.sym.symbol = NULL;
1536         yylval.ssym.sym.block = NULL;
1537         free (uptokstart);
1538         yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1539         if (is_a_field)
1540           return FIELDNAME;
1541         else
1542           return NAME;
1543       }
1544     /* Call lookup_symtab, not lookup_partial_symtab, in case there are
1545        no psymtabs (coff, xcoff, or some future change to blow away the
1546        psymtabs once once symbols are read).  */
1547     if ((sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1548         || lookup_symtab (tmp.c_str ()))
1549       {
1550         yylval.ssym.sym.symbol = sym;
1551         yylval.ssym.sym.block = NULL;
1552         yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1553         free (uptokstart);
1554         return BLOCKNAME;
1555       }
1556     if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1557         {
1558 #if 1
1559           /* Despite the following flaw, we need to keep this code enabled.
1560              Because we can get called from check_stub_method, if we don't
1561              handle nested types then it screws many operations in any
1562              program which uses nested types.  */
1563           /* In "A::x", if x is a member function of A and there happens
1564              to be a type (nested or not, since the stabs don't make that
1565              distinction) named x, then this code incorrectly thinks we
1566              are dealing with nested types rather than a member function.  */
1567
1568           const char *p;
1569           const char *namestart;
1570           struct symbol *best_sym;
1571
1572           /* Look ahead to detect nested types.  This probably should be
1573              done in the grammar, but trying seemed to introduce a lot
1574              of shift/reduce and reduce/reduce conflicts.  It's possible
1575              that it could be done, though.  Or perhaps a non-grammar, but
1576              less ad hoc, approach would work well.  */
1577
1578           /* Since we do not currently have any way of distinguishing
1579              a nested type from a non-nested one (the stabs don't tell
1580              us whether a type is nested), we just ignore the
1581              containing type.  */
1582
1583           p = pstate->lexptr;
1584           best_sym = sym;
1585           while (1)
1586             {
1587               /* Skip whitespace.  */
1588               while (*p == ' ' || *p == '\t' || *p == '\n')
1589                 ++p;
1590               if (*p == ':' && p[1] == ':')
1591                 {
1592                   /* Skip the `::'.  */
1593                   p += 2;
1594                   /* Skip whitespace.  */
1595                   while (*p == ' ' || *p == '\t' || *p == '\n')
1596                     ++p;
1597                   namestart = p;
1598                   while (*p == '_' || *p == '$' || (*p >= '0' && *p <= '9')
1599                          || (*p >= 'a' && *p <= 'z')
1600                          || (*p >= 'A' && *p <= 'Z'))
1601                     ++p;
1602                   if (p != namestart)
1603                     {
1604                       struct symbol *cur_sym;
1605                       /* As big as the whole rest of the expression, which is
1606                          at least big enough.  */
1607                       char *ncopy
1608                         = (char *) alloca (tmp.size () + strlen (namestart)
1609                                            + 3);
1610                       char *tmp1;
1611
1612                       tmp1 = ncopy;
1613                       memcpy (tmp1, tmp.c_str (), tmp.size ());
1614                       tmp1 += tmp.size ();
1615                       memcpy (tmp1, "::", 2);
1616                       tmp1 += 2;
1617                       memcpy (tmp1, namestart, p - namestart);
1618                       tmp1[p - namestart] = '\0';
1619                       cur_sym
1620                         = lookup_symbol (ncopy,
1621                                          pstate->expression_context_block,
1622                                          VAR_DOMAIN, NULL).symbol;
1623                       if (cur_sym)
1624                         {
1625                           if (SYMBOL_CLASS (cur_sym) == LOC_TYPEDEF)
1626                             {
1627                               best_sym = cur_sym;
1628                               pstate->lexptr = p;
1629                             }
1630                           else
1631                             break;
1632                         }
1633                       else
1634                         break;
1635                     }
1636                   else
1637                     break;
1638                 }
1639               else
1640                 break;
1641             }
1642
1643           yylval.tsym.type = SYMBOL_TYPE (best_sym);
1644 #else /* not 0 */
1645           yylval.tsym.type = SYMBOL_TYPE (sym);
1646 #endif /* not 0 */
1647           free (uptokstart);
1648           return TYPENAME;
1649         }
1650     yylval.tsym.type
1651       = language_lookup_primitive_type (pstate->language (),
1652                                         pstate->gdbarch (), tmp.c_str ());
1653     if (yylval.tsym.type != NULL)
1654       {
1655         free (uptokstart);
1656         return TYPENAME;
1657       }
1658
1659     /* Input names that aren't symbols but ARE valid hex numbers,
1660        when the input radix permits them, can be names or numbers
1661        depending on the parse.  Note we support radixes > 16 here.  */
1662     if (!sym
1663         && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1664             || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1665       {
1666         YYSTYPE newlval;        /* Its value is ignored.  */
1667         hextype = parse_number (pstate, tokstart, namelen, 0, &newlval);
1668         if (hextype == INT)
1669           {
1670             yylval.ssym.sym.symbol = sym;
1671             yylval.ssym.sym.block = NULL;
1672             yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1673             free (uptokstart);
1674             return NAME_OR_INT;
1675           }
1676       }
1677
1678     free(uptokstart);
1679     /* Any other kind of symbol.  */
1680     yylval.ssym.sym.symbol = sym;
1681     yylval.ssym.sym.block = NULL;
1682     return NAME;
1683   }
1684 }
1685
1686 /* See language.h.  */
1687
1688 int
1689 pascal_language::parser (struct parser_state *par_state) const
1690 {
1691   /* Setting up the parser state.  */
1692   scoped_restore pstate_restore = make_scoped_restore (&pstate);
1693   gdb_assert (par_state != NULL);
1694   pstate = par_state;
1695   paren_depth = 0;
1696
1697   int result = yyparse ();
1698   if (!result)
1699     pstate->set_operation (pstate->pop ());
1700   return result;
1701 }
1702
1703 static void
1704 yyerror (const char *msg)
1705 {
1706   if (pstate->prev_lexptr)
1707     pstate->lexptr = pstate->prev_lexptr;
1708
1709   error (_("A %s in expression, near `%s'."), msg, pstate->lexptr);
1710 }