gdb/p-exp.y

   1 /* YACC parser for Pascal expressions, for GDB.
   2    Copyright (C) 2000-2019 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 static 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> DOLLAR_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     :       DOLLAR_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   const char *tokstart;
1116   char *uptokstart;
1117   const char *tokptr;
1118   int explen, tempbufindex;
1119   static char *tempbuf;
1120   static int tempbufsize;
1121
1122  retry:
1123
1124   prev_lexptr = lexptr;
1125
1126   tokstart = lexptr;
1127   explen = strlen (lexptr);
1128
1129   /* See if it is a special token of length 3.  */
1130   if (explen > 2)
1131     for (int i = 0; i < sizeof (tokentab3) / sizeof (tokentab3[0]); i++)
1132       if (strncasecmp (tokstart, tokentab3[i].oper, 3) == 0
1133           && (!isalpha (tokentab3[i].oper[0]) || explen == 3
1134               || (!isalpha (tokstart[3])
1135                   && !isdigit (tokstart[3]) && tokstart[3] != '_')))
1136         {
1137           lexptr += 3;
1138           yylval.opcode = tokentab3[i].opcode;
1139           return tokentab3[i].token;
1140         }
1141
1142   /* See if it is a special token of length 2.  */
1143   if (explen > 1)
1144   for (int i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
1145       if (strncasecmp (tokstart, tokentab2[i].oper, 2) == 0
1146           && (!isalpha (tokentab2[i].oper[0]) || explen == 2
1147               || (!isalpha (tokstart[2])
1148                   && !isdigit (tokstart[2]) && tokstart[2] != '_')))
1149         {
1150           lexptr += 2;
1151           yylval.opcode = tokentab2[i].opcode;
1152           return tokentab2[i].token;
1153         }
1154
1155   switch (c = *tokstart)
1156     {
1157     case 0:
1158       if (search_field && parse_completion)
1159         return COMPLETE;
1160       else
1161        return 0;
1162
1163     case ' ':
1164     case '\t':
1165     case '\n':
1166       lexptr++;
1167       goto retry;
1168
1169     case '\'':
1170       /* We either have a character constant ('0' or '\177' for example)
1171          or we have a quoted symbol reference ('foo(int,int)' in object pascal
1172          for example).  */
1173       lexptr++;
1174       c = *lexptr++;
1175       if (c == '\\')
1176         c = parse_escape (parse_gdbarch (pstate), &lexptr);
1177       else if (c == '\'')
1178         error (_("Empty character constant."));
1179
1180       yylval.typed_val_int.val = c;
1181       yylval.typed_val_int.type = parse_type (pstate)->builtin_char;
1182
1183       c = *lexptr++;
1184       if (c != '\'')
1185         {
1186           namelen = skip_quoted (tokstart) - tokstart;
1187           if (namelen > 2)
1188             {
1189               lexptr = tokstart + namelen;
1190               if (lexptr[-1] != '\'')
1191                 error (_("Unmatched single quote."));
1192               namelen -= 2;
1193               tokstart++;
1194               uptokstart = uptok(tokstart,namelen);
1195               goto tryname;
1196             }
1197           error (_("Invalid character constant."));
1198         }
1199       return INT;
1200
1201     case '(':
1202       paren_depth++;
1203       lexptr++;
1204       return c;
1205
1206     case ')':
1207       if (paren_depth == 0)
1208         return 0;
1209       paren_depth--;
1210       lexptr++;
1211       return c;
1212
1213     case ',':
1214       if (comma_terminates && paren_depth == 0)
1215         return 0;
1216       lexptr++;
1217       return c;
1218
1219     case '.':
1220       /* Might be a floating point number.  */
1221       if (lexptr[1] < '0' || lexptr[1] > '9')
1222         {
1223           goto symbol;          /* Nope, must be a symbol.  */
1224         }
1225
1226       /* FALL THRU.  */
1227
1228     case '0':
1229     case '1':
1230     case '2':
1231     case '3':
1232     case '4':
1233     case '5':
1234     case '6':
1235     case '7':
1236     case '8':
1237     case '9':
1238       {
1239         /* It's a number.  */
1240         int got_dot = 0, got_e = 0, toktype;
1241         const char *p = tokstart;
1242         int hex = input_radix > 10;
1243
1244         if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1245           {
1246             p += 2;
1247             hex = 1;
1248           }
1249         else if (c == '0' && (p[1]=='t' || p[1]=='T'
1250                               || p[1]=='d' || p[1]=='D'))
1251           {
1252             p += 2;
1253             hex = 0;
1254           }
1255
1256         for (;; ++p)
1257           {
1258             /* This test includes !hex because 'e' is a valid hex digit
1259                and thus does not indicate a floating point number when
1260                the radix is hex.  */
1261             if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1262               got_dot = got_e = 1;
1263             /* This test does not include !hex, because a '.' always indicates
1264                a decimal floating point number regardless of the radix.  */
1265             else if (!got_dot && *p == '.')
1266               got_dot = 1;
1267             else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
1268                      && (*p == '-' || *p == '+'))
1269               /* This is the sign of the exponent, not the end of the
1270                  number.  */
1271               continue;
1272             /* We will take any letters or digits.  parse_number will
1273                complain if past the radix, or if L or U are not final.  */
1274             else if ((*p < '0' || *p > '9')
1275                      && ((*p < 'a' || *p > 'z')
1276                                   && (*p < 'A' || *p > 'Z')))
1277               break;
1278           }
1279         toktype = parse_number (pstate, tokstart,
1280                                 p - tokstart, got_dot | got_e, &yylval);
1281         if (toktype == ERROR)
1282           {
1283             char *err_copy = (char *) alloca (p - tokstart + 1);
1284
1285             memcpy (err_copy, tokstart, p - tokstart);
1286             err_copy[p - tokstart] = 0;
1287             error (_("Invalid number \"%s\"."), err_copy);
1288           }
1289         lexptr = p;
1290         return toktype;
1291       }
1292
1293     case '+':
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     symbol:
1313       lexptr++;
1314       return c;
1315
1316     case '"':
1317
1318       /* Build the gdb internal form of the input string in tempbuf,
1319          translating any standard C escape forms seen.  Note that the
1320          buffer is null byte terminated *only* for the convenience of
1321          debugging gdb itself and printing the buffer contents when
1322          the buffer contains no embedded nulls.  Gdb does not depend
1323          upon the buffer being null byte terminated, it uses the length
1324          string instead.  This allows gdb to handle C strings (as well
1325          as strings in other languages) with embedded null bytes.  */
1326
1327       tokptr = ++tokstart;
1328       tempbufindex = 0;
1329
1330       do {
1331         /* Grow the static temp buffer if necessary, including allocating
1332            the first one on demand.  */
1333         if (tempbufindex + 1 >= tempbufsize)
1334           {
1335             tempbuf = (char *) realloc (tempbuf, tempbufsize += 64);
1336           }
1337
1338         switch (*tokptr)
1339           {
1340           case '\0':
1341           case '"':
1342             /* Do nothing, loop will terminate.  */
1343             break;
1344           case '\\':
1345             ++tokptr;
1346             c = parse_escape (parse_gdbarch (pstate), &tokptr);
1347             if (c == -1)
1348               {
1349                 continue;
1350               }
1351             tempbuf[tempbufindex++] = c;
1352             break;
1353           default:
1354             tempbuf[tempbufindex++] = *tokptr++;
1355             break;
1356           }
1357       } while ((*tokptr != '"') && (*tokptr != '\0'));
1358       if (*tokptr++ != '"')
1359         {
1360           error (_("Unterminated string in expression."));
1361         }
1362       tempbuf[tempbufindex] = '\0';     /* See note above.  */
1363       yylval.sval.ptr = tempbuf;
1364       yylval.sval.length = tempbufindex;
1365       lexptr = tokptr;
1366       return (STRING);
1367     }
1368
1369   if (!(c == '_' || c == '$'
1370         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1371     /* We must have come across a bad character (e.g. ';').  */
1372     error (_("Invalid character '%c' in expression."), c);
1373
1374   /* It's a name.  See how long it is.  */
1375   namelen = 0;
1376   for (c = tokstart[namelen];
1377        (c == '_' || c == '$' || (c >= '0' && c <= '9')
1378         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c == '<');)
1379     {
1380       /* Template parameter lists are part of the name.
1381          FIXME: This mishandles `print $a<4&&$a>3'.  */
1382       if (c == '<')
1383         {
1384           int i = namelen;
1385           int nesting_level = 1;
1386           while (tokstart[++i])
1387             {
1388               if (tokstart[i] == '<')
1389                 nesting_level++;
1390               else if (tokstart[i] == '>')
1391                 {
1392                   if (--nesting_level == 0)
1393                     break;
1394                 }
1395             }
1396           if (tokstart[i] == '>')
1397             namelen = i;
1398           else
1399             break;
1400         }
1401
1402       /* do NOT uppercase internals because of registers !!!  */
1403       c = tokstart[++namelen];
1404     }
1405
1406   uptokstart = uptok(tokstart,namelen);
1407
1408   /* The token "if" terminates the expression and is NOT
1409      removed from the input stream.  */
1410   if (namelen == 2 && uptokstart[0] == 'I' && uptokstart[1] == 'F')
1411     {
1412       free (uptokstart);
1413       return 0;
1414     }
1415
1416   lexptr += namelen;
1417
1418   tryname:
1419
1420   /* Catch specific keywords.  Should be done with a data structure.  */
1421   switch (namelen)
1422     {
1423     case 6:
1424       if (strcmp (uptokstart, "OBJECT") == 0)
1425         {
1426           free (uptokstart);
1427           return CLASS;
1428         }
1429       if (strcmp (uptokstart, "RECORD") == 0)
1430         {
1431           free (uptokstart);
1432           return STRUCT;
1433         }
1434       if (strcmp (uptokstart, "SIZEOF") == 0)
1435         {
1436           free (uptokstart);
1437           return SIZEOF;
1438         }
1439       break;
1440     case 5:
1441       if (strcmp (uptokstart, "CLASS") == 0)
1442         {
1443           free (uptokstart);
1444           return CLASS;
1445         }
1446       if (strcmp (uptokstart, "FALSE") == 0)
1447         {
1448           yylval.lval = 0;
1449           free (uptokstart);
1450           return FALSEKEYWORD;
1451         }
1452       break;
1453     case 4:
1454       if (strcmp (uptokstart, "TRUE") == 0)
1455         {
1456           yylval.lval = 1;
1457           free (uptokstart);
1458           return TRUEKEYWORD;
1459         }
1460       if (strcmp (uptokstart, "SELF") == 0)
1461         {
1462           /* Here we search for 'this' like
1463              inserted in FPC stabs debug info.  */
1464           static const char this_name[] = "this";
1465
1466           if (lookup_symbol (this_name, expression_context_block,
1467                              VAR_DOMAIN, NULL).symbol)
1468             {
1469               free (uptokstart);
1470               return THIS;
1471             }
1472         }
1473       break;
1474     default:
1475       break;
1476     }
1477
1478   yylval.sval.ptr = tokstart;
1479   yylval.sval.length = namelen;
1480
1481   if (*tokstart == '$')
1482     {
1483       char *tmp;
1484
1485       /* $ is the normal prefix for pascal hexadecimal values
1486         but this conflicts with the GDB use for debugger variables
1487         so in expression to enter hexadecimal values
1488         we still need to use C syntax with 0xff  */
1489       write_dollar_variable (pstate, yylval.sval);
1490       tmp = (char *) alloca (namelen + 1);
1491       memcpy (tmp, tokstart, namelen);
1492       tmp[namelen] = '\0';
1493       intvar = lookup_only_internalvar (tmp + 1);
1494       free (uptokstart);
1495       return DOLLAR_VARIABLE;
1496     }
1497
1498   /* Use token-type BLOCKNAME for symbols that happen to be defined as
1499      functions or symtabs.  If this is not so, then ...
1500      Use token-type TYPENAME for symbols that happen to be defined
1501      currently as names of types; NAME for other symbols.
1502      The caller is not constrained to care about the distinction.  */
1503   {
1504     char *tmp = copy_name (yylval.sval);
1505     struct symbol *sym;
1506     struct field_of_this_result is_a_field_of_this;
1507     int is_a_field = 0;
1508     int hextype;
1509
1510     is_a_field_of_this.type = NULL;
1511     if (search_field && current_type)
1512       is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
1513     if (is_a_field)
1514       sym = NULL;
1515     else
1516       sym = lookup_symbol (tmp, expression_context_block,
1517                            VAR_DOMAIN, &is_a_field_of_this).symbol;
1518     /* second chance uppercased (as Free Pascal does).  */
1519     if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
1520       {
1521        for (int i = 0; i <= namelen; i++)
1522          {
1523            if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1524              tmp[i] -= ('a'-'A');
1525          }
1526        if (search_field && current_type)
1527          is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
1528        if (is_a_field)
1529          sym = NULL;
1530        else
1531          sym = lookup_symbol (tmp, expression_context_block,
1532                               VAR_DOMAIN, &is_a_field_of_this).symbol;
1533       }
1534     /* Third chance Capitalized (as GPC does).  */
1535     if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
1536       {
1537        for (int i = 0; i <= namelen; i++)
1538          {
1539            if (i == 0)
1540              {
1541               if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1542                 tmp[i] -= ('a'-'A');
1543              }
1544            else
1545            if ((tmp[i] >= 'A' && tmp[i] <= 'Z'))
1546              tmp[i] -= ('A'-'a');
1547           }
1548        if (search_field && current_type)
1549          is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
1550        if (is_a_field)
1551          sym = NULL;
1552        else
1553          sym = lookup_symbol (tmp, expression_context_block,
1554                               VAR_DOMAIN, &is_a_field_of_this).symbol;
1555       }
1556
1557     if (is_a_field || (is_a_field_of_this.type != NULL))
1558       {
1559         tempbuf = (char *) realloc (tempbuf, namelen + 1);
1560         strncpy (tempbuf, tmp, namelen);
1561         tempbuf [namelen] = 0;
1562         yylval.sval.ptr = tempbuf;
1563         yylval.sval.length = namelen;
1564         yylval.ssym.sym.symbol = NULL;
1565         yylval.ssym.sym.block = NULL;
1566         free (uptokstart);
1567         yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1568         if (is_a_field)
1569           return FIELDNAME;
1570         else
1571           return NAME;
1572       }
1573     /* Call lookup_symtab, not lookup_partial_symtab, in case there are
1574        no psymtabs (coff, xcoff, or some future change to blow away the
1575        psymtabs once once symbols are read).  */
1576     if ((sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1577         || lookup_symtab (tmp))
1578       {
1579         yylval.ssym.sym.symbol = sym;
1580         yylval.ssym.sym.block = NULL;
1581         yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1582         free (uptokstart);
1583         return BLOCKNAME;
1584       }
1585     if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1586         {
1587 #if 1
1588           /* Despite the following flaw, we need to keep this code enabled.
1589              Because we can get called from check_stub_method, if we don't
1590              handle nested types then it screws many operations in any
1591              program which uses nested types.  */
1592           /* In "A::x", if x is a member function of A and there happens
1593              to be a type (nested or not, since the stabs don't make that
1594              distinction) named x, then this code incorrectly thinks we
1595              are dealing with nested types rather than a member function.  */
1596
1597           const char *p;
1598           const char *namestart;
1599           struct symbol *best_sym;
1600
1601           /* Look ahead to detect nested types.  This probably should be
1602              done in the grammar, but trying seemed to introduce a lot
1603              of shift/reduce and reduce/reduce conflicts.  It's possible
1604              that it could be done, though.  Or perhaps a non-grammar, but
1605              less ad hoc, approach would work well.  */
1606
1607           /* Since we do not currently have any way of distinguishing
1608              a nested type from a non-nested one (the stabs don't tell
1609              us whether a type is nested), we just ignore the
1610              containing type.  */
1611
1612           p = lexptr;
1613           best_sym = sym;
1614           while (1)
1615             {
1616               /* Skip whitespace.  */
1617               while (*p == ' ' || *p == '\t' || *p == '\n')
1618                 ++p;
1619               if (*p == ':' && p[1] == ':')
1620                 {
1621                   /* Skip the `::'.  */
1622                   p += 2;
1623                   /* Skip whitespace.  */
1624                   while (*p == ' ' || *p == '\t' || *p == '\n')
1625                     ++p;
1626                   namestart = p;
1627                   while (*p == '_' || *p == '$' || (*p >= '0' && *p <= '9')
1628                          || (*p >= 'a' && *p <= 'z')
1629                          || (*p >= 'A' && *p <= 'Z'))
1630                     ++p;
1631                   if (p != namestart)
1632                     {
1633                       struct symbol *cur_sym;
1634                       /* As big as the whole rest of the expression, which is
1635                          at least big enough.  */
1636                       char *ncopy
1637                         = (char *) alloca (strlen (tmp) + strlen (namestart)
1638                                            + 3);
1639                       char *tmp1;
1640
1641                       tmp1 = ncopy;
1642                       memcpy (tmp1, tmp, strlen (tmp));
1643                       tmp1 += strlen (tmp);
1644                       memcpy (tmp1, "::", 2);
1645                       tmp1 += 2;
1646                       memcpy (tmp1, namestart, p - namestart);
1647                       tmp1[p - namestart] = '\0';
1648                       cur_sym = lookup_symbol (ncopy, expression_context_block,
1649                                                VAR_DOMAIN, NULL).symbol;
1650                       if (cur_sym)
1651                         {
1652                           if (SYMBOL_CLASS (cur_sym) == LOC_TYPEDEF)
1653                             {
1654                               best_sym = cur_sym;
1655                               lexptr = p;
1656                             }
1657                           else
1658                             break;
1659                         }
1660                       else
1661                         break;
1662                     }
1663                   else
1664                     break;
1665                 }
1666               else
1667                 break;
1668             }
1669
1670           yylval.tsym.type = SYMBOL_TYPE (best_sym);
1671 #else /* not 0 */
1672           yylval.tsym.type = SYMBOL_TYPE (sym);
1673 #endif /* not 0 */
1674           free (uptokstart);
1675           return TYPENAME;
1676         }
1677     yylval.tsym.type
1678       = language_lookup_primitive_type (parse_language (pstate),
1679                                         parse_gdbarch (pstate), tmp);
1680     if (yylval.tsym.type != NULL)
1681       {
1682         free (uptokstart);
1683         return TYPENAME;
1684       }
1685
1686     /* Input names that aren't symbols but ARE valid hex numbers,
1687        when the input radix permits them, can be names or numbers
1688        depending on the parse.  Note we support radixes > 16 here.  */
1689     if (!sym
1690         && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1691             || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1692       {
1693         YYSTYPE newlval;        /* Its value is ignored.  */
1694         hextype = parse_number (pstate, tokstart, namelen, 0, &newlval);
1695         if (hextype == INT)
1696           {
1697             yylval.ssym.sym.symbol = sym;
1698             yylval.ssym.sym.block = NULL;
1699             yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1700             free (uptokstart);
1701             return NAME_OR_INT;
1702           }
1703       }
1704
1705     free(uptokstart);
1706     /* Any other kind of symbol.  */
1707     yylval.ssym.sym.symbol = sym;
1708     yylval.ssym.sym.block = NULL;
1709     return NAME;
1710   }
1711 }
1712
1713 int
1714 pascal_parse (struct parser_state *par_state)
1715 {
1716   /* Setting up the parser state.  */
1717   scoped_restore pstate_restore = make_scoped_restore (&pstate);
1718   gdb_assert (par_state != NULL);
1719   pstate = par_state;
1720
1721   return yyparse ();
1722 }
1723
1724 static void
1725 yyerror (const char *msg)
1726 {
1727   if (prev_lexptr)
1728     lexptr = prev_lexptr;
1729
1730   error (_("A %s in expression, near `%s'."), msg, lexptr);
1731 }