gdb/p-exp.y

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