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