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