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