gdb/f-exp.y

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