gdb/p-exp.y

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