gdb/p-exp.y

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