gdb/p-exp.y

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