gdb/p-exp.y

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