gdb/f-exp.y

   1
   2 /* YACC parser for Fortran expressions, for GDB.
   3    Copyright (C) 1986-2019 Free Software Foundation, Inc.
   4
   5    Contributed by Motorola.  Adapted from the C parser by Farooq Butt
   6    (fmbutt@engage.sps.mot.com).
   7
   8    This file is part of GDB.
   9
  10    This program is free software; you can redistribute it and/or modify
  11    it under the terms of the GNU General Public License as published by
  12    the Free Software Foundation; either version 3 of the License, or
  13    (at your option) any later version.
  14
  15    This program is distributed in the hope that it will be useful,
  16    but WITHOUT ANY WARRANTY; without even the implied warranty of
  17    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18    GNU General Public License for more details.
  19
  20    You should have received a copy of the GNU General Public License
  21    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  22
  23 /* This was blantantly ripped off the C expression parser, please
  24    be aware of that as you look at its basic structure -FMB */
  25
  26 /* Parse a F77 expression from text in a string,
  27    and return the result as a  struct expression  pointer.
  28    That structure contains arithmetic operations in reverse polish,
  29    with constants represented by operations that are followed by special data.
  30    See expression.h for the details of the format.
  31    What is important here is that it can be built up sequentially
  32    during the process of parsing; the lower levels of the tree always
  33    come first in the result.
  34
  35    Note that malloc's and realloc's in this file are transformed to
  36    xmalloc and xrealloc respectively by the same sed command in the
  37    makefile that remaps any other malloc/realloc inserted by the parser
  38    generator.  Doing this with #defines and trying to control the interaction
  39    with include files (<malloc.h> and <stdlib.h> for example) just became
  40    too messy, particularly when such includes can be inserted at random
  41    times by the parser generator.  */
  42
  43 %{
  44
  45 #include "defs.h"
  46 #include "expression.h"
  47 #include "value.h"
  48 #include "parser-defs.h"
  49 #include "language.h"
  50 #include "f-lang.h"
  51 #include "bfd.h" /* Required by objfiles.h.  */
  52 #include "symfile.h" /* Required by objfiles.h.  */
  53 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
  54 #include "block.h"
  55 #include <ctype.h>
  56 #include <algorithm>
  57 #include "type-stack.h"
  58
  59 #define parse_type(ps) builtin_type (ps->gdbarch ())
  60 #define parse_f_type(ps) builtin_f_type (ps->gdbarch ())
  61
  62 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror,
  63    etc).  */
  64 #define GDB_YY_REMAP_PREFIX f_
  65 #include "yy-remap.h"
  66
  67 /* The state of the parser, used internally when we are parsing the
  68    expression.  */
  69
  70 static struct parser_state *pstate = NULL;
  71
  72 /* Depth of parentheses.  */
  73 static int paren_depth;
  74
  75 /* The current type stack.  */
  76 static struct type_stack *type_stack;
  77
  78 int yyparse (void);
  79
  80 static int yylex (void);
  81
  82 static void yyerror (const char *);
  83
  84 static void growbuf_by_size (int);
  85
  86 static int match_string_literal (void);
  87
  88 static void push_kind_type (LONGEST val, struct type *type);
  89
  90 static struct type *convert_to_kind_type (struct type *basetype, int kind);
  91
  92 %}
  93
  94 /* Although the yacc "value" of an expression is not used,
  95    since the result is stored in the structure being created,
  96    other node types do have values.  */
  97
  98 %union
  99   {
 100     LONGEST lval;
 101     struct {
 102       LONGEST val;
 103       struct type *type;
 104     } typed_val;
 105     struct {
 106       gdb_byte val[16];
 107       struct type *type;
 108     } typed_val_float;
 109     struct symbol *sym;
 110     struct type *tval;
 111     struct stoken sval;
 112     struct ttype tsym;
 113     struct symtoken ssym;
 114     int voidval;
 115     enum exp_opcode opcode;
 116     struct internalvar *ivar;
 117
 118     struct type **tvec;
 119     int *ivec;
 120   }
 121
 122 %{
 123 /* YYSTYPE gets defined by %union */
 124 static int parse_number (struct parser_state *, const char *, int,
 125                          int, YYSTYPE *);
 126 %}
 127
 128 %type <voidval> exp  type_exp start variable
 129 %type <tval> type typebase
 130 %type <tvec> nonempty_typelist
 131 /* %type <bval> block */
 132
 133 /* Fancy type parsing.  */
 134 %type <voidval> func_mod direct_abs_decl abs_decl
 135 %type <tval> ptype
 136
 137 %token <typed_val> INT
 138 %token <typed_val_float> FLOAT
 139
 140 /* Both NAME and TYPENAME tokens represent symbols in the input,
 141    and both convey their data as strings.
 142    But a TYPENAME is a string that happens to be defined as a typedef
 143    or builtin type name (such as int or char)
 144    and a NAME is any other symbol.
 145    Contexts where this distinction is not important can use the
 146    nonterminal "name", which matches either NAME or TYPENAME.  */
 147
 148 %token <sval> STRING_LITERAL
 149 %token <lval> BOOLEAN_LITERAL
 150 %token <ssym> NAME
 151 %token <tsym> TYPENAME
 152 %type <sval> name
 153 %type <ssym> name_not_typename
 154
 155 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
 156    but which would parse as a valid number in the current input radix.
 157    E.g. "c" when input_radix==16.  Depending on the parse, it will be
 158    turned into a name or into a number.  */
 159
 160 %token <ssym> NAME_OR_INT
 161
 162 %token SIZEOF KIND
 163 %token ERROR
 164
 165 /* Special type cases, put in to allow the parser to distinguish different
 166    legal basetypes.  */
 167 %token INT_KEYWORD INT_S2_KEYWORD LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD
 168 %token LOGICAL_S8_KEYWORD
 169 %token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD
 170 %token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD
 171 %token BOOL_AND BOOL_OR BOOL_NOT
 172 %token <lval> CHARACTER
 173
 174 %token <voidval> DOLLAR_VARIABLE
 175
 176 %token <opcode> ASSIGN_MODIFY
 177 %token <opcode> UNOP_INTRINSIC BINOP_INTRINSIC
 178
 179 %left ','
 180 %left ABOVE_COMMA
 181 %right '=' ASSIGN_MODIFY
 182 %right '?'
 183 %left BOOL_OR
 184 %right BOOL_NOT
 185 %left BOOL_AND
 186 %left '|'
 187 %left '^'
 188 %left '&'
 189 %left EQUAL NOTEQUAL
 190 %left LESSTHAN GREATERTHAN LEQ GEQ
 191 %left LSH RSH
 192 %left '@'
 193 %left '+' '-'
 194 %left '*' '/'
 195 %right STARSTAR
 196 %right '%'
 197 %right UNARY
 198 %right '('
 199
 200 \f
 201 %%
 202
 203 start   :       exp
 204         |       type_exp
 205         ;
 206
 207 type_exp:       type
 208                         { write_exp_elt_opcode (pstate, OP_TYPE);
 209                           write_exp_elt_type (pstate, $1);
 210                           write_exp_elt_opcode (pstate, OP_TYPE); }
 211         ;
 212
 213 exp     :       '(' exp ')'
 214                         { }
 215         ;
 216
 217 /* Expressions, not including the comma operator.  */
 218 exp     :       '*' exp    %prec UNARY
 219                         { write_exp_elt_opcode (pstate, UNOP_IND); }
 220         ;
 221
 222 exp     :       '&' exp    %prec UNARY
 223                         { write_exp_elt_opcode (pstate, UNOP_ADDR); }
 224         ;
 225
 226 exp     :       '-' exp    %prec UNARY
 227                         { write_exp_elt_opcode (pstate, UNOP_NEG); }
 228         ;
 229
 230 exp     :       BOOL_NOT exp    %prec UNARY
 231                         { write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
 232         ;
 233
 234 exp     :       '~' exp    %prec UNARY
 235                         { write_exp_elt_opcode (pstate, UNOP_COMPLEMENT); }
 236         ;
 237
 238 exp     :       SIZEOF exp       %prec UNARY
 239                         { write_exp_elt_opcode (pstate, UNOP_SIZEOF); }
 240         ;
 241
 242 exp     :       KIND '(' exp ')'       %prec UNARY
 243                         { write_exp_elt_opcode (pstate, UNOP_FORTRAN_KIND); }
 244         ;
 245
 246 /* No more explicit array operators, we treat everything in F77 as
 247    a function call.  The disambiguation as to whether we are
 248    doing a subscript operation or a function call is done
 249    later in eval.c.  */
 250
 251 exp     :       exp '('
 252                         { pstate->start_arglist (); }
 253                 arglist ')'
 254                         { write_exp_elt_opcode (pstate,
 255                                                 OP_F77_UNDETERMINED_ARGLIST);
 256                           write_exp_elt_longcst (pstate,
 257                                                  pstate->end_arglist ());
 258                           write_exp_elt_opcode (pstate,
 259                                               OP_F77_UNDETERMINED_ARGLIST); }
 260         ;
 261
 262 exp     :       UNOP_INTRINSIC '(' exp ')'
 263                         { write_exp_elt_opcode (pstate, $1); }
 264         ;
 265
 266 exp     :       BINOP_INTRINSIC '(' exp ',' exp ')'
 267                         { write_exp_elt_opcode (pstate, $1); }
 268         ;
 269
 270 arglist :
 271         ;
 272
 273 arglist :       exp
 274                         { pstate->arglist_len = 1; }
 275         ;
 276
 277 arglist :       subrange
 278                         { pstate->arglist_len = 1; }
 279         ;
 280
 281 arglist :       arglist ',' exp   %prec ABOVE_COMMA
 282                         { pstate->arglist_len++; }
 283         ;
 284
 285 /* There are four sorts of subrange types in F90.  */
 286
 287 subrange:       exp ':' exp     %prec ABOVE_COMMA
 288                         { write_exp_elt_opcode (pstate, OP_RANGE);
 289                           write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT);
 290                           write_exp_elt_opcode (pstate, OP_RANGE); }
 291         ;
 292
 293 subrange:       exp ':' %prec ABOVE_COMMA
 294                         { write_exp_elt_opcode (pstate, OP_RANGE);
 295                           write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT);
 296                           write_exp_elt_opcode (pstate, OP_RANGE); }
 297         ;
 298
 299 subrange:       ':' exp %prec ABOVE_COMMA
 300                         { write_exp_elt_opcode (pstate, OP_RANGE);
 301                           write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT);
 302                           write_exp_elt_opcode (pstate, OP_RANGE); }
 303         ;
 304
 305 subrange:       ':'     %prec ABOVE_COMMA
 306                         { write_exp_elt_opcode (pstate, OP_RANGE);
 307                           write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT);
 308                           write_exp_elt_opcode (pstate, OP_RANGE); }
 309         ;
 310
 311 complexnum:     exp ',' exp
 312                         { }
 313         ;
 314
 315 exp     :       '(' complexnum ')'
 316                         { write_exp_elt_opcode (pstate, OP_COMPLEX);
 317                           write_exp_elt_type (pstate,
 318                                               parse_f_type (pstate)
 319                                               ->builtin_complex_s16);
 320                           write_exp_elt_opcode (pstate, OP_COMPLEX); }
 321         ;
 322
 323 exp     :       '(' type ')' exp  %prec UNARY
 324                         { write_exp_elt_opcode (pstate, UNOP_CAST);
 325                           write_exp_elt_type (pstate, $2);
 326                           write_exp_elt_opcode (pstate, UNOP_CAST); }
 327         ;
 328
 329 exp     :       exp '%' name
 330                         { write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
 331                           write_exp_string (pstate, $3);
 332                           write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
 333         ;
 334
 335 /* Binary operators in order of decreasing precedence.  */
 336
 337 exp     :       exp '@' exp
 338                         { write_exp_elt_opcode (pstate, BINOP_REPEAT); }
 339         ;
 340
 341 exp     :       exp STARSTAR exp
 342                         { write_exp_elt_opcode (pstate, BINOP_EXP); }
 343         ;
 344
 345 exp     :       exp '*' exp
 346                         { write_exp_elt_opcode (pstate, BINOP_MUL); }
 347         ;
 348
 349 exp     :       exp '/' exp
 350                         { write_exp_elt_opcode (pstate, BINOP_DIV); }
 351         ;
 352
 353 exp     :       exp '+' exp
 354                         { write_exp_elt_opcode (pstate, BINOP_ADD); }
 355         ;
 356
 357 exp     :       exp '-' exp
 358                         { write_exp_elt_opcode (pstate, BINOP_SUB); }
 359         ;
 360
 361 exp     :       exp LSH exp
 362                         { write_exp_elt_opcode (pstate, BINOP_LSH); }
 363         ;
 364
 365 exp     :       exp RSH exp
 366                         { write_exp_elt_opcode (pstate, BINOP_RSH); }
 367         ;
 368
 369 exp     :       exp EQUAL exp
 370                         { write_exp_elt_opcode (pstate, BINOP_EQUAL); }
 371         ;
 372
 373 exp     :       exp NOTEQUAL exp
 374                         { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
 375         ;
 376
 377 exp     :       exp LEQ exp
 378                         { write_exp_elt_opcode (pstate, BINOP_LEQ); }
 379         ;
 380
 381 exp     :       exp GEQ exp
 382                         { write_exp_elt_opcode (pstate, BINOP_GEQ); }
 383         ;
 384
 385 exp     :       exp LESSTHAN exp
 386                         { write_exp_elt_opcode (pstate, BINOP_LESS); }
 387         ;
 388
 389 exp     :       exp GREATERTHAN exp
 390                         { write_exp_elt_opcode (pstate, BINOP_GTR); }
 391         ;
 392
 393 exp     :       exp '&' exp
 394                         { write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
 395         ;
 396
 397 exp     :       exp '^' exp
 398                         { write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
 399         ;
 400
 401 exp     :       exp '|' exp
 402                         { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
 403         ;
 404
 405 exp     :       exp BOOL_AND exp
 406                         { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
 407         ;
 408
 409
 410 exp     :       exp BOOL_OR exp
 411                         { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
 412         ;
 413
 414 exp     :       exp '=' exp
 415                         { write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
 416         ;
 417
 418 exp     :       exp ASSIGN_MODIFY exp
 419                         { write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY);
 420                           write_exp_elt_opcode (pstate, $2);
 421                           write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY); }
 422         ;
 423
 424 exp     :       INT
 425                         { write_exp_elt_opcode (pstate, OP_LONG);
 426                           write_exp_elt_type (pstate, $1.type);
 427                           write_exp_elt_longcst (pstate, (LONGEST) ($1.val));
 428                           write_exp_elt_opcode (pstate, OP_LONG); }
 429         ;
 430
 431 exp     :       NAME_OR_INT
 432                         { YYSTYPE val;
 433                           parse_number (pstate, $1.stoken.ptr,
 434                                         $1.stoken.length, 0, &val);
 435                           write_exp_elt_opcode (pstate, OP_LONG);
 436                           write_exp_elt_type (pstate, val.typed_val.type);
 437                           write_exp_elt_longcst (pstate,
 438                                                  (LONGEST)val.typed_val.val);
 439                           write_exp_elt_opcode (pstate, OP_LONG); }
 440         ;
 441
 442 exp     :       FLOAT
 443                         { write_exp_elt_opcode (pstate, OP_FLOAT);
 444                           write_exp_elt_type (pstate, $1.type);
 445                           write_exp_elt_floatcst (pstate, $1.val);
 446                           write_exp_elt_opcode (pstate, OP_FLOAT); }
 447         ;
 448
 449 exp     :       variable
 450         ;
 451
 452 exp     :       DOLLAR_VARIABLE
 453         ;
 454
 455 exp     :       SIZEOF '(' type ')'     %prec UNARY
 456                         { write_exp_elt_opcode (pstate, OP_LONG);
 457                           write_exp_elt_type (pstate,
 458                                               parse_f_type (pstate)
 459                                               ->builtin_integer);
 460                           $3 = check_typedef ($3);
 461                           write_exp_elt_longcst (pstate,
 462                                                  (LONGEST) TYPE_LENGTH ($3));
 463                           write_exp_elt_opcode (pstate, OP_LONG); }
 464         ;
 465
 466 exp     :       BOOLEAN_LITERAL
 467                         { write_exp_elt_opcode (pstate, OP_BOOL);
 468                           write_exp_elt_longcst (pstate, (LONGEST) $1);
 469                           write_exp_elt_opcode (pstate, OP_BOOL);
 470                         }
 471         ;
 472
 473 exp     :       STRING_LITERAL
 474                         {
 475                           write_exp_elt_opcode (pstate, OP_STRING);
 476                           write_exp_string (pstate, $1);
 477                           write_exp_elt_opcode (pstate, OP_STRING);
 478                         }
 479         ;
 480
 481 variable:       name_not_typename
 482                         { struct block_symbol sym = $1.sym;
 483
 484                           if (sym.symbol)
 485                             {
 486                               if (symbol_read_needs_frame (sym.symbol))
 487                                 pstate->block_tracker->update (sym);
 488                               write_exp_elt_opcode (pstate, OP_VAR_VALUE);
 489                               write_exp_elt_block (pstate, sym.block);
 490                               write_exp_elt_sym (pstate, sym.symbol);
 491                               write_exp_elt_opcode (pstate, OP_VAR_VALUE);
 492                               break;
 493                             }
 494                           else
 495                             {
 496                               struct bound_minimal_symbol msymbol;
 497                               std::string arg = copy_name ($1.stoken);
 498
 499                               msymbol =
 500                                 lookup_bound_minimal_symbol (arg.c_str ());
 501                               if (msymbol.minsym != NULL)
 502                                 write_exp_msymbol (pstate, msymbol);
 503                               else if (!have_full_symbols () && !have_partial_symbols ())
 504                                 error (_("No symbol table is loaded.  Use the \"file\" command."));
 505                               else
 506                                 error (_("No symbol \"%s\" in current context."),
 507                                        arg.c_str ());
 508                             }
 509                         }
 510         ;
 511
 512
 513 type    :       ptype
 514         ;
 515
 516 ptype   :       typebase
 517         |       typebase abs_decl
 518                 {
 519                   /* This is where the interesting stuff happens.  */
 520                   int done = 0;
 521                   int array_size;
 522                   struct type *follow_type = $1;
 523                   struct type *range_type;
 524
 525                   while (!done)
 526                     switch (type_stack->pop ())
 527                       {
 528                       case tp_end:
 529                         done = 1;
 530                         break;
 531                       case tp_pointer:
 532                         follow_type = lookup_pointer_type (follow_type);
 533                         break;
 534                       case tp_reference:
 535                         follow_type = lookup_lvalue_reference_type (follow_type);
 536                         break;
 537                       case tp_array:
 538                         array_size = type_stack->pop_int ();
 539                         if (array_size != -1)
 540                           {
 541                             range_type =
 542                               create_static_range_type ((struct type *) NULL,
 543                                                         parse_f_type (pstate)
 544                                                         ->builtin_integer,
 545                                                         0, array_size - 1);
 546                             follow_type =
 547                               create_array_type ((struct type *) NULL,
 548                                                  follow_type, range_type);
 549                           }
 550                         else
 551                           follow_type = lookup_pointer_type (follow_type);
 552                         break;
 553                       case tp_function:
 554                         follow_type = lookup_function_type (follow_type);
 555                         break;
 556                       case tp_kind:
 557                         {
 558                           int kind_val = type_stack->pop_int ();
 559                           follow_type
 560                             = convert_to_kind_type (follow_type, kind_val);
 561                         }
 562                         break;
 563                       }
 564                   $$ = follow_type;
 565                 }
 566         ;
 567
 568 abs_decl:       '*'
 569                         { type_stack->push (tp_pointer); $$ = 0; }
 570         |       '*' abs_decl
 571                         { type_stack->push (tp_pointer); $$ = $2; }
 572         |       '&'
 573                         { type_stack->push (tp_reference); $$ = 0; }
 574         |       '&' abs_decl
 575                         { type_stack->push (tp_reference); $$ = $2; }
 576         |       direct_abs_decl
 577         ;
 578
 579 direct_abs_decl: '(' abs_decl ')'
 580                         { $$ = $2; }
 581         |       '(' KIND '=' INT ')'
 582                         { push_kind_type ($4.val, $4.type); }
 583         |       '*' INT
 584                         { push_kind_type ($2.val, $2.type); }
 585         |       direct_abs_decl func_mod
 586                         { type_stack->push (tp_function); }
 587         |       func_mod
 588                         { type_stack->push (tp_function); }
 589         ;
 590
 591 func_mod:       '(' ')'
 592                         { $$ = 0; }
 593         |       '(' nonempty_typelist ')'
 594                         { free ($2); $$ = 0; }
 595         ;
 596
 597 typebase  /* Implements (approximately): (type-qualifier)* type-specifier */
 598         :       TYPENAME
 599                         { $$ = $1.type; }
 600         |       INT_KEYWORD
 601                         { $$ = parse_f_type (pstate)->builtin_integer; }
 602         |       INT_S2_KEYWORD
 603                         { $$ = parse_f_type (pstate)->builtin_integer_s2; }
 604         |       CHARACTER
 605                         { $$ = parse_f_type (pstate)->builtin_character; }
 606         |       LOGICAL_S8_KEYWORD
 607                         { $$ = parse_f_type (pstate)->builtin_logical_s8; }
 608         |       LOGICAL_KEYWORD
 609                         { $$ = parse_f_type (pstate)->builtin_logical; }
 610         |       LOGICAL_S2_KEYWORD
 611                         { $$ = parse_f_type (pstate)->builtin_logical_s2; }
 612         |       LOGICAL_S1_KEYWORD
 613                         { $$ = parse_f_type (pstate)->builtin_logical_s1; }
 614         |       REAL_KEYWORD
 615                         { $$ = parse_f_type (pstate)->builtin_real; }
 616         |       REAL_S8_KEYWORD
 617                         { $$ = parse_f_type (pstate)->builtin_real_s8; }
 618         |       REAL_S16_KEYWORD
 619                         { $$ = parse_f_type (pstate)->builtin_real_s16; }
 620         |       COMPLEX_S8_KEYWORD
 621                         { $$ = parse_f_type (pstate)->builtin_complex_s8; }
 622         |       COMPLEX_S16_KEYWORD
 623                         { $$ = parse_f_type (pstate)->builtin_complex_s16; }
 624         |       COMPLEX_S32_KEYWORD
 625                         { $$ = parse_f_type (pstate)->builtin_complex_s32; }
 626         ;
 627
 628 nonempty_typelist
 629         :       type
 630                 { $$ = (struct type **) malloc (sizeof (struct type *) * 2);
 631                   $<ivec>$[0] = 1;      /* Number of types in vector */
 632                   $$[1] = $1;
 633                 }
 634         |       nonempty_typelist ',' type
 635                 { int len = sizeof (struct type *) * (++($<ivec>1[0]) + 1);
 636                   $$ = (struct type **) realloc ((char *) $1, len);
 637                   $$[$<ivec>$[0]] = $3;
 638                 }
 639         ;
 640
 641 name    :       NAME
 642                 {  $$ = $1.stoken; }
 643         ;
 644
 645 name_not_typename :     NAME
 646 /* These would be useful if name_not_typename was useful, but it is just
 647    a fake for "variable", so these cause reduce/reduce conflicts because
 648    the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
 649    =exp) or just an exp.  If name_not_typename was ever used in an lvalue
 650    context where only a name could occur, this might be useful.
 651         |       NAME_OR_INT
 652    */
 653         ;
 654
 655 %%
 656
 657 /* Take care of parsing a number (anything that starts with a digit).
 658    Set yylval and return the token type; update lexptr.
 659    LEN is the number of characters in it.  */
 660
 661 /*** Needs some error checking for the float case ***/
 662
 663 static int
 664 parse_number (struct parser_state *par_state,
 665               const char *p, int len, int parsed_float, YYSTYPE *putithere)
 666 {
 667   LONGEST n = 0;
 668   LONGEST prevn = 0;
 669   int c;
 670   int base = input_radix;
 671   int unsigned_p = 0;
 672   int long_p = 0;
 673   ULONGEST high_bit;
 674   struct type *signed_type;
 675   struct type *unsigned_type;
 676
 677   if (parsed_float)
 678     {
 679       /* It's a float since it contains a point or an exponent.  */
 680       /* [dD] is not understood as an exponent by parse_float,
 681          change it to 'e'.  */
 682       char *tmp, *tmp2;
 683
 684       tmp = xstrdup (p);
 685       for (tmp2 = tmp; *tmp2; ++tmp2)
 686         if (*tmp2 == 'd' || *tmp2 == 'D')
 687           *tmp2 = 'e';
 688
 689       /* FIXME: Should this use different types?  */
 690       putithere->typed_val_float.type = parse_f_type (pstate)->builtin_real_s8;
 691       bool parsed = parse_float (tmp, len,
 692                                  putithere->typed_val_float.type,
 693                                  putithere->typed_val_float.val);
 694       free (tmp);
 695       return parsed? FLOAT : ERROR;
 696     }
 697
 698   /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
 699   if (p[0] == '0')
 700     switch (p[1])
 701       {
 702       case 'x':
 703       case 'X':
 704         if (len >= 3)
 705           {
 706             p += 2;
 707             base = 16;
 708             len -= 2;
 709           }
 710         break;
 711
 712       case 't':
 713       case 'T':
 714       case 'd':
 715       case 'D':
 716         if (len >= 3)
 717           {
 718             p += 2;
 719             base = 10;
 720             len -= 2;
 721           }
 722         break;
 723
 724       default:
 725         base = 8;
 726         break;
 727       }
 728
 729   while (len-- > 0)
 730     {
 731       c = *p++;
 732       if (isupper (c))
 733         c = tolower (c);
 734       if (len == 0 && c == 'l')
 735         long_p = 1;
 736       else if (len == 0 && c == 'u')
 737         unsigned_p = 1;
 738       else
 739         {
 740           int i;
 741           if (c >= '0' && c <= '9')
 742             i = c - '0';
 743           else if (c >= 'a' && c <= 'f')
 744             i = c - 'a' + 10;
 745           else
 746             return ERROR;       /* Char not a digit */
 747           if (i >= base)
 748             return ERROR;               /* Invalid digit in this base */
 749           n *= base;
 750           n += i;
 751         }
 752       /* Portably test for overflow (only works for nonzero values, so make
 753          a second check for zero).  */
 754       if ((prevn >= n) && n != 0)
 755         unsigned_p=1;           /* Try something unsigned */
 756       /* If range checking enabled, portably test for unsigned overflow.  */
 757       if (RANGE_CHECK && n != 0)
 758         {
 759           if ((unsigned_p && (unsigned)prevn >= (unsigned)n))
 760             range_error (_("Overflow on numeric constant."));
 761         }
 762       prevn = n;
 763     }
 764
 765   /* If the number is too big to be an int, or it's got an l suffix
 766      then it's a long.  Work out if this has to be a long by
 767      shifting right and seeing if anything remains, and the
 768      target int size is different to the target long size.
 769
 770      In the expression below, we could have tested
 771      (n >> gdbarch_int_bit (parse_gdbarch))
 772      to see if it was zero,
 773      but too many compilers warn about that, when ints and longs
 774      are the same size.  So we shift it twice, with fewer bits
 775      each time, for the same result.  */
 776
 777   if ((gdbarch_int_bit (par_state->gdbarch ())
 778        != gdbarch_long_bit (par_state->gdbarch ())
 779        && ((n >> 2)
 780            >> (gdbarch_int_bit (par_state->gdbarch ())-2))) /* Avoid
 781                                                             shift warning */
 782       || long_p)
 783     {
 784       high_bit = ((ULONGEST)1)
 785       << (gdbarch_long_bit (par_state->gdbarch ())-1);
 786       unsigned_type = parse_type (par_state)->builtin_unsigned_long;
 787       signed_type = parse_type (par_state)->builtin_long;
 788     }
 789   else
 790     {
 791       high_bit =
 792         ((ULONGEST)1) << (gdbarch_int_bit (par_state->gdbarch ()) - 1);
 793       unsigned_type = parse_type (par_state)->builtin_unsigned_int;
 794       signed_type = parse_type (par_state)->builtin_int;
 795     }
 796
 797   putithere->typed_val.val = n;
 798
 799   /* If the high bit of the worked out type is set then this number
 800      has to be unsigned.  */
 801
 802   if (unsigned_p || (n & high_bit))
 803     putithere->typed_val.type = unsigned_type;
 804   else
 805     putithere->typed_val.type = signed_type;
 806
 807   return INT;
 808 }
 809
 810 /* Called to setup the type stack when we encounter a '(kind=N)' type
 811    modifier, performs some bounds checking on 'N' and then pushes this to
 812    the type stack followed by the 'tp_kind' marker.  */
 813 static void
 814 push_kind_type (LONGEST val, struct type *type)
 815 {
 816   int ival;
 817
 818   if (TYPE_UNSIGNED (type))
 819     {
 820       ULONGEST uval = static_cast <ULONGEST> (val);
 821       if (uval > INT_MAX)
 822         error (_("kind value out of range"));
 823       ival = static_cast <int> (uval);
 824     }
 825   else
 826     {
 827       if (val > INT_MAX || val < 0)
 828         error (_("kind value out of range"));
 829       ival = static_cast <int> (val);
 830     }
 831
 832   type_stack->push (ival);
 833   type_stack->push (tp_kind);
 834 }
 835
 836 /* Called when a type has a '(kind=N)' modifier after it, for example
 837    'character(kind=1)'.  The BASETYPE is the type described by 'character'
 838    in our example, and KIND is the integer '1'.  This function returns a
 839    new type that represents the basetype of a specific kind.  */
 840 static struct type *
 841 convert_to_kind_type (struct type *basetype, int kind)
 842 {
 843   if (basetype == parse_f_type (pstate)->builtin_character)
 844     {
 845       /* Character of kind 1 is a special case, this is the same as the
 846          base character type.  */
 847       if (kind == 1)
 848         return parse_f_type (pstate)->builtin_character;
 849     }
 850   else if (basetype == parse_f_type (pstate)->builtin_complex_s8)
 851     {
 852       if (kind == 4)
 853         return parse_f_type (pstate)->builtin_complex_s8;
 854       else if (kind == 8)
 855         return parse_f_type (pstate)->builtin_complex_s16;
 856       else if (kind == 16)
 857         return parse_f_type (pstate)->builtin_complex_s32;
 858     }
 859   else if (basetype == parse_f_type (pstate)->builtin_real)
 860     {
 861       if (kind == 4)
 862         return parse_f_type (pstate)->builtin_real;
 863       else if (kind == 8)
 864         return parse_f_type (pstate)->builtin_real_s8;
 865       else if (kind == 16)
 866         return parse_f_type (pstate)->builtin_real_s16;
 867     }
 868   else if (basetype == parse_f_type (pstate)->builtin_logical)
 869     {
 870       if (kind == 1)
 871         return parse_f_type (pstate)->builtin_logical_s1;
 872       else if (kind == 2)
 873         return parse_f_type (pstate)->builtin_logical_s2;
 874       else if (kind == 4)
 875         return parse_f_type (pstate)->builtin_logical;
 876       else if (kind == 8)
 877         return parse_f_type (pstate)->builtin_logical_s8;
 878     }
 879   else if (basetype == parse_f_type (pstate)->builtin_integer)
 880     {
 881       if (kind == 2)
 882         return parse_f_type (pstate)->builtin_integer_s2;
 883       else if (kind == 4)
 884         return parse_f_type (pstate)->builtin_integer;
 885       else if (kind == 8)
 886         return parse_f_type (pstate)->builtin_integer_s8;
 887     }
 888
 889   error (_("unsupported kind %d for type %s"),
 890          kind, TYPE_SAFE_NAME (basetype));
 891
 892   /* Should never get here.  */
 893   return nullptr;
 894 }
 895
 896 struct token
 897 {
 898   /* The string to match against.  */
 899   const char *oper;
 900
 901   /* The lexer token to return.  */
 902   int token;
 903
 904   /* The expression opcode to embed within the token.  */
 905   enum exp_opcode opcode;
 906
 907   /* When this is true the string in OPER is matched exactly including
 908      case, when this is false OPER is matched case insensitively.  */
 909   bool case_sensitive;
 910 };
 911
 912 static const struct token dot_ops[] =
 913 {
 914   { ".and.", BOOL_AND, BINOP_END, false },
 915   { ".or.", BOOL_OR, BINOP_END, false },
 916   { ".not.", BOOL_NOT, BINOP_END, false },
 917   { ".eq.", EQUAL, BINOP_END, false },
 918   { ".eqv.", EQUAL, BINOP_END, false },
 919   { ".neqv.", NOTEQUAL, BINOP_END, false },
 920   { ".ne.", NOTEQUAL, BINOP_END, false },
 921   { ".le.", LEQ, BINOP_END, false },
 922   { ".ge.", GEQ, BINOP_END, false },
 923   { ".gt.", GREATERTHAN, BINOP_END, false },
 924   { ".lt.", LESSTHAN, BINOP_END, false },
 925 };
 926
 927 /* Holds the Fortran representation of a boolean, and the integer value we
 928    substitute in when one of the matching strings is parsed.  */
 929 struct f77_boolean_val
 930 {
 931   /* The string representing a Fortran boolean.  */
 932   const char *name;
 933
 934   /* The integer value to replace it with.  */
 935   int value;
 936 };
 937
 938 /* The set of Fortran booleans.  These are matched case insensitively.  */
 939 static const struct f77_boolean_val boolean_values[]  =
 940 {
 941   { ".true.", 1 },
 942   { ".false.", 0 }
 943 };
 944
 945 static const struct token f77_keywords[] =
 946 {
 947   /* Historically these have always been lowercase only in GDB.  */
 948   { "complex_16", COMPLEX_S16_KEYWORD, BINOP_END, true },
 949   { "complex_32", COMPLEX_S32_KEYWORD, BINOP_END, true },
 950   { "character", CHARACTER, BINOP_END, true },
 951   { "integer_2", INT_S2_KEYWORD, BINOP_END, true },
 952   { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END, true },
 953   { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END, true },
 954   { "logical_8", LOGICAL_S8_KEYWORD, BINOP_END, true },
 955   { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END, true },
 956   { "integer", INT_KEYWORD, BINOP_END, true },
 957   { "logical", LOGICAL_KEYWORD, BINOP_END, true },
 958   { "real_16", REAL_S16_KEYWORD, BINOP_END, true },
 959   { "complex", COMPLEX_S8_KEYWORD, BINOP_END, true },
 960   { "sizeof", SIZEOF, BINOP_END, true },
 961   { "real_8", REAL_S8_KEYWORD, BINOP_END, true },
 962   { "real", REAL_KEYWORD, BINOP_END, true },
 963   /* The following correspond to actual functions in Fortran and are case
 964      insensitive.  */
 965   { "kind", KIND, BINOP_END, false },
 966   { "abs", UNOP_INTRINSIC, UNOP_ABS, false },
 967   { "mod", BINOP_INTRINSIC, BINOP_MOD, false },
 968   { "floor", UNOP_INTRINSIC, UNOP_FORTRAN_FLOOR, false },
 969   { "ceiling", UNOP_INTRINSIC, UNOP_FORTRAN_CEILING, false },
 970   { "modulo", BINOP_INTRINSIC, BINOP_FORTRAN_MODULO, false },
 971   { "cmplx", BINOP_INTRINSIC, BINOP_FORTRAN_CMPLX, false },
 972 };
 973
 974 /* Implementation of a dynamically expandable buffer for processing input
 975    characters acquired through lexptr and building a value to return in
 976    yylval.  Ripped off from ch-exp.y */
 977
 978 static char *tempbuf;           /* Current buffer contents */
 979 static int tempbufsize;         /* Size of allocated buffer */
 980 static int tempbufindex;        /* Current index into buffer */
 981
 982 #define GROWBY_MIN_SIZE 64      /* Minimum amount to grow buffer by */
 983
 984 #define CHECKBUF(size) \
 985   do { \
 986     if (tempbufindex + (size) >= tempbufsize) \
 987       { \
 988         growbuf_by_size (size); \
 989       } \
 990   } while (0);
 991
 992
 993 /* Grow the static temp buffer if necessary, including allocating the
 994    first one on demand.  */
 995
 996 static void
 997 growbuf_by_size (int count)
 998 {
 999   int growby;
1000
1001   growby = std::max (count, GROWBY_MIN_SIZE);
1002   tempbufsize += growby;
1003   if (tempbuf == NULL)
1004     tempbuf = (char *) malloc (tempbufsize);
1005   else
1006     tempbuf = (char *) realloc (tempbuf, tempbufsize);
1007 }
1008
1009 /* Blatantly ripped off from ch-exp.y. This routine recognizes F77
1010    string-literals.
1011
1012    Recognize a string literal.  A string literal is a nonzero sequence
1013    of characters enclosed in matching single quotes, except that
1014    a single character inside single quotes is a character literal, which
1015    we reject as a string literal.  To embed the terminator character inside
1016    a string, it is simply doubled (I.E. 'this''is''one''string') */
1017
1018 static int
1019 match_string_literal (void)
1020 {
1021   const char *tokptr = pstate->lexptr;
1022
1023   for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
1024     {
1025       CHECKBUF (1);
1026       if (*tokptr == *pstate->lexptr)
1027         {
1028           if (*(tokptr + 1) == *pstate->lexptr)
1029             tokptr++;
1030           else
1031             break;
1032         }
1033       tempbuf[tempbufindex++] = *tokptr;
1034     }
1035   if (*tokptr == '\0'                                   /* no terminator */
1036       || tempbufindex == 0)                             /* no string */
1037     return 0;
1038   else
1039     {
1040       tempbuf[tempbufindex] = '\0';
1041       yylval.sval.ptr = tempbuf;
1042       yylval.sval.length = tempbufindex;
1043       pstate->lexptr = ++tokptr;
1044       return STRING_LITERAL;
1045     }
1046 }
1047
1048 /* Read one token, getting characters through lexptr.  */
1049
1050 static int
1051 yylex (void)
1052 {
1053   int c;
1054   int namelen;
1055   unsigned int token;
1056   const char *tokstart;
1057
1058  retry:
1059
1060   pstate->prev_lexptr = pstate->lexptr;
1061
1062   tokstart = pstate->lexptr;
1063
1064   /* First of all, let us make sure we are not dealing with the
1065      special tokens .true. and .false. which evaluate to 1 and 0.  */
1066
1067   if (*pstate->lexptr == '.')
1068     {
1069       for (int i = 0; i < ARRAY_SIZE (boolean_values); i++)
1070         {
1071           if (strncasecmp (tokstart, boolean_values[i].name,
1072                            strlen (boolean_values[i].name)) == 0)
1073             {
1074               pstate->lexptr += strlen (boolean_values[i].name);
1075               yylval.lval = boolean_values[i].value;
1076               return BOOLEAN_LITERAL;
1077             }
1078         }
1079     }
1080
1081   /* See if it is a special .foo. operator.  */
1082   for (int i = 0; i < ARRAY_SIZE (dot_ops); i++)
1083     if (strncasecmp (tokstart, dot_ops[i].oper,
1084                      strlen (dot_ops[i].oper)) == 0)
1085       {
1086         gdb_assert (!dot_ops[i].case_sensitive);
1087         pstate->lexptr += strlen (dot_ops[i].oper);
1088         yylval.opcode = dot_ops[i].opcode;
1089         return dot_ops[i].token;
1090       }
1091
1092   /* See if it is an exponentiation operator.  */
1093
1094   if (strncmp (tokstart, "**", 2) == 0)
1095     {
1096       pstate->lexptr += 2;
1097       yylval.opcode = BINOP_EXP;
1098       return STARSTAR;
1099     }
1100
1101   switch (c = *tokstart)
1102     {
1103     case 0:
1104       return 0;
1105
1106     case ' ':
1107     case '\t':
1108     case '\n':
1109       pstate->lexptr++;
1110       goto retry;
1111
1112     case '\'':
1113       token = match_string_literal ();
1114       if (token != 0)
1115         return (token);
1116       break;
1117
1118     case '(':
1119       paren_depth++;
1120       pstate->lexptr++;
1121       return c;
1122
1123     case ')':
1124       if (paren_depth == 0)
1125         return 0;
1126       paren_depth--;
1127       pstate->lexptr++;
1128       return c;
1129
1130     case ',':
1131       if (pstate->comma_terminates && paren_depth == 0)
1132         return 0;
1133       pstate->lexptr++;
1134       return c;
1135
1136     case '.':
1137       /* Might be a floating point number.  */
1138       if (pstate->lexptr[1] < '0' || pstate->lexptr[1] > '9')
1139         goto symbol;            /* Nope, must be a symbol.  */
1140       /* FALL THRU.  */
1141
1142     case '0':
1143     case '1':
1144     case '2':
1145     case '3':
1146     case '4':
1147     case '5':
1148     case '6':
1149     case '7':
1150     case '8':
1151     case '9':
1152       {
1153         /* It's a number.  */
1154         int got_dot = 0, got_e = 0, got_d = 0, toktype;
1155         const char *p = tokstart;
1156         int hex = input_radix > 10;
1157
1158         if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1159           {
1160             p += 2;
1161             hex = 1;
1162           }
1163         else if (c == '0' && (p[1]=='t' || p[1]=='T'
1164                               || p[1]=='d' || p[1]=='D'))
1165           {
1166             p += 2;
1167             hex = 0;
1168           }
1169
1170         for (;; ++p)
1171           {
1172             if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1173               got_dot = got_e = 1;
1174             else if (!hex && !got_d && (*p == 'd' || *p == 'D'))
1175               got_dot = got_d = 1;
1176             else if (!hex && !got_dot && *p == '.')
1177               got_dot = 1;
1178             else if (((got_e && (p[-1] == 'e' || p[-1] == 'E'))
1179                      || (got_d && (p[-1] == 'd' || p[-1] == 'D')))
1180                      && (*p == '-' || *p == '+'))
1181               /* This is the sign of the exponent, not the end of the
1182                  number.  */
1183               continue;
1184             /* We will take any letters or digits.  parse_number will
1185                complain if past the radix, or if L or U are not final.  */
1186             else if ((*p < '0' || *p > '9')
1187                      && ((*p < 'a' || *p > 'z')
1188                          && (*p < 'A' || *p > 'Z')))
1189               break;
1190           }
1191         toktype = parse_number (pstate, tokstart, p - tokstart,
1192                                 got_dot|got_e|got_d,
1193                                 &yylval);
1194         if (toktype == ERROR)
1195           {
1196             char *err_copy = (char *) alloca (p - tokstart + 1);
1197
1198             memcpy (err_copy, tokstart, p - tokstart);
1199             err_copy[p - tokstart] = 0;
1200             error (_("Invalid number \"%s\"."), err_copy);
1201           }
1202         pstate->lexptr = p;
1203         return toktype;
1204       }
1205
1206     case '+':
1207     case '-':
1208     case '*':
1209     case '/':
1210     case '%':
1211     case '|':
1212     case '&':
1213     case '^':
1214     case '~':
1215     case '!':
1216     case '@':
1217     case '<':
1218     case '>':
1219     case '[':
1220     case ']':
1221     case '?':
1222     case ':':
1223     case '=':
1224     case '{':
1225     case '}':
1226     symbol:
1227       pstate->lexptr++;
1228       return c;
1229     }
1230
1231   if (!(c == '_' || c == '$' || c ==':'
1232         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1233     /* We must have come across a bad character (e.g. ';').  */
1234     error (_("Invalid character '%c' in expression."), c);
1235
1236   namelen = 0;
1237   for (c = tokstart[namelen];
1238        (c == '_' || c == '$' || c == ':' || (c >= '0' && c <= '9')
1239         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
1240        c = tokstart[++namelen]);
1241
1242   /* The token "if" terminates the expression and is NOT
1243      removed from the input stream.  */
1244
1245   if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1246     return 0;
1247
1248   pstate->lexptr += namelen;
1249
1250   /* Catch specific keywords.  */
1251
1252   for (int i = 0; i < ARRAY_SIZE (f77_keywords); i++)
1253     if (strlen (f77_keywords[i].oper) == namelen
1254         && ((!f77_keywords[i].case_sensitive
1255              && strncasecmp (tokstart, f77_keywords[i].oper, namelen) == 0)
1256             || (f77_keywords[i].case_sensitive
1257                 && strncmp (tokstart, f77_keywords[i].oper, namelen) == 0)))
1258       {
1259         yylval.opcode = f77_keywords[i].opcode;
1260         return f77_keywords[i].token;
1261       }
1262
1263   yylval.sval.ptr = tokstart;
1264   yylval.sval.length = namelen;
1265
1266   if (*tokstart == '$')
1267     {
1268       write_dollar_variable (pstate, yylval.sval);
1269       return DOLLAR_VARIABLE;
1270     }
1271
1272   /* Use token-type TYPENAME for symbols that happen to be defined
1273      currently as names of types; NAME for other symbols.
1274      The caller is not constrained to care about the distinction.  */
1275   {
1276     std::string tmp = copy_name (yylval.sval);
1277     struct block_symbol result;
1278     enum domain_enum_tag lookup_domains[] =
1279     {
1280       STRUCT_DOMAIN,
1281       VAR_DOMAIN,
1282       MODULE_DOMAIN
1283     };
1284     int hextype;
1285
1286     for (int i = 0; i < ARRAY_SIZE (lookup_domains); ++i)
1287       {
1288         result = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1289                                 lookup_domains[i], NULL);
1290         if (result.symbol && SYMBOL_CLASS (result.symbol) == LOC_TYPEDEF)
1291           {
1292             yylval.tsym.type = SYMBOL_TYPE (result.symbol);
1293             return TYPENAME;
1294           }
1295
1296         if (result.symbol)
1297           break;
1298       }
1299
1300     yylval.tsym.type
1301       = language_lookup_primitive_type (pstate->language (),
1302                                         pstate->gdbarch (), tmp.c_str ());
1303     if (yylval.tsym.type != NULL)
1304       return TYPENAME;
1305
1306     /* Input names that aren't symbols but ARE valid hex numbers,
1307        when the input radix permits them, can be names or numbers
1308        depending on the parse.  Note we support radixes > 16 here.  */
1309     if (!result.symbol
1310         && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1311             || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1312       {
1313         YYSTYPE newlval;        /* Its value is ignored.  */
1314         hextype = parse_number (pstate, tokstart, namelen, 0, &newlval);
1315         if (hextype == INT)
1316           {
1317             yylval.ssym.sym = result;
1318             yylval.ssym.is_a_field_of_this = false;
1319             return NAME_OR_INT;
1320           }
1321       }
1322
1323     /* Any other kind of symbol */
1324     yylval.ssym.sym = result;
1325     yylval.ssym.is_a_field_of_this = false;
1326     return NAME;
1327   }
1328 }
1329
1330 int
1331 f_parse (struct parser_state *par_state)
1332 {
1333   /* Setting up the parser state.  */
1334   scoped_restore pstate_restore = make_scoped_restore (&pstate);
1335   scoped_restore restore_yydebug = make_scoped_restore (&yydebug,
1336                                                         parser_debug);
1337   gdb_assert (par_state != NULL);
1338   pstate = par_state;
1339   paren_depth = 0;
1340
1341   struct type_stack stack;
1342   scoped_restore restore_type_stack = make_scoped_restore (&type_stack,
1343                                                            &stack);
1344
1345   return yyparse ();
1346 }
1347
1348 static void
1349 yyerror (const char *msg)
1350 {
1351   if (pstate->prev_lexptr)
1352     pstate->lexptr = pstate->prev_lexptr;
1353
1354   error (_("A %s in expression, near `%s'."), msg, pstate->lexptr);
1355 }