gdb/p-exp.y

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