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