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