gdb/f-exp.y

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