gdb/p-exp.y

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