gdb/p-exp.y

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