contrib/gdb-6.2.1/gdb/p-exp.y

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