contrib/gdb-7/gdb/p-exp.y

   1 /* YACC parser for Pascal expressions, for GDB.
   2    Copyright (C) 2000, 2006, 2007, 2008, 2009, 2010
   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, $1.stoken.length, 0, &val);
 496                           write_exp_elt_opcode (OP_LONG);
 497                           write_exp_elt_type (val.typed_val_int.type);
 498                           current_type = val.typed_val_int.type;
 499                           write_exp_elt_longcst ((LONGEST)val.typed_val_int.val);
 500                           write_exp_elt_opcode (OP_LONG);
 501                         }
 502         ;
 503
 504
 505 exp     :       FLOAT
 506                         { write_exp_elt_opcode (OP_DOUBLE);
 507                           write_exp_elt_type ($1.type);
 508                           current_type = $1.type;
 509                           write_exp_elt_dblcst ($1.dval);
 510                           write_exp_elt_opcode (OP_DOUBLE); }
 511         ;
 512
 513 exp     :       variable
 514         ;
 515
 516 exp     :       VARIABLE
 517                         /* Already written by write_dollar_variable. */
 518         ;
 519
 520 exp     :       SIZEOF '(' type ')'     %prec UNARY
 521                         { write_exp_elt_opcode (OP_LONG);
 522                           write_exp_elt_type (parse_type->builtin_int);
 523                           CHECK_TYPEDEF ($3);
 524                           write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
 525                           write_exp_elt_opcode (OP_LONG); }
 526         ;
 527
 528 exp     :       SIZEOF  '(' exp ')'      %prec UNARY
 529                         { write_exp_elt_opcode (UNOP_SIZEOF); }
 530
 531 exp     :       STRING
 532                         { /* C strings are converted into array constants with
 533                              an explicit null byte added at the end.  Thus
 534                              the array upper bound is the string length.
 535                              There is no such thing in C as a completely empty
 536                              string. */
 537                           char *sp = $1.ptr; int count = $1.length;
 538                           while (count-- > 0)
 539                             {
 540                               write_exp_elt_opcode (OP_LONG);
 541                               write_exp_elt_type (parse_type->builtin_char);
 542                               write_exp_elt_longcst ((LONGEST)(*sp++));
 543                               write_exp_elt_opcode (OP_LONG);
 544                             }
 545                           write_exp_elt_opcode (OP_LONG);
 546                           write_exp_elt_type (parse_type->builtin_char);
 547                           write_exp_elt_longcst ((LONGEST)'\0');
 548                           write_exp_elt_opcode (OP_LONG);
 549                           write_exp_elt_opcode (OP_ARRAY);
 550                           write_exp_elt_longcst ((LONGEST) 0);
 551                           write_exp_elt_longcst ((LONGEST) ($1.length));
 552                           write_exp_elt_opcode (OP_ARRAY); }
 553         ;
 554
 555 /* Object pascal  */
 556 exp     :       THIS
 557                         {
 558                           struct value * this_val;
 559                           struct type * this_type;
 560                           write_exp_elt_opcode (OP_THIS);
 561                           write_exp_elt_opcode (OP_THIS);
 562                           /* we need type of this */
 563                           this_val = value_of_this (0);
 564                           if (this_val)
 565                             this_type = value_type (this_val);
 566                           else
 567                             this_type = NULL;
 568                           if (this_type)
 569                             {
 570                               if (TYPE_CODE (this_type) == TYPE_CODE_PTR)
 571                                 {
 572                                   this_type = TYPE_TARGET_TYPE (this_type);
 573                                   write_exp_elt_opcode (UNOP_IND);
 574                                 }
 575                             }
 576
 577                           current_type = this_type;
 578                         }
 579         ;
 580
 581 /* end of object pascal.  */
 582
 583 block   :       BLOCKNAME
 584                         {
 585                           if ($1.sym != 0)
 586                               $$ = SYMBOL_BLOCK_VALUE ($1.sym);
 587                           else
 588                             {
 589                               struct symtab *tem =
 590                                   lookup_symtab (copy_name ($1.stoken));
 591                               if (tem)
 592                                 $$ = BLOCKVECTOR_BLOCK (BLOCKVECTOR (tem), STATIC_BLOCK);
 593                               else
 594                                 error ("No file or function \"%s\".",
 595                                        copy_name ($1.stoken));
 596                             }
 597                         }
 598         ;
 599
 600 block   :       block COLONCOLON name
 601                         { struct symbol *tem
 602                             = lookup_symbol (copy_name ($3), $1,
 603                                              VAR_DOMAIN, (int *) NULL);
 604                           if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
 605                             error ("No function \"%s\" in specified context.",
 606                                    copy_name ($3));
 607                           $$ = SYMBOL_BLOCK_VALUE (tem); }
 608         ;
 609
 610 variable:       block COLONCOLON name
 611                         { struct symbol *sym;
 612                           sym = lookup_symbol (copy_name ($3), $1,
 613                                                VAR_DOMAIN, (int *) NULL);
 614                           if (sym == 0)
 615                             error ("No symbol \"%s\" in specified context.",
 616                                    copy_name ($3));
 617
 618                           write_exp_elt_opcode (OP_VAR_VALUE);
 619                           /* block_found is set by lookup_symbol.  */
 620                           write_exp_elt_block (block_found);
 621                           write_exp_elt_sym (sym);
 622                           write_exp_elt_opcode (OP_VAR_VALUE); }
 623         ;
 624
 625 qualified_name: typebase COLONCOLON name
 626                         {
 627                           struct type *type = $1;
 628                           if (TYPE_CODE (type) != TYPE_CODE_STRUCT
 629                               && TYPE_CODE (type) != TYPE_CODE_UNION)
 630                             error ("`%s' is not defined as an aggregate type.",
 631                                    TYPE_NAME (type));
 632
 633                           write_exp_elt_opcode (OP_SCOPE);
 634                           write_exp_elt_type (type);
 635                           write_exp_string ($3);
 636                           write_exp_elt_opcode (OP_SCOPE);
 637                         }
 638         ;
 639
 640 variable:       qualified_name
 641         |       COLONCOLON name
 642                         {
 643                           char *name = copy_name ($2);
 644                           struct symbol *sym;
 645                           struct minimal_symbol *msymbol;
 646
 647                           sym =
 648                             lookup_symbol (name, (const struct block *) NULL,
 649                                            VAR_DOMAIN, (int *) NULL);
 650                           if (sym)
 651                             {
 652                               write_exp_elt_opcode (OP_VAR_VALUE);
 653                               write_exp_elt_block (NULL);
 654                               write_exp_elt_sym (sym);
 655                               write_exp_elt_opcode (OP_VAR_VALUE);
 656                               break;
 657                             }
 658
 659                           msymbol = lookup_minimal_symbol (name, NULL, NULL);
 660                           if (msymbol != NULL)
 661                             write_exp_msymbol (msymbol);
 662                           else if (!have_full_symbols () && !have_partial_symbols ())
 663                             error ("No symbol table is loaded.  Use the \"file\" command.");
 664                           else
 665                             error ("No symbol \"%s\" in current context.", name);
 666                         }
 667         ;
 668
 669 variable:       name_not_typename
 670                         { struct symbol *sym = $1.sym;
 671
 672                           if (sym)
 673                             {
 674                               if (symbol_read_needs_frame (sym))
 675                                 {
 676                                   if (innermost_block == 0
 677                                       || contained_in (block_found,
 678                                                        innermost_block))
 679                                     innermost_block = block_found;
 680                                 }
 681
 682                               write_exp_elt_opcode (OP_VAR_VALUE);
 683                               /* We want to use the selected frame, not
 684                                  another more inner frame which happens to
 685                                  be in the same block.  */
 686                               write_exp_elt_block (NULL);
 687                               write_exp_elt_sym (sym);
 688                               write_exp_elt_opcode (OP_VAR_VALUE);
 689                               current_type = sym->type; }
 690                           else if ($1.is_a_field_of_this)
 691                             {
 692                               struct value * this_val;
 693                               struct type * this_type;
 694                               /* Object pascal: it hangs off of `this'.  Must
 695                                  not inadvertently convert from a method call
 696                                  to data ref.  */
 697                               if (innermost_block == 0
 698                                   || contained_in (block_found,
 699                                                    innermost_block))
 700                                 innermost_block = block_found;
 701                               write_exp_elt_opcode (OP_THIS);
 702                               write_exp_elt_opcode (OP_THIS);
 703                               write_exp_elt_opcode (STRUCTOP_PTR);
 704                               write_exp_string ($1.stoken);
 705                               write_exp_elt_opcode (STRUCTOP_PTR);
 706                               /* we need type of this */
 707                               this_val = value_of_this (0);
 708                               if (this_val)
 709                                 this_type = value_type (this_val);
 710                               else
 711                                 this_type = NULL;
 712                               if (this_type)
 713                                 current_type = lookup_struct_elt_type (
 714                                   this_type,
 715                                   copy_name ($1.stoken), 0);
 716                               else
 717                                 current_type = NULL;
 718                             }
 719                           else
 720                             {
 721                               struct minimal_symbol *msymbol;
 722                               char *arg = copy_name ($1.stoken);
 723
 724                               msymbol =
 725                                 lookup_minimal_symbol (arg, NULL, NULL);
 726                               if (msymbol != NULL)
 727                                 write_exp_msymbol (msymbol);
 728                               else if (!have_full_symbols () && !have_partial_symbols ())
 729                                 error ("No symbol table is loaded.  Use the \"file\" command.");
 730                               else
 731                                 error ("No symbol \"%s\" in current context.",
 732                                        copy_name ($1.stoken));
 733                             }
 734                         }
 735         ;
 736
 737
 738 ptype   :       typebase
 739         ;
 740
 741 /* We used to try to recognize more pointer to member types here, but
 742    that didn't work (shift/reduce conflicts meant that these rules never
 743    got executed).  The problem is that
 744      int (foo::bar::baz::bizzle)
 745    is a function type but
 746      int (foo::bar::baz::bizzle::*)
 747    is a pointer to member type.  Stroustrup loses again!  */
 748
 749 type    :       ptype
 750         ;
 751
 752 typebase  /* Implements (approximately): (type-qualifier)* type-specifier */
 753         :       '^' typebase
 754                         { $$ = lookup_pointer_type ($2); }
 755         |       TYPENAME
 756                         { $$ = $1.type; }
 757         |       STRUCT name
 758                         { $$ = lookup_struct (copy_name ($2),
 759                                               expression_context_block); }
 760         |       CLASS name
 761                         { $$ = lookup_struct (copy_name ($2),
 762                                               expression_context_block); }
 763         /* "const" and "volatile" are curently ignored.  A type qualifier
 764            after the type is handled in the ptype rule.  I think these could
 765            be too.  */
 766         ;
 767
 768 name    :       NAME { $$ = $1.stoken; }
 769         |       BLOCKNAME { $$ = $1.stoken; }
 770         |       TYPENAME { $$ = $1.stoken; }
 771         |       NAME_OR_INT  { $$ = $1.stoken; }
 772         ;
 773
 774 name_not_typename :     NAME
 775         |       BLOCKNAME
 776 /* These would be useful if name_not_typename was useful, but it is just
 777    a fake for "variable", so these cause reduce/reduce conflicts because
 778    the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
 779    =exp) or just an exp.  If name_not_typename was ever used in an lvalue
 780    context where only a name could occur, this might be useful.
 781         |       NAME_OR_INT
 782  */
 783         ;
 784
 785 %%
 786
 787 /* Take care of parsing a number (anything that starts with a digit).
 788    Set yylval and return the token type; update lexptr.
 789    LEN is the number of characters in it.  */
 790
 791 /*** Needs some error checking for the float case ***/
 792
 793 static int
 794 parse_number (p, len, parsed_float, putithere)
 795      char *p;
 796      int len;
 797      int parsed_float;
 798      YYSTYPE *putithere;
 799 {
 800   /* FIXME: Shouldn't these be unsigned?  We don't deal with negative values
 801      here, and we do kind of silly things like cast to unsigned.  */
 802   LONGEST n = 0;
 803   LONGEST prevn = 0;
 804   ULONGEST un;
 805
 806   int i = 0;
 807   int c;
 808   int base = input_radix;
 809   int unsigned_p = 0;
 810
 811   /* Number of "L" suffixes encountered.  */
 812   int long_p = 0;
 813
 814   /* We have found a "L" or "U" suffix.  */
 815   int found_suffix = 0;
 816
 817   ULONGEST high_bit;
 818   struct type *signed_type;
 819   struct type *unsigned_type;
 820
 821   if (parsed_float)
 822     {
 823       /* It's a float since it contains a point or an exponent.  */
 824       char c;
 825       int num = 0;      /* number of tokens scanned by scanf */
 826       char saved_char = p[len];
 827
 828       p[len] = 0;       /* null-terminate the token */
 829       num = sscanf (p, "%" DOUBLEST_SCAN_FORMAT "%c",
 830                     &putithere->typed_val_float.dval, &c);
 831       p[len] = saved_char;      /* restore the input stream */
 832       if (num != 1)             /* check scanf found ONLY a float ... */
 833         return ERROR;
 834       /* See if it has `f' or `l' suffix (float or long double).  */
 835
 836       c = tolower (p[len - 1]);
 837
 838       if (c == 'f')
 839         putithere->typed_val_float.type = parse_type->builtin_float;
 840       else if (c == 'l')
 841         putithere->typed_val_float.type = parse_type->builtin_long_double;
 842       else if (isdigit (c) || c == '.')
 843         putithere->typed_val_float.type = parse_type->builtin_double;
 844       else
 845         return ERROR;
 846
 847       return FLOAT;
 848     }
 849
 850   /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
 851   if (p[0] == '0')
 852     switch (p[1])
 853       {
 854       case 'x':
 855       case 'X':
 856         if (len >= 3)
 857           {
 858             p += 2;
 859             base = 16;
 860             len -= 2;
 861           }
 862         break;
 863
 864       case 't':
 865       case 'T':
 866       case 'd':
 867       case 'D':
 868         if (len >= 3)
 869           {
 870             p += 2;
 871             base = 10;
 872             len -= 2;
 873           }
 874         break;
 875
 876       default:
 877         base = 8;
 878         break;
 879       }
 880
 881   while (len-- > 0)
 882     {
 883       c = *p++;
 884       if (c >= 'A' && c <= 'Z')
 885         c += 'a' - 'A';
 886       if (c != 'l' && c != 'u')
 887         n *= base;
 888       if (c >= '0' && c <= '9')
 889         {
 890           if (found_suffix)
 891             return ERROR;
 892           n += i = c - '0';
 893         }
 894       else
 895         {
 896           if (base > 10 && c >= 'a' && c <= 'f')
 897             {
 898               if (found_suffix)
 899                 return ERROR;
 900               n += i = c - 'a' + 10;
 901             }
 902           else if (c == 'l')
 903             {
 904               ++long_p;
 905               found_suffix = 1;
 906             }
 907           else if (c == 'u')
 908             {
 909               unsigned_p = 1;
 910               found_suffix = 1;
 911             }
 912           else
 913             return ERROR;       /* Char not a digit */
 914         }
 915       if (i >= base)
 916         return ERROR;           /* Invalid digit in this base */
 917
 918       /* Portably test for overflow (only works for nonzero values, so make
 919          a second check for zero).  FIXME: Can't we just make n and prevn
 920          unsigned and avoid this?  */
 921       if (c != 'l' && c != 'u' && (prevn >= n) && n != 0)
 922         unsigned_p = 1;         /* Try something unsigned */
 923
 924       /* Portably test for unsigned overflow.
 925          FIXME: This check is wrong; for example it doesn't find overflow
 926          on 0x123456789 when LONGEST is 32 bits.  */
 927       if (c != 'l' && c != 'u' && n != 0)
 928         {
 929           if ((unsigned_p && (ULONGEST) prevn >= (ULONGEST) n))
 930             error ("Numeric constant too large.");
 931         }
 932       prevn = n;
 933     }
 934
 935   /* An integer constant is an int, a long, or a long long.  An L
 936      suffix forces it to be long; an LL suffix forces it to be long
 937      long.  If not forced to a larger size, it gets the first type of
 938      the above that it fits in.  To figure out whether it fits, we
 939      shift it right and see whether anything remains.  Note that we
 940      can't shift sizeof (LONGEST) * HOST_CHAR_BIT bits or more in one
 941      operation, because many compilers will warn about such a shift
 942      (which always produces a zero result).  Sometimes gdbarch_int_bit
 943      or gdbarch_long_bit will be that big, sometimes not.  To deal with
 944      the case where it is we just always shift the value more than
 945      once, with fewer bits each time.  */
 946
 947   un = (ULONGEST)n >> 2;
 948   if (long_p == 0
 949       && (un >> (gdbarch_int_bit (parse_gdbarch) - 2)) == 0)
 950     {
 951       high_bit = ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch) - 1);
 952
 953       /* A large decimal (not hex or octal) constant (between INT_MAX
 954          and UINT_MAX) is a long or unsigned long, according to ANSI,
 955          never an unsigned int, but this code treats it as unsigned
 956          int.  This probably should be fixed.  GCC gives a warning on
 957          such constants.  */
 958
 959       unsigned_type = parse_type->builtin_unsigned_int;
 960       signed_type = parse_type->builtin_int;
 961     }
 962   else if (long_p <= 1
 963            && (un >> (gdbarch_long_bit (parse_gdbarch) - 2)) == 0)
 964     {
 965       high_bit = ((ULONGEST)1) << (gdbarch_long_bit (parse_gdbarch) - 1);
 966       unsigned_type = parse_type->builtin_unsigned_long;
 967       signed_type = parse_type->builtin_long;
 968     }
 969   else
 970     {
 971       int shift;
 972       if (sizeof (ULONGEST) * HOST_CHAR_BIT
 973           < gdbarch_long_long_bit (parse_gdbarch))
 974         /* A long long does not fit in a LONGEST.  */
 975         shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
 976       else
 977         shift = (gdbarch_long_long_bit (parse_gdbarch) - 1);
 978       high_bit = (ULONGEST) 1 << shift;
 979       unsigned_type = parse_type->builtin_unsigned_long_long;
 980       signed_type = parse_type->builtin_long_long;
 981     }
 982
 983    putithere->typed_val_int.val = n;
 984
 985    /* If the high bit of the worked out type is set then this number
 986       has to be unsigned. */
 987
 988    if (unsigned_p || (n & high_bit))
 989      {
 990        putithere->typed_val_int.type = unsigned_type;
 991      }
 992    else
 993      {
 994        putithere->typed_val_int.type = signed_type;
 995      }
 996
 997    return INT;
 998 }
 999
