gdb/p-exp.y

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