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