gdb/p-exp.y

   1 /* YACC parser for Pascal expressions, for GDB.
   2    Copyright (C) 2000, 2006, 2007, 2008, 2009 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 "gdb_string.h"
  48 #include <ctype.h>
  49 #include "expression.h"
  50 #include "value.h"
  51 #include "parser-defs.h"
  52 #include "language.h"
  53 #include "p-lang.h"
  54 #include "bfd.h" /* Required by objfiles.h.  */
  55 #include "symfile.h" /* Required by objfiles.h.  */
  56 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
  57 #include "block.h"
  58
  59 #define parse_type builtin_type (parse_gdbarch)
  60
  61 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
  62    as well as gratuitiously global symbol names, so we can have multiple
  63    yacc generated parsers in gdb.  Note that these are only the variables
  64    produced by yacc.  If other parser generators (bison, byacc, etc) produce
  65    additional global names that conflict at link time, then those parser
  66    generators need to be fixed instead of adding those names to this list. */
  67
  68 #define yymaxdepth pascal_maxdepth
  69 #define yyparse pascal_parse
  70 #define yylex   pascal_lex
  71 #define yyerror pascal_error
  72 #define yylval  pascal_lval
  73 #define yychar  pascal_char
  74 #define yydebug pascal_debug
  75 #define yypact  pascal_pact
  76 #define yyr1    pascal_r1
  77 #define yyr2    pascal_r2
  78 #define yydef   pascal_def
  79 #define yychk   pascal_chk
  80 #define yypgo   pascal_pgo
  81 #define yyact   pascal_act
  82 #define yyexca  pascal_exca
  83 #define yyerrflag pascal_errflag
  84 #define yynerrs pascal_nerrs
  85 #define yyps    pascal_ps
  86 #define yypv    pascal_pv
  87 #define yys     pascal_s
  88 #define yy_yys  pascal_yys
  89 #define yystate pascal_state
  90 #define yytmp   pascal_tmp
  91 #define yyv     pascal_v
  92 #define yy_yyv  pascal_yyv
  93 #define yyval   pascal_val
  94 #define yylloc  pascal_lloc
  95 #define yyreds  pascal_reds             /* With YYDEBUG defined */
  96 #define yytoks  pascal_toks             /* With YYDEBUG defined */
  97 #define yyname  pascal_name             /* With YYDEBUG defined */
  98 #define yyrule  pascal_rule             /* With YYDEBUG defined */
  99 #define yylhs   pascal_yylhs
 100 #define yylen   pascal_yylen
 101 #define yydefred pascal_yydefred
 102 #define yydgoto pascal_yydgoto
 103 #define yysindex pascal_yysindex
 104 #define yyrindex pascal_yyrindex
 105 #define yygindex pascal_yygindex
 106 #define yytable  pascal_yytable
 107 #define yycheck  pascal_yycheck
 108
 109 #ifndef YYDEBUG
 110 #define YYDEBUG 1               /* Default to yydebug support */
 111 #endif
 112
 113 #define YYFPRINTF parser_fprintf
 114
 115 int yyparse (void);
 116
 117 static int yylex (void);
 118
 119 void
 120 yyerror (char *);
 121
 122 static char * uptok (char *, int);
 123 %}
 124
 125 /* Although the yacc "value" of an expression is not used,
 126    since the result is stored in the structure being created,
 127    other node types do have values.  */
 128
 129 %union
 130   {
 131     LONGEST lval;
 132     struct {
 133       LONGEST val;
 134       struct type *type;
 135     } typed_val_int;
 136     struct {
 137       DOUBLEST dval;
 138       struct type *type;
 139     } typed_val_float;
 140     struct symbol *sym;
 141     struct type *tval;
 142     struct stoken sval;
 143     struct ttype tsym;
 144     struct symtoken ssym;
 145     int voidval;
 146     struct block *bval;
 147     enum exp_opcode opcode;
 148     struct internalvar *ivar;
 149
 150     struct type **tvec;
 151     int *ivec;
 152   }
 153
 154 %{
 155 /* YYSTYPE gets defined by %union */
 156 static int
 157 parse_number (char *, int, int, YYSTYPE *);
 158
 159 static struct type *current_type;
 160 static int leftdiv_is_integer;
 161 static void push_current_type (void);
 162 static void pop_current_type (void);
 163 static int search_field;
 164 %}
 165
 166 %type <voidval> exp exp1 type_exp start normal_start variable qualified_name
 167 %type <tval> type typebase
 168 /* %type <bval> block */
 169
 170 /* Fancy type parsing.  */
 171 %type <tval> ptype
 172
 173 %token <typed_val_int> INT
 174 %token <typed_val_float> FLOAT
 175
 176 /* Both NAME and TYPENAME tokens represent symbols in the input,
 177    and both convey their data as strings.
 178    But a TYPENAME is a string that happens to be defined as a typedef
 179    or builtin type name (such as int or char)
 180    and a NAME is any other symbol.
 181    Contexts where this distinction is not important can use the
 182    nonterminal "name", which matches either NAME or TYPENAME.  */
 183
 184 %token <sval> STRING
 185 %token <sval> FIELDNAME
 186 %token <ssym> NAME /* BLOCKNAME defined below to give it higher precedence. */
 187 %token <tsym> TYPENAME
 188 %type <sval> name
 189 %type <ssym> name_not_typename
 190
 191 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
 192    but which would parse as a valid number in the current input radix.
 193    E.g. "c" when input_radix==16.  Depending on the parse, it will be
 194    turned into a name or into a number.  */
 195
 196 %token <ssym> NAME_OR_INT
 197
 198 %token STRUCT CLASS SIZEOF COLONCOLON
 199 %token ERROR
 200
 201 /* Special type cases, put in to allow the parser to distinguish different
 202    legal basetypes.  */
 203
 204 %token <voidval> VARIABLE
 205
 206
 207 /* Object pascal */
 208 %token THIS
 209 %token <lval> TRUEKEYWORD FALSEKEYWORD
 210
 211 %left ','
 212 %left ABOVE_COMMA
 213 %right ASSIGN
 214 %left NOT
 215 %left OR
 216 %left XOR
 217 %left ANDAND
 218 %left '=' NOTEQUAL
 219 %left '<' '>' LEQ GEQ
 220 %left LSH RSH DIV MOD
 221 %left '@'
 222 %left '+' '-'
 223 %left '*' '/'
 224 %right UNARY INCREMENT DECREMENT
 225 %right ARROW '.' '[' '('
 226 %left '^'
 227 %token <ssym> BLOCKNAME
 228 %type <bval> block
 229 %left COLONCOLON
 230
 231 \f
 232 %%
 233
 234 start   :       { current_type = NULL;
 235                   search_field = 0;
 236                   leftdiv_is_integer = 0;
 237                 }
 238                 normal_start {}
 239         ;
 240
 241 normal_start    :
 242                 exp1
 243         |       type_exp
 244         ;
 245
 246 type_exp:       type
 247                         { write_exp_elt_opcode(OP_TYPE);
 248                           write_exp_elt_type($1);
 249                           write_exp_elt_opcode(OP_TYPE);
 250                           current_type = $1; } ;
 251
 252 /* Expressions, including the comma operator.  */
 253 exp1    :       exp
 254         |       exp1 ',' exp
 255                         { write_exp_elt_opcode (BINOP_COMMA); }
 256         ;
 257
 258 /* Expressions, not including the comma operator.  */
 259 exp     :       exp '^'   %prec UNARY
 260                         { write_exp_elt_opcode (UNOP_IND);
 261                           if (current_type)
 262                             current_type = TYPE_TARGET_TYPE (current_type); }
 263         ;
 264
 265 exp     :       '@' exp    %prec UNARY
 266                         { write_exp_elt_opcode (UNOP_ADDR);
 267                           if (current_type)
 268                             current_type = TYPE_POINTER_TYPE (current_type); }
 269         ;
 270
 271 exp     :       '-' exp    %prec UNARY
 272                         { write_exp_elt_opcode (UNOP_NEG); }
 273         ;
 274
 275 exp     :       NOT exp    %prec UNARY
 276                         { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
 277         ;
 278
 279 exp     :       INCREMENT '(' exp ')'   %prec UNARY
 280                         { write_exp_elt_opcode (UNOP_PREINCREMENT); }
 281         ;
 282
 283 exp     :       DECREMENT  '(' exp ')'   %prec UNARY
 284                         { write_exp_elt_opcode (UNOP_PREDECREMENT); }
 285         ;
 286
 287 exp     :       exp '.' { search_field = 1; }
 288                 FIELDNAME
 289                 /* name */
 290                         { write_exp_elt_opcode (STRUCTOP_STRUCT);
 291                           write_exp_string ($4);
 292                           write_exp_elt_opcode (STRUCTOP_STRUCT);
 293                           search_field = 0;
 294                           if (current_type)
 295                             { while (TYPE_CODE (current_type) == TYPE_CODE_PTR)
 296                                 current_type = TYPE_TARGET_TYPE (current_type);
 297                               current_type = lookup_struct_elt_type (
 298                                 current_type, $4.ptr, 0); };
 299                          } ;
 300 exp     :       exp '['
 301                         /* We need to save the current_type value */
 302                         { char *arrayname;
 303                           int arrayfieldindex;
 304                           arrayfieldindex = is_pascal_string_type (
 305                                 current_type, NULL, NULL,
 306                                 NULL, NULL, &arrayname);
 307                           if (arrayfieldindex)
 308                             {
 309                               struct stoken stringsval;
 310                               stringsval.ptr = alloca (strlen (arrayname) + 1);
 311                               stringsval.length = strlen (arrayname);
 312                               strcpy (stringsval.ptr, arrayname);
 313                               current_type = TYPE_FIELD_TYPE (current_type,
 314                                 arrayfieldindex - 1);
 315                               write_exp_elt_opcode (STRUCTOP_STRUCT);
 316                               write_exp_string (stringsval);
 317                               write_exp_elt_opcode (STRUCTOP_STRUCT);
 318                             }
 319                           push_current_type ();  }
 320                 exp1 ']'
 321                         { pop_current_type ();
 322                           write_exp_elt_opcode (BINOP_SUBSCRIPT);
 323                           if (current_type)
 324                             current_type = TYPE_TARGET_TYPE (current_type); }
 325         ;
 326
 327 exp     :       exp '('
 328                         /* This is to save the value of arglist_len
 329                            being accumulated by an outer function call.  */
 330                         { push_current_type ();
 331                           start_arglist (); }
 332                 arglist ')'     %prec ARROW
 333                         { write_exp_elt_opcode (OP_FUNCALL);
 334                           write_exp_elt_longcst ((LONGEST) end_arglist ());
 335                           write_exp_elt_opcode (OP_FUNCALL);
 336                           pop_current_type ();
 337                           if (current_type)
 338                             current_type = TYPE_TARGET_TYPE (current_type);
 339                         }
 340         ;
 341
 342 arglist :
 343          | exp
 344                         { arglist_len = 1; }
 345          | arglist ',' exp   %prec ABOVE_COMMA
 346                         { arglist_len++; }
 347         ;
 348
 349 exp     :       type '(' exp ')' %prec UNARY
 350                         { if (current_type)
 351                             {
 352                               /* Allow automatic dereference of classes.  */
 353                               if ((TYPE_CODE (current_type) == TYPE_CODE_PTR)
 354                                   && (TYPE_CODE (TYPE_TARGET_TYPE (current_type)) == TYPE_CODE_CLASS)
 355                                   && (TYPE_CODE ($1) == TYPE_CODE_CLASS))
 356                                 write_exp_elt_opcode (UNOP_IND);
 357                             }
 358                           write_exp_elt_opcode (UNOP_CAST);
 359                           write_exp_elt_type ($1);
 360                           write_exp_elt_opcode (UNOP_CAST);
 361                           current_type = $1; }
 362         ;
 363
 364 exp     :       '(' exp1 ')'
 365                         { }
 366         ;
 367
 368 /* Binary operators in order of decreasing precedence.  */
 369
 370 exp     :       exp '*' exp
 371                         { write_exp_elt_opcode (BINOP_MUL); }
 372         ;
 373
 374 exp     :       exp '/' {
 375                           if (current_type && is_integral_type (current_type))
 376                             leftdiv_is_integer = 1;
 377                         }
 378                 exp
 379                         {
 380                           if (leftdiv_is_integer && current_type
 381                               && is_integral_type (current_type))
 382                             {
 383                               write_exp_elt_opcode (UNOP_CAST);
 384                               write_exp_elt_type (parse_type->builtin_long_double);
 385                               current_type = parse_type->builtin_long_double;
 386                               write_exp_elt_opcode (UNOP_CAST);
 387                               leftdiv_is_integer = 0;
 388                             }
 389
 390                           write_exp_elt_opcode (BINOP_DIV);
 391                         }
 392         ;
 393
 394 exp     :       exp DIV exp
 395                         { write_exp_elt_opcode (BINOP_INTDIV); }
 396         ;
 397
 398 exp     :       exp MOD exp
 399                         { write_exp_elt_opcode (BINOP_REM); }
 400         ;
 401
 402 exp     :       exp '+' exp
 403                         { write_exp_elt_opcode (BINOP_ADD); }
 404         ;
 405
 406 exp     :       exp '-' exp
 407                         { write_exp_elt_opcode (BINOP_SUB); }
 408         ;
 409
 410 exp     :       exp LSH exp
 411                         { write_exp_elt_opcode (BINOP_LSH); }
 412         ;
 413
 414 exp     :       exp RSH exp
 415                         { write_exp_elt_opcode (BINOP_RSH); }
 416         ;
 417
 418 exp     :       exp '=' exp
 419                         { write_exp_elt_opcode (BINOP_EQUAL);
 420                           current_type = parse_type->builtin_bool;
 421                         }
 422         ;
 423
 424 exp     :       exp NOTEQUAL exp
 425                         { write_exp_elt_opcode (BINOP_NOTEQUAL);
 426                           current_type = parse_type->builtin_bool;
 427                         }
 428         ;
 429
 430 exp     :       exp LEQ exp
 431                         { write_exp_elt_opcode (BINOP_LEQ);
 432                           current_type = parse_type->builtin_bool;
 433                         }
 434         ;
 435
 436 exp     :       exp GEQ exp
 437                         { write_exp_elt_opcode (BINOP_GEQ);
 438                           current_type = parse_type->builtin_bool;
 439                         }
 440         ;
 441
 442 exp     :       exp '<' exp
 443                         { write_exp_elt_opcode (BINOP_LESS);
 444                           current_type = parse_type->builtin_bool;
 445                         }
 446         ;
 447
 448 exp     :       exp '>' exp
 449                         { write_exp_elt_opcode (BINOP_GTR);
 450                           current_type = parse_type->builtin_bool;
 451                         }
 452         ;
 453
 454 exp     :       exp ANDAND exp
 455                         { write_exp_elt_opcode (BINOP_BITWISE_AND); }
 456         ;
 457
 458 exp     :       exp XOR exp
 459                         { write_exp_elt_opcode (BINOP_BITWISE_XOR); }
 460         ;
 461
 462 exp     :       exp OR exp
 463                         { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
 464         ;
 465
 466 exp     :       exp ASSIGN exp
 467                         { write_exp_elt_opcode (BINOP_ASSIGN); }
 468         ;
 469
 470 exp     :       TRUEKEYWORD
 471                         { write_exp_elt_opcode (OP_BOOL);
 472                           write_exp_elt_longcst ((LONGEST) $1);
 473                           current_type = parse_type->builtin_bool;
 474                           write_exp_elt_opcode (OP_BOOL); }
 475         ;
 476
 477 exp     :       FALSEKEYWORD
 478                         { write_exp_elt_opcode (OP_BOOL);
 479                           write_exp_elt_longcst ((LONGEST) $1);
 480                           current_type = parse_type->builtin_bool;
 481                           write_exp_elt_opcode (OP_BOOL); }
 482         ;
 483
 484 exp     :       INT
 485                         { write_exp_elt_opcode (OP_LONG);
 486                           write_exp_elt_type ($1.type);
 487                           current_type = $1.type;
 488                           write_exp_elt_longcst ((LONGEST)($1.val));
 489                           write_exp_elt_opcode (OP_LONG); }
 490         ;
 491
 492 exp     :       NAME_OR_INT
 493                         { YYSTYPE val;
 494                           parse_number ($1.stoken.ptr, $1.stoken.length, 0, &val);
 495                           write_exp_elt_opcode (OP_LONG);
 496                           write_exp_elt_type (val.typed_val_int.type);
 497                           current_type = val.typed_val_int.type;
 498                           write_exp_elt_longcst ((LONGEST)val.typed_val_int.val);
 499                           write_exp_elt_opcode (OP_LONG);
 500                         }
 501         ;
 502
 503
 504 exp     :       FLOAT
 505                         { write_exp_elt_opcode (OP_DOUBLE);
 506                           write_exp_elt_type ($1.type);
 507                           current_type = $1.type;
 508                           write_exp_elt_dblcst ($1.dval);
 509                           write_exp_elt_opcode (OP_DOUBLE); }
 510         ;
 511
 512 exp     :       variable
 513         ;
 514
 515 exp     :       VARIABLE
 516                         /* Already written by write_dollar_variable. */
 517         ;
 518
 519 exp     :       SIZEOF '(' type ')'     %prec UNARY
 520                         { write_exp_elt_opcode (OP_LONG);
 521                           write_exp_elt_type (parse_type->builtin_int);
 522                           CHECK_TYPEDEF ($3);
 523                           write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
 524                           write_exp_elt_opcode (OP_LONG); }
 525         ;
 526
 527 exp     :       STRING
 528                         { /* C strings are converted into array constants with
 529                              an explicit null byte added at the end.  Thus
 530                              the array upper bound is the string length.
 531                              There is no such thing in C as a completely empty
 532                              string. */
 533                           char *sp = $1.ptr; int count = $1.length;
 534                           while (count-- > 0)
 535                             {
 536                               write_exp_elt_opcode (OP_LONG);
 537                               write_exp_elt_type (parse_type->builtin_char);
 538                               write_exp_elt_longcst ((LONGEST)(*sp++));
 539                               write_exp_elt_opcode (OP_LONG);
 540                             }
 541                           write_exp_elt_opcode (OP_LONG);
 542                           write_exp_elt_type (parse_type->builtin_char);
 543                           write_exp_elt_longcst ((LONGEST)'\0');
 544                           write_exp_elt_opcode (OP_LONG);
 545                           write_exp_elt_opcode (OP_ARRAY);
 546                           write_exp_elt_longcst ((LONGEST) 0);
 547                           write_exp_elt_longcst ((LONGEST) ($1.length));
 548                           write_exp_elt_opcode (OP_ARRAY); }
 549         ;
 550
 551 /* Object pascal  */
 552 exp     :       THIS
 553                         {
 554                           struct value * this_val;
 555                           struct type * this_type;
 556                           write_exp_elt_opcode (OP_THIS);
 557                           write_exp_elt_opcode (OP_THIS);
 558                           /* we need type of this */
 559                           this_val = value_of_this (0);
 560                           if (this_val)
 561                             this_type = value_type (this_val);
 562                           else
 563                             this_type = NULL;
 564                           if (this_type)
 565                             {
 566                               if (TYPE_CODE (this_type) == TYPE_CODE_PTR)
 567                                 {
 568                                   this_type = TYPE_TARGET_TYPE (this_type);
 569                                   write_exp_elt_opcode (UNOP_IND);
 570                                 }
 571                             }
 572
 573                           current_type = this_type;
 574                         }
 575         ;
 576
 577 /* end of object pascal.  */
 578
 579 block   :       BLOCKNAME
 580                         {
 581                           if ($1.sym != 0)
 582                               $$ = SYMBOL_BLOCK_VALUE ($1.sym);
 583                           else
 584                             {
 585                               struct symtab *tem =
 586                                   lookup_symtab (copy_name ($1.stoken));
 587                               if (tem)
 588                                 $$ = BLOCKVECTOR_BLOCK (BLOCKVECTOR (tem), STATIC_BLOCK);
 589                               else
 590                                 error ("No file or function \"%s\".",
 591                                        copy_name ($1.stoken));
 592                             }
 593                         }
 594         ;
 595
 596 block   :       block COLONCOLON name
 597                         { struct symbol *tem
 598                             = lookup_symbol (copy_name ($3), $1,
 599                                              VAR_DOMAIN, (int *) NULL);
 600                           if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
 601                             error ("No function \"%s\" in specified context.",
 602                                    copy_name ($3));
 603                           $$ = SYMBOL_BLOCK_VALUE (tem); }
 604         ;
 605
 606 variable:       block COLONCOLON name
 607                         { struct symbol *sym;
 608                           sym = lookup_symbol (copy_name ($3), $1,
 609                                                VAR_DOMAIN, (int *) NULL);
 610                           if (sym == 0)
 611                             error ("No symbol \"%s\" in specified context.",
 612                                    copy_name ($3));
 613
 614                           write_exp_elt_opcode (OP_VAR_VALUE);
 615                           /* block_found is set by lookup_symbol.  */
 616                           write_exp_elt_block (block_found);
 617                           write_exp_elt_sym (sym);
 618                           write_exp_elt_opcode (OP_VAR_VALUE); }
 619         ;
 620
 621 qualified_name: typebase COLONCOLON name
 622                         {
 623                           struct type *type = $1;
 624                           if (TYPE_CODE (type) != TYPE_CODE_STRUCT
 625                               && TYPE_CODE (type) != TYPE_CODE_UNION)
 626                             error ("`%s' is not defined as an aggregate type.",
 627                                    TYPE_NAME (type));
 628
 629                           write_exp_elt_opcode (OP_SCOPE);
 630                           write_exp_elt_type (type);
 631                           write_exp_string ($3);
 632                           write_exp_elt_opcode (OP_SCOPE);
 633                         }
 634         ;
 635
 636 variable:       qualified_name
 637         |       COLONCOLON name
 638                         {
 639                           char *name = copy_name ($2);
 640                           struct symbol *sym;
 641                           struct minimal_symbol *msymbol;
 642
 643                           sym =
 644                             lookup_symbol (name, (const struct block *) NULL,
 645                                            VAR_DOMAIN, (int *) NULL);
 646                           if (sym)
 647                             {
 648                               write_exp_elt_opcode (OP_VAR_VALUE);
 649                               write_exp_elt_block (NULL);
 650                               write_exp_elt_sym (sym);
 651                               write_exp_elt_opcode (OP_VAR_VALUE);
 652                               break;
 653                             }
 654
 655                           msymbol = lookup_minimal_symbol (name, NULL, NULL);
 656                           if (msymbol != NULL)
 657                             write_exp_msymbol (msymbol);
 658                           else if (!have_full_symbols () && !have_partial_symbols ())
 659                             error ("No symbol table is loaded.  Use the \"file\" command.");
 660                           else
 661                             error ("No symbol \"%s\" in current context.", name);
 662                         }
 663         ;
 664
 665 variable:       name_not_typename
 666                         { struct symbol *sym = $1.sym;
 667
 668                           if (sym)
 669                             {
 670                               if (symbol_read_needs_frame (sym))
 671                                 {
 672                                   if (innermost_block == 0
 673                                       || contained_in (block_found,
 674                                                        innermost_block))
 675                                     innermost_block = block_found;
 676                                 }
 677
 678                               write_exp_elt_opcode (OP_VAR_VALUE);
 679                               /* We want to use the selected frame, not
 680                                  another more inner frame which happens to
 681                                  be in the same block.  */
 682                               write_exp_elt_block (NULL);
 683                               write_exp_elt_sym (sym);
 684                               write_exp_elt_opcode (OP_VAR_VALUE);
 685                               current_type = sym->type; }
 686                           else if ($1.is_a_field_of_this)
 687                             {
 688                               struct value * this_val;
 689                               struct type * this_type;
 690                               /* Object pascal: it hangs off of `this'.  Must
 691                                  not inadvertently convert from a method call
 692                                  to data ref.  */
 693                               if (innermost_block == 0
 694                                   || contained_in (block_found,
 695                                                    innermost_block))
 696                                 innermost_block = block_found;
 697                               write_exp_elt_opcode (OP_THIS);
 698                               write_exp_elt_opcode (OP_THIS);
 699                               write_exp_elt_opcode (STRUCTOP_PTR);
 700                               write_exp_string ($1.stoken);
 701                               write_exp_elt_opcode (STRUCTOP_PTR);
 702                               /* we need type of this */
 703                               this_val = value_of_this (0);
 704                               if (this_val)
 705                                 this_type = value_type (this_val);
 706                               else
 707                                 this_type = NULL;
 708                               if (this_type)
 709                                 current_type = lookup_struct_elt_type (
 710                                   this_type,
 711                                   copy_name ($1.stoken), 0);
 712                               else
 713                                 current_type = NULL;
 714                             }
 715                           else
 716                             {
 717                               struct minimal_symbol *msymbol;
 718                               char *arg = copy_name ($1.stoken);
 719
 720                               msymbol =
 721                                 lookup_minimal_symbol (arg, NULL, NULL);
 722                               if (msymbol != NULL)
 723                                 write_exp_msymbol (msymbol);
 724                               else if (!have_full_symbols () && !have_partial_symbols ())
 725                                 error ("No symbol table is loaded.  Use the \"file\" command.");
 726                               else
 727                                 error ("No symbol \"%s\" in current context.",
 728                                        copy_name ($1.stoken));
 729                             }
 730                         }
 731         ;
 732
 733
 734 ptype   :       typebase
 735         ;
 736
 737 /* We used to try to recognize more pointer to member types here, but
 738    that didn't work (shift/reduce conflicts meant that these rules never
 739    got executed).  The problem is that
 740      int (foo::bar::baz::bizzle)
 741    is a function type but
 742      int (foo::bar::baz::bizzle::*)
 743    is a pointer to member type.  Stroustrup loses again!  */
 744
 745 type    :       ptype
 746         ;
 747
 748 typebase  /* Implements (approximately): (type-qualifier)* type-specifier */
 749         :       '^' typebase
 750                         { $$ = lookup_pointer_type ($2); }
 751         |       TYPENAME
 752                         { $$ = $1.type; }
 753         |       STRUCT name
 754                         { $$ = lookup_struct (copy_name ($2),
 755                                               expression_context_block); }
 756         |       CLASS name
 757                         { $$ = lookup_struct (copy_name ($2),
 758                                               expression_context_block); }
 759         /* "const" and "volatile" are curently ignored.  A type qualifier
 760            after the type is handled in the ptype rule.  I think these could
 761            be too.  */
 762         ;
 763
 764 name    :       NAME { $$ = $1.stoken; }
 765         |       BLOCKNAME { $$ = $1.stoken; }
 766         |       TYPENAME { $$ = $1.stoken; }
 767         |       NAME_OR_INT  { $$ = $1.stoken; }
 768         ;
 769
 770 name_not_typename :     NAME
 771         |       BLOCKNAME
 772 /* These would be useful if name_not_typename was useful, but it is just
 773    a fake for "variable", so these cause reduce/reduce conflicts because
 774    the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
 775    =exp) or just an exp.  If name_not_typename was ever used in an lvalue
 776    context where only a name could occur, this might be useful.
 777         |       NAME_OR_INT
 778  */
 779         ;
 780
 781 %%
 782
 783 /* Take care of parsing a number (anything that starts with a digit).
 784    Set yylval and return the token type; update lexptr.
 785    LEN is the number of characters in it.  */
 786
 787 /*** Needs some error checking for the float case ***/
 788
 789 static int
 790 parse_number (p, len, parsed_float, putithere)
 791      char *p;
 792      int len;
 793      int parsed_float;
 794      YYSTYPE *putithere;
 795 {
 796   /* FIXME: Shouldn't these be unsigned?  We don't deal with negative values
 797      here, and we do kind of silly things like cast to unsigned.  */
 798   LONGEST n = 0;
 799   LONGEST prevn = 0;
 800   ULONGEST un;
 801
 802   int i = 0;
 803   int c;
 804   int base = input_radix;
 805   int unsigned_p = 0;
 806
 807   /* Number of "L" suffixes encountered.  */
 808   int long_p = 0;
 809
 810   /* We have found a "L" or "U" suffix.  */
 811   int found_suffix = 0;
 812
 813   ULONGEST high_bit;
 814   struct type *signed_type;
 815   struct type *unsigned_type;
 816
 817   if (parsed_float)
 818     {
 819       /* It's a float since it contains a point or an exponent.  */
 820       char c;
 821       int num = 0;      /* number of tokens scanned by scanf */
 822       char saved_char = p[len];
 823
 824       p[len] = 0;       /* null-terminate the token */
 825       num = sscanf (p, "%" DOUBLEST_SCAN_FORMAT "%c",
 826                     &putithere->typed_val_float.dval, &c);
 827       p[len] = saved_char;      /* restore the input stream */
 828       if (num != 1)             /* check scanf found ONLY a float ... */
 829         return ERROR;
 830       /* See if it has `f' or `l' suffix (float or long double).  */
 831
 832       c = tolower (p[len - 1]);
 833
 834       if (c == 'f')
 835         putithere->typed_val_float.type = parse_type->builtin_float;
 836       else if (c == 'l')
 837         putithere->typed_val_float.type = parse_type->builtin_long_double;
 838       else if (isdigit (c) || c == '.')
 839         putithere->typed_val_float.type = parse_type->builtin_double;
 840       else
 841         return ERROR;
 842
 843       return FLOAT;
 844     }
 845
 846   /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
 847   if (p[0] == '0')
 848     switch (p[1])
 849       {
 850       case 'x':
 851       case 'X':
 852         if (len >= 3)
 853           {
 854             p += 2;
 855             base = 16;
 856             len -= 2;
 857           }
 858         break;
 859
 860       case 't':
 861       case 'T':
 862       case 'd':
 863       case 'D':
 864         if (len >= 3)
 865           {
 866             p += 2;
 867             base = 10;
 868             len -= 2;
 869           }
 870         break;
 871
 872       default:
 873         base = 8;
 874         break;
 875       }
 876
 877   while (len-- > 0)
 878     {
 879       c = *p++;
 880       if (c >= 'A' && c <= 'Z')
 881         c += 'a' - 'A';
 882       if (c != 'l' && c != 'u')
 883         n *= base;
 884       if (c >= '0' && c <= '9')
 885         {
 886           if (found_suffix)
 887             return ERROR;
 888           n += i = c - '0';
 889         }
 890       else
 891         {
 892           if (base > 10 && c >= 'a' && c <= 'f')
 893             {
 894               if (found_suffix)
 895                 return ERROR;
 896               n += i = c - 'a' + 10;
 897             }
 898           else if (c == 'l')
 899             {
 900               ++long_p;
 901               found_suffix = 1;
 902             }
 903           else if (c == 'u')
 904             {
 905               unsigned_p = 1;
 906               found_suffix = 1;
 907             }
 908           else
 909             return ERROR;       /* Char not a digit */
 910         }
 911       if (i >= base)
 912         return ERROR;           /* Invalid digit in this base */
 913
 914       /* Portably test for overflow (only works for nonzero values, so make
 915          a second check for zero).  FIXME: Can't we just make n and prevn
 916          unsigned and avoid this?  */
 917       if (c != 'l' && c != 'u' && (prevn >= n) && n != 0)
 918         unsigned_p = 1;         /* Try something unsigned */
 919
 920       /* Portably test for unsigned overflow.
 921          FIXME: This check is wrong; for example it doesn't find overflow
 922          on 0x123456789 when LONGEST is 32 bits.  */
 923       if (c != 'l' && c != 'u' && n != 0)
 924         {
 925           if ((unsigned_p && (ULONGEST) prevn >= (ULONGEST) n))
 926             error ("Numeric constant too large.");
 927         }
 928       prevn = n;
 929     }
 930
 931   /* An integer constant is an int, a long, or a long long.  An L
 932      suffix forces it to be long; an LL suffix forces it to be long
 933      long.  If not forced to a larger size, it gets the first type of
 934      the above that it fits in.  To figure out whether it fits, we
 935      shift it right and see whether anything remains.  Note that we
 936      can't shift sizeof (LONGEST) * HOST_CHAR_BIT bits or more in one
 937      operation, because many compilers will warn about such a shift
 938      (which always produces a zero result).  Sometimes gdbarch_int_bit
 939      or gdbarch_long_bit will be that big, sometimes not.  To deal with
 940      the case where it is we just always shift the value more than
 941      once, with fewer bits each time.  */
 942
 943   un = (ULONGEST)n >> 2;
 944   if (long_p == 0
 945       && (un >> (gdbarch_int_bit (parse_gdbarch) - 2)) == 0)
 946     {
 947       high_bit = ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch) - 1);
 948
 949       /* A large decimal (not hex or octal) constant (between INT_MAX
 950          and UINT_MAX) is a long or unsigned long, according to ANSI,
 951          never an unsigned int, but this code treats it as unsigned
 952          int.  This probably should be fixed.  GCC gives a warning on
 953          such constants.  */
 954
 955       unsigned_type = parse_type->builtin_unsigned_int;
 956       signed_type = parse_type->builtin_int;
 957     }
 958   else if (long_p <= 1
 959            && (un >> (gdbarch_long_bit (parse_gdbarch) - 2)) == 0)
 960     {
 961       high_bit = ((ULONGEST)1) << (gdbarch_long_bit (parse_gdbarch) - 1);
 962       unsigned_type = parse_type->builtin_unsigned_long;
 963       signed_type = parse_type->builtin_long;
 964     }
 965   else
 966     {
 967       int shift;
 968       if (sizeof (ULONGEST) * HOST_CHAR_BIT
 969           < gdbarch_long_long_bit (parse_gdbarch))
 970         /* A long long does not fit in a LONGEST.  */
 971         shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
 972       else
 973         shift = (gdbarch_long_long_bit (parse_gdbarch) - 1);
 974       high_bit = (ULONGEST) 1 << shift;
 975       unsigned_type = parse_type->builtin_unsigned_long_long;
 976       signed_type = parse_type->builtin_long_long;
 977     }
 978
 979    putithere->typed_val_int.val = n;
 980
 981    /* If the high bit of the worked out type is set then this number
 982       has to be unsigned. */
 983
 984    if (unsigned_p || (n & high_bit))
 985      {
 986        putithere->typed_val_int.type = unsigned_type;
 987      }
 988    else
 989      {
 990        putithere->typed_val_int.type = signed_type;
 991      }
 992
 993    return INT;
 994 }
 995
 996
 997 struct type_push
 998 {
 999   struct type *stored;
1000   struct type_push *next;
1001 };
1002
1003 static struct type_push *tp_top = NULL;
1004
1005 static void
1006 push_current_type (void)
1007 {
1008   struct type_push *tpnew;
1009   tpnew = (struct type_push *) malloc (sizeof (struct type_push));
1010   tpnew->next = tp_top;
1011   tpnew->stored = current_type;
1012   current_type = NULL;
1013   tp_top = tpnew;
1014 }
1015
1016 static void
1017 pop_current_type (void)
1018 {
1019   struct type_push *tp = tp_top;
1020   if (tp)
1021     {
1022       current_type = tp->stored;
1023       tp_top = tp->next;
1024       free (tp);
1025     }
1026 }
1027
1028 struct token
1029 {
1030   char *operator;
1031   int token;
1032   enum exp_opcode opcode;
1033 };
1034
1035 static const struct token tokentab3[] =
1036   {
1037     {"shr", RSH, BINOP_END},
1038     {"shl", LSH, BINOP_END},
1039     {"and", ANDAND, BINOP_END},
1040     {"div", DIV, BINOP_END},
1041     {"not", NOT, BINOP_END},
1042     {"mod", MOD, BINOP_END},
1043     {"inc", INCREMENT, BINOP_END},
1044     {"dec", DECREMENT, BINOP_END},
1045     {"xor", XOR, BINOP_END}
1046   };
1047
1048 static const struct token tokentab2[] =
1049   {
1050     {"or", OR, BINOP_END},
1051     {"<>", NOTEQUAL, BINOP_END},
1052     {"<=", LEQ, BINOP_END},
1053     {">=", GEQ, BINOP_END},
1054     {":=", ASSIGN, BINOP_END},
1055     {"::", COLONCOLON, BINOP_END} };
1056
1057 /* Allocate uppercased var */
1058 /* make an uppercased copy of tokstart */
1059 static char * uptok (tokstart, namelen)
1060   char *tokstart;
1061   int namelen;
1062 {
1063   int i;
1064   char *uptokstart = (char *)malloc(namelen+1);
1065   for (i = 0;i <= namelen;i++)
1066     {
1067       if ((tokstart[i]>='a' && tokstart[i]<='z'))
1068         uptokstart[i] = tokstart[i]-('a'-'A');
1069       else
1070         uptokstart[i] = tokstart[i];
1071     }
1072   uptokstart[namelen]='\0';
1073   return uptokstart;
1074 }
1075 /* Read one token, getting characters through lexptr.  */
1076
1077
1078 static int
1079 yylex ()
1080 {
1081   int c;
1082   int namelen;
1083   unsigned int i;
1084   char *tokstart;
1085   char *uptokstart;
1086   char *tokptr;
1087   char *p;
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 (&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 (&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 }