gdb/p-exp.y

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