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 (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 (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   char *tokstart;
1137   char *uptokstart;
1138   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   explen = strlen (lexptr);
1150   tokstart = alloca (explen + 1);
1151   memcpy (tokstart, lexptr, explen + 1);
1152
1153   /* See if it is a special token of length 3.  */
1154   if (explen > 2)
1155     for (i = 0; i < sizeof (tokentab3) / sizeof (tokentab3[0]); i++)
1156       if (strncasecmp (tokstart, tokentab3[i].operator, 3) == 0
1157           && (!isalpha (tokentab3[i].operator[0]) || explen == 3
1158               || (!isalpha (tokstart[3])
1159                   && !isdigit (tokstart[3]) && tokstart[3] != '_')))
1160         {
1161           lexptr += 3;
1162           yylval.opcode = tokentab3[i].opcode;
1163           return tokentab3[i].token;
1164         }
1165
1166   /* See if it is a special token of length 2.  */
1167   if (explen > 1)
1168   for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
1169       if (strncasecmp (tokstart, tokentab2[i].operator, 2) == 0
1170           && (!isalpha (tokentab2[i].operator[0]) || explen == 2
1171               || (!isalpha (tokstart[2])
1172                   && !isdigit (tokstart[2]) && tokstart[2] != '_')))
1173         {
1174           lexptr += 2;
1175           yylval.opcode = tokentab2[i].opcode;
1176           return tokentab2[i].token;
1177         }
1178
1179   switch (c = *tokstart)
1180     {
1181     case 0:
1182       if (saw_structop && search_field)
1183         return COMPLETE;
1184       else
1185        return 0;
1186
1187     case ' ':
1188     case '\t':
1189     case '\n':
1190       lexptr++;
1191       goto retry;
1192
1193     case '\'':
1194       /* We either have a character constant ('0' or '\177' for example)
1195          or we have a quoted symbol reference ('foo(int,int)' in object pascal
1196          for example).  */
1197       lexptr++;
1198       c = *lexptr++;
1199       if (c == '\\')
1200         c = parse_escape (parse_gdbarch, &lexptr);
1201       else if (c == '\'')
1202         error (_("Empty character constant."));
1203
1204       yylval.typed_val_int.val = c;
1205       yylval.typed_val_int.type = parse_type->builtin_char;
1206
1207       c = *lexptr++;
1208       if (c != '\'')
1209         {
1210           namelen = skip_quoted (tokstart) - tokstart;
1211           if (namelen > 2)
1212             {
1213               lexptr = tokstart + namelen;
1214               if (lexptr[-1] != '\'')
1215                 error (_("Unmatched single quote."));
1216               namelen -= 2;
1217               tokstart++;
1218               uptokstart = uptok(tokstart,namelen);
1219               goto tryname;
1220             }
1221           error (_("Invalid character constant."));
1222         }
1223       return INT;
1224
1225     case '(':
1226       paren_depth++;
1227       lexptr++;
1228       return c;
1229
1230     case ')':
1231       if (paren_depth == 0)
1232         return 0;
1233       paren_depth--;
1234       lexptr++;
1235       return c;
1236
1237     case ',':
1238       if (comma_terminates && paren_depth == 0)
1239         return 0;
1240       lexptr++;
1241       return c;
1242
1243     case '.':
1244       /* Might be a floating point number.  */
1245       if (lexptr[1] < '0' || lexptr[1] > '9')
1246         {
1247           if (parse_completion)
1248             last_was_structop = 1;
1249           goto symbol;          /* Nope, must be a symbol.  */
1250         }
1251
1252       /* FALL THRU into number case.  */
1253
1254     case '0':
1255     case '1':
1256     case '2':
1257     case '3':
1258     case '4':
1259     case '5':
1260     case '6':
1261     case '7':
1262     case '8':
1263     case '9':
1264       {
1265         /* It's a number.  */
1266         int got_dot = 0, got_e = 0, toktype;
1267         char *p = tokstart;
1268         int hex = input_radix > 10;
1269
1270         if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1271           {
1272             p += 2;
1273             hex = 1;
1274           }
1275         else if (c == '0' && (p[1]=='t' || p[1]=='T'
1276                               || p[1]=='d' || p[1]=='D'))
1277           {
1278             p += 2;
1279             hex = 0;
1280           }
1281
1282         for (;; ++p)
1283           {
1284             /* This test includes !hex because 'e' is a valid hex digit
1285                and thus does not indicate a floating point number when
1286                the radix is hex.  */
1287             if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1288               got_dot = got_e = 1;
1289             /* This test does not include !hex, because a '.' always indicates
1290                a decimal floating point number regardless of the radix.  */
1291             else if (!got_dot && *p == '.')
1292               got_dot = 1;
1293             else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
1294                      && (*p == '-' || *p == '+'))
1295               /* This is the sign of the exponent, not the end of the
1296                  number.  */
1297               continue;
1298             /* We will take any letters or digits.  parse_number will
1299                complain if past the radix, or if L or U are not final.  */
1300             else if ((*p < '0' || *p > '9')
1301                      && ((*p < 'a' || *p > 'z')
1302                                   && (*p < 'A' || *p > 'Z')))
1303               break;
1304           }
1305         toktype = parse_number (tokstart,
1306                                 p - tokstart, got_dot | got_e, &yylval);
1307         if (toktype == ERROR)
1308           {
1309             char *err_copy = (char *) alloca (p - tokstart + 1);
1310
1311             memcpy (err_copy, tokstart, p - tokstart);
1312             err_copy[p - tokstart] = 0;
1313             error (_("Invalid number \"%s\"."), err_copy);
1314           }
1315         lexptr = p;
1316         return toktype;
1317       }
1318
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     case '}':
1338     symbol:
1339       lexptr++;
1340       return c;
1341
1342     case '"':
1343
1344       /* Build the gdb internal form of the input string in tempbuf,
1345          translating any standard C escape forms seen.  Note that the
1346          buffer is null byte terminated *only* for the convenience of
1347          debugging gdb itself and printing the buffer contents when
1348          the buffer contains no embedded nulls.  Gdb does not depend
1349          upon the buffer being null byte terminated, it uses the length
1350          string instead.  This allows gdb to handle C strings (as well
1351          as strings in other languages) with embedded null bytes.  */
1352
1353       tokptr = ++tokstart;
1354       tempbufindex = 0;
1355
1356       do {
1357         /* Grow the static temp buffer if necessary, including allocating
1358            the first one on demand.  */
1359         if (tempbufindex + 1 >= tempbufsize)
1360           {
1361             tempbuf = (char *) realloc (tempbuf, tempbufsize += 64);
1362           }
1363
1364         switch (*tokptr)
1365           {
1366           case '\0':
1367           case '"':
1368             /* Do nothing, loop will terminate.  */
1369             break;
1370           case '\\':
1371             {
1372               const char *s, *o;
1373
1374               o = s = ++tokptr;
1375               c = parse_escape (parse_gdbarch, &s);
1376               *tokptr += s - o;
1377               if (c == -1)
1378                 {
1379                   continue;
1380                 }
1381               tempbuf[tempbufindex++] = c;
1382             }
1383             break;
1384           default:
1385             tempbuf[tempbufindex++] = *tokptr++;
1386             break;
1387           }
1388       } while ((*tokptr != '"') && (*tokptr != '\0'));
1389       if (*tokptr++ != '"')
1390         {
1391           error (_("Unterminated string in expression."));
1392         }
1393       tempbuf[tempbufindex] = '\0';     /* See note above.  */
1394       yylval.sval.ptr = tempbuf;
1395       yylval.sval.length = tempbufindex;
1396       lexptr = tokptr;
1397       return (STRING);
1398     }
1399
1400   if (!(c == '_' || c == '$'
1401         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1402     /* We must have come across a bad character (e.g. ';').  */
1403     error (_("Invalid character '%c' in expression."), c);
1404
1405   /* It's a name.  See how long it is.  */
1406   namelen = 0;
1407   for (c = tokstart[namelen];
1408        (c == '_' || c == '$' || (c >= '0' && c <= '9')
1409         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c == '<');)
1410     {
1411       /* Template parameter lists are part of the name.
1412          FIXME: This mishandles `print $a<4&&$a>3'.  */
1413       if (c == '<')
1414         {
1415           int i = namelen;
1416           int nesting_level = 1;
1417           while (tokstart[++i])
1418             {
1419               if (tokstart[i] == '<')
1420                 nesting_level++;
1421               else if (tokstart[i] == '>')
1422                 {
1423                   if (--nesting_level == 0)
1424                     break;
1425                 }
1426             }
1427           if (tokstart[i] == '>')
1428             namelen = i;
1429           else
1430             break;
1431         }
1432
1433       /* do NOT uppercase internals because of registers !!!  */
1434       c = tokstart[++namelen];
1435     }
1436
1437   uptokstart = uptok(tokstart,namelen);
1438
1439   /* The token "if" terminates the expression and is NOT
1440      removed from the input stream.  */
1441   if (namelen == 2 && uptokstart[0] == 'I' && uptokstart[1] == 'F')
1442     {
1443       free (uptokstart);
1444       return 0;
1445     }
1446
1447   lexptr += namelen;
1448
1449   tryname:
1450
1451   /* Catch specific keywords.  Should be done with a data structure.  */
1452   switch (namelen)
1453     {
1454     case 6:
1455       if (strcmp (uptokstart, "OBJECT") == 0)
1456         {
1457           free (uptokstart);
1458           return CLASS;
1459         }
1460       if (strcmp (uptokstart, "RECORD") == 0)
1461         {
1462           free (uptokstart);
1463           return STRUCT;
1464         }
1465       if (strcmp (uptokstart, "SIZEOF") == 0)
1466         {
1467           free (uptokstart);
1468           return SIZEOF;
1469         }
1470       break;
1471     case 5:
1472       if (strcmp (uptokstart, "CLASS") == 0)
1473         {
1474           free (uptokstart);
1475           return CLASS;
1476         }
1477       if (strcmp (uptokstart, "FALSE") == 0)
1478         {
1479           yylval.lval = 0;
1480           free (uptokstart);
1481           return FALSEKEYWORD;
1482         }
1483       break;
1484     case 4:
1485       if (strcmp (uptokstart, "TRUE") == 0)
1486         {
1487           yylval.lval = 1;
1488           free (uptokstart);
1489           return TRUEKEYWORD;
1490         }
1491       if (strcmp (uptokstart, "SELF") == 0)
1492         {
1493           /* Here we search for 'this' like
1494              inserted in FPC stabs debug info.  */
1495           static const char this_name[] = "this";
1496
1497           if (lookup_symbol (this_name, expression_context_block,
1498                              VAR_DOMAIN, NULL))
1499             {
1500               free (uptokstart);
1501               return THIS;
1502             }
1503         }
1504       break;
1505     default:
1506       break;
1507     }
1508
1509   yylval.sval.ptr = tokstart;
1510   yylval.sval.length = namelen;
1511
1512   if (*tokstart == '$')
1513     {
1514       char c;
1515       /* $ is the normal prefix for pascal hexadecimal values
1516         but this conflicts with the GDB use for debugger variables
1517         so in expression to enter hexadecimal values
1518         we still need to use C syntax with 0xff  */
1519       write_dollar_variable (yylval.sval);
1520       c = tokstart[namelen];
1521       tokstart[namelen] = 0;
1522       intvar = lookup_only_internalvar (++tokstart);
1523       --tokstart;
1524       tokstart[namelen] = c;
1525       free (uptokstart);
1526       return VARIABLE;
1527     }
1528
1529   /* Use token-type BLOCKNAME for symbols that happen to be defined as
1530      functions or symtabs.  If this is not so, then ...
1531      Use token-type TYPENAME for symbols that happen to be defined
1532      currently as names of types; NAME for other symbols.
1533      The caller is not constrained to care about the distinction.  */
1534   {
1535     char *tmp = copy_name (yylval.sval);
1536     struct symbol *sym;
1537     struct field_of_this_result is_a_field_of_this;
1538     int is_a_field = 0;
1539     int hextype;
1540
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 || parse_completion)
1545       sym = NULL;
1546     else
1547       sym = lookup_symbol (tmp, expression_context_block,
1548                            VAR_DOMAIN, &is_a_field_of_this);
1549     /* second chance uppercased (as Free Pascal does).  */
1550     if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
1551       {
1552        for (i = 0; i <= namelen; i++)
1553          {
1554            if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1555              tmp[i] -= ('a'-'A');
1556          }
1557        if (search_field && current_type)
1558          is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
1559        if (is_a_field || parse_completion)
1560          sym = NULL;
1561        else
1562          sym = lookup_symbol (tmp, expression_context_block,
1563                               VAR_DOMAIN, &is_a_field_of_this);
1564        if (sym || is_a_field_of_this.type != NULL || is_a_field)
1565          for (i = 0; i <= namelen; i++)
1566            {
1567              if ((tokstart[i] >= 'a' && tokstart[i] <= 'z'))
1568                tokstart[i] -= ('a'-'A');
1569            }
1570       }
1571     /* Third chance Capitalized (as GPC does).  */
1572     if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
1573       {
1574        for (i = 0; i <= namelen; i++)
1575          {
1576            if (i == 0)
1577              {
1578               if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1579                 tmp[i] -= ('a'-'A');
1580              }
1581            else
1582            if ((tmp[i] >= 'A' && tmp[i] <= 'Z'))
1583              tmp[i] -= ('A'-'a');
1584           }
1585        if (search_field && current_type)
1586          is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
1587        if (is_a_field || parse_completion)
1588          sym = NULL;
1589        else
1590          sym = lookup_symbol (tmp, expression_context_block,
1591                               VAR_DOMAIN, &is_a_field_of_this);
1592        if (sym || is_a_field_of_this.type != NULL || is_a_field)
1593           for (i = 0; i <= namelen; i++)
1594             {
1595               if (i == 0)
1596                 {
1597                   if ((tokstart[i] >= 'a' && tokstart[i] <= 'z'))
1598                     tokstart[i] -= ('a'-'A');
1599                 }
1600               else
1601                 if ((tokstart[i] >= 'A' && tokstart[i] <= 'Z'))
1602                   tokstart[i] -= ('A'-'a');
1603             }
1604       }
1605
1606     if (is_a_field)
1607       {
1608         tempbuf = (char *) realloc (tempbuf, namelen + 1);
1609         strncpy (tempbuf, tokstart, namelen); tempbuf [namelen] = 0;
1610         yylval.sval.ptr = tempbuf;
1611         yylval.sval.length = namelen;
1612         free (uptokstart);
1613         return FIELDNAME;
1614       }
1615     /* Call lookup_symtab, not lookup_partial_symtab, in case there are
1616        no psymtabs (coff, xcoff, or some future change to blow away the
1617        psymtabs once once symbols are read).  */
1618     if ((sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1619         || lookup_symtab (tmp))
1620       {
1621         yylval.ssym.sym = sym;
1622         yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1623         free (uptokstart);
1624         return BLOCKNAME;
1625       }
1626     if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1627         {
1628 #if 1
1629           /* Despite the following flaw, we need to keep this code enabled.
1630              Because we can get called from check_stub_method, if we don't
1631              handle nested types then it screws many operations in any
1632              program which uses nested types.  */
1633           /* In "A::x", if x is a member function of A and there happens
1634              to be a type (nested or not, since the stabs don't make that
1635              distinction) named x, then this code incorrectly thinks we
1636              are dealing with nested types rather than a member function.  */
1637
1638           const char *p;
1639           const char *namestart;
1640           struct symbol *best_sym;
1641
1642           /* Look ahead to detect nested types.  This probably should be
1643              done in the grammar, but trying seemed to introduce a lot
1644              of shift/reduce and reduce/reduce conflicts.  It's possible
1645              that it could be done, though.  Or perhaps a non-grammar, but
1646              less ad hoc, approach would work well.  */
1647
1648           /* Since we do not currently have any way of distinguishing
1649              a nested type from a non-nested one (the stabs don't tell
1650              us whether a type is nested), we just ignore the
1651              containing type.  */
1652
1653           p = lexptr;
1654           best_sym = sym;
1655           while (1)
1656             {
1657               /* Skip whitespace.  */
1658               while (*p == ' ' || *p == '\t' || *p == '\n')
1659                 ++p;
1660               if (*p == ':' && p[1] == ':')
1661                 {
1662                   /* Skip the `::'.  */
1663                   p += 2;
1664                   /* Skip whitespace.  */
1665                   while (*p == ' ' || *p == '\t' || *p == '\n')
1666                     ++p;
1667                   namestart = p;
1668                   while (*p == '_' || *p == '$' || (*p >= '0' && *p <= '9')
1669                          || (*p >= 'a' && *p <= 'z')
1670                          || (*p >= 'A' && *p <= 'Z'))
1671                     ++p;
1672                   if (p != namestart)
1673                     {
1674                       struct symbol *cur_sym;
1675                       /* As big as the whole rest of the expression, which is
1676                          at least big enough.  */
1677                       char *ncopy = alloca (strlen (tmp)+strlen (namestart)+3);
1678                       char *tmp1;
1679
1680                       tmp1 = ncopy;
1681                       memcpy (tmp1, tmp, strlen (tmp));
1682                       tmp1 += strlen (tmp);
1683                       memcpy (tmp1, "::", 2);
1684                       tmp1 += 2;
1685                       memcpy (tmp1, namestart, p - namestart);
1686                       tmp1[p - namestart] = '\0';
1687                       cur_sym = lookup_symbol (ncopy, expression_context_block,
1688                                                VAR_DOMAIN, NULL);
1689                       if (cur_sym)
1690                         {
1691                           if (SYMBOL_CLASS (cur_sym) == LOC_TYPEDEF)
1692                             {
1693                               best_sym = cur_sym;
1694                               lexptr = p;
1695                             }
1696                           else
1697                             break;
1698                         }
1699                       else
1700                         break;
1701                     }
1702                   else
1703                     break;
1704                 }
1705               else
1706                 break;
1707             }
1708
1709           yylval.tsym.type = SYMBOL_TYPE (best_sym);
1710 #else /* not 0 */
1711           yylval.tsym.type = SYMBOL_TYPE (sym);
1712 #endif /* not 0 */
1713           free (uptokstart);
1714           return TYPENAME;
1715         }
1716     yylval.tsym.type
1717       = language_lookup_primitive_type_by_name (parse_language,
1718                                                 parse_gdbarch, tmp);
1719     if (yylval.tsym.type != NULL)
1720       {
1721         free (uptokstart);
1722         return TYPENAME;
1723       }
1724
1725     /* Input names that aren't symbols but ARE valid hex numbers,
1726        when the input radix permits them, can be names or numbers
1727        depending on the parse.  Note we support radixes > 16 here.  */
1728     if (!sym
1729         && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1730             || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1731       {
1732         YYSTYPE newlval;        /* Its value is ignored.  */
1733         hextype = parse_number (tokstart, namelen, 0, &newlval);
1734         if (hextype == INT)
1735           {
1736             yylval.ssym.sym = sym;
1737             yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1738             free (uptokstart);
1739             return NAME_OR_INT;
1740           }
1741       }
1742
1743     free(uptokstart);
1744     /* Any other kind of symbol.  */
1745     yylval.ssym.sym = sym;
1746     yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1747     return NAME;
1748   }
1749 }
1750
1751 void
1752 yyerror (char *msg)
1753 {
1754   if (prev_lexptr)
1755     lexptr = prev_lexptr;
1756
1757   error (_("A %s in expression, near `%s'."), (msg ? msg : "error"), lexptr);
1758 }