gdb/p-exp.y

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