gdb/p-exp.y

   1 /* YACC parser for Pascal expressions, for GDB.
   2    Copyright (C) 2000-2017 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                                 {
 713                                   if (innermost_block == 0
 714                                       || contained_in (sym.block,
 715                                                        innermost_block))
 716                                     innermost_block = sym.block;
 717                                 }
 718
 719                               write_exp_elt_opcode (pstate, OP_VAR_VALUE);
 720                               write_exp_elt_block (pstate, sym.block);
 721                               write_exp_elt_sym (pstate, sym.symbol);
 722                               write_exp_elt_opcode (pstate, OP_VAR_VALUE);
 723                               current_type = sym.symbol->type; }
 724                           else if ($1.is_a_field_of_this)
 725                             {
 726                               struct value * this_val;
 727                               struct type * this_type;
 728                               /* Object pascal: it hangs off of `this'.  Must
 729                                  not inadvertently convert from a method call
 730                                  to data ref.  */
 731                               if (innermost_block == 0
 732                                   || contained_in (sym.block,
 733                                                    innermost_block))
 734                                 innermost_block = sym.block;
 735                               write_exp_elt_opcode (pstate, OP_THIS);
 736                               write_exp_elt_opcode (pstate, OP_THIS);
 737                               write_exp_elt_opcode (pstate, STRUCTOP_PTR);
 738                               write_exp_string (pstate, $1.stoken);
 739                               write_exp_elt_opcode (pstate, STRUCTOP_PTR);
 740                               /* We need type of this.  */
 741                               this_val
 742                                 = value_of_this_silent (parse_language (pstate));
 743                               if (this_val)
 744                                 this_type = value_type (this_val);
 745                               else
 746                                 this_type = NULL;
 747                               if (this_type)
 748                                 current_type = lookup_struct_elt_type (
 749                                   this_type,
 750                                   copy_name ($1.stoken), 0);
 751                               else
 752                                 current_type = NULL;
 753                             }
 754                           else
 755                             {
 756                               struct bound_minimal_symbol msymbol;
 757                               char *arg = copy_name ($1.stoken);
 758
 759                               msymbol =
 760                                 lookup_bound_minimal_symbol (arg);
 761                               if (msymbol.minsym != NULL)
 762                                 write_exp_msymbol (pstate, msymbol);
 763                               else if (!have_full_symbols ()
 764                                        && !have_partial_symbols ())
 765                                 error (_("No symbol table is loaded.  "
 766                                        "Use the \"file\" command."));
 767                               else
 768                                 error (_("No symbol \"%s\" in current context."),
 769                                        copy_name ($1.stoken));
 770                             }
 771                         }
 772         ;
 773
 774
 775 ptype   :       typebase
 776         ;
 777
 778 /* We used to try to recognize more pointer to member types here, but
 779    that didn't work (shift/reduce conflicts meant that these rules never
 780    got executed).  The problem is that
 781      int (foo::bar::baz::bizzle)
 782    is a function type but
 783      int (foo::bar::baz::bizzle::*)
 784    is a pointer to member type.  Stroustrup loses again!  */
 785
 786 type    :       ptype
 787         ;
 788
 789 typebase  /* Implements (approximately): (type-qualifier)* type-specifier */
 790         :       '^' typebase
 791                         { $$ = lookup_pointer_type ($2); }
 792         |       TYPENAME
 793                         { $$ = $1.type; }
 794         |       STRUCT name
 795                         { $$ = lookup_struct (copy_name ($2),
 796                                               expression_context_block); }
 797         |       CLASS name
 798                         { $$ = lookup_struct (copy_name ($2),
 799                                               expression_context_block); }
 800         /* "const" and "volatile" are curently ignored.  A type qualifier
 801            after the type is handled in the ptype rule.  I think these could
 802            be too.  */
 803         ;
 804
 805 name    :       NAME { $$ = $1.stoken; }
 806         |       BLOCKNAME { $$ = $1.stoken; }
 807         |       TYPENAME { $$ = $1.stoken; }
 808         |       NAME_OR_INT  { $$ = $1.stoken; }
 809         ;
 810
 811 name_not_typename :     NAME
 812         |       BLOCKNAME
 813 /* These would be useful if name_not_typename was useful, but it is just
 814    a fake for "variable", so these cause reduce/reduce conflicts because
 815    the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
 816    =exp) or just an exp.  If name_not_typename was ever used in an lvalue
 817    context where only a name could occur, this might be useful.
 818         |       NAME_OR_INT
 819  */
 820         ;
 821
 822 %%
 823
 824 /* Take care of parsing a number (anything that starts with a digit).
 825    Set yylval and return the token type; update lexptr.
 826    LEN is the number of characters in it.  */
 827
 828 /*** Needs some error checking for the float case ***/
 829
 830 static int
 831 parse_number (struct parser_state *par_state,
 832               const char *p, int len, int parsed_float, YYSTYPE *putithere)
 833 {
 834   /* FIXME: Shouldn't these be unsigned?  We don't deal with negative values
 835      here, and we do kind of silly things like cast to unsigned.  */
 836   LONGEST n = 0;
 837   LONGEST prevn = 0;
 838   ULONGEST un;
 839
 840   int i = 0;
 841   int c;
 842   int base = input_radix;
 843   int unsigned_p = 0;
 844
 845   /* Number of "L" suffixes encountered.  */
 846   int long_p = 0;
 847
 848   /* We have found a "L" or "U" suffix.  */
 849   int found_suffix = 0;
 850
 851   ULONGEST high_bit;
 852   struct type *signed_type;
 853   struct type *unsigned_type;
 854
 855   if (parsed_float)
 856     {
 857       /* Handle suffixes: 'f' for float, 'l' for long double.
 858          FIXME: This appears to be an extension -- do we want this?  */
 859       if (len >= 1 && tolower (p[len - 1]) == 'f')
 860         {
 861           putithere->typed_val_float.type
 862             = parse_type (par_state)->builtin_float;
 863           len--;
 864         }
 865       else if (len >= 1 && tolower (p[len - 1]) == 'l')
 866         {
 867           putithere->typed_val_float.type
 868             = parse_type (par_state)->builtin_long_double;
 869           len--;
 870         }
 871       /* Default type for floating-point literals is double.  */
 872       else
 873         {
 874           putithere->typed_val_float.type
 875             = parse_type (par_state)->builtin_double;
 876         }
 877
 878       if (!parse_float (p, len,
 879                         putithere->typed_val_float.type,
 880                         putithere->typed_val_float.val))
 881         return ERROR;
 882       return FLOAT;
 883     }
 884
 885   /* Handle base-switching prefixes 0x, 0t, 0d, 0.  */
 886   if (p[0] == '0')
 887     switch (p[1])
 888       {
 889       case 'x':
 890       case 'X':
 891         if (len >= 3)
 892           {
 893             p += 2;
 894             base = 16;
 895             len -= 2;
 896           }
 897         break;
 898
 899       case 't':
 900       case 'T':
 901       case 'd':
 902       case 'D':
 903         if (len >= 3)
 904           {
 905             p += 2;
 906             base = 10;
 907             len -= 2;
 908           }
 909         break;
 910
 911       default:
 912         base = 8;
 913         break;
 914       }
 915
 916   while (len-- > 0)
 917     {
 918       c = *p++;
 919       if (c >= 'A' && c <= 'Z')
 920         c += 'a' - 'A';
 921       if (c != 'l' && c != 'u')
 922         n *= base;
 923       if (c >= '0' && c <= '9')
 924         {
 925           if (found_suffix)
 926             return ERROR;
 927           n += i = c - '0';
 928         }
 929       else
 930         {
 931           if (base > 10 && c >= 'a' && c <= 'f')
 932             {
 933               if (found_suffix)
 934                 return ERROR;
 935               n += i = c - 'a' + 10;
 936             }
 937           else if (c == 'l')
 938             {
 939               ++long_p;
 940               found_suffix = 1;
 941             }
 942           else if (c == 'u')
 943             {
 944               unsigned_p = 1;
 945               found_suffix = 1;
 946             }
 947           else
 948             return ERROR;       /* Char not a digit */
 949         }
 950       if (i >= base)
 951         return ERROR;           /* Invalid digit in this base.  */
 952
 953       /* Portably test for overflow (only works for nonzero values, so make
 954          a second check for zero).  FIXME: Can't we just make n and prevn
 955          unsigned and avoid this?  */
 956       if (c != 'l' && c != 'u' && (prevn >= n) && n != 0)
 957         unsigned_p = 1;         /* Try something unsigned.  */
 958
 959       /* Portably test for unsigned overflow.
 960          FIXME: This check is wrong; for example it doesn't find overflow
 961          on 0x123456789 when LONGEST is 32 bits.  */
 962       if (c != 'l' && c != 'u' && n != 0)
 963         {
 964           if ((unsigned_p && (ULONGEST) prevn >= (ULONGEST) n))
 965             error (_("Numeric constant too large."));
 966         }
 967       prevn = n;
 968     }
 969
 970   /* An integer constant is an int, a long, or a long long.  An L
 971      suffix forces it to be long; an LL suffix forces it to be long
 972      long.  If not forced to a larger size, it gets the first type of
 973      the above that it fits in.  To figure out whether it fits, we
 974      shift it right and see whether anything remains.  Note that we
 975      can't shift sizeof (LONGEST) * HOST_CHAR_BIT bits or more in one
 976      operation, because many compilers will warn about such a shift
 977      (which always produces a zero result).  Sometimes gdbarch_int_bit
 978      or gdbarch_long_bit will be that big, sometimes not.  To deal with
 979      the case where it is we just always shift the value more than
 980      once, with fewer bits each time.  */
 981
 982   un = (ULONGEST)n >> 2;
 983   if (long_p == 0
 984       && (un >> (gdbarch_int_bit (parse_gdbarch (par_state)) - 2)) == 0)
 985     {
 986       high_bit
 987         = ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch (par_state)) - 1);
 988
 989       /* A large decimal (not hex or octal) constant (between INT_MAX
 990          and UINT_MAX) is a long or unsigned long, according to ANSI,
 991          never an unsigned int, but this code treats it as unsigned
 992          int.  This probably should be fixed.  GCC gives a warning on
 993          such constants.  */
 994
 995       unsigned_type = parse_type (par_state)->builtin_unsigned_int;
 996       signed_type = parse_type (par_state)->builtin_int;
 997     }
 998   else if (long_p <= 1
 999            && (un >> (gdbarch_long_bit (parse_gdbarch (par_state)) - 2)) == 0)
1000     {
1001       high_bit
1002         = ((ULONGEST)1) << (gdbarch_long_bit (parse_gdbarch (par_state)) - 1);
1003       unsigned_type = parse_type (par_state)->builtin_unsigned_long;
1004       signed_type = parse_type (par_state)->builtin_long;
1005     }
1006   else
1007     {
1008       int shift;
1009       if (sizeof (ULONGEST) * HOST_CHAR_BIT
1010           < gdbarch_long_long_bit (parse_gdbarch (par_state)))
1011         /* A long long does not fit in a LONGEST.  */
1012         shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
1013       else
1014         shift = (gdbarch_long_long_bit (parse_gdbarch (par_state)) - 1);
1015       high_bit = (ULONGEST) 1 << shift;
1016       unsigned_type = parse_type (par_state)->builtin_unsigned_long_long;
1017       signed_type = parse_type (par_state)->builtin_long_long;
1018     }
1019
1020    putithere->typed_val_int.val = n;
1021
1022    /* If the high bit of the worked out type is set then this number
1023       has to be unsigned.  */
1024
1025    if (unsigned_p || (n & high_bit))
1026      {
1027        putithere->typed_val_int.type = unsigned_type;
1028      }
1029    else
1030      {
1031        putithere->typed_val_int.type = signed_type;
1032      }
1033
1034    return INT;
1035 }
1036
1037
1038 struct type_push
1039 {
1040   struct type *stored;
1041   struct type_push *next;
1042 };
1043
1044 static struct type_push *tp_top = NULL;
1045
1046 static void
1047 push_current_type (void)
1048 {
1049   struct type_push *tpnew;
1050   tpnew = (struct type_push *) malloc (sizeof (struct type_push));
1051   tpnew->next = tp_top;
1052   tpnew->stored = current_type;
1053   current_type = NULL;
1054   tp_top = tpnew;
1055 }
1056
1057 static void
1058 pop_current_type (void)
1059 {
1060   struct type_push *tp = tp_top;
1061   if (tp)
1062     {
1063       current_type = tp->stored;
1064       tp_top = tp->next;
1065       free (tp);
1066     }
1067 }
1068
1069 struct token
1070 {
1071   const char *oper;
1072   int token;
1073   enum exp_opcode opcode;
1074 };
1075
1076 static const struct token tokentab3[] =
1077   {
1078     {"shr", RSH, BINOP_END},
1079     {"shl", LSH, BINOP_END},
1080     {"and", ANDAND, BINOP_END},
1081     {"div", DIV, BINOP_END},
1082     {"not", NOT, BINOP_END},
1083     {"mod", MOD, BINOP_END},
1084     {"inc", INCREMENT, BINOP_END},
1085     {"dec", DECREMENT, BINOP_END},
1086     {"xor", XOR, BINOP_END}
1087   };
1088
1089 static const struct token tokentab2[] =
1090   {
1091     {"or", OR, BINOP_END},
1092     {"<>", NOTEQUAL, BINOP_END},
1093     {"<=", LEQ, BINOP_END},
1094     {">=", GEQ, BINOP_END},
1095     {":=", ASSIGN, BINOP_END},
1096     {"::", COLONCOLON, BINOP_END} };
1097
1098 /* Allocate uppercased var: */
1099 /* make an uppercased copy of tokstart.  */
1100 static char *
1101 uptok (const char *tokstart, int namelen)
1102 {
1103   int i;
1104   char *uptokstart = (char *)malloc(namelen+1);
1105   for (i = 0;i <= namelen;i++)
1106     {
1107       if ((tokstart[i]>='a' && tokstart[i]<='z'))
1108         uptokstart[i] = tokstart[i]-('a'-'A');
1109       else
1110         uptokstart[i] = tokstart[i];
1111     }
1112   uptokstart[namelen]='\0';
1113   return uptokstart;
1114 }
1115
1116 /* Read one token, getting characters through lexptr.  */
1117
1118 static int
1119 yylex (void)
1120 {
1121   int c;
1122   int namelen;
1123   unsigned int i;
1124   const char *tokstart;
1125   char *uptokstart;
1126   const char *tokptr;
1127   int explen, tempbufindex;
1128   static char *tempbuf;
1129   static int tempbufsize;
1130
1131  retry:
1132
1133   prev_lexptr = lexptr;
1134
1135   tokstart = lexptr;
1136   explen = strlen (lexptr);
1137
1138   /* See if it is a special token of length 3.  */
1139   if (explen > 2)
1140     for (i = 0; i < sizeof (tokentab3) / sizeof (tokentab3[0]); i++)
1141       if (strncasecmp (tokstart, tokentab3[i].oper, 3) == 0
1142           && (!isalpha (tokentab3[i].oper[0]) || explen == 3
1143               || (!isalpha (tokstart[3])
1144                   && !isdigit (tokstart[3]) && tokstart[3] != '_')))
1145         {
1146           lexptr += 3;
1147           yylval.opcode = tokentab3[i].opcode;
1148           return tokentab3[i].token;
1149         }
1150
1151   /* See if it is a special token of length 2.  */
1152   if (explen > 1)
1153   for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
1154       if (strncasecmp (tokstart, tokentab2[i].oper, 2) == 0
1155           && (!isalpha (tokentab2[i].oper[0]) || explen == 2
1156               || (!isalpha (tokstart[2])
1157                   && !isdigit (tokstart[2]) && tokstart[2] != '_')))
1158         {
1159           lexptr += 2;
1160           yylval.opcode = tokentab2[i].opcode;
1161           return tokentab2[i].token;
1162         }
1163
1164   switch (c = *tokstart)
1165     {
1166     case 0:
1167       if (search_field && parse_completion)
1168         return COMPLETE;
1169       else
1170        return 0;
1171
1172     case ' ':
1173     case '\t':
1174     case '\n':
1175       lexptr++;
1176       goto retry;
1177
1178     case '\'':
1179       /* We either have a character constant ('0' or '\177' for example)
1180          or we have a quoted symbol reference ('foo(int,int)' in object pascal
1181          for example).  */
1182       lexptr++;
1183       c = *lexptr++;
1184       if (c == '\\')
1185         c = parse_escape (parse_gdbarch (pstate), &lexptr);
1186       else if (c == '\'')
1187         error (_("Empty character constant."));
1188
1189       yylval.typed_val_int.val = c;
1190       yylval.typed_val_int.type = parse_type (pstate)->builtin_char;
1191
1192       c = *lexptr++;
1193       if (c != '\'')
1194         {
1195           namelen = skip_quoted (tokstart) - tokstart;
1196           if (namelen > 2)
1197             {
1198               lexptr = tokstart + namelen;
1199               if (lexptr[-1] != '\'')
1200                 error (_("Unmatched single quote."));
1201               namelen -= 2;
1202               tokstart++;
1203               uptokstart = uptok(tokstart,namelen);
1204               goto tryname;
1205             }
1206           error (_("Invalid character constant."));
1207         }
1208       return INT;
1209
1210     case '(':
1211       paren_depth++;
1212       lexptr++;
1213       return c;
1214
1215     case ')':
1216       if (paren_depth == 0)
1217         return 0;
1218       paren_depth--;
1219       lexptr++;
1220       return c;
1221
1222     case ',':
1223       if (comma_terminates && paren_depth == 0)
1224         return 0;
1225       lexptr++;
1226       return c;
1227
1228     case '.':
1229       /* Might be a floating point number.  */
1230       if (lexptr[1] < '0' || lexptr[1] > '9')
1231         {
1232           goto symbol;          /* Nope, must be a symbol.  */
1233         }
1234
1235       /* FALL THRU into number case.  */
1236
1237     case '0':
1238     case '1':
1239     case '2':
1240     case '3':
1241     case '4':
1242     case '5':
1243     case '6':
1244     case '7':
1245     case '8':
1246     case '9':
1247       {
1248         /* It's a number.  */
1249         int got_dot = 0, got_e = 0, toktype;
1250         const char *p = tokstart;
1251         int hex = input_radix > 10;
1252
1253         if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1254           {
1255             p += 2;
1256             hex = 1;
1257           }
1258         else if (c == '0' && (p[1]=='t' || p[1]=='T'
1259                               || p[1]=='d' || p[1]=='D'))
1260           {
1261             p += 2;
1262             hex = 0;
1263           }
1264
1265         for (;; ++p)
1266           {
1267             /* This test includes !hex because 'e' is a valid hex digit
1268                and thus does not indicate a floating point number when
1269                the radix is hex.  */
1270             if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1271               got_dot = got_e = 1;
1272             /* This test does not include !hex, because a '.' always indicates
1273                a decimal floating point number regardless of the radix.  */
1274             else if (!got_dot && *p == '.')
1275               got_dot = 1;
1276             else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
1277                      && (*p == '-' || *p == '+'))
1278               /* This is the sign of the exponent, not the end of the
1279                  number.  */
1280               continue;
1281             /* We will take any letters or digits.  parse_number will
1282                complain if past the radix, or if L or U are not final.  */
1283             else if ((*p < '0' || *p > '9')
1284                      && ((*p < 'a' || *p > 'z')
1285                                   && (*p < 'A' || *p > 'Z')))
1286               break;
1287           }
1288         toktype = parse_number (pstate, tokstart,
1289                                 p - tokstart, got_dot | got_e, &yylval);
1290         if (toktype == ERROR)
1291           {
1292             char *err_copy = (char *) alloca (p - tokstart + 1);
1293
1294             memcpy (err_copy, tokstart, p - tokstart);
1295             err_copy[p - tokstart] = 0;
1296             error (_("Invalid number \"%s\"."), err_copy);
1297           }
1298         lexptr = p;
1299         return toktype;
1300       }
1301
1302     case '+':
1303     case '-':
1304     case '*':
1305     case '/':
1306     case '|':
1307     case '&':
1308     case '^':
1309     case '~':
1310     case '!':
1311     case '@':
1312     case '<':
1313     case '>':
1314     case '[':
1315     case ']':
1316     case '?':
1317     case ':':
1318     case '=':
1319     case '{':
1320     case '}':
1321     symbol:
1322       lexptr++;
1323       return c;
1324
1325     case '"':
1326
1327       /* Build the gdb internal form of the input string in tempbuf,
1328          translating any standard C escape forms seen.  Note that the
1329          buffer is null byte terminated *only* for the convenience of
1330          debugging gdb itself and printing the buffer contents when
1331          the buffer contains no embedded nulls.  Gdb does not depend
1332          upon the buffer being null byte terminated, it uses the length
1333          string instead.  This allows gdb to handle C strings (as well
1334          as strings in other languages) with embedded null bytes.  */
1335
1336       tokptr = ++tokstart;
1337       tempbufindex = 0;
1338
1339       do {
1340         /* Grow the static temp buffer if necessary, including allocating
1341            the first one on demand.  */
1342         if (tempbufindex + 1 >= tempbufsize)
1343           {
1344             tempbuf = (char *) realloc (tempbuf, tempbufsize += 64);
1345           }
1346
1347         switch (*tokptr)
1348           {
1349           case '\0':
1350           case '"':
1351             /* Do nothing, loop will terminate.  */
1352             break;
1353           case '\\':
1354             ++tokptr;
1355             c = parse_escape (parse_gdbarch (pstate), &tokptr);
1356             if (c == -1)
1357               {
1358                 continue;
1359               }
1360             tempbuf[tempbufindex++] = c;
1361             break;
1362           default:
1363             tempbuf[tempbufindex++] = *tokptr++;
1364             break;
1365           }
1366       } while ((*tokptr != '"') && (*tokptr != '\0'));
1367       if (*tokptr++ != '"')
1368         {
1369           error (_("Unterminated string in expression."));
1370         }
1371       tempbuf[tempbufindex] = '\0';     /* See note above.  */
1372       yylval.sval.ptr = tempbuf;
1373       yylval.sval.length = tempbufindex;
1374       lexptr = tokptr;
1375       return (STRING);
1376     }
1377
1378   if (!(c == '_' || c == '$'
1379         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1380     /* We must have come across a bad character (e.g. ';').  */
1381     error (_("Invalid character '%c' in expression."), c);
1382
1383   /* It's a name.  See how long it is.  */
1384   namelen = 0;
1385   for (c = tokstart[namelen];
1386        (c == '_' || c == '$' || (c >= '0' && c <= '9')
1387         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c == '<');)
1388     {
1389       /* Template parameter lists are part of the name.
1390          FIXME: This mishandles `print $a<4&&$a>3'.  */
1391       if (c == '<')
1392         {
1393           int i = namelen;
1394           int nesting_level = 1;
1395           while (tokstart[++i])
1396             {
1397               if (tokstart[i] == '<')
1398                 nesting_level++;
1399               else if (tokstart[i] == '>')
1400                 {
1401                   if (--nesting_level == 0)
1402                     break;
1403                 }
1404             }
1405           if (tokstart[i] == '>')
1406             namelen = i;
1407           else
1408             break;
1409         }
1410
1411       /* do NOT uppercase internals because of registers !!!  */
1412       c = tokstart[++namelen];
1413     }
1414
1415   uptokstart = uptok(tokstart,namelen);
1416
1417   /* The token "if" terminates the expression and is NOT
1418      removed from the input stream.  */
1419   if (namelen == 2 && uptokstart[0] == 'I' && uptokstart[1] == 'F')
1420     {
1421       free (uptokstart);
1422       return 0;
1423     }
1424
1425   lexptr += namelen;
1426
1427   tryname:
1428
1429   /* Catch specific keywords.  Should be done with a data structure.  */
1430   switch (namelen)
1431     {
1432     case 6:
1433       if (strcmp (uptokstart, "OBJECT") == 0)
1434         {
1435           free (uptokstart);
1436           return CLASS;
1437         }
1438       if (strcmp (uptokstart, "RECORD") == 0)
1439         {
1440           free (uptokstart);
1441           return STRUCT;
1442         }
1443       if (strcmp (uptokstart, "SIZEOF") == 0)
1444         {
1445           free (uptokstart);
1446           return SIZEOF;
1447         }
1448       break;
1449     case 5:
1450       if (strcmp (uptokstart, "CLASS") == 0)
1451         {
1452           free (uptokstart);
1453           return CLASS;
1454         }
1455       if (strcmp (uptokstart, "FALSE") == 0)
1456         {
1457           yylval.lval = 0;
1458           free (uptokstart);
1459           return FALSEKEYWORD;
1460         }
1461       break;
1462     case 4:
1463       if (strcmp (uptokstart, "TRUE") == 0)
1464         {
1465           yylval.lval = 1;
1466           free (uptokstart);
1467           return TRUEKEYWORD;
1468         }
1469       if (strcmp (uptokstart, "SELF") == 0)
1470         {
1471           /* Here we search for 'this' like
1472              inserted in FPC stabs debug info.  */
1473           static const char this_name[] = "this";
1474
1475           if (lookup_symbol (this_name, expression_context_block,
1476                              VAR_DOMAIN, NULL).symbol)
1477             {
1478               free (uptokstart);
1479               return THIS;
1480             }
1481         }
1482       break;
1483     default:
1484       break;
1485     }
1486
1487   yylval.sval.ptr = tokstart;
1488   yylval.sval.length = namelen;
1489
1490   if (*tokstart == '$')
1491     {
1492       char *tmp;
1493
1494       /* $ is the normal prefix for pascal hexadecimal values
1495         but this conflicts with the GDB use for debugger variables
1496         so in expression to enter hexadecimal values
1497         we still need to use C syntax with 0xff  */
1498       write_dollar_variable (pstate, yylval.sval);
1499       tmp = (char *) alloca (namelen + 1);
1500       memcpy (tmp, tokstart, namelen);
1501       tmp[namelen] = '\0';
1502       intvar = lookup_only_internalvar (tmp + 1);
1503       free (uptokstart);
1504       return VARIABLE;
1505     }
1506
1507   /* Use token-type BLOCKNAME for symbols that happen to be defined as
1508      functions or symtabs.  If this is not so, then ...
1509      Use token-type TYPENAME for symbols that happen to be defined
1510      currently as names of types; NAME for other symbols.
1511      The caller is not constrained to care about the distinction.  */
1512   {
1513     char *tmp = copy_name (yylval.sval);
1514     struct symbol *sym;
1515     struct field_of_this_result is_a_field_of_this;
1516     int is_a_field = 0;
1517     int hextype;
1518
1519     is_a_field_of_this.type = NULL;
1520     if (search_field && current_type)
1521       is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
1522     if (is_a_field)
1523       sym = NULL;
1524     else
1525       sym = lookup_symbol (tmp, expression_context_block,
1526                            VAR_DOMAIN, &is_a_field_of_this).symbol;
1527     /* second chance uppercased (as Free Pascal does).  */
1528     if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
1529       {
1530        for (i = 0; i <= namelen; i++)
1531          {
1532            if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1533              tmp[i] -= ('a'-'A');
1534          }
1535        if (search_field && current_type)
1536          is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
1537        if (is_a_field)
1538          sym = NULL;
1539        else
1540          sym = lookup_symbol (tmp, expression_context_block,
1541                               VAR_DOMAIN, &is_a_field_of_this).symbol;
1542       }
1543     /* Third chance Capitalized (as GPC does).  */
1544     if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
1545       {
1546        for (i = 0; i <= namelen; i++)
1547          {
1548            if (i == 0)
1549              {
1550               if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1551                 tmp[i] -= ('a'-'A');
1552              }
1553            else
1554            if ((tmp[i] >= 'A' && tmp[i] <= 'Z'))
1555              tmp[i] -= ('A'-'a');
1556           }
1557        if (search_field && current_type)
1558          is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
1559        if (is_a_field)
1560          sym = NULL;
1561        else
1562          sym = lookup_symbol (tmp, expression_context_block,
1563                               VAR_DOMAIN, &is_a_field_of_this).symbol;
1564       }
1565
1566     if (is_a_field || (is_a_field_of_this.type != NULL))
1567       {
1568         tempbuf = (char *) realloc (tempbuf, namelen + 1);
1569         strncpy (tempbuf, tmp, namelen);
1570         tempbuf [namelen] = 0;
1571         yylval.sval.ptr = tempbuf;
1572         yylval.sval.length = namelen;
1573         yylval.ssym.sym.symbol = NULL;
1574         yylval.ssym.sym.block = NULL;
1575         free (uptokstart);
1576         yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1577         if (is_a_field)
1578           return FIELDNAME;
1579         else
1580           return NAME;
1581       }
1582     /* Call lookup_symtab, not lookup_partial_symtab, in case there are
1583        no psymtabs (coff, xcoff, or some future change to blow away the
1584        psymtabs once once symbols are read).  */
1585     if ((sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1586         || lookup_symtab (tmp))
1587       {
1588         yylval.ssym.sym.symbol = sym;
1589         yylval.ssym.sym.block = NULL;
1590         yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1591         free (uptokstart);
1592         return BLOCKNAME;
1593       }
1594     if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1595         {
1596 #if 1
1597           /* Despite the following flaw, we need to keep this code enabled.
1598              Because we can get called from check_stub_method, if we don't
1599              handle nested types then it screws many operations in any
1600              program which uses nested types.  */
1601           /* In "A::x", if x is a member function of A and there happens
1602              to be a type (nested or not, since the stabs don't make that
1603              distinction) named x, then this code incorrectly thinks we
1604              are dealing with nested types rather than a member function.  */
1605
1606           const char *p;
1607           const char *namestart;
1608           struct symbol *best_sym;
1609
1610           /* Look ahead to detect nested types.  This probably should be
1611              done in the grammar, but trying seemed to introduce a lot
1612              of shift/reduce and reduce/reduce conflicts.  It's possible
1613              that it could be done, though.  Or perhaps a non-grammar, but
1614              less ad hoc, approach would work well.  */
1615
1616           /* Since we do not currently have any way of distinguishing
1617              a nested type from a non-nested one (the stabs don't tell
1618              us whether a type is nested), we just ignore the
1619              containing type.  */
1620
1621           p = lexptr;
1622           best_sym = sym;
1623           while (1)
1624             {
1625               /* Skip whitespace.  */
1626               while (*p == ' ' || *p == '\t' || *p == '\n')
1627                 ++p;
1628               if (*p == ':' && p[1] == ':')
1629                 {
1630                   /* Skip the `::'.  */
1631                   p += 2;
1632                   /* Skip whitespace.  */
1633                   while (*p == ' ' || *p == '\t' || *p == '\n')
1634                     ++p;
1635                   namestart = p;
1636                   while (*p == '_' || *p == '$' || (*p >= '0' && *p <= '9')
1637                          || (*p >= 'a' && *p <= 'z')
1638                          || (*p >= 'A' && *p <= 'Z'))
1639                     ++p;
1640                   if (p != namestart)
1641                     {
1642                       struct symbol *cur_sym;
1643                       /* As big as the whole rest of the expression, which is
1644                          at least big enough.  */
1645                       char *ncopy
1646                         = (char *) alloca (strlen (tmp) + strlen (namestart)
1647                                            + 3);
1648                       char *tmp1;
1649
1650                       tmp1 = ncopy;
1651                       memcpy (tmp1, tmp, strlen (tmp));
1652                       tmp1 += strlen (tmp);
1653                       memcpy (tmp1, "::", 2);
1654                       tmp1 += 2;
1655                       memcpy (tmp1, namestart, p - namestart);
1656                       tmp1[p - namestart] = '\0';
1657                       cur_sym = lookup_symbol (ncopy, expression_context_block,
1658                                                VAR_DOMAIN, NULL).symbol;
1659                       if (cur_sym)
1660                         {
1661                           if (SYMBOL_CLASS (cur_sym) == LOC_TYPEDEF)
1662                             {
1663                               best_sym = cur_sym;
1664                               lexptr = p;
1665                             }
1666                           else
1667                             break;
1668                         }
1669                       else
1670                         break;
1671                     }
1672                   else
1673                     break;
1674                 }
1675               else
1676                 break;
1677             }
1678
1679           yylval.tsym.type = SYMBOL_TYPE (best_sym);
1680 #else /* not 0 */
1681           yylval.tsym.type = SYMBOL_TYPE (sym);
1682 #endif /* not 0 */
1683           free (uptokstart);
1684           return TYPENAME;
1685         }
1686     yylval.tsym.type
1687       = language_lookup_primitive_type (parse_language (pstate),
1688                                         parse_gdbarch (pstate), tmp);
1689     if (yylval.tsym.type != NULL)
1690       {
1691         free (uptokstart);
1692         return TYPENAME;
1693       }
1694
1695     /* Input names that aren't symbols but ARE valid hex numbers,
1696        when the input radix permits them, can be names or numbers
1697        depending on the parse.  Note we support radixes > 16 here.  */
1698     if (!sym
1699         && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1700             || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1701       {
1702         YYSTYPE newlval;        /* Its value is ignored.  */
1703         hextype = parse_number (pstate, tokstart, namelen, 0, &newlval);
1704         if (hextype == INT)
1705           {
1706             yylval.ssym.sym.symbol = sym;
1707             yylval.ssym.sym.block = NULL;
1708             yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1709             free (uptokstart);
1710             return NAME_OR_INT;
1711           }
1712       }
1713
1714     free(uptokstart);
1715     /* Any other kind of symbol.  */
1716     yylval.ssym.sym.symbol = sym;
1717     yylval.ssym.sym.block = NULL;
1718     return NAME;
1719   }
1720 }
1721
1722 int
1723 pascal_parse (struct parser_state *par_state)
1724 {
1725   /* Setting up the parser state.  */
1726   scoped_restore pstate_restore = make_scoped_restore (&pstate);
1727   gdb_assert (par_state != NULL);
1728   pstate = par_state;
1729
1730   return yyparse ();
1731 }
1732
1733 void
1734 yyerror (const char *msg)
1735 {
1736   if (prev_lexptr)
1737     lexptr = prev_lexptr;
1738
1739   error (_("A %s in expression, near `%s'."), (msg ? msg : "error"), lexptr);
1740 }