gdb/p-exp.y

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