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