1000
1001 struct type_push
1002 {
1003   struct type *stored;
1004   struct type_push *next;
1005 };
1006
1007 static struct type_push *tp_top = NULL;
1008
1009 static void
1010 push_current_type (void)
1011 {
1012   struct type_push *tpnew;
1013   tpnew = (struct type_push *) malloc (sizeof (struct type_push));
1014   tpnew->next = tp_top;
1015   tpnew->stored = current_type;
1016   current_type = NULL;
1017   tp_top = tpnew;
1018 }
1019
1020 static void
1021 pop_current_type (void)
1022 {
1023   struct type_push *tp = tp_top;
1024   if (tp)
1025     {
1026       current_type = tp->stored;
1027       tp_top = tp->next;
1028       free (tp);
1029     }
1030 }
1031
1032 struct token
1033 {
1034   char *operator;
1035   int token;
1036   enum exp_opcode opcode;
1037 };
1038
1039 static const struct token tokentab3[] =
1040   {
1041     {"shr", RSH, BINOP_END},
1042     {"shl", LSH, BINOP_END},
1043     {"and", ANDAND, BINOP_END},
1044     {"div", DIV, BINOP_END},
1045     {"not", NOT, BINOP_END},
1046     {"mod", MOD, BINOP_END},
1047     {"inc", INCREMENT, BINOP_END},
1048     {"dec", DECREMENT, BINOP_END},
1049     {"xor", XOR, BINOP_END}
1050   };
1051
1052 static const struct token tokentab2[] =
1053   {
1054     {"or", OR, BINOP_END},
1055     {"<>", NOTEQUAL, BINOP_END},
1056     {"<=", LEQ, BINOP_END},
1057     {">=", GEQ, BINOP_END},
1058     {":=", ASSIGN, BINOP_END},
1059     {"::", COLONCOLON, BINOP_END} };
1060
1061 /* Allocate uppercased var */
1062 /* make an uppercased copy of tokstart */
1063 static char * uptok (tokstart, namelen)
1064   char *tokstart;
1065   int namelen;
1066 {
1067   int i;
1068   char *uptokstart = (char *)malloc(namelen+1);
1069   for (i = 0;i <= namelen;i++)
1070     {
1071       if ((tokstart[i]>='a' && tokstart[i]<='z'))
1072         uptokstart[i] = tokstart[i]-('a'-'A');
1073       else
1074         uptokstart[i] = tokstart[i];
1075     }
1076   uptokstart[namelen]='\0';
1077   return uptokstart;
1078 }
1079 /* Read one token, getting characters through lexptr.  */
1080
1081
1082 static int
1083 yylex ()
1084 {
1085   int c;
1086   int namelen;
1087   unsigned int i;
1088   char *tokstart;
1089   char *uptokstart;
1090   char *tokptr;
1091   int explen, tempbufindex;
1092   static char *tempbuf;
1093   static int tempbufsize;
1094
1095  retry:
1096
1097   prev_lexptr = lexptr;
1098
1099   tokstart = lexptr;
1100   explen = strlen (lexptr);
1101   /* See if it is a special token of length 3.  */
1102   if (explen > 2)
1103     for (i = 0; i < sizeof (tokentab3) / sizeof (tokentab3[0]); i++)
1104       if (strncasecmp (tokstart, tokentab3[i].operator, 3) == 0
1105           && (!isalpha (tokentab3[i].operator[0]) || explen == 3
1106               || (!isalpha (tokstart[3]) && !isdigit (tokstart[3]) && tokstart[3] != '_')))
1107         {
1108           lexptr += 3;
1109           yylval.opcode = tokentab3[i].opcode;
1110           return tokentab3[i].token;
1111         }
1112
1113   /* See if it is a special token of length 2.  */
1114   if (explen > 1)
1115   for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
1116       if (strncasecmp (tokstart, tokentab2[i].operator, 2) == 0
1117           && (!isalpha (tokentab2[i].operator[0]) || explen == 2
1118               || (!isalpha (tokstart[2]) && !isdigit (tokstart[2]) && tokstart[2] != '_')))
1119         {
1120           lexptr += 2;
1121           yylval.opcode = tokentab2[i].opcode;
1122           return tokentab2[i].token;
1123         }
1124
1125   switch (c = *tokstart)
1126     {
1127     case 0:
1128       return 0;
1129
1130     case ' ':
1131     case '\t':
1132     case '\n':
1133       lexptr++;
1134       goto retry;
1135
1136     case '\'':
1137       /* We either have a character constant ('0' or '\177' for example)
1138          or we have a quoted symbol reference ('foo(int,int)' in object pascal
1139          for example). */
1140       lexptr++;
1141       c = *lexptr++;
1142       if (c == '\\')
1143         c = parse_escape (parse_gdbarch, &lexptr);
1144       else if (c == '\'')
1145         error ("Empty character constant.");
1146
1147       yylval.typed_val_int.val = c;
1148       yylval.typed_val_int.type = parse_type->builtin_char;
1149
1150       c = *lexptr++;
1151       if (c != '\'')
1152         {
1153           namelen = skip_quoted (tokstart) - tokstart;
1154           if (namelen > 2)
1155             {
1156               lexptr = tokstart + namelen;
1157               if (lexptr[-1] != '\'')
1158                 error ("Unmatched single quote.");
1159               namelen -= 2;
1160               tokstart++;
1161               uptokstart = uptok(tokstart,namelen);
1162               goto tryname;
1163             }
1164           error ("Invalid character constant.");
1165         }
1166       return INT;
1167
1168     case '(':
1169       paren_depth++;
1170       lexptr++;
1171       return c;
1172
1173     case ')':
1174       if (paren_depth == 0)
1175         return 0;
1176       paren_depth--;
1177       lexptr++;
1178       return c;
1179
1180     case ',':
1181       if (comma_terminates && paren_depth == 0)
1182         return 0;
1183       lexptr++;
1184       return c;
1185
1186     case '.':
1187       /* Might be a floating point number.  */
1188       if (lexptr[1] < '0' || lexptr[1] > '9')
1189         goto symbol;            /* Nope, must be a symbol. */
1190       /* FALL THRU into number case.  */
1191
1192     case '0':
1193     case '1':
1194     case '2':
1195     case '3':
1196     case '4':
1197     case '5':
1198     case '6':
1199     case '7':
1200     case '8':
1201     case '9':
1202       {
1203         /* It's a number.  */
1204         int got_dot = 0, got_e = 0, toktype;
1205         char *p = tokstart;
1206         int hex = input_radix > 10;
1207
1208         if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1209           {
1210             p += 2;
1211             hex = 1;
1212           }
1213         else if (c == '0' && (p[1]=='t' || p[1]=='T' || p[1]=='d' || p[1]=='D'))
1214           {
1215             p += 2;
1216             hex = 0;
1217           }
1218
1219         for (;; ++p)
1220           {
1221             /* This test includes !hex because 'e' is a valid hex digit
1222                and thus does not indicate a floating point number when
1223                the radix is hex.  */
1224             if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1225               got_dot = got_e = 1;
1226             /* This test does not include !hex, because a '.' always indicates
1227                a decimal floating point number regardless of the radix.  */
1228             else if (!got_dot && *p == '.')
1229               got_dot = 1;
1230             else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
1231                      && (*p == '-' || *p == '+'))
1232               /* This is the sign of the exponent, not the end of the
1233                  number.  */
1234               continue;
1235             /* We will take any letters or digits.  parse_number will
1236                complain if past the radix, or if L or U are not final.  */
1237             else if ((*p < '0' || *p > '9')
1238                      && ((*p < 'a' || *p > 'z')
1239                                   && (*p < 'A' || *p > 'Z')))
1240               break;
1241           }
1242         toktype = parse_number (tokstart, p - tokstart, got_dot|got_e, &yylval);
1243         if (toktype == ERROR)
1244           {
1245             char *err_copy = (char *) alloca (p - tokstart + 1);
1246
1247             memcpy (err_copy, tokstart, p - tokstart);
1248             err_copy[p - tokstart] = 0;
1249             error ("Invalid number \"%s\".", err_copy);
1250           }
1251         lexptr = p;
1252         return toktype;
1253       }
1254
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     case '}':
1274     symbol:
1275       lexptr++;
1276       return c;
1277
1278     case '"':
1279
1280       /* Build the gdb internal form of the input string in tempbuf,
1281          translating any standard C escape forms seen.  Note that the
1282          buffer is null byte terminated *only* for the convenience of
1283          debugging gdb itself and printing the buffer contents when
1284          the buffer contains no embedded nulls.  Gdb does not depend
1285          upon the buffer being null byte terminated, it uses the length
1286          string instead.  This allows gdb to handle C strings (as well
1287          as strings in other languages) with embedded null bytes */
1288
1289       tokptr = ++tokstart;
1290       tempbufindex = 0;
1291
1292       do {
1293         /* Grow the static temp buffer if necessary, including allocating
1294            the first one on demand. */
1295         if (tempbufindex + 1 >= tempbufsize)
1296           {
1297             tempbuf = (char *) realloc (tempbuf, tempbufsize += 64);
1298           }
1299
1300         switch (*tokptr)
1301           {
1302           case '\0':
1303           case '"':
1304             /* Do nothing, loop will terminate. */
1305             break;
1306           case '\\':
1307             tokptr++;
1308             c = parse_escape (parse_gdbarch, &tokptr);
1309             if (c == -1)
1310               {
1311                 continue;
1312               }
1313             tempbuf[tempbufindex++] = c;
1314             break;
1315           default:
1316             tempbuf[tempbufindex++] = *tokptr++;
1317             break;
1318           }
1319       } while ((*tokptr != '"') && (*tokptr != '\0'));
1320       if (*tokptr++ != '"')
1321         {
1322           error ("Unterminated string in expression.");
1323         }
1324       tempbuf[tempbufindex] = '\0';     /* See note above */
1325       yylval.sval.ptr = tempbuf;
1326       yylval.sval.length = tempbufindex;
1327       lexptr = tokptr;
1328       return (STRING);
1329     }
1330
1331   if (!(c == '_' || c == '$'
1332         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1333     /* We must have come across a bad character (e.g. ';').  */
1334     error ("Invalid character '%c' in expression.", c);
1335
1336   /* It's a name.  See how long it is.  */
1337   namelen = 0;
1338   for (c = tokstart[namelen];
1339        (c == '_' || c == '$' || (c >= '0' && c <= '9')
1340         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c == '<');)
1341     {
1342       /* Template parameter lists are part of the name.
1343          FIXME: This mishandles `print $a<4&&$a>3'.  */
1344       if (c == '<')
1345         {
1346           int i = namelen;
1347           int nesting_level = 1;
1348           while (tokstart[++i])
1349             {
1350               if (tokstart[i] == '<')
1351                 nesting_level++;
1352               else if (tokstart[i] == '>')
1353                 {
1354                   if (--nesting_level == 0)
1355                     break;
1356                 }
1357             }
1358           if (tokstart[i] == '>')
1359             namelen = i;
1360           else
1361             break;
1362         }
1363
1364       /* do NOT uppercase internals because of registers !!! */
1365       c = tokstart[++namelen];
1366     }
1367
1368   uptokstart = uptok(tokstart,namelen);
1369
1370   /* The token "if" terminates the expression and is NOT
1371      removed from the input stream.  */
1372   if (namelen == 2 && uptokstart[0] == 'I' && uptokstart[1] == 'F')
1373     {
1374       free (uptokstart);
1375       return 0;
1376     }
1377
1378   lexptr += namelen;
1379
1380   tryname:
1381
1382   /* Catch specific keywords.  Should be done with a data structure.  */
1383   switch (namelen)
1384     {
1385     case 6:
1386       if (strcmp (uptokstart, "OBJECT") == 0)
1387         {
1388           free (uptokstart);
1389           return CLASS;
1390         }
1391       if (strcmp (uptokstart, "RECORD") == 0)
1392         {
1393           free (uptokstart);
1394           return STRUCT;
1395         }
1396       if (strcmp (uptokstart, "SIZEOF") == 0)
1397         {
1398           free (uptokstart);
1399           return SIZEOF;
1400         }
1401       break;
1402     case 5:
1403       if (strcmp (uptokstart, "CLASS") == 0)
1404         {
1405           free (uptokstart);
1406           return CLASS;
1407         }
1408       if (strcmp (uptokstart, "FALSE") == 0)
1409         {
1410           yylval.lval = 0;
1411           free (uptokstart);
1412           return FALSEKEYWORD;
1413         }
1414       break;
1415     case 4:
1416       if (strcmp (uptokstart, "TRUE") == 0)
1417         {
1418           yylval.lval = 1;
1419           free (uptokstart);
1420           return TRUEKEYWORD;
1421         }
1422       if (strcmp (uptokstart, "SELF") == 0)
1423         {
1424           /* here we search for 'this' like
1425              inserted in FPC stabs debug info */
1426           static const char this_name[] = "this";
1427
1428           if (lookup_symbol (this_name, expression_context_block,
1429                              VAR_DOMAIN, (int *) NULL))
1430             {
1431               free (uptokstart);
1432               return THIS;
1433             }
1434         }
1435       break;
1436     default:
1437       break;
1438     }
1439
1440   yylval.sval.ptr = tokstart;
1441   yylval.sval.length = namelen;
1442
1443   if (*tokstart == '$')
1444     {
1445       /* $ is the normal prefix for pascal hexadecimal values
1446         but this conflicts with the GDB use for debugger variables
1447         so in expression to enter hexadecimal values
1448         we still need to use C syntax with 0xff  */
1449       write_dollar_variable (yylval.sval);
1450       free (uptokstart);
1451       return VARIABLE;
1452     }
1453
1454   /* Use token-type BLOCKNAME for symbols that happen to be defined as
1455      functions or symtabs.  If this is not so, then ...
1456      Use token-type TYPENAME for symbols that happen to be defined
1457      currently as names of types; NAME for other symbols.
1458      The caller is not constrained to care about the distinction.  */
1459   {
1460     char *tmp = copy_name (yylval.sval);
1461     struct symbol *sym;
1462     int is_a_field_of_this = 0;
1463     int is_a_field = 0;
1464     int hextype;
1465
1466
1467     if (search_field && current_type)
1468       is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
1469     if (is_a_field)
1470       sym = NULL;
1471     else
1472       sym = lookup_symbol (tmp, expression_context_block,
1473                            VAR_DOMAIN, &is_a_field_of_this);
1474     /* second chance uppercased (as Free Pascal does).  */
1475     if (!sym && !is_a_field_of_this && !is_a_field)
1476       {
1477        for (i = 0; i <= namelen; i++)
1478          {
1479            if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1480              tmp[i] -= ('a'-'A');
1481          }
1482        if (search_field && current_type)
1483          is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
1484        if (is_a_field)
1485          sym = NULL;
1486        else
1487          sym = lookup_symbol (tmp, expression_context_block,
1488                               VAR_DOMAIN, &is_a_field_of_this);
1489        if (sym || is_a_field_of_this || is_a_field)
1490          for (i = 0; i <= namelen; i++)
1491            {
1492              if ((tokstart[i] >= 'a' && tokstart[i] <= 'z'))
1493                tokstart[i] -= ('a'-'A');
1494            }
1495       }
1496     /* Third chance Capitalized (as GPC does).  */
1497     if (!sym && !is_a_field_of_this && !is_a_field)
1498       {
1499        for (i = 0; i <= namelen; i++)
1500          {
1501            if (i == 0)
1502              {
1503               if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1504                 tmp[i] -= ('a'-'A');
1505              }
1506            else
1507            if ((tmp[i] >= 'A' && tmp[i] <= 'Z'))
1508              tmp[i] -= ('A'-'a');
1509           }
1510        if (search_field && current_type)
1511          is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
1512        if (is_a_field)
1513          sym = NULL;
1514        else
1515          sym = lookup_symbol (tmp, expression_context_block,
1516                               VAR_DOMAIN, &is_a_field_of_this);
1517        if (sym || is_a_field_of_this || is_a_field)
1518           for (i = 0; i <= namelen; i++)
1519             {
1520               if (i == 0)
1521                 {
1522                   if ((tokstart[i] >= 'a' && tokstart[i] <= 'z'))
1523                     tokstart[i] -= ('a'-'A');
1524                 }
1525               else
1526                 if ((tokstart[i] >= 'A' && tokstart[i] <= 'Z'))
1527                   tokstart[i] -= ('A'-'a');
1528             }
1529       }
1530
1531     if (is_a_field)
1532       {
1533         tempbuf = (char *) realloc (tempbuf, namelen + 1);
1534         strncpy (tempbuf, tokstart, namelen); tempbuf [namelen] = 0;
1535         yylval.sval.ptr = tempbuf;
1536         yylval.sval.length = namelen;
1537         free (uptokstart);
1538         return FIELDNAME;
1539       }
1540     /* Call lookup_symtab, not lookup_partial_symtab, in case there are
1541        no psymtabs (coff, xcoff, or some future change to blow away the
1542        psymtabs once once symbols are read).  */
1543     if ((sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1544         || lookup_symtab (tmp))
1545       {
1546         yylval.ssym.sym = sym;
1547         yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1548         free (uptokstart);
1549         return BLOCKNAME;
1550       }
1551     if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1552         {
1553 #if 1
1554           /* Despite the following flaw, we need to keep this code enabled.
1555              Because we can get called from check_stub_method, if we don't
1556              handle nested types then it screws many operations in any
1557              program which uses nested types.  */
1558           /* In "A::x", if x is a member function of A and there happens
1559              to be a type (nested or not, since the stabs don't make that
1560              distinction) named x, then this code incorrectly thinks we
1561              are dealing with nested types rather than a member function.  */
1562
1563           char *p;
1564           char *namestart;
1565           struct symbol *best_sym;
1566
1567           /* Look ahead to detect nested types.  This probably should be
1568              done in the grammar, but trying seemed to introduce a lot
1569              of shift/reduce and reduce/reduce conflicts.  It's possible
1570              that it could be done, though.  Or perhaps a non-grammar, but
1571              less ad hoc, approach would work well.  */
1572
1573           /* Since we do not currently have any way of distinguishing
1574              a nested type from a non-nested one (the stabs don't tell
1575              us whether a type is nested), we just ignore the
1576              containing type.  */
1577
1578           p = lexptr;
1579           best_sym = sym;
1580           while (1)
1581             {
1582               /* Skip whitespace.  */
1583               while (*p == ' ' || *p == '\t' || *p == '\n')
1584                 ++p;
1585               if (*p == ':' && p[1] == ':')
1586                 {
1587                   /* Skip the `::'.  */
1588                   p += 2;
1589                   /* Skip whitespace.  */
1590                   while (*p == ' ' || *p == '\t' || *p == '\n')
1591                     ++p;
1592                   namestart = p;
1593                   while (*p == '_' || *p == '$' || (*p >= '0' && *p <= '9')
1594                          || (*p >= 'a' && *p <= 'z')
1595                          || (*p >= 'A' && *p <= 'Z'))
1596                     ++p;
1597                   if (p != namestart)
1598                     {
1599                       struct symbol *cur_sym;
1600                       /* As big as the whole rest of the expression, which is
1601                          at least big enough.  */
1602                       char *ncopy = alloca (strlen (tmp)+strlen (namestart)+3);
1603                       char *tmp1;
1604
1605                       tmp1 = ncopy;
1606                       memcpy (tmp1, tmp, strlen (tmp));
1607                       tmp1 += strlen (tmp);
1608                       memcpy (tmp1, "::", 2);
1609                       tmp1 += 2;
1610                       memcpy (tmp1, namestart, p - namestart);
1611                       tmp1[p - namestart] = '\0';
1612                       cur_sym = lookup_symbol (ncopy, expression_context_block,
1613                                                VAR_DOMAIN, (int *) NULL);
1614                       if (cur_sym)
1615                         {
1616                           if (SYMBOL_CLASS (cur_sym) == LOC_TYPEDEF)
1617                             {
1618                               best_sym = cur_sym;
1619                               lexptr = p;
1620                             }
1621                           else
1622                             break;
1623                         }
1624                       else
1625                         break;
1626                     }
1627                   else
1628                     break;
1629                 }
1630               else
1631                 break;
1632             }
1633
1634           yylval.tsym.type = SYMBOL_TYPE (best_sym);
1635 #else /* not 0 */
1636           yylval.tsym.type = SYMBOL_TYPE (sym);
1637 #endif /* not 0 */
1638           free (uptokstart);
1639           return TYPENAME;
1640         }
1641     yylval.tsym.type
1642       = language_lookup_primitive_type_by_name (parse_language,
1643                                                 parse_gdbarch, tmp);
1644     if (yylval.tsym.type != NULL)
1645       {
1646         free (uptokstart);
1647         return TYPENAME;
1648       }
1649
1650     /* Input names that aren't symbols but ARE valid hex numbers,
1651        when the input radix permits them, can be names or numbers
1652        depending on the parse.  Note we support radixes > 16 here.  */
1653     if (!sym
1654         && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1655             || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1656       {
1657         YYSTYPE newlval;        /* Its value is ignored.  */
1658         hextype = parse_number (tokstart, namelen, 0, &newlval);
1659         if (hextype == INT)
1660           {
1661             yylval.ssym.sym = sym;
1662             yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1663             free (uptokstart);
1664             return NAME_OR_INT;
1665           }
1666       }
1667
1668     free(uptokstart);
1669     /* Any other kind of symbol */
1670     yylval.ssym.sym = sym;
1671     yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1672     return NAME;
1673   }
1674 }
1675
1676 void
1677 yyerror (msg)
1678      char *msg;
1679 {
1680   if (prev_lexptr)
1681     lexptr = prev_lexptr;
1682
1683   error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
1684 }