gdb/p-exp.y

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