gdb/p-exp.y

   1 /* YACC parser for Pascal expressions, for GDB.
   2    Copyright (C) 2000-2022 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                               $$ = $1.sym.symbol->value_block ();
 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
 623                                   (tem->compunit ()->blockvector (),
 624                                    STATIC_BLOCK);
 625                               else
 626                                 error (_("No file or function \"%s\"."),
 627                                        copy.c_str ());
 628                             }
 629                         }
 630         ;
 631
 632 block   :       block COLONCOLON name
 633                         {
 634                           std::string copy = copy_name ($3);
 635                           struct symbol *tem
 636                             = lookup_symbol (copy.c_str (), $1,
 637                                              VAR_DOMAIN, NULL).symbol;
 638
 639                           if (!tem || tem->aclass () != LOC_BLOCK)
 640                             error (_("No function \"%s\" in specified context."),
 641                                    copy.c_str ());
 642                           $$ = tem->value_block (); }
 643         ;
 644
 645 variable:       block COLONCOLON name
 646                         { struct block_symbol sym;
 647
 648                           std::string copy = copy_name ($3);
 649                           sym = lookup_symbol (copy.c_str (), $1,
 650                                                VAR_DOMAIN, NULL);
 651                           if (sym.symbol == 0)
 652                             error (_("No symbol \"%s\" in specified context."),
 653                                    copy.c_str ());
 654
 655                           pstate->push_new<var_value_operation> (sym);
 656                         }
 657         ;
 658
 659 qualified_name: typebase COLONCOLON name
 660                         {
 661                           struct type *type = $1;
 662
 663                           if (type->code () != TYPE_CODE_STRUCT
 664                               && type->code () != TYPE_CODE_UNION)
 665                             error (_("`%s' is not defined as an aggregate type."),
 666                                    type->name ());
 667
 668                           pstate->push_new<scope_operation>
 669                             (type, copy_name ($3));
 670                         }
 671         ;
 672
 673 variable:       qualified_name
 674         |       COLONCOLON name
 675                         {
 676                           std::string name = copy_name ($2);
 677
 678                           struct block_symbol sym
 679                             = lookup_symbol (name.c_str (), nullptr,
 680                                              VAR_DOMAIN, nullptr);
 681                           pstate->push_symbol (name.c_str (), sym);
 682                         }
 683         ;
 684
 685 variable:       name_not_typename
 686                         { struct block_symbol sym = $1.sym;
 687
 688                           if (sym.symbol)
 689                             {
 690                               if (symbol_read_needs_frame (sym.symbol))
 691                                 pstate->block_tracker->update (sym);
 692
 693                               pstate->push_new<var_value_operation> (sym);
 694                               current_type = sym.symbol->type (); }
 695                           else if ($1.is_a_field_of_this)
 696                             {
 697                               struct value * this_val;
 698                               struct type * this_type;
 699                               /* Object pascal: it hangs off of `this'.  Must
 700                                  not inadvertently convert from a method call
 701                                  to data ref.  */
 702                               pstate->block_tracker->update (sym);
 703                               operation_up thisop
 704                                 = make_operation<op_this_operation> ();
 705                               pstate->push_new<structop_operation>
 706                                 (std::move (thisop), copy_name ($1.stoken));
 707                               /* We need type of this.  */
 708                               this_val
 709                                 = value_of_this_silent (pstate->language ());
 710                               if (this_val)
 711                                 this_type = value_type (this_val);
 712                               else
 713                                 this_type = NULL;
 714                               if (this_type)
 715                                 current_type = lookup_struct_elt_type (
 716                                   this_type,
 717                                   copy_name ($1.stoken).c_str (), 0);
 718                               else
 719                                 current_type = NULL;
 720                             }
 721                           else
 722                             {
 723                               struct bound_minimal_symbol msymbol;
 724                               std::string arg = copy_name ($1.stoken);
 725
 726                               msymbol =
 727                                 lookup_bound_minimal_symbol (arg.c_str ());
 728                               if (msymbol.minsym != NULL)
 729                                 pstate->push_new<var_msym_value_operation>
 730                                   (msymbol);
 731                               else if (!have_full_symbols ()
 732                                        && !have_partial_symbols ())
 733                                 error (_("No symbol table is loaded.  "
 734                                        "Use the \"file\" command."));
 735                               else
 736                                 error (_("No symbol \"%s\" in current context."),
 737                                        arg.c_str ());
 738                             }
 739                         }
 740         ;
 741
 742
 743 ptype   :       typebase
 744         ;
 745
 746 /* We used to try to recognize more pointer to member types here, but
 747    that didn't work (shift/reduce conflicts meant that these rules never
 748    got executed).  The problem is that
 749      int (foo::bar::baz::bizzle)
 750    is a function type but
 751      int (foo::bar::baz::bizzle::*)
 752    is a pointer to member type.  Stroustrup loses again!  */
 753
 754 type    :       ptype
 755         ;
 756
 757 typebase  /* Implements (approximately): (type-qualifier)* type-specifier */
 758         :       '^' typebase
 759                         { $$ = lookup_pointer_type ($2); }
 760         |       TYPENAME
 761                         { $$ = $1.type; }
 762         |       STRUCT name
 763                         { $$
 764                             = lookup_struct (copy_name ($2).c_str (),
 765                                              pstate->expression_context_block);
 766                         }
 767         |       CLASS name
 768                         { $$
 769                             = lookup_struct (copy_name ($2).c_str (),
 770                                              pstate->expression_context_block);
 771                         }
 772         /* "const" and "volatile" are curently ignored.  A type qualifier
 773            after the type is handled in the ptype rule.  I think these could
 774            be too.  */
 775         ;
 776
 777 name    :       NAME { $$ = $1.stoken; }
 778         |       BLOCKNAME { $$ = $1.stoken; }
 779         |       TYPENAME { $$ = $1.stoken; }
 780         |       NAME_OR_INT  { $$ = $1.stoken; }
 781         ;
 782
 783 name_not_typename :     NAME
 784         |       BLOCKNAME
 785 /* These would be useful if name_not_typename was useful, but it is just
 786    a fake for "variable", so these cause reduce/reduce conflicts because
 787    the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
 788    =exp) or just an exp.  If name_not_typename was ever used in an lvalue
 789    context where only a name could occur, this might be useful.
 790         |       NAME_OR_INT
 791  */
 792         ;
 793
 794 %%
 795
 796 /* Take care of parsing a number (anything that starts with a digit).
 797    Set yylval and return the token type; update lexptr.
 798    LEN is the number of characters in it.  */
 799
 800 /*** Needs some error checking for the float case ***/
 801
 802 static int
 803 parse_number (struct parser_state *par_state,
 804               const char *p, int len, int parsed_float, YYSTYPE *putithere)
 805 {
 806   ULONGEST n = 0;
 807   ULONGEST prevn = 0;
 808   ULONGEST un;
 809
 810   int i = 0;
 811   int c;
 812   int base = input_radix;
 813   int unsigned_p = 0;
 814
 815   /* Number of "L" suffixes encountered.  */
 816   int long_p = 0;
 817
 818   /* We have found a "L" or "U" suffix.  */
 819   int found_suffix = 0;
 820
 821   ULONGEST high_bit;
 822   struct type *signed_type;
 823   struct type *unsigned_type;
 824
 825   if (parsed_float)
 826     {
 827       /* Handle suffixes: 'f' for float, 'l' for long double.
 828          FIXME: This appears to be an extension -- do we want this?  */
 829       if (len >= 1 && tolower (p[len - 1]) == 'f')
 830         {
 831           putithere->typed_val_float.type
 832             = parse_type (par_state)->builtin_float;
 833           len--;
 834         }
 835       else if (len >= 1 && tolower (p[len - 1]) == 'l')
 836         {
 837           putithere->typed_val_float.type
 838             = parse_type (par_state)->builtin_long_double;
 839           len--;
 840         }
 841       /* Default type for floating-point literals is double.  */
 842       else
 843         {
 844           putithere->typed_val_float.type
 845             = parse_type (par_state)->builtin_double;
 846         }
 847
 848       if (!parse_float (p, len,
 849                         putithere->typed_val_float.type,
 850                         putithere->typed_val_float.val))
 851         return ERROR;
 852       return FLOAT;
 853     }
 854
 855   /* Handle base-switching prefixes 0x, 0t, 0d, 0.  */
 856   if (p[0] == '0' && len > 1)
 857     switch (p[1])
 858       {
 859       case 'x':
 860       case 'X':
 861         if (len >= 3)
 862           {
 863             p += 2;
 864             base = 16;
 865             len -= 2;
 866           }
 867         break;
 868
 869       case 't':
 870       case 'T':
 871       case 'd':
 872       case 'D':
 873         if (len >= 3)
 874           {
 875             p += 2;
 876             base = 10;
 877             len -= 2;
 878           }
 879         break;
 880
 881       default:
 882         base = 8;
 883         break;
 884       }
 885
 886   while (len-- > 0)
 887     {
 888       c = *p++;
 889       if (c >= 'A' && c <= 'Z')
 890         c += 'a' - 'A';
 891       if (c != 'l' && c != 'u')
 892         n *= base;
 893       if (c >= '0' && c <= '9')
 894         {
 895           if (found_suffix)
 896             return ERROR;
 897           n += i = c - '0';
 898         }
 899       else
 900         {
 901           if (base > 10 && c >= 'a' && c <= 'f')
 902             {
 903               if (found_suffix)
 904                 return ERROR;
 905               n += i = c - 'a' + 10;
 906             }
 907           else if (c == 'l')
 908             {
 909               ++long_p;
 910               found_suffix = 1;
 911             }
 912           else if (c == 'u')
 913             {
 914               unsigned_p = 1;
 915               found_suffix = 1;
 916             }
 917           else
 918             return ERROR;       /* Char not a digit */
 919         }
 920       if (i >= base)
 921         return ERROR;           /* Invalid digit in this base.  */
 922
 923       /* Portably test for overflow (only works for nonzero values, so make
 924          a second check for zero).  FIXME: Can't we just make n and prevn
 925          unsigned and avoid this?  */
 926       if (c != 'l' && c != 'u' && (prevn >= n) && n != 0)
 927         unsigned_p = 1;         /* Try something unsigned.  */
 928
 929       /* Portably test for unsigned overflow.
 930          FIXME: This check is wrong; for example it doesn't find overflow
 931          on 0x123456789 when LONGEST is 32 bits.  */
 932       if (c != 'l' && c != 'u' && n != 0)
 933         {
 934           if (unsigned_p && prevn >= n)
 935             error (_("Numeric constant too large."));
 936         }
 937       prevn = n;
 938     }
 939
 940   /* An integer constant is an int, a long, or a long long.  An L
 941      suffix forces it to be long; an LL suffix forces it to be long
 942      long.  If not forced to a larger size, it gets the first type of
 943      the above that it fits in.  To figure out whether it fits, we
 944      shift it right and see whether anything remains.  Note that we
 945      can't shift sizeof (LONGEST) * HOST_CHAR_BIT bits or more in one
 946      operation, because many compilers will warn about such a shift
 947      (which always produces a zero result).  Sometimes gdbarch_int_bit
 948      or gdbarch_long_bit will be that big, sometimes not.  To deal with
 949      the case where it is we just always shift the value more than
 950      once, with fewer bits each time.  */
 951
 952   un = n >> 2;
 953   if (long_p == 0
 954       && (un >> (gdbarch_int_bit (par_state->gdbarch ()) - 2)) == 0)
 955     {
 956       high_bit
 957         = ((ULONGEST)1) << (gdbarch_int_bit (par_state->gdbarch ()) - 1);
 958
 959       /* A large decimal (not hex or octal) constant (between INT_MAX
 960          and UINT_MAX) is a long or unsigned long, according to ANSI,
 961          never an unsigned int, but this code treats it as unsigned
 962          int.  This probably should be fixed.  GCC gives a warning on
 963          such constants.  */
 964
 965       unsigned_type = parse_type (par_state)->builtin_unsigned_int;
 966       signed_type = parse_type (par_state)->builtin_int;
 967     }
 968   else if (long_p <= 1
 969            && (un >> (gdbarch_long_bit (par_state->gdbarch ()) - 2)) == 0)
 970     {
 971       high_bit
 972         = ((ULONGEST)1) << (gdbarch_long_bit (par_state->gdbarch ()) - 1);
 973       unsigned_type = parse_type (par_state)->builtin_unsigned_long;
 974       signed_type = parse_type (par_state)->builtin_long;
 975     }
 976   else
 977     {
 978       int shift;
 979       if (sizeof (ULONGEST) * HOST_CHAR_BIT
 980           < gdbarch_long_long_bit (par_state->gdbarch ()))
 981         /* A long long does not fit in a LONGEST.  */
 982         shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
 983       else
 984         shift = (gdbarch_long_long_bit (par_state->gdbarch ()) - 1);
 985       high_bit = (ULONGEST) 1 << shift;
 986       unsigned_type = parse_type (par_state)->builtin_unsigned_long_long;
 987       signed_type = parse_type (par_state)->builtin_long_long;
 988     }
 989
 990    putithere->typed_val_int.val = n;
 991
 992    /* If the high bit of the worked out type is set then this number
 993       has to be unsigned.  */
 994
 995    if (unsigned_p || (n & high_bit))
 996      {
 997        putithere->typed_val_int.type = unsigned_type;
 998      }
 999    else
1000      {
1001        putithere->typed_val_int.type = signed_type;
1002      }
1003
1004    return INT;
1005 }
1006
1007
1008 struct type_push
1009 {
1010   struct type *stored;
1011   struct type_push *next;
1012 };
1013
1014 static struct type_push *tp_top = NULL;
1015
1016 static void
1017 push_current_type (void)
1018 {
1019   struct type_push *tpnew;
1020   tpnew = (struct type_push *) malloc (sizeof (struct type_push));
1021   tpnew->next = tp_top;
1022   tpnew->stored = current_type;
1023   current_type = NULL;
1024   tp_top = tpnew;
1025 }
1026
1027 static void
1028 pop_current_type (void)
1029 {
1030   struct type_push *tp = tp_top;
1031   if (tp)
1032     {
1033       current_type = tp->stored;
1034       tp_top = tp->next;
1035       free (tp);
1036     }
1037 }
1038
1039 struct token
1040 {
1041   const char *oper;
1042   int token;
1043   enum exp_opcode opcode;
1044 };
1045
1046 static const struct token tokentab3[] =
1047   {
1048     {"shr", RSH, OP_NULL},
1049     {"shl", LSH, OP_NULL},
1050     {"and", ANDAND, OP_NULL},
1051     {"div", DIV, OP_NULL},
1052     {"not", NOT, OP_NULL},
1053     {"mod", MOD, OP_NULL},
1054     {"inc", INCREMENT, OP_NULL},
1055     {"dec", DECREMENT, OP_NULL},
1056     {"xor", XOR, OP_NULL}
1057   };
1058
1059 static const struct token tokentab2[] =
1060   {
1061     {"or", OR, OP_NULL},
1062     {"<>", NOTEQUAL, OP_NULL},
1063     {"<=", LEQ, OP_NULL},
1064     {">=", GEQ, OP_NULL},
1065     {":=", ASSIGN, OP_NULL},
1066     {"::", COLONCOLON, OP_NULL} };
1067
1068 /* Allocate uppercased var: */
1069 /* make an uppercased copy of tokstart.  */
1070 static char *
1071 uptok (const char *tokstart, int namelen)
1072 {
1073   int i;
1074   char *uptokstart = (char *)malloc(namelen+1);
1075   for (i = 0;i <= namelen;i++)
1076     {
1077       if ((tokstart[i]>='a' && tokstart[i]<='z'))
1078         uptokstart[i] = tokstart[i]-('a'-'A');
1079       else
1080         uptokstart[i] = tokstart[i];
1081     }
1082   uptokstart[namelen]='\0';
1083   return uptokstart;
1084 }
1085
1086 /* Read one token, getting characters through lexptr.  */
1087
1088 static int
1089 yylex (void)
1090 {
1091   int c;
1092   int namelen;
1093   const char *tokstart;
1094   char *uptokstart;
1095   const char *tokptr;
1096   int explen, tempbufindex;
1097   static char *tempbuf;
1098   static int tempbufsize;
1099
1100  retry:
1101
1102   pstate->prev_lexptr = pstate->lexptr;
1103
1104   tokstart = pstate->lexptr;
1105   explen = strlen (pstate->lexptr);
1106
1107   /* See if it is a special token of length 3.  */
1108   if (explen > 2)
1109     for (const auto &token : tokentab3)
1110       if (strncasecmp (tokstart, token.oper, 3) == 0
1111           && (!isalpha (token.oper[0]) || explen == 3
1112               || (!isalpha (tokstart[3])
1113                   && !isdigit (tokstart[3]) && tokstart[3] != '_')))
1114         {
1115           pstate->lexptr += 3;
1116           yylval.opcode = token.opcode;
1117           return token.token;
1118         }
1119
1120   /* See if it is a special token of length 2.  */
1121   if (explen > 1)
1122     for (const auto &token : tokentab2)
1123       if (strncasecmp (tokstart, token.oper, 2) == 0
1124           && (!isalpha (token.oper[0]) || explen == 2
1125               || (!isalpha (tokstart[2])
1126                   && !isdigit (tokstart[2]) && tokstart[2] != '_')))
1127         {
1128           pstate->lexptr += 2;
1129           yylval.opcode = token.opcode;
1130           return token.token;
1131         }
1132
1133   switch (c = *tokstart)
1134     {
1135     case 0:
1136       if (search_field && pstate->parse_completion)
1137         return COMPLETE;
1138       else
1139        return 0;
1140
1141     case ' ':
1142     case '\t':
1143     case '\n':
1144       pstate->lexptr++;
1145       goto retry;
1146
1147     case '\'':
1148       /* We either have a character constant ('0' or '\177' for example)
1149          or we have a quoted symbol reference ('foo(int,int)' in object pascal
1150          for example).  */
1151       pstate->lexptr++;
1152       c = *pstate->lexptr++;
1153       if (c == '\\')
1154         c = parse_escape (pstate->gdbarch (), &pstate->lexptr);
1155       else if (c == '\'')
1156         error (_("Empty character constant."));
1157
1158       yylval.typed_val_int.val = c;
1159       yylval.typed_val_int.type = parse_type (pstate)->builtin_char;
1160
1161       c = *pstate->lexptr++;
1162       if (c != '\'')
1163         {
1164           namelen = skip_quoted (tokstart) - tokstart;
1165           if (namelen > 2)
1166             {
1167               pstate->lexptr = tokstart + namelen;
1168               if (pstate->lexptr[-1] != '\'')
1169                 error (_("Unmatched single quote."));
1170               namelen -= 2;
1171               tokstart++;
1172               uptokstart = uptok(tokstart,namelen);
1173               goto tryname;
1174             }
1175           error (_("Invalid character constant."));
1176         }
1177       return INT;
1178
1179     case '(':
1180       paren_depth++;
1181       pstate->lexptr++;
1182       return c;
1183
1184     case ')':
1185       if (paren_depth == 0)
1186         return 0;
1187       paren_depth--;
1188       pstate->lexptr++;
1189       return c;
1190
1191     case ',':
1192       if (pstate->comma_terminates && paren_depth == 0)
1193         return 0;
1194       pstate->lexptr++;
1195       return c;
1196
1197     case '.':
1198       /* Might be a floating point number.  */
1199       if (pstate->lexptr[1] < '0' || pstate->lexptr[1] > '9')
1200         {
1201           goto symbol;          /* Nope, must be a symbol.  */
1202         }
1203
1204       /* FALL THRU.  */
1205
1206     case '0':
1207     case '1':
1208     case '2':
1209     case '3':
1210     case '4':
1211     case '5':
1212     case '6':
1213     case '7':
1214     case '8':
1215     case '9':
1216       {
1217         /* It's a number.  */
1218         int got_dot = 0, got_e = 0, toktype;
1219         const char *p = tokstart;
1220         int hex = input_radix > 10;
1221
1222         if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1223           {
1224             p += 2;
1225             hex = 1;
1226           }
1227         else if (c == '0' && (p[1]=='t' || p[1]=='T'
1228                               || p[1]=='d' || p[1]=='D'))
1229           {
1230             p += 2;
1231             hex = 0;
1232           }
1233
1234         for (;; ++p)
1235           {
1236             /* This test includes !hex because 'e' is a valid hex digit
1237                and thus does not indicate a floating point number when
1238                the radix is hex.  */
1239             if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1240               got_dot = got_e = 1;
1241             /* This test does not include !hex, because a '.' always indicates
1242                a decimal floating point number regardless of the radix.  */
1243             else if (!got_dot && *p == '.')
1244               got_dot = 1;
1245             else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
1246                      && (*p == '-' || *p == '+'))
1247               /* This is the sign of the exponent, not the end of the
1248                  number.  */
1249               continue;
1250             /* We will take any letters or digits.  parse_number will
1251                complain if past the radix, or if L or U are not final.  */
1252             else if ((*p < '0' || *p > '9')
1253                      && ((*p < 'a' || *p > 'z')
1254                                   && (*p < 'A' || *p > 'Z')))
1255               break;
1256           }
1257         toktype = parse_number (pstate, tokstart,
1258                                 p - tokstart, got_dot | got_e, &yylval);
1259         if (toktype == ERROR)
1260           {
1261             char *err_copy = (char *) alloca (p - tokstart + 1);
1262
1263             memcpy (err_copy, tokstart, p - tokstart);
1264             err_copy[p - tokstart] = 0;
1265             error (_("Invalid number \"%s\"."), err_copy);
1266           }
1267         pstate->lexptr = p;
1268         return toktype;
1269       }
1270
1271     case '+':
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     symbol:
1291       pstate->lexptr++;
1292       return c;
1293
1294     case '"':
1295
1296       /* Build the gdb internal form of the input string in tempbuf,
1297          translating any standard C escape forms seen.  Note that the
1298          buffer is null byte terminated *only* for the convenience of
1299          debugging gdb itself and printing the buffer contents when
1300          the buffer contains no embedded nulls.  Gdb does not depend
1301          upon the buffer being null byte terminated, it uses the length
1302          string instead.  This allows gdb to handle C strings (as well
1303          as strings in other languages) with embedded null bytes.  */
1304
1305       tokptr = ++tokstart;
1306       tempbufindex = 0;
1307
1308       do {
1309         /* Grow the static temp buffer if necessary, including allocating
1310            the first one on demand.  */
1311         if (tempbufindex + 1 >= tempbufsize)
1312           {
1313             tempbuf = (char *) realloc (tempbuf, tempbufsize += 64);
1314           }
1315
1316         switch (*tokptr)
1317           {
1318           case '\0':
1319           case '"':
1320             /* Do nothing, loop will terminate.  */
1321             break;
1322           case '\\':
1323             ++tokptr;
1324             c = parse_escape (pstate->gdbarch (), &tokptr);
1325             if (c == -1)
1326               {
1327                 continue;
1328               }
1329             tempbuf[tempbufindex++] = c;
1330             break;
1331           default:
1332             tempbuf[tempbufindex++] = *tokptr++;
1333             break;
1334           }
1335       } while ((*tokptr != '"') && (*tokptr != '\0'));
1336       if (*tokptr++ != '"')
1337         {
1338           error (_("Unterminated string in expression."));
1339         }
1340       tempbuf[tempbufindex] = '\0';     /* See note above.  */
1341       yylval.sval.ptr = tempbuf;
1342       yylval.sval.length = tempbufindex;
1343       pstate->lexptr = tokptr;
1344       return (STRING);
1345     }
1346
1347   if (!(c == '_' || c == '$'
1348         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1349     /* We must have come across a bad character (e.g. ';').  */
1350     error (_("Invalid character '%c' in expression."), c);
1351
1352   /* It's a name.  See how long it is.  */
1353   namelen = 0;
1354   for (c = tokstart[namelen];
1355        (c == '_' || c == '$' || (c >= '0' && c <= '9')
1356         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c == '<');)
1357     {
1358       /* Template parameter lists are part of the name.
1359          FIXME: This mishandles `print $a<4&&$a>3'.  */
1360       if (c == '<')
1361         {
1362           int i = namelen;
1363           int nesting_level = 1;
1364           while (tokstart[++i])
1365             {
1366               if (tokstart[i] == '<')
1367                 nesting_level++;
1368               else if (tokstart[i] == '>')
1369                 {
1370                   if (--nesting_level == 0)
1371                     break;
1372                 }
1373             }
1374           if (tokstart[i] == '>')
1375             namelen = i;
1376           else
1377             break;
1378         }
1379
1380       /* do NOT uppercase internals because of registers !!!  */
1381       c = tokstart[++namelen];
1382     }
1383
1384   uptokstart = uptok(tokstart,namelen);
1385
1386   /* The token "if" terminates the expression and is NOT
1387      removed from the input stream.  */
1388   if (namelen == 2 && uptokstart[0] == 'I' && uptokstart[1] == 'F')
1389     {
1390       free (uptokstart);
1391       return 0;
1392     }
1393
1394   pstate->lexptr += namelen;
1395
1396   tryname:
1397
1398   /* Catch specific keywords.  Should be done with a data structure.  */
1399   switch (namelen)
1400     {
1401     case 6:
1402       if (strcmp (uptokstart, "OBJECT") == 0)
1403         {
1404           free (uptokstart);
1405           return CLASS;
1406         }
1407       if (strcmp (uptokstart, "RECORD") == 0)
1408         {
1409           free (uptokstart);
1410           return STRUCT;
1411         }
1412       if (strcmp (uptokstart, "SIZEOF") == 0)
1413         {
1414           free (uptokstart);
1415           return SIZEOF;
1416         }
1417       break;
1418     case 5:
1419       if (strcmp (uptokstart, "CLASS") == 0)
1420         {
1421           free (uptokstart);
1422           return CLASS;
1423         }
1424       if (strcmp (uptokstart, "FALSE") == 0)
1425         {
1426           yylval.lval = 0;
1427           free (uptokstart);
1428           return FALSEKEYWORD;
1429         }
1430       break;
1431     case 4:
1432       if (strcmp (uptokstart, "TRUE") == 0)
1433         {
1434           yylval.lval = 1;
1435           free (uptokstart);
1436           return TRUEKEYWORD;
1437         }
1438       if (strcmp (uptokstart, "SELF") == 0)
1439         {
1440           /* Here we search for 'this' like
1441              inserted in FPC stabs debug info.  */
1442           static const char this_name[] = "this";
1443
1444           if (lookup_symbol (this_name, pstate->expression_context_block,
1445                              VAR_DOMAIN, NULL).symbol)
1446             {
1447               free (uptokstart);
1448               return THIS;
1449             }
1450         }
1451       break;
1452     default:
1453       break;
1454     }
1455
1456   yylval.sval.ptr = tokstart;
1457   yylval.sval.length = namelen;
1458
1459   if (*tokstart == '$')
1460     {
1461       free (uptokstart);
1462       return DOLLAR_VARIABLE;
1463     }
1464
1465   /* Use token-type BLOCKNAME for symbols that happen to be defined as
1466      functions or symtabs.  If this is not so, then ...
1467      Use token-type TYPENAME for symbols that happen to be defined
1468      currently as names of types; NAME for other symbols.
1469      The caller is not constrained to care about the distinction.  */
1470   {
1471     std::string tmp = copy_name (yylval.sval);
1472     struct symbol *sym;
1473     struct field_of_this_result is_a_field_of_this;
1474     int is_a_field = 0;
1475     int hextype;
1476
1477     is_a_field_of_this.type = NULL;
1478     if (search_field && current_type)
1479       is_a_field = (lookup_struct_elt_type (current_type,
1480                                             tmp.c_str (), 1) != NULL);
1481     if (is_a_field)
1482       sym = NULL;
1483     else
1484       sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1485                            VAR_DOMAIN, &is_a_field_of_this).symbol;
1486     /* second chance uppercased (as Free Pascal does).  */
1487     if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
1488       {
1489        for (int i = 0; i <= namelen; i++)
1490          {
1491            if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1492              tmp[i] -= ('a'-'A');
1493          }
1494        if (search_field && current_type)
1495          is_a_field = (lookup_struct_elt_type (current_type,
1496                                                tmp.c_str (), 1) != NULL);
1497        if (is_a_field)
1498          sym = NULL;
1499        else
1500          sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1501                               VAR_DOMAIN, &is_a_field_of_this).symbol;
1502       }
1503     /* Third chance Capitalized (as GPC does).  */
1504     if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
1505       {
1506        for (int i = 0; i <= namelen; i++)
1507          {
1508            if (i == 0)
1509              {
1510               if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1511                 tmp[i] -= ('a'-'A');
1512              }
1513            else
1514            if ((tmp[i] >= 'A' && tmp[i] <= 'Z'))
1515              tmp[i] -= ('A'-'a');
1516           }
1517        if (search_field && current_type)
1518          is_a_field = (lookup_struct_elt_type (current_type,
1519                                                tmp.c_str (), 1) != NULL);
1520        if (is_a_field)
1521          sym = NULL;
1522        else
1523          sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1524                               VAR_DOMAIN, &is_a_field_of_this).symbol;
1525       }
1526
1527     if (is_a_field || (is_a_field_of_this.type != NULL))
1528       {
1529         tempbuf = (char *) realloc (tempbuf, namelen + 1);
1530         strncpy (tempbuf, tmp.c_str (), namelen);
1531         tempbuf [namelen] = 0;
1532         yylval.sval.ptr = tempbuf;
1533         yylval.sval.length = namelen;
1534         yylval.ssym.sym.symbol = NULL;
1535         yylval.ssym.sym.block = NULL;
1536         free (uptokstart);
1537         yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1538         if (is_a_field)
1539           return FIELDNAME;
1540         else
1541           return NAME;
1542       }
1543     /* Call lookup_symtab, not lookup_partial_symtab, in case there are
1544        no psymtabs (coff, xcoff, or some future change to blow away the
1545        psymtabs once once symbols are read).  */
1546     if ((sym && sym->aclass () == LOC_BLOCK)
1547         || lookup_symtab (tmp.c_str ()))
1548       {
1549         yylval.ssym.sym.symbol = sym;
1550         yylval.ssym.sym.block = NULL;
1551         yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1552         free (uptokstart);
1553         return BLOCKNAME;
1554       }
1555     if (sym && sym->aclass () == LOC_TYPEDEF)
1556         {
1557 #if 1
1558           /* Despite the following flaw, we need to keep this code enabled.
1559              Because we can get called from check_stub_method, if we don't
1560              handle nested types then it screws many operations in any
1561              program which uses nested types.  */
1562           /* In "A::x", if x is a member function of A and there happens
1563              to be a type (nested or not, since the stabs don't make that
1564              distinction) named x, then this code incorrectly thinks we
1565              are dealing with nested types rather than a member function.  */
1566
1567           const char *p;
1568           const char *namestart;
1569           struct symbol *best_sym;
1570
1571           /* Look ahead to detect nested types.  This probably should be
1572              done in the grammar, but trying seemed to introduce a lot
1573              of shift/reduce and reduce/reduce conflicts.  It's possible
1574              that it could be done, though.  Or perhaps a non-grammar, but
1575              less ad hoc, approach would work well.  */
1576
1577           /* Since we do not currently have any way of distinguishing
1578              a nested type from a non-nested one (the stabs don't tell
1579              us whether a type is nested), we just ignore the
1580              containing type.  */
1581
1582           p = pstate->lexptr;
1583           best_sym = sym;
1584           while (1)
1585             {
1586               /* Skip whitespace.  */
1587               while (*p == ' ' || *p == '\t' || *p == '\n')
1588                 ++p;
1589               if (*p == ':' && p[1] == ':')
1590                 {
1591                   /* Skip the `::'.  */
1592                   p += 2;
1593                   /* Skip whitespace.  */
1594                   while (*p == ' ' || *p == '\t' || *p == '\n')
1595                     ++p;
1596                   namestart = p;
1597                   while (*p == '_' || *p == '$' || (*p >= '0' && *p <= '9')
1598                          || (*p >= 'a' && *p <= 'z')
1599                          || (*p >= 'A' && *p <= 'Z'))
1600                     ++p;
1601                   if (p != namestart)
1602                     {
1603                       struct symbol *cur_sym;
1604                       /* As big as the whole rest of the expression, which is
1605                          at least big enough.  */
1606                       char *ncopy
1607                         = (char *) alloca (tmp.size () + strlen (namestart)
1608                                            + 3);
1609                       char *tmp1;
1610
1611                       tmp1 = ncopy;
1612                       memcpy (tmp1, tmp.c_str (), tmp.size ());
1613                       tmp1 += tmp.size ();
1614                       memcpy (tmp1, "::", 2);
1615                       tmp1 += 2;
1616                       memcpy (tmp1, namestart, p - namestart);
1617                       tmp1[p - namestart] = '\0';
1618                       cur_sym
1619                         = lookup_symbol (ncopy,
1620                                          pstate->expression_context_block,
1621                                          VAR_DOMAIN, NULL).symbol;
1622                       if (cur_sym)
1623                         {
1624                           if (cur_sym->aclass () == LOC_TYPEDEF)
1625                             {
1626                               best_sym = cur_sym;
1627                               pstate->lexptr = p;
1628                             }
1629                           else
1630                             break;
1631                         }
1632                       else
1633                         break;
1634                     }
1635                   else
1636                     break;
1637                 }
1638               else
1639                 break;
1640             }
1641
1642           yylval.tsym.type = best_sym->type ();
1643 #else /* not 0 */
1644           yylval.tsym.type = sym->type ();
1645 #endif /* not 0 */
1646           free (uptokstart);
1647           return TYPENAME;
1648         }
1649     yylval.tsym.type
1650       = language_lookup_primitive_type (pstate->language (),
1651                                         pstate->gdbarch (), tmp.c_str ());
1652     if (yylval.tsym.type != NULL)
1653       {
1654         free (uptokstart);
1655         return TYPENAME;
1656       }
1657
1658     /* Input names that aren't symbols but ARE valid hex numbers,
1659        when the input radix permits them, can be names or numbers
1660        depending on the parse.  Note we support radixes > 16 here.  */
1661     if (!sym
1662         && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1663             || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1664       {
1665         YYSTYPE newlval;        /* Its value is ignored.  */
1666         hextype = parse_number (pstate, tokstart, namelen, 0, &newlval);
1667         if (hextype == INT)
1668           {
1669             yylval.ssym.sym.symbol = sym;
1670             yylval.ssym.sym.block = NULL;
1671             yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1672             free (uptokstart);
1673             return NAME_OR_INT;
1674           }
1675       }
1676
1677     free(uptokstart);
1678     /* Any other kind of symbol.  */
1679     yylval.ssym.sym.symbol = sym;
1680     yylval.ssym.sym.block = NULL;
1681     return NAME;
1682   }
1683 }
1684
1685 /* See language.h.  */
1686
1687 int
1688 pascal_language::parser (struct parser_state *par_state) const
1689 {
1690   /* Setting up the parser state.  */
1691   scoped_restore pstate_restore = make_scoped_restore (&pstate);
1692   gdb_assert (par_state != NULL);
1693   pstate = par_state;
1694   paren_depth = 0;
1695
1696   int result = yyparse ();
1697   if (!result)
1698     pstate->set_operation (pstate->pop ());
1699   return result;
1700 }
1701
1702 static void
1703 yyerror (const char *msg)
1704 {
1705   if (pstate->prev_lexptr)
1706     pstate->lexptr = pstate->prev_lexptr;
1707
1708   error (_("A %s in expression, near `%s'."), msg, pstate->lexptr);
1709 }