gdb/p-exp.y

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