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