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