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