gdb/p-exp.y

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