gdb/p-exp.y

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