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