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