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