gdb/p-exp.y

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