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