gdb/p-exp.y

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