gdb/p-exp.y

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