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
 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_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 arglist :
 267         ;
 268
 269 arglist :       exp
 270                         { pstate->arglist_len = 1; }
 271         ;
 272
 273 arglist :       subrange
 274                         { pstate->arglist_len = 1; }
 275         ;
 276
 277 arglist :       arglist ',' exp   %prec ABOVE_COMMA
 278                         { pstate->arglist_len++; }
 279         ;
 280
 281 /* There are four sorts of subrange types in F90.  */
 282
 283 subrange:       exp ':' exp     %prec ABOVE_COMMA
 284                         { write_exp_elt_opcode (pstate, OP_RANGE);
 285                           write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT);
 286                           write_exp_elt_opcode (pstate, OP_RANGE); }
 287         ;
 288
 289 subrange:       exp ':' %prec ABOVE_COMMA
 290                         { write_exp_elt_opcode (pstate, OP_RANGE);
 291                           write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT);
 292                           write_exp_elt_opcode (pstate, OP_RANGE); }
 293         ;
 294
 295 subrange:       ':' exp %prec ABOVE_COMMA
 296                         { write_exp_elt_opcode (pstate, OP_RANGE);
 297                           write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT);
 298                           write_exp_elt_opcode (pstate, OP_RANGE); }
 299         ;
 300
 301 subrange:       ':'     %prec ABOVE_COMMA
 302                         { write_exp_elt_opcode (pstate, OP_RANGE);
 303                           write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT);
 304                           write_exp_elt_opcode (pstate, OP_RANGE); }
 305         ;
 306
 307 complexnum:     exp ',' exp
 308                         { }
 309         ;
 310
 311 exp     :       '(' complexnum ')'
 312                         { write_exp_elt_opcode (pstate, OP_COMPLEX);
 313                           write_exp_elt_type (pstate,
 314                                               parse_f_type (pstate)
 315                                               ->builtin_complex_s16);
 316                           write_exp_elt_opcode (pstate, OP_COMPLEX); }
 317         ;
 318
 319 exp     :       '(' type ')' exp  %prec UNARY
 320                         { write_exp_elt_opcode (pstate, UNOP_CAST);
 321                           write_exp_elt_type (pstate, $2);
 322                           write_exp_elt_opcode (pstate, UNOP_CAST); }
 323         ;
 324
 325 exp     :       exp '%' name
 326                         { write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
 327                           write_exp_string (pstate, $3);
 328                           write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
 329         ;
 330
 331 /* Binary operators in order of decreasing precedence.  */
 332
 333 exp     :       exp '@' exp
 334                         { write_exp_elt_opcode (pstate, BINOP_REPEAT); }
 335         ;
 336
 337 exp     :       exp STARSTAR exp
 338                         { write_exp_elt_opcode (pstate, BINOP_EXP); }
 339         ;
 340
 341 exp     :       exp '*' exp
 342                         { write_exp_elt_opcode (pstate, BINOP_MUL); }
 343         ;
 344
 345 exp     :       exp '/' exp
 346                         { write_exp_elt_opcode (pstate, BINOP_DIV); }
 347         ;
 348
 349 exp     :       exp '+' exp
 350                         { write_exp_elt_opcode (pstate, BINOP_ADD); }
 351         ;
 352
 353 exp     :       exp '-' exp
 354                         { write_exp_elt_opcode (pstate, BINOP_SUB); }
 355         ;
 356
 357 exp     :       exp LSH exp
 358                         { write_exp_elt_opcode (pstate, BINOP_LSH); }
 359         ;
 360
 361 exp     :       exp RSH exp
 362                         { write_exp_elt_opcode (pstate, BINOP_RSH); }
 363         ;
 364
 365 exp     :       exp EQUAL exp
 366                         { write_exp_elt_opcode (pstate, BINOP_EQUAL); }
 367         ;
 368
 369 exp     :       exp NOTEQUAL exp
 370                         { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
 371         ;
 372
 373 exp     :       exp LEQ exp
 374                         { write_exp_elt_opcode (pstate, BINOP_LEQ); }
 375         ;
 376
 377 exp     :       exp GEQ exp
 378                         { write_exp_elt_opcode (pstate, BINOP_GEQ); }
 379         ;
 380
 381 exp     :       exp LESSTHAN exp
 382                         { write_exp_elt_opcode (pstate, BINOP_LESS); }
 383         ;
 384
 385 exp     :       exp GREATERTHAN exp
 386                         { write_exp_elt_opcode (pstate, BINOP_GTR); }
 387         ;
 388
 389 exp     :       exp '&' exp
 390                         { write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
 391         ;
 392
 393 exp     :       exp '^' exp
 394                         { write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
 395         ;
 396
 397 exp     :       exp '|' exp
 398                         { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
 399         ;
 400
 401 exp     :       exp BOOL_AND exp
 402                         { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
 403         ;
 404
 405
 406 exp     :       exp BOOL_OR exp
 407                         { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
 408         ;
 409
 410 exp     :       exp '=' exp
 411                         { write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
 412         ;
 413
 414 exp     :       exp ASSIGN_MODIFY exp
 415                         { write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY);
 416                           write_exp_elt_opcode (pstate, $2);
 417                           write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY); }
 418         ;
 419
 420 exp     :       INT
 421                         { write_exp_elt_opcode (pstate, OP_LONG);
 422                           write_exp_elt_type (pstate, $1.type);
 423                           write_exp_elt_longcst (pstate, (LONGEST) ($1.val));
 424                           write_exp_elt_opcode (pstate, OP_LONG); }
 425         ;
 426
 427 exp     :       NAME_OR_INT
 428                         { YYSTYPE val;
 429                           parse_number (pstate, $1.stoken.ptr,
 430                                         $1.stoken.length, 0, &val);
 431                           write_exp_elt_opcode (pstate, OP_LONG);
 432                           write_exp_elt_type (pstate, val.typed_val.type);
 433                           write_exp_elt_longcst (pstate,
 434                                                  (LONGEST)val.typed_val.val);
 435                           write_exp_elt_opcode (pstate, OP_LONG); }
 436         ;
 437
 438 exp     :       FLOAT
 439                         { write_exp_elt_opcode (pstate, OP_FLOAT);
 440                           write_exp_elt_type (pstate, $1.type);
 441                           write_exp_elt_floatcst (pstate, $1.val);
 442                           write_exp_elt_opcode (pstate, OP_FLOAT); }
 443         ;
 444
 445 exp     :       variable
 446         ;
 447
 448 exp     :       DOLLAR_VARIABLE
 449         ;
 450
 451 exp     :       SIZEOF '(' type ')'     %prec UNARY
 452                         { write_exp_elt_opcode (pstate, OP_LONG);
 453                           write_exp_elt_type (pstate,
 454                                               parse_f_type (pstate)
 455                                               ->builtin_integer);
 456                           $3 = check_typedef ($3);
 457                           write_exp_elt_longcst (pstate,
 458                                                  (LONGEST) TYPE_LENGTH ($3));
 459                           write_exp_elt_opcode (pstate, OP_LONG); }
 460         ;
 461
 462 exp     :       BOOLEAN_LITERAL
 463                         { write_exp_elt_opcode (pstate, OP_BOOL);
 464                           write_exp_elt_longcst (pstate, (LONGEST) $1);
 465                           write_exp_elt_opcode (pstate, OP_BOOL);
 466                         }
 467         ;
 468
 469 exp     :       STRING_LITERAL
 470                         {
 471                           write_exp_elt_opcode (pstate, OP_STRING);
 472                           write_exp_string (pstate, $1);
 473                           write_exp_elt_opcode (pstate, OP_STRING);
 474                         }
 475         ;
 476
 477 variable:       name_not_typename
 478                         { struct block_symbol sym = $1.sym;
 479
 480                           if (sym.symbol)
 481                             {
 482                               if (symbol_read_needs_frame (sym.symbol))
 483                                 pstate->block_tracker->update (sym);
 484                               write_exp_elt_opcode (pstate, OP_VAR_VALUE);
 485                               write_exp_elt_block (pstate, sym.block);
 486                               write_exp_elt_sym (pstate, sym.symbol);
 487                               write_exp_elt_opcode (pstate, OP_VAR_VALUE);
 488                               break;
 489                             }
 490                           else
 491                             {
 492                               struct bound_minimal_symbol msymbol;
 493                               char *arg = copy_name ($1.stoken);
 494
 495                               msymbol =
 496                                 lookup_bound_minimal_symbol (arg);
 497                               if (msymbol.minsym != NULL)
 498                                 write_exp_msymbol (pstate, msymbol);
 499                               else if (!have_full_symbols () && !have_partial_symbols ())
 500                                 error (_("No symbol table is loaded.  Use the \"file\" command."));
 501                               else
 502                                 error (_("No symbol \"%s\" in current context."),
 503                                        copy_name ($1.stoken));
 504                             }
 505                         }
 506         ;
 507
 508
 509 type    :       ptype
 510         ;
 511
 512 ptype   :       typebase
 513         |       typebase abs_decl
 514                 {
 515                   /* This is where the interesting stuff happens.  */
 516                   int done = 0;
 517                   int array_size;
 518                   struct type *follow_type = $1;
 519                   struct type *range_type;
 520
 521                   while (!done)
 522                     switch (type_stack->pop ())
 523                       {
 524                       case tp_end:
 525                         done = 1;
 526                         break;
 527                       case tp_pointer:
 528                         follow_type = lookup_pointer_type (follow_type);
 529                         break;
 530                       case tp_reference:
 531                         follow_type = lookup_lvalue_reference_type (follow_type);
 532                         break;
 533                       case tp_array:
 534                         array_size = type_stack->pop_int ();
 535                         if (array_size != -1)
 536                           {
 537                             range_type =
 538                               create_static_range_type ((struct type *) NULL,
 539                                                         parse_f_type (pstate)
 540                                                         ->builtin_integer,
 541                                                         0, array_size - 1);
 542                             follow_type =
 543                               create_array_type ((struct type *) NULL,
 544                                                  follow_type, range_type);
 545                           }
 546                         else
 547                           follow_type = lookup_pointer_type (follow_type);
 548                         break;
 549                       case tp_function:
 550                         follow_type = lookup_function_type (follow_type);
 551                         break;
 552                       case tp_kind:
 553                         {
 554                           int kind_val = type_stack->pop_int ();
 555                           follow_type
 556                             = convert_to_kind_type (follow_type, kind_val);
 557                         }
 558                         break;
 559                       }
 560                   $$ = follow_type;
 561                 }
 562         ;
 563
 564 abs_decl:       '*'
 565                         { type_stack->push (tp_pointer); $$ = 0; }
 566         |       '*' abs_decl
 567                         { type_stack->push (tp_pointer); $$ = $2; }
 568         |       '&'
 569                         { type_stack->push (tp_reference); $$ = 0; }
 570         |       '&' abs_decl
 571                         { type_stack->push (tp_reference); $$ = $2; }
 572         |       direct_abs_decl
 573         ;
 574
 575 direct_abs_decl: '(' abs_decl ')'
 576                         { $$ = $2; }
 577         |       '(' KIND '=' INT ')'
 578                         { push_kind_type ($4.val, $4.type); }
 579         |       '*' INT
 580                         { push_kind_type ($2.val, $2.type); }
 581         |       direct_abs_decl func_mod
 582                         { type_stack->push (tp_function); }
 583         |       func_mod
 584                         { type_stack->push (tp_function); }
 585         ;
 586
 587 func_mod:       '(' ')'
 588                         { $$ = 0; }
 589         |       '(' nonempty_typelist ')'
 590                         { free ($2); $$ = 0; }
 591         ;
 592
 593 typebase  /* Implements (approximately): (type-qualifier)* type-specifier */
 594         :       TYPENAME
 595                         { $$ = $1.type; }
 596         |       INT_KEYWORD
 597                         { $$ = parse_f_type (pstate)->builtin_integer; }
 598         |       INT_S2_KEYWORD
 599                         { $$ = parse_f_type (pstate)->builtin_integer_s2; }
 600         |       CHARACTER
 601                         { $$ = parse_f_type (pstate)->builtin_character; }
 602         |       LOGICAL_S8_KEYWORD
 603                         { $$ = parse_f_type (pstate)->builtin_logical_s8; }
 604         |       LOGICAL_KEYWORD
 605                         { $$ = parse_f_type (pstate)->builtin_logical; }
 606         |       LOGICAL_S2_KEYWORD
 607                         { $$ = parse_f_type (pstate)->builtin_logical_s2; }
 608         |       LOGICAL_S1_KEYWORD
 609                         { $$ = parse_f_type (pstate)->builtin_logical_s1; }
 610         |       REAL_KEYWORD
 611                         { $$ = parse_f_type (pstate)->builtin_real; }
 612         |       REAL_S8_KEYWORD
 613                         { $$ = parse_f_type (pstate)->builtin_real_s8; }
 614         |       REAL_S16_KEYWORD
 615                         { $$ = parse_f_type (pstate)->builtin_real_s16; }
 616         |       COMPLEX_S8_KEYWORD
 617                         { $$ = parse_f_type (pstate)->builtin_complex_s8; }
 618         |       COMPLEX_S16_KEYWORD
 619                         { $$ = parse_f_type (pstate)->builtin_complex_s16; }
 620         |       COMPLEX_S32_KEYWORD
 621                         { $$ = parse_f_type (pstate)->builtin_complex_s32; }
 622         ;
 623
 624 nonempty_typelist
 625         :       type
 626                 { $$ = (struct type **) malloc (sizeof (struct type *) * 2);
 627                   $<ivec>$[0] = 1;      /* Number of types in vector */
 628                   $$[1] = $1;
 629                 }
 630         |       nonempty_typelist ',' type
 631                 { int len = sizeof (struct type *) * (++($<ivec>1[0]) + 1);
 632                   $$ = (struct type **) realloc ((char *) $1, len);
 633                   $$[$<ivec>$[0]] = $3;
 634                 }
 635         ;
 636
 637 name    :       NAME
 638                 {  $$ = $1.stoken; }
 639         ;
 640
 641 name_not_typename :     NAME
 642 /* These would be useful if name_not_typename was useful, but it is just
 643    a fake for "variable", so these cause reduce/reduce conflicts because
 644    the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
 645    =exp) or just an exp.  If name_not_typename was ever used in an lvalue
 646    context where only a name could occur, this might be useful.
 647         |       NAME_OR_INT
 648    */
 649         ;
 650
 651 %%
 652
 653 /* Take care of parsing a number (anything that starts with a digit).
 654    Set yylval and return the token type; update lexptr.
 655    LEN is the number of characters in it.  */
 656
 657 /*** Needs some error checking for the float case ***/
 658
 659 static int
 660 parse_number (struct parser_state *par_state,
 661               const char *p, int len, int parsed_float, YYSTYPE *putithere)
 662 {
 663   LONGEST n = 0;
 664   LONGEST prevn = 0;
 665   int c;
 666   int base = input_radix;
 667   int unsigned_p = 0;
 668   int long_p = 0;
 669   ULONGEST high_bit;
 670   struct type *signed_type;
 671   struct type *unsigned_type;
 672
 673   if (parsed_float)
 674     {
 675       /* It's a float since it contains a point or an exponent.  */
 676       /* [dD] is not understood as an exponent by parse_float,
 677          change it to 'e'.  */
 678       char *tmp, *tmp2;
 679
 680       tmp = xstrdup (p);
 681       for (tmp2 = tmp; *tmp2; ++tmp2)
 682         if (*tmp2 == 'd' || *tmp2 == 'D')
 683           *tmp2 = 'e';
 684
 685       /* FIXME: Should this use different types?  */
 686       putithere->typed_val_float.type = parse_f_type (pstate)->builtin_real_s8;
 687       bool parsed = parse_float (tmp, len,
 688                                  putithere->typed_val_float.type,
 689                                  putithere->typed_val_float.val);
 690       free (tmp);
 691       return parsed? FLOAT : ERROR;
 692     }
 693
 694   /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
 695   if (p[0] == '0')
 696     switch (p[1])
 697       {
 698       case 'x':
 699       case 'X':
 700         if (len >= 3)
 701           {
 702             p += 2;
 703             base = 16;
 704             len -= 2;
 705           }
 706         break;
 707
 708       case 't':
 709       case 'T':
 710       case 'd':
 711       case 'D':
 712         if (len >= 3)
 713           {
 714             p += 2;
 715             base = 10;
 716             len -= 2;
 717           }
 718         break;
 719
 720       default:
 721         base = 8;
 722         break;
 723       }
 724
 725   while (len-- > 0)
 726     {
 727       c = *p++;
 728       if (isupper (c))
 729         c = tolower (c);
 730       if (len == 0 && c == 'l')
 731         long_p = 1;
 732       else if (len == 0 && c == 'u')
 733         unsigned_p = 1;
 734       else
 735         {
 736           int i;
 737           if (c >= '0' && c <= '9')
 738             i = c - '0';
 739           else if (c >= 'a' && c <= 'f')
 740             i = c - 'a' + 10;
 741           else
 742             return ERROR;       /* Char not a digit */
 743           if (i >= base)
 744             return ERROR;               /* Invalid digit in this base */
 745           n *= base;
 746           n += i;
 747         }
 748       /* Portably test for overflow (only works for nonzero values, so make
 749          a second check for zero).  */
 750       if ((prevn >= n) && n != 0)
 751         unsigned_p=1;           /* Try something unsigned */
 752       /* If range checking enabled, portably test for unsigned overflow.  */
 753       if (RANGE_CHECK && n != 0)
 754         {
 755           if ((unsigned_p && (unsigned)prevn >= (unsigned)n))
 756             range_error (_("Overflow on numeric constant."));
 757         }
 758       prevn = n;
 759     }
 760
 761   /* If the number is too big to be an int, or it's got an l suffix
 762      then it's a long.  Work out if this has to be a long by
 763      shifting right and seeing if anything remains, and the
 764      target int size is different to the target long size.
 765
 766      In the expression below, we could have tested
 767      (n >> gdbarch_int_bit (parse_gdbarch))
 768      to see if it was zero,
 769      but too many compilers warn about that, when ints and longs
 770      are the same size.  So we shift it twice, with fewer bits
 771      each time, for the same result.  */
 772
 773   if ((gdbarch_int_bit (par_state->gdbarch ())
 774        != gdbarch_long_bit (par_state->gdbarch ())
 775        && ((n >> 2)
 776            >> (gdbarch_int_bit (par_state->gdbarch ())-2))) /* Avoid
 777                                                             shift warning */
 778       || long_p)
 779     {
 780       high_bit = ((ULONGEST)1)
 781       << (gdbarch_long_bit (par_state->gdbarch ())-1);
 782       unsigned_type = parse_type (par_state)->builtin_unsigned_long;
 783       signed_type = parse_type (par_state)->builtin_long;
 784     }
 785   else
 786     {
 787       high_bit =
 788         ((ULONGEST)1) << (gdbarch_int_bit (par_state->gdbarch ()) - 1);
 789       unsigned_type = parse_type (par_state)->builtin_unsigned_int;
 790       signed_type = parse_type (par_state)->builtin_int;
 791     }
 792
 793   putithere->typed_val.val = n;
 794
 795   /* If the high bit of the worked out type is set then this number
 796      has to be unsigned.  */
 797
 798   if (unsigned_p || (n & high_bit))
 799     putithere->typed_val.type = unsigned_type;
 800   else
 801     putithere->typed_val.type = signed_type;
 802
 803   return INT;
 804 }
 805
 806 /* Called to setup the type stack when we encounter a '(kind=N)' type
 807    modifier, performs some bounds checking on 'N' and then pushes this to
 808    the type stack followed by the 'tp_kind' marker.  */
 809 static void
 810 push_kind_type (LONGEST val, struct type *type)
 811 {
 812   int ival;
 813
 814   if (TYPE_UNSIGNED (type))
 815     {
 816       ULONGEST uval = static_cast <ULONGEST> (val);
 817       if (uval > INT_MAX)
 818         error (_("kind value out of range"));
 819       ival = static_cast <int> (uval);
 820     }
 821   else
 822     {
 823       if (val > INT_MAX || val < 0)
 824         error (_("kind value out of range"));
 825       ival = static_cast <int> (val);
 826     }
 827
 828   type_stack->push (ival);
 829   type_stack->push (tp_kind);
 830 }
 831
 832 /* Called when a type has a '(kind=N)' modifier after it, for example
 833    'character(kind=1)'.  The BASETYPE is the type described by 'character'
 834    in our example, and KIND is the integer '1'.  This function returns a
 835    new type that represents the basetype of a specific kind.  */
 836 static struct type *
 837 convert_to_kind_type (struct type *basetype, int kind)
 838 {
 839   if (basetype == parse_f_type (pstate)->builtin_character)
 840     {
 841       /* Character of kind 1 is a special case, this is the same as the
 842          base character type.  */
 843       if (kind == 1)
 844         return parse_f_type (pstate)->builtin_character;
 845     }
 846   else if (basetype == parse_f_type (pstate)->builtin_complex_s8)
 847     {
 848       if (kind == 4)
 849         return parse_f_type (pstate)->builtin_complex_s8;
 850       else if (kind == 8)
 851         return parse_f_type (pstate)->builtin_complex_s16;
 852       else if (kind == 16)
 853         return parse_f_type (pstate)->builtin_complex_s32;
 854     }
 855   else if (basetype == parse_f_type (pstate)->builtin_real)
 856     {
 857       if (kind == 4)
 858         return parse_f_type (pstate)->builtin_real;
 859       else if (kind == 8)
 860         return parse_f_type (pstate)->builtin_real_s8;
 861       else if (kind == 16)
 862         return parse_f_type (pstate)->builtin_real_s16;
 863     }
 864   else if (basetype == parse_f_type (pstate)->builtin_logical)
 865     {
 866       if (kind == 1)
 867         return parse_f_type (pstate)->builtin_logical_s1;
 868       else if (kind == 2)
 869         return parse_f_type (pstate)->builtin_logical_s2;
 870       else if (kind == 4)
 871         return parse_f_type (pstate)->builtin_logical;
 872       else if (kind == 8)
 873         return parse_f_type (pstate)->builtin_logical_s8;
 874     }
 875   else if (basetype == parse_f_type (pstate)->builtin_integer)
 876     {
 877       if (kind == 2)
 878         return parse_f_type (pstate)->builtin_integer_s2;
 879       else if (kind == 4)
 880         return parse_f_type (pstate)->builtin_integer;
 881       else if (kind == 8)
 882         return parse_f_type (pstate)->builtin_integer_s8;
 883     }
 884
 885   error (_("unsupported kind %d for type %s"),
 886          kind, TYPE_SAFE_NAME (basetype));
 887
 888   /* Should never get here.  */
 889   return nullptr;
 890 }
 891
 892 struct token
 893 {
 894   /* The string to match against.  */
 895   const char *oper;
 896
 897   /* The lexer token to return.  */
 898   int token;
 899
 900   /* The expression opcode to embed within the token.  */
 901   enum exp_opcode opcode;
 902
 903   /* When this is true the string in OPER is matched exactly including
 904      case, when this is false OPER is matched case insensitively.  */
 905   bool case_sensitive;
 906 };
 907
 908 static const struct token dot_ops[] =
 909 {
 910   { ".and.", BOOL_AND, BINOP_END, false },
 911   { ".or.", BOOL_OR, BINOP_END, false },
 912   { ".not.", BOOL_NOT, BINOP_END, false },
 913   { ".eq.", EQUAL, BINOP_END, false },
 914   { ".eqv.", EQUAL, BINOP_END, false },
 915   { ".neqv.", NOTEQUAL, BINOP_END, false },
 916   { ".ne.", NOTEQUAL, BINOP_END, false },
 917   { ".le.", LEQ, BINOP_END, false },
 918   { ".ge.", GEQ, BINOP_END, false },
 919   { ".gt.", GREATERTHAN, BINOP_END, false },
 920   { ".lt.", LESSTHAN, BINOP_END, false },
 921 };
 922
 923 /* Holds the Fortran representation of a boolean, and the integer value we
 924    substitute in when one of the matching strings is parsed.  */
 925 struct f77_boolean_val
 926 {
 927   /* The string representing a Fortran boolean.  */
 928   const char *name;
 929
 930   /* The integer value to replace it with.  */
 931   int value;
 932 };
 933
 934 /* The set of Fortran booleans.  These are matched case insensitively.  */
 935 static const struct f77_boolean_val boolean_values[]  =
 936 {
 937   { ".true.", 1 },
 938   { ".false.", 0 }
 939 };
 940
 941 static const struct token f77_keywords[] =
 942 {
 943   /* Historically these have always been lowercase only in GDB.  */
 944   { "complex_16", COMPLEX_S16_KEYWORD, BINOP_END, true },
 945   { "complex_32", COMPLEX_S32_KEYWORD, BINOP_END, true },
 946   { "character", CHARACTER, BINOP_END, true },
 947   { "integer_2", INT_S2_KEYWORD, BINOP_END, true },
 948   { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END, true },
 949   { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END, true },
 950   { "logical_8", LOGICAL_S8_KEYWORD, BINOP_END, true },
 951   { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END, true },
 952   { "integer", INT_KEYWORD, BINOP_END, true },
 953   { "logical", LOGICAL_KEYWORD, BINOP_END, true },
 954   { "real_16", REAL_S16_KEYWORD, BINOP_END, true },
 955   { "complex", COMPLEX_S8_KEYWORD, BINOP_END, true },
 956   { "sizeof", SIZEOF, BINOP_END, true },
 957   { "real_8", REAL_S8_KEYWORD, BINOP_END, true },
 958   { "real", REAL_KEYWORD, BINOP_END, true },
 959   /* The following correspond to actual functions in Fortran and are case
 960      insensitive.  */
 961   { "kind", KIND, BINOP_END, false },
 962   { "abs", UNOP_INTRINSIC, UNOP_ABS, false }
 963 };
 964
 965 /* Implementation of a dynamically expandable buffer for processing input
 966    characters acquired through lexptr and building a value to return in
 967    yylval.  Ripped off from ch-exp.y */
 968
 969 static char *tempbuf;           /* Current buffer contents */
 970 static int tempbufsize;         /* Size of allocated buffer */
 971 static int tempbufindex;        /* Current index into buffer */
 972
 973 #define GROWBY_MIN_SIZE 64      /* Minimum amount to grow buffer by */
 974
 975 #define CHECKBUF(size) \
 976   do { \
 977     if (tempbufindex + (size) >= tempbufsize) \
 978       { \
 979         growbuf_by_size (size); \
 980       } \
 981   } while (0);
 982
 983
 984 /* Grow the static temp buffer if necessary, including allocating the
 985    first one on demand.  */
 986
 987 static void
 988 growbuf_by_size (int count)
 989 {
 990   int growby;
 991
 992   growby = std::max (count, GROWBY_MIN_SIZE);
 993   tempbufsize += growby;
 994   if (tempbuf == NULL)
 995     tempbuf = (char *) malloc (tempbufsize);
 996   else
 997     tempbuf = (char *) realloc (tempbuf, tempbufsize);
 998 }
 999
1000 /* Blatantly ripped off from ch-exp.y. This routine recognizes F77
1001    string-literals.
1002
1003    Recognize a string literal.  A string literal is a nonzero sequence
1004    of characters enclosed in matching single quotes, except that
1005    a single character inside single quotes is a character literal, which
1006    we reject as a string literal.  To embed the terminator character inside
1007    a string, it is simply doubled (I.E. 'this''is''one''string') */
1008
1009 static int
1010 match_string_literal (void)
1011 {
1012   const char *tokptr = pstate->lexptr;
1013
1014   for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
1015     {
1016       CHECKBUF (1);
1017       if (*tokptr == *pstate->lexptr)
1018         {
1019           if (*(tokptr + 1) == *pstate->lexptr)
1020             tokptr++;
1021           else
1022             break;
1023         }
1024       tempbuf[tempbufindex++] = *tokptr;
1025     }
1026   if (*tokptr == '\0'                                   /* no terminator */
1027       || tempbufindex == 0)                             /* no string */
1028     return 0;
1029   else
1030     {
1031       tempbuf[tempbufindex] = '\0';
1032       yylval.sval.ptr = tempbuf;
1033       yylval.sval.length = tempbufindex;
1034       pstate->lexptr = ++tokptr;
1035       return STRING_LITERAL;
1036     }
1037 }
1038
1039 /* Read one token, getting characters through lexptr.  */
1040
1041 static int
1042 yylex (void)
1043 {
1044   int c;
1045   int namelen;
1046   unsigned int token;
1047   const char *tokstart;
1048
1049  retry:
1050
1051   pstate->prev_lexptr = pstate->lexptr;
1052
1053   tokstart = pstate->lexptr;
1054
1055   /* First of all, let us make sure we are not dealing with the
1056      special tokens .true. and .false. which evaluate to 1 and 0.  */
1057
1058   if (*pstate->lexptr == '.')
1059     {
1060       for (int i = 0; i < ARRAY_SIZE (boolean_values); i++)
1061         {
1062           if (strncasecmp (tokstart, boolean_values[i].name,
1063                            strlen (boolean_values[i].name)) == 0)
1064             {
1065               pstate->lexptr += strlen (boolean_values[i].name);
1066               yylval.lval = boolean_values[i].value;
1067               return BOOLEAN_LITERAL;
1068             }
1069         }
1070     }
1071
1072   /* See if it is a special .foo. operator.  */
1073   for (int i = 0; i < ARRAY_SIZE (dot_ops); i++)
1074     if (strncasecmp (tokstart, dot_ops[i].oper,
1075                      strlen (dot_ops[i].oper)) == 0)
1076       {
1077         gdb_assert (!dot_ops[i].case_sensitive);
1078         pstate->lexptr += strlen (dot_ops[i].oper);
1079         yylval.opcode = dot_ops[i].opcode;
1080         return dot_ops[i].token;
1081       }
1082
1083   /* See if it is an exponentiation operator.  */
1084
1085   if (strncmp (tokstart, "**", 2) == 0)
1086     {
1087       pstate->lexptr += 2;
1088       yylval.opcode = BINOP_EXP;
1089       return STARSTAR;
1090     }
1091
1092   switch (c = *tokstart)
1093     {
1094     case 0:
1095       return 0;
1096
1097     case ' ':
1098     case '\t':
1099     case '\n':
1100       pstate->lexptr++;
1101       goto retry;
1102
1103     case '\'':
1104       token = match_string_literal ();
1105       if (token != 0)
1106         return (token);
1107       break;
1108
1109     case '(':
1110       paren_depth++;
1111       pstate->lexptr++;
1112       return c;
1113
1114     case ')':
1115       if (paren_depth == 0)
1116         return 0;
1117       paren_depth--;
1118       pstate->lexptr++;
1119       return c;
1120
1121     case ',':
1122       if (pstate->comma_terminates && paren_depth == 0)
1123         return 0;
1124       pstate->lexptr++;
1125       return c;
1126
1127     case '.':
1128       /* Might be a floating point number.  */
1129       if (pstate->lexptr[1] < '0' || pstate->lexptr[1] > '9')
1130         goto symbol;            /* Nope, must be a symbol.  */
1131       /* FALL THRU.  */
1132
1133     case '0':
1134     case '1':
1135     case '2':
1136     case '3':
1137     case '4':
1138     case '5':
1139     case '6':
1140     case '7':
1141     case '8':
1142     case '9':
1143       {
1144         /* It's a number.  */
1145         int got_dot = 0, got_e = 0, got_d = 0, toktype;
1146         const char *p = tokstart;
1147         int hex = input_radix > 10;
1148
1149         if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1150           {
1151             p += 2;
1152             hex = 1;
1153           }
1154         else if (c == '0' && (p[1]=='t' || p[1]=='T'
1155                               || p[1]=='d' || p[1]=='D'))
1156           {
1157             p += 2;
1158             hex = 0;
1159           }
1160
1161         for (;; ++p)
1162           {
1163             if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1164               got_dot = got_e = 1;
1165             else if (!hex && !got_d && (*p == 'd' || *p == 'D'))
1166               got_dot = got_d = 1;
1167             else if (!hex && !got_dot && *p == '.')
1168               got_dot = 1;
1169             else if (((got_e && (p[-1] == 'e' || p[-1] == 'E'))
1170                      || (got_d && (p[-1] == 'd' || p[-1] == 'D')))
1171                      && (*p == '-' || *p == '+'))
1172               /* This is the sign of the exponent, not the end of the
1173                  number.  */
1174               continue;
1175             /* We will take any letters or digits.  parse_number will
1176                complain if past the radix, or if L or U are not final.  */
1177             else if ((*p < '0' || *p > '9')
1178                      && ((*p < 'a' || *p > 'z')
1179                          && (*p < 'A' || *p > 'Z')))
1180               break;
1181           }
1182         toktype = parse_number (pstate, tokstart, p - tokstart,
1183                                 got_dot|got_e|got_d,
1184                                 &yylval);
1185         if (toktype == ERROR)
1186           {
1187             char *err_copy = (char *) alloca (p - tokstart + 1);
1188
1189             memcpy (err_copy, tokstart, p - tokstart);
1190             err_copy[p - tokstart] = 0;
1191             error (_("Invalid number \"%s\"."), err_copy);
1192           }
1193         pstate->lexptr = p;
1194         return toktype;
1195       }
1196
1197     case '+':
1198     case '-':
1199     case '*':
1200     case '/':
1201     case '%':
1202     case '|':
1203     case '&':
1204     case '^':
1205     case '~':
1206     case '!':
1207     case '@':
1208     case '<':
1209     case '>':
1210     case '[':
1211     case ']':
1212     case '?':
1213     case ':':
1214     case '=':
1215     case '{':
1216     case '}':
1217     symbol:
1218       pstate->lexptr++;
1219       return c;
1220     }
1221
1222   if (!(c == '_' || c == '$' || c ==':'
1223         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1224     /* We must have come across a bad character (e.g. ';').  */
1225     error (_("Invalid character '%c' in expression."), c);
1226
1227   namelen = 0;
1228   for (c = tokstart[namelen];
1229        (c == '_' || c == '$' || c == ':' || (c >= '0' && c <= '9')
1230         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
1231        c = tokstart[++namelen]);
1232
1233   /* The token "if" terminates the expression and is NOT
1234      removed from the input stream.  */
1235
1236   if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1237     return 0;
1238
1239   pstate->lexptr += namelen;
1240
1241   /* Catch specific keywords.  */
1242
1243   for (int i = 0; i < ARRAY_SIZE (f77_keywords); i++)
1244     if (strlen (f77_keywords[i].oper) == namelen
1245         && ((!f77_keywords[i].case_sensitive
1246              && strncasecmp (tokstart, f77_keywords[i].oper, namelen) == 0)
1247             || (f77_keywords[i].case_sensitive
1248                 && strncmp (tokstart, f77_keywords[i].oper, namelen) == 0)))
1249       {
1250         yylval.opcode = f77_keywords[i].opcode;
1251         return f77_keywords[i].token;
1252       }
1253
1254   yylval.sval.ptr = tokstart;
1255   yylval.sval.length = namelen;
1256
1257   if (*tokstart == '$')
1258     {
1259       write_dollar_variable (pstate, yylval.sval);
1260       return DOLLAR_VARIABLE;
1261     }
1262
1263   /* Use token-type TYPENAME for symbols that happen to be defined
1264      currently as names of types; NAME for other symbols.
1265      The caller is not constrained to care about the distinction.  */
1266   {
1267     char *tmp = copy_name (yylval.sval);
1268     struct block_symbol result;
1269     struct field_of_this_result is_a_field_of_this;
1270     enum domain_enum_tag lookup_domains[] =
1271     {
1272       STRUCT_DOMAIN,
1273       VAR_DOMAIN,
1274       MODULE_DOMAIN
1275     };
1276     int hextype;
1277
1278     for (int i = 0; i < ARRAY_SIZE (lookup_domains); ++i)
1279       {
1280         /* Initialize this in case we *don't* use it in this call; that
1281            way we can refer to it unconditionally below.  */
1282         memset (&is_a_field_of_this, 0, sizeof (is_a_field_of_this));
1283
1284         result = lookup_symbol (tmp, pstate->expression_context_block,
1285                                 lookup_domains[i],
1286                                 pstate->language ()->la_language
1287                                 == language_cplus
1288                                   ? &is_a_field_of_this : NULL);
1289         if (result.symbol && SYMBOL_CLASS (result.symbol) == LOC_TYPEDEF)
1290           {
1291             yylval.tsym.type = SYMBOL_TYPE (result.symbol);
1292             return TYPENAME;
1293           }
1294
1295         if (result.symbol)
1296           break;
1297       }
1298
1299     yylval.tsym.type
1300       = language_lookup_primitive_type (pstate->language (),
1301                                         pstate->gdbarch (), tmp);
1302     if (yylval.tsym.type != NULL)
1303       return TYPENAME;
1304
1305     /* Input names that aren't symbols but ARE valid hex numbers,
1306        when the input radix permits them, can be names or numbers
1307        depending on the parse.  Note we support radixes > 16 here.  */
1308     if (!result.symbol
1309         && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1310             || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1311       {
1312         YYSTYPE newlval;        /* Its value is ignored.  */
1313         hextype = parse_number (pstate, tokstart, namelen, 0, &newlval);
1314         if (hextype == INT)
1315           {
1316             yylval.ssym.sym = result;
1317             yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1318             return NAME_OR_INT;
1319           }
1320       }
1321
1322     /* Any other kind of symbol */
1323     yylval.ssym.sym = result;
1324     yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1325     return NAME;
1326   }
1327 }
1328
1329 int
1330 f_parse (struct parser_state *par_state)
1331 {
1332   /* Setting up the parser state.  */
1333   scoped_restore pstate_restore = make_scoped_restore (&pstate);
1334   scoped_restore restore_yydebug = make_scoped_restore (&yydebug,
1335                                                         parser_debug);
1336   gdb_assert (par_state != NULL);
1337   pstate = par_state;
1338   paren_depth = 0;
1339
1340   struct type_stack stack;
1341   scoped_restore restore_type_stack = make_scoped_restore (&type_stack,
1342                                                            &stack);
1343
1344   return yyparse ();
1345 }
1346
1347 static void
1348 yyerror (const char *msg)
1349 {
1350   if (pstate->prev_lexptr)
1351     pstate->lexptr = pstate->prev_lexptr;
1352
1353   error (_("A %s in expression, near `%s'."), msg, pstate->lexptr);
1354 }