gdb/p-exp.y

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