gdb/p-exp.y

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