gdb/f-exp.y - gdb


  2. /* YACC parser for Fortran expressions, for GDB.
  3.    Copyright (C) 1986-2015 Free Software Foundation, Inc.

  5.    Contributed by Motorola.  Adapted from the C parser by Farooq Butt
  6.    (fmbutt@engage.sps.mot.com).

  8.    This file is part of GDB.

  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.

  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.

  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/>.  */

  23. /* This was blantantly ripped off the C expression parser, please
  24.    be aware of that as you look at its basic structure -FMB */

  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.

  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.  */

  43. %{

  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>

  57. #define parse_type(ps) builtin_type (parse_gdbarch (ps))
  58. #define parse_f_type(ps) builtin_f_type (parse_gdbarch (ps))

  60. /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
  61.    as well as gratuitiously global symbol names, so we can have multiple
  62.    yacc generated parsers in gdb.  Note that these are only the variables
  63.    produced by yacc.  If other parser generators (bison, byacc, etc) produce
  64.    additional global names that conflict at link time, then those parser
  65.    generators need to be fixed instead of adding those names to this list.  */

  67. #define        yymaxdepth f_maxdepth
  68. #define        yyparse f_parse_internal
  69. #define        yylex        f_lex
  70. #define        yyerror        f_error
  71. #define        yylval        f_lval
  72. #define        yychar        f_char
  73. #define        yydebug        f_debug
  74. #define        yypact        f_pact
  75. #define        yyr1        f_r1
  76. #define        yyr2        f_r2
  77. #define        yydef        f_def
  78. #define        yychk        f_chk
  79. #define        yypgo        f_pgo
  80. #define        yyact        f_act
  81. #define        yyexca        f_exca
  82. #define yyerrflag f_errflag
  83. #define yynerrs        f_nerrs
  84. #define        yyps        f_ps
  85. #define        yypv        f_pv
  86. #define        yys        f_s
  87. #define        yy_yys        f_yys
  88. #define        yystate        f_state
  89. #define        yytmp        f_tmp
  90. #define        yyv        f_v
  91. #define        yy_yyv        f_yyv
  92. #define        yyval        f_val
  93. #define        yylloc        f_lloc
  94. #define yyreds        f_reds                /* With YYDEBUG defined */
  95. #define yytoks        f_toks                /* With YYDEBUG defined */
  96. #define yyname        f_name                /* With YYDEBUG defined */
  97. #define yyrule        f_rule                /* With YYDEBUG defined */
  98. #define yylhs        f_yylhs
  99. #define yylen        f_yylen
  100. #define yydefred f_yydefred
  101. #define yydgoto        f_yydgoto
  102. #define yysindex f_yysindex
  103. #define yyrindex f_yyrindex
  104. #define yygindex f_yygindex
  105. #define yytable         f_yytable
  106. #define yycheck         f_yycheck
  107. #define yyss        f_yyss
  108. #define yysslim        f_yysslim
  109. #define yyssp        f_yyssp
  110. #define yystacksize f_yystacksize
  111. #define yyvs        f_yyvs
  112. #define yyvsp        f_yyvsp

  114. #ifndef YYDEBUG
  115. #define        YYDEBUG        1                /* Default to yydebug support */
  116. #endif

  118. #define YYFPRINTF parser_fprintf

  120. /* The state of the parser, used internally when we are parsing the
  121.    expression.  */

  123. static struct parser_state *pstate = NULL;

  125. int yyparse (void);

  127. static int yylex (void);

  129. void yyerror (char *);

  131. static void growbuf_by_size (int);

  133. static int match_string_literal (void);

  135. %}

  137. /* Although the yacc "value" of an expression is not used,
  138.    since the result is stored in the structure being created,
  139.    other node types do have values.  */

  141. %union
  142.   {
  143.     LONGEST lval;
  144.     struct {
  145.       LONGEST val;
  146.       struct type *type;
  147.     } typed_val;
  148.     DOUBLEST dval;
  149.     struct symbol *sym;
  150.     struct type *tval;
  151.     struct stoken sval;
  152.     struct ttype tsym;
  153.     struct symtoken ssym;
  154.     int voidval;
  155.     struct block *bval;
  156.     enum exp_opcode opcode;
  157.     struct internalvar *ivar;

  159.     struct type **tvec;
  160.     int *ivec;
  161.   }

  163. %{
  164. /* YYSTYPE gets defined by %union */
  165. static int parse_number (struct parser_state *, const char *, int,
  166.                          int, YYSTYPE *);
  167. %}

  169. %type <voidval> exp  type_exp start variable
  170. %type <tval> type typebase
  171. %type <tvec> nonempty_typelist
  172. /* %type <bval> block */

  174. /* Fancy type parsing.  */
  175. %type <voidval> func_mod direct_abs_decl abs_decl
  176. %type <tval> ptype

  178. %token <typed_val> INT
  179. %token <dval> FLOAT

  181. /* Both NAME and TYPENAME tokens represent symbols in the input,
  182.    and both convey their data as strings.
  183.    But a TYPENAME is a string that happens to be defined as a typedef
  184.    or builtin type name (such as int or char)
  185.    and a NAME is any other symbol.
  186.    Contexts where this distinction is not important can use the
  187.    nonterminal "name", which matches either NAME or TYPENAME.  */

  189. %token <sval> STRING_LITERAL
  190. %token <lval> BOOLEAN_LITERAL
  191. %token <ssym> NAME
  192. %token <tsym> TYPENAME
  193. %type <sval> name
  194. %type <ssym> name_not_typename

  196. /* A NAME_OR_INT is a symbol which is not known in the symbol table,
  197.    but which would parse as a valid number in the current input radix.
  198.    E.g. "c" when input_radix==16.  Depending on the parse, it will be
  199.    turned into a name or into a number.  */

  201. %token <ssym> NAME_OR_INT

  203. %token  SIZEOF
  204. %token ERROR

  206. /* Special type cases, put in to allow the parser to distinguish different
  207.    legal basetypes.  */
  208. %token INT_KEYWORD INT_S2_KEYWORD LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD
  209. %token LOGICAL_S8_KEYWORD
  210. %token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD
  211. %token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD
  212. %token BOOL_AND BOOL_OR BOOL_NOT
  213. %token <lval> CHARACTER

  215. %token <voidval> VARIABLE

  217. %token <opcode> ASSIGN_MODIFY

  219. %left ','
  220. %left ABOVE_COMMA
  221. %right '=' ASSIGN_MODIFY
  222. %right '?'
  223. %left BOOL_OR
  224. %right BOOL_NOT
  225. %left BOOL_AND
  226. %left '|'
  227. %left '^'
  228. %left '&'
  229. %left EQUAL NOTEQUAL
  230. %left LESSTHAN GREATERTHAN LEQ GEQ
  231. %left LSH RSH
  232. %left '@'
  233. %left '+' '-'
  234. %left '*' '/'
  235. %right STARSTAR
  236. %right '%'
  237. %right UNARY
  238. %right '('


  241. %%

  243. start   :        exp
  244.         |        type_exp
  245.         ;

  247. type_exp:        type
  248.                         { write_exp_elt_opcode (pstate, OP_TYPE);
  249.                           write_exp_elt_type (pstate, $1);
  250.                           write_exp_elt_opcode (pstate, OP_TYPE); }
  251.         ;

  253. exp     :       '(' exp ')'
  254.                         { }
  255.         ;

  257. /* Expressions, not including the comma operator.  */
  258. exp        :        '*' exp    %prec UNARY
  259.                         { write_exp_elt_opcode (pstate, UNOP_IND); }
  260.         ;

  262. exp        :        '&' exp    %prec UNARY
  263.                         { write_exp_elt_opcode (pstate, UNOP_ADDR); }
  264.         ;

  266. exp        :        '-' exp    %prec UNARY
  267.                         { write_exp_elt_opcode (pstate, UNOP_NEG); }
  268.         ;

  270. exp        :        BOOL_NOT exp    %prec UNARY
  271.                         { write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
  272.         ;

  274. exp        :        '~' exp    %prec UNARY
  275.                         { write_exp_elt_opcode (pstate, UNOP_COMPLEMENT); }
  276.         ;

  278. exp        :        SIZEOF exp       %prec UNARY
  279.                         { write_exp_elt_opcode (pstate, UNOP_SIZEOF); }
  280.         ;

  282. /* No more explicit array operators, we treat everything in F77 as
  283.    a function call.  The disambiguation as to whether we are
  284.    doing a subscript operation or a function call is done
  285.    later in eval.c.  */

  287. exp        :        exp '('
  288.                         { start_arglist (); }
  289.                 arglist ')'
  290.                         { write_exp_elt_opcode (pstate,
  291.                                                 OP_F77_UNDETERMINED_ARGLIST);
  292.                           write_exp_elt_longcst (pstate,
  293.                                                  (LONGEST) end_arglist ());
  294.                           write_exp_elt_opcode (pstate,
  295.                                               OP_F77_UNDETERMINED_ARGLIST); }
  296.         ;

  298. arglist        :
  299.         ;

  301. arglist        :        exp
  302.                         { arglist_len = 1; }
  303.         ;

  305. arglist :        subrange
  306.                         { arglist_len = 1; }
  307.         ;

  309. arglist        :        arglist ',' exp   %prec ABOVE_COMMA
  310.                         { arglist_len++; }
  311.         ;

  313. /* There are four sorts of subrange types in F90.  */

  315. subrange:        exp ':' exp        %prec ABOVE_COMMA
  316.                         { write_exp_elt_opcode (pstate, OP_F90_RANGE);
  317.                           write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT);
  318.                           write_exp_elt_opcode (pstate, OP_F90_RANGE); }
  319.         ;

  321. subrange:        exp ':'        %prec ABOVE_COMMA
  322.                         { write_exp_elt_opcode (pstate, OP_F90_RANGE);
  323.                           write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT);
  324.                           write_exp_elt_opcode (pstate, OP_F90_RANGE); }
  325.         ;

  327. subrange:        ':' exp        %prec ABOVE_COMMA
  328.                         { write_exp_elt_opcode (pstate, OP_F90_RANGE);
  329.                           write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT);
  330.                           write_exp_elt_opcode (pstate, OP_F90_RANGE); }
  331.         ;

  333. subrange:        ':'        %prec ABOVE_COMMA
  334.                         { write_exp_elt_opcode (pstate, OP_F90_RANGE);
  335.                           write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT);
  336.                           write_exp_elt_opcode (pstate, OP_F90_RANGE); }
  337.         ;

  339. complexnum:     exp ',' exp
  340.                         { }
  341.         ;

  343. exp        :        '(' complexnum ')'
  344.                         { write_exp_elt_opcode (pstate, OP_COMPLEX);
  345.                           write_exp_elt_type (pstate,
  346.                                               parse_f_type (pstate)
  347.                                               ->builtin_complex_s16);
  348.                           write_exp_elt_opcode (pstate, OP_COMPLEX); }
  349.         ;

  351. exp        :        '(' type ')' exp  %prec UNARY
  352.                         { write_exp_elt_opcode (pstate, UNOP_CAST);
  353.                           write_exp_elt_type (pstate, $2);
  354.                           write_exp_elt_opcode (pstate, UNOP_CAST); }
  355.         ;

  357. exp     :       exp '%' name
  358.                         { write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
  359.                           write_exp_string (pstate, $3);
  360.                           write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
  361.         ;

  363. /* Binary operators in order of decreasing precedence.  */

  365. exp        :        exp '@' exp
  366.                         { write_exp_elt_opcode (pstate, BINOP_REPEAT); }
  367.         ;

  369. exp        :        exp STARSTAR exp
  370.                         { write_exp_elt_opcode (pstate, BINOP_EXP); }
  371.         ;

  373. exp        :        exp '*' exp
  374.                         { write_exp_elt_opcode (pstate, BINOP_MUL); }
  375.         ;

  377. exp        :        exp '/' exp
  378.                         { write_exp_elt_opcode (pstate, BINOP_DIV); }
  379.         ;

  381. exp        :        exp '+' exp
  382.                         { write_exp_elt_opcode (pstate, BINOP_ADD); }
  383.         ;

  385. exp        :        exp '-' exp
  386.                         { write_exp_elt_opcode (pstate, BINOP_SUB); }
  387.         ;

  389. exp        :        exp LSH exp
  390.                         { write_exp_elt_opcode (pstate, BINOP_LSH); }
  391.         ;

  393. exp        :        exp RSH exp
  394.                         { write_exp_elt_opcode (pstate, BINOP_RSH); }
  395.         ;

  397. exp        :        exp EQUAL exp
  398.                         { write_exp_elt_opcode (pstate, BINOP_EQUAL); }
  399.         ;

  401. exp        :        exp NOTEQUAL exp
  402.                         { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
  403.         ;

  405. exp        :        exp LEQ exp
  406.                         { write_exp_elt_opcode (pstate, BINOP_LEQ); }
  407.         ;

  409. exp        :        exp GEQ exp
  410.                         { write_exp_elt_opcode (pstate, BINOP_GEQ); }
  411.         ;

  413. exp        :        exp LESSTHAN exp
  414.                         { write_exp_elt_opcode (pstate, BINOP_LESS); }
  415.         ;

  417. exp        :        exp GREATERTHAN exp
  418.                         { write_exp_elt_opcode (pstate, BINOP_GTR); }
  419.         ;

  421. exp        :        exp '&' exp
  422.                         { write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
  423.         ;

  425. exp        :        exp '^' exp
  426.                         { write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
  427.         ;

  429. exp        :        exp '|' exp
  430.                         { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
  431.         ;

  433. exp     :       exp BOOL_AND exp
  434.                         { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
  435.         ;


  438. exp        :        exp BOOL_OR exp
  439.                         { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
  440.         ;

  442. exp        :        exp '=' exp
  443.                         { write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
  444.         ;

  446. exp        :        exp ASSIGN_MODIFY exp
  447.                         { write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY);
  448.                           write_exp_elt_opcode (pstate, $2);
  449.                           write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY); }
  450.         ;

  452. exp        :        INT
  453.                         { write_exp_elt_opcode (pstate, OP_LONG);
  454.                           write_exp_elt_type (pstate, $1.type);
  455.                           write_exp_elt_longcst (pstate, (LONGEST) ($1.val));
  456.                           write_exp_elt_opcode (pstate, OP_LONG); }
  457.         ;

  459. exp        :        NAME_OR_INT
  460.                         { YYSTYPE val;
  461.                           parse_number (pstate, $1.stoken.ptr,
  462.                                         $1.stoken.length, 0, &val);
  463.                           write_exp_elt_opcode (pstate, OP_LONG);
  464.                           write_exp_elt_type (pstate, val.typed_val.type);
  465.                           write_exp_elt_longcst (pstate,
  466.                                                  (LONGEST)val.typed_val.val);
  467.                           write_exp_elt_opcode (pstate, OP_LONG); }
  468.         ;

  470. exp        :        FLOAT
  471.                         { write_exp_elt_opcode (pstate, OP_DOUBLE);
  472.                           write_exp_elt_type (pstate,
  473.                                               parse_f_type (pstate)
  474.                                               ->builtin_real_s8);
  475.                           write_exp_elt_dblcst (pstate, $1);
  476.                           write_exp_elt_opcode (pstate, OP_DOUBLE); }
  477.         ;

  479. exp        :        variable
  480.         ;

  482. exp        :        VARIABLE
  483.         ;

  485. exp        :        SIZEOF '(' type ')'        %prec UNARY
  486.                         { write_exp_elt_opcode (pstate, OP_LONG);
  487.                           write_exp_elt_type (pstate,
  488.                                               parse_f_type (pstate)
  489.                                               ->builtin_integer);
  490.                           CHECK_TYPEDEF ($3);
  491.                           write_exp_elt_longcst (pstate,
  492.                                                  (LONGEST) TYPE_LENGTH ($3));
  493.                           write_exp_elt_opcode (pstate, OP_LONG); }
  494.         ;

  496. exp     :       BOOLEAN_LITERAL
  497.                         { write_exp_elt_opcode (pstate, OP_BOOL);
  498.                           write_exp_elt_longcst (pstate, (LONGEST) $1);
  499.                           write_exp_elt_opcode (pstate, OP_BOOL);
  500.                         }
  501.         ;

  503. exp        :        STRING_LITERAL
  504.                         {
  505.                           write_exp_elt_opcode (pstate, OP_STRING);
  506.                           write_exp_string (pstate, $1);
  507.                           write_exp_elt_opcode (pstate, OP_STRING);
  508.                         }
  509.         ;

  511. variable:        name_not_typename
  512.                         { struct symbol *sym = $1.sym;

  514.                           if (sym)
  515.                             {
  516.                               if (symbol_read_needs_frame (sym))
  517.                                 {
  518.                                   if (innermost_block == 0
  519.                                       || contained_in (block_found,
  520.                                                        innermost_block))
  521.                                     innermost_block = block_found;
  522.                                 }
  523.                               write_exp_elt_opcode (pstate, OP_VAR_VALUE);
  524.                               /* We want to use the selected frame, not
  525.                                  another more inner frame which happens to
  526.                                  be in the same block.  */
  527.                               write_exp_elt_block (pstate, NULL);
  528.                               write_exp_elt_sym (pstate, sym);
  529.                               write_exp_elt_opcode (pstate, OP_VAR_VALUE);
  530.                               break;
  531.                             }
  532.                           else
  533.                             {
  534.                               struct bound_minimal_symbol msymbol;
  535.                               char *arg = copy_name ($1.stoken);

  537.                               msymbol =
  538.                                 lookup_bound_minimal_symbol (arg);
  539.                               if (msymbol.minsym != NULL)
  540.                                 write_exp_msymbol (pstate, msymbol);
  541.                               else if (!have_full_symbols () && !have_partial_symbols ())
  542.                                 error (_("No symbol table is loaded.  Use the \"file\" command."));
  543.                               else
  544.                                 error (_("No symbol \"%s\" in current context."),
  545.                                        copy_name ($1.stoken));
  546.                             }
  547.                         }
  548.         ;


  551. type    :       ptype
  552.         ;

  554. ptype        :        typebase
  555.         |        typebase abs_decl
  556.                 {
  557.                   /* This is where the interesting stuff happens.  */
  558.                   int done = 0;
  559.                   int array_size;
  560.                   struct type *follow_type = $1;
  561.                   struct type *range_type;

  563.                   while (!done)
  564.                     switch (pop_type ())
  565.                       {
  566.                       case tp_end:
  567.                         done = 1;
  568.                         break;
  569.                       case tp_pointer:
  570.                         follow_type = lookup_pointer_type (follow_type);
  571.                         break;
  572.                       case tp_reference:
  573.                         follow_type = lookup_reference_type (follow_type);
  574.                         break;
  575.                       case tp_array:
  576.                         array_size = pop_type_int ();
  577.                         if (array_size != -1)
  578.                           {
  579.                             range_type =
  580.                               create_static_range_type ((struct type *) NULL,
  581.                                                         parse_f_type (pstate)
  582.                                                         ->builtin_integer,
  583.                                                         0, array_size - 1);
  584.                             follow_type =
  585.                               create_array_type ((struct type *) NULL,
  586.                                                  follow_type, range_type);
  587.                           }
  588.                         else
  589.                           follow_type = lookup_pointer_type (follow_type);
  590.                         break;
  591.                       case tp_function:
  592.                         follow_type = lookup_function_type (follow_type);
  593.                         break;
  594.                       }
  595.                   $$ = follow_type;
  596.                 }
  597.         ;

  599. abs_decl:        '*'
  600.                         { push_type (tp_pointer); $$ = 0; }
  601.         |        '*' abs_decl
  602.                         { push_type (tp_pointer); $$ = $2; }
  603.         |        '&'
  604.                         { push_type (tp_reference); $$ = 0; }
  605.         |        '&' abs_decl
  606.                         { push_type (tp_reference); $$ = $2; }
  607.         |        direct_abs_decl
  608.         ;

  610. direct_abs_decl: '(' abs_decl ')'
  611.                         { $$ = $2; }
  612.         |         direct_abs_decl func_mod
  613.                         { push_type (tp_function); }
  614.         |        func_mod
  615.                         { push_type (tp_function); }
  616.         ;

  618. func_mod:        '(' ')'
  619.                         { $$ = 0; }
  620.         |        '(' nonempty_typelist ')'
  621.                         { free ($2); $$ = 0; }
  622.         ;

  624. typebase  /* Implements (approximately): (type-qualifier)* type-specifier */
  625.         :        TYPENAME
  626.                         { $$ = $1.type; }
  627.         |        INT_KEYWORD
  628.                         { $$ = parse_f_type (pstate)->builtin_integer; }
  629.         |        INT_S2_KEYWORD
  630.                         { $$ = parse_f_type (pstate)->builtin_integer_s2; }
  631.         |        CHARACTER
  632.                         { $$ = parse_f_type (pstate)->builtin_character; }
  633.         |        LOGICAL_S8_KEYWORD
  634.                         { $$ = parse_f_type (pstate)->builtin_logical_s8; }
  635.         |        LOGICAL_KEYWORD
  636.                         { $$ = parse_f_type (pstate)->builtin_logical; }
  637.         |        LOGICAL_S2_KEYWORD
  638.                         { $$ = parse_f_type (pstate)->builtin_logical_s2; }
  639.         |        LOGICAL_S1_KEYWORD
  640.                         { $$ = parse_f_type (pstate)->builtin_logical_s1; }
  641.         |        REAL_KEYWORD
  642.                         { $$ = parse_f_type (pstate)->builtin_real; }
  643.         |       REAL_S8_KEYWORD
  644.                         { $$ = parse_f_type (pstate)->builtin_real_s8; }
  645.         |        REAL_S16_KEYWORD
  646.                         { $$ = parse_f_type (pstate)->builtin_real_s16; }
  647.         |        COMPLEX_S8_KEYWORD
  648.                         { $$ = parse_f_type (pstate)->builtin_complex_s8; }
  649.         |        COMPLEX_S16_KEYWORD
  650.                         { $$ = parse_f_type (pstate)->builtin_complex_s16; }
  651.         |        COMPLEX_S32_KEYWORD
  652.                         { $$ = parse_f_type (pstate)->builtin_complex_s32; }
  653.         ;

  655. nonempty_typelist
  656.         :        type
  657.                 { $$ = (struct type **) malloc (sizeof (struct type *) * 2);
  658.                   $<ivec>$[0] = 1;        /* Number of types in vector */
  659.                   $$[1] = $1;
  660.                 }
  661.         |        nonempty_typelist ',' type
  662.                 { int len = sizeof (struct type *) * (++($<ivec>1[0]) + 1);
  663.                   $$ = (struct type **) realloc ((char *) $1, len);
  664.                   $$[$<ivec>$[0]] = $3;
  665.                 }
  666.         ;

  668. name        :        NAME
  669.                 {  $$ = $1.stoken; }
  670.         ;

  672. name_not_typename :        NAME
  673. /* These would be useful if name_not_typename was useful, but it is just
  674.    a fake for "variable", so these cause reduce/reduce conflicts because
  675.    the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
  676.    =exp) or just an exp.  If name_not_typename was ever used in an lvalue
  677.    context where only a name could occur, this might be useful.
  678.           |        NAME_OR_INT
  679.    */
  680.         ;

  682. %%

  684. /* Take care of parsing a number (anything that starts with a digit).
  685.    Set yylval and return the token type; update lexptr.
  686.    LEN is the number of characters in it.  */

  688. /*** Needs some error checking for the float case ***/

  690. static int
  691. parse_number (struct parser_state *par_state,
  692.               const char *p, int len, int parsed_float, YYSTYPE *putithere)
  693. {
  694.   LONGEST n = 0;
  695.   LONGEST prevn = 0;
  696.   int c;
  697.   int base = input_radix;
  698.   int unsigned_p = 0;
  699.   int long_p = 0;
  700.   ULONGEST high_bit;
  701.   struct type *signed_type;
  702.   struct type *unsigned_type;

  704.   if (parsed_float)
  705.     {
  706.       /* It's a float since it contains a point or an exponent.  */
  707.       /* [dD] is not understood as an exponent by atof, change it to 'e'.  */
  708.       char *tmp, *tmp2;

  710.       tmp = xstrdup (p);
  711.       for (tmp2 = tmp; *tmp2; ++tmp2)
  712.         if (*tmp2 == 'd' || *tmp2 == 'D')
  713.           *tmp2 = 'e';
  714.       putithere->dval = atof (tmp);
  715.       free (tmp);
  716.       return FLOAT;
  717.     }

  719.   /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
  720.   if (p[0] == '0')
  721.     switch (p[1])
  722.       {
  723.       case 'x':
  724.       case 'X':
  725.         if (len >= 3)
  726.           {
  727.             p += 2;
  728.             base = 16;
  729.             len -= 2;
  730.           }
  731.         break;

  733.       case 't':
  734.       case 'T':
  735.       case 'd':
  736.       case 'D':
  737.         if (len >= 3)
  738.           {
  739.             p += 2;
  740.             base = 10;
  741.             len -= 2;
  742.           }
  743.         break;

  745.       default:
  746.         base = 8;
  747.         break;
  748.       }

  750.   while (len-- > 0)
  751.     {
  752.       c = *p++;
  753.       if (isupper (c))
  754.         c = tolower (c);
  755.       if (len == 0 && c == 'l')
  756.         long_p = 1;
  757.       else if (len == 0 && c == 'u')
  758.         unsigned_p = 1;
  759.       else
  760.         {
  761.           int i;
  762.           if (c >= '0' && c <= '9')
  763.             i = c - '0';
  764.           else if (c >= 'a' && c <= 'f')
  765.             i = c - 'a' + 10;
  766.           else
  767.             return ERROR;        /* Char not a digit */
  768.           if (i >= base)
  769.             return ERROR;                /* Invalid digit in this base */
  770.           n *= base;
  771.           n += i;
  772.         }
  773.       /* Portably test for overflow (only works for nonzero values, so make
  774.          a second check for zero).  */
  775.       if ((prevn >= n) && n != 0)
  776.         unsigned_p=1;                /* Try something unsigned */
  777.       /* If range checking enabled, portably test for unsigned overflow.  */
  778.       if (RANGE_CHECK && n != 0)
  779.         {
  780.           if ((unsigned_p && (unsigned)prevn >= (unsigned)n))
  781.             range_error (_("Overflow on numeric constant."));
  782.         }
  783.       prevn = n;
  784.     }

  786.   /* If the number is too big to be an int, or it's got an l suffix
  787.      then it's a long.  Work out if this has to be a long by
  788.      shifting right and seeing if anything remains, and the
  789.      target int size is different to the target long size.

  791.      In the expression below, we could have tested
  792.      (n >> gdbarch_int_bit (parse_gdbarch))
  793.      to see if it was zero,
  794.      but too many compilers warn about that, when ints and longs
  795.      are the same size.  So we shift it twice, with fewer bits
  796.      each time, for the same result.  */

  798.   if ((gdbarch_int_bit (parse_gdbarch (par_state))
  799.        != gdbarch_long_bit (parse_gdbarch (par_state))
  800.        && ((n >> 2)
  801.            >> (gdbarch_int_bit (parse_gdbarch (par_state))-2))) /* Avoid
  802.                                                             shift warning */
  803.       || long_p)
  804.     {
  805.       high_bit = ((ULONGEST)1)
  806.       << (gdbarch_long_bit (parse_gdbarch (par_state))-1);
  807.       unsigned_type = parse_type (par_state)->builtin_unsigned_long;
  808.       signed_type = parse_type (par_state)->builtin_long;
  809.     }
  810.   else
  811.     {
  812.       high_bit =
  813.         ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch (par_state)) - 1);
  814.       unsigned_type = parse_type (par_state)->builtin_unsigned_int;
  815.       signed_type = parse_type (par_state)->builtin_int;
  816.     }

  818.   putithere->typed_val.val = n;

  820.   /* If the high bit of the worked out type is set then this number
  821.      has to be unsigned.  */

  823.   if (unsigned_p || (n & high_bit))
  824.     putithere->typed_val.type = unsigned_type;
  825.   else
  826.     putithere->typed_val.type = signed_type;

  828.   return INT;
  829. }

  831. struct token
  832. {
  833.   char *operator;
  834.   int token;
  835.   enum exp_opcode opcode;
  836. };

  838. static const struct token dot_ops[] =
  839. {
  840.   { ".and.", BOOL_AND, BINOP_END },
  841.   { ".AND.", BOOL_AND, BINOP_END },
  842.   { ".or.", BOOL_OR, BINOP_END },
  843.   { ".OR.", BOOL_OR, BINOP_END },
  844.   { ".not.", BOOL_NOT, BINOP_END },
  845.   { ".NOT.", BOOL_NOT, BINOP_END },
  846.   { ".eq.", EQUAL, BINOP_END },
  847.   { ".EQ.", EQUAL, BINOP_END },
  848.   { ".eqv.", EQUAL, BINOP_END },
  849.   { ".NEQV.", NOTEQUAL, BINOP_END },
  850.   { ".neqv.", NOTEQUAL, BINOP_END },
  851.   { ".EQV.", EQUAL, BINOP_END },
  852.   { ".ne.", NOTEQUAL, BINOP_END },
  853.   { ".NE.", NOTEQUAL, BINOP_END },
  854.   { ".le.", LEQ, BINOP_END },
  855.   { ".LE.", LEQ, BINOP_END },
  856.   { ".ge.", GEQ, BINOP_END },
  857.   { ".GE.", GEQ, BINOP_END },
  858.   { ".gt.", GREATERTHAN, BINOP_END },
  859.   { ".GT.", GREATERTHAN, BINOP_END },
  860.   { ".lt.", LESSTHAN, BINOP_END },
  861.   { ".LT.", LESSTHAN, BINOP_END },
  862.   { NULL, 0, 0 }
  863. };

  865. struct f77_boolean_val
  866. {
  867.   char *name;
  868.   int value;
  869. };

  871. static const struct f77_boolean_val boolean_values[]  =
  872. {
  873.   { ".true.", 1 },
  874.   { ".TRUE.", 1 },
  875.   { ".false.", 0 },
  876.   { ".FALSE.", 0 },
  877.   { NULL, 0 }
  878. };

  880. static const struct token f77_keywords[] =
  881. {
  882.   { "complex_16", COMPLEX_S16_KEYWORD, BINOP_END },
  883.   { "complex_32", COMPLEX_S32_KEYWORD, BINOP_END },
  884.   { "character", CHARACTER, BINOP_END },
  885.   { "integer_2", INT_S2_KEYWORD, BINOP_END },
  886.   { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END },
  887.   { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END },
  888.   { "logical_8", LOGICAL_S8_KEYWORD, BINOP_END },
  889.   { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END },
  890.   { "integer", INT_KEYWORD, BINOP_END },
  891.   { "logical", LOGICAL_KEYWORD, BINOP_END },
  892.   { "real_16", REAL_S16_KEYWORD, BINOP_END },
  893.   { "complex", COMPLEX_S8_KEYWORD, BINOP_END },
  894.   { "sizeof", SIZEOF, BINOP_END },
  895.   { "real_8", REAL_S8_KEYWORD, BINOP_END },
  896.   { "real", REAL_KEYWORD, BINOP_END },
  897.   { NULL, 0, 0 }
  898. };

  900. /* Implementation of a dynamically expandable buffer for processing input
  901.    characters acquired through lexptr and building a value to return in
  902.    yylval.  Ripped off from ch-exp.y */

  904. static char *tempbuf;                /* Current buffer contents */
  905. static int tempbufsize;                /* Size of allocated buffer */
  906. static int tempbufindex;        /* Current index into buffer */

  908. #define GROWBY_MIN_SIZE 64        /* Minimum amount to grow buffer by */

  910. #define CHECKBUF(size) \
  911.   do { \
  912.     if (tempbufindex + (size) >= tempbufsize) \
  913.       { \
  914.         growbuf_by_size (size); \
  915.       } \
  916.   } while (0);


  919. /* Grow the static temp buffer if necessary, including allocating the
  920.    first one on demand.  */

  922. static void
  923. growbuf_by_size (int count)
  924. {
  925.   int growby;

  927.   growby = max (count, GROWBY_MIN_SIZE);
  928.   tempbufsize += growby;
  929.   if (tempbuf == NULL)
  930.     tempbuf = (char *) malloc (tempbufsize);
  931.   else
  932.     tempbuf = (char *) realloc (tempbuf, tempbufsize);
  933. }

  935. /* Blatantly ripped off from ch-exp.y. This routine recognizes F77
  936.    string-literals.

  938.    Recognize a string literal.  A string literal is a nonzero sequence
  939.    of characters enclosed in matching single quotes, except that
  940.    a single character inside single quotes is a character literal, which
  941.    we reject as a string literal.  To embed the terminator character inside
  942.    a string, it is simply doubled (I.E. 'this''is''one''string') */

  944. static int
  945. match_string_literal (void)
  946. {
  947.   const char *tokptr = lexptr;

  949.   for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
  950.     {
  951.       CHECKBUF (1);
  952.       if (*tokptr == *lexptr)
  953.         {
  954.           if (*(tokptr + 1) == *lexptr)
  955.             tokptr++;
  956.           else
  957.             break;
  958.         }
  959.       tempbuf[tempbufindex++] = *tokptr;
  960.     }
  961.   if (*tokptr == '\0'                                        /* no terminator */
  962.       || tempbufindex == 0)                                /* no string */
  963.     return 0;
  964.   else
  965.     {
  966.       tempbuf[tempbufindex] = '\0';
  967.       yylval.sval.ptr = tempbuf;
  968.       yylval.sval.length = tempbufindex;
  969.       lexptr = ++tokptr;
  970.       return STRING_LITERAL;
  971.     }
  972. }

  974. /* Read one token, getting characters through lexptr.  */

  976. static int
  977. yylex (void)
  978. {
  979.   int c;
  980.   int namelen;
  981.   unsigned int i,token;
  982.   const char *tokstart;

  984. retry:

  986.   prev_lexptr = lexptr;

  988.   tokstart = lexptr;

  990.   /* First of all, let us make sure we are not dealing with the
  991.      special tokens .true. and .false. which evaluate to 1 and 0.  */

  993.   if (*lexptr == '.')
  994.     {
  995.       for (i = 0; boolean_values[i].name != NULL; i++)
  996.         {
  997.           if (strncmp (tokstart, boolean_values[i].name,
  998.                        strlen (boolean_values[i].name)) == 0)
  999.             {
  1000.               lexptr += strlen (boolean_values[i].name);
  1001.               yylval.lval = boolean_values[i].value;
  1002.               return BOOLEAN_LITERAL;
  1003.             }
  1004.         }
  1005.     }

  1007.   /* See if it is a special .foo. operator.  */

  1009.   for (i = 0; dot_ops[i].operator != NULL; i++)
  1010.     if (strncmp (tokstart, dot_ops[i].operator,
  1011.                  strlen (dot_ops[i].operator)) == 0)
  1012.       {
  1013.         lexptr += strlen (dot_ops[i].operator);
  1014.         yylval.opcode = dot_ops[i].opcode;
  1015.         return dot_ops[i].token;
  1016.       }

  1018.   /* See if it is an exponentiation operator.  */

  1020.   if (strncmp (tokstart, "**", 2) == 0)
  1021.     {
  1022.       lexptr += 2;
  1023.       yylval.opcode = BINOP_EXP;
  1024.       return STARSTAR;
  1025.     }

  1027.   switch (c = *tokstart)
  1028.     {
  1029.     case 0:
  1030.       return 0;

  1032.     case ' ':
  1033.     case '\t':
  1034.     case '\n':
  1035.       lexptr++;
  1036.       goto retry;

  1038.     case '\'':
  1039.       token = match_string_literal ();
  1040.       if (token != 0)
  1041.         return (token);
  1042.       break;

  1044.     case '(':
  1045.       paren_depth++;
  1046.       lexptr++;
  1047.       return c;

  1049.     case ')':
  1050.       if (paren_depth == 0)
  1051.         return 0;
  1052.       paren_depth--;
  1053.       lexptr++;
  1054.       return c;

  1056.     case ',':
  1057.       if (comma_terminates && paren_depth == 0)
  1058.         return 0;
  1059.       lexptr++;
  1060.       return c;

  1062.     case '.':
  1063.       /* Might be a floating point number.  */
  1064.       if (lexptr[1] < '0' || lexptr[1] > '9')
  1065.         goto symbol;                /* Nope, must be a symbol.  */
  1066.       /* FALL THRU into number case.  */

  1068.     case '0':
  1069.     case '1':
  1070.     case '2':
  1071.     case '3':
  1072.     case '4':
  1073.     case '5':
  1074.     case '6':
  1075.     case '7':
  1076.     case '8':
  1077.     case '9':
  1078.       {
  1079.         /* It's a number.  */
  1080.         int got_dot = 0, got_e = 0, got_d = 0, toktype;
  1081.         const char *p = tokstart;
  1082.         int hex = input_radix > 10;

  1084.         if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
  1085.           {
  1086.             p += 2;
  1087.             hex = 1;
  1088.           }
  1089.         else if (c == '0' && (p[1]=='t' || p[1]=='T'
  1090.                               || p[1]=='d' || p[1]=='D'))
  1091.           {
  1092.             p += 2;
  1093.             hex = 0;
  1094.           }

  1096.         for (;; ++p)
  1097.           {
  1098.             if (!hex && !got_e && (*p == 'e' || *p == 'E'))
  1099.               got_dot = got_e = 1;
  1100.             else if (!hex && !got_d && (*p == 'd' || *p == 'D'))
  1101.               got_dot = got_d = 1;
  1102.             else if (!hex && !got_dot && *p == '.')
  1103.               got_dot = 1;
  1104.             else if (((got_e && (p[-1] == 'e' || p[-1] == 'E'))
  1105.                      || (got_d && (p[-1] == 'd' || p[-1] == 'D')))
  1106.                      && (*p == '-' || *p == '+'))
  1107.               /* This is the sign of the exponent, not the end of the
  1108.                  number.  */
  1109.               continue;
  1110.             /* We will take any letters or digits.  parse_number will
  1111.                complain if past the radix, or if L or U are not final.  */
  1112.             else if ((*p < '0' || *p > '9')
  1113.                      && ((*p < 'a' || *p > 'z')
  1114.                          && (*p < 'A' || *p > 'Z')))
  1115.               break;
  1116.           }
  1117.         toktype = parse_number (pstate, tokstart, p - tokstart,
  1118.                                 got_dot|got_e|got_d,
  1119.                                 &yylval);
  1120.         if (toktype == ERROR)
  1121.           {
  1122.             char *err_copy = (char *) alloca (p - tokstart + 1);

  1124.             memcpy (err_copy, tokstart, p - tokstart);
  1125.             err_copy[p - tokstart] = 0;
  1126.             error (_("Invalid number \"%s\"."), err_copy);
  1127.           }
  1128.         lexptr = p;
  1129.         return toktype;
  1130.       }

  1132.     case '+':
  1133.     case '-':
  1134.     case '*':
  1135.     case '/':
  1136.     case '%':
  1137.     case '|':
  1138.     case '&':
  1139.     case '^':
  1140.     case '~':
  1141.     case '!':
  1142.     case '@':
  1143.     case '<':
  1144.     case '>':
  1145.     case '[':
  1146.     case ']':
  1147.     case '?':
  1148.     case ':':
  1149.     case '=':
  1150.     case '{':
  1151.     case '}':
  1152.     symbol:
  1153.       lexptr++;
  1154.       return c;
  1155.     }

  1157.   if (!(c == '_' || c == '$' || c ==':'
  1158.         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
  1159.     /* We must have come across a bad character (e.g. ';').  */
  1160.     error (_("Invalid character '%c' in expression."), c);

  1162.   namelen = 0;
  1163.   for (c = tokstart[namelen];
  1164.        (c == '_' || c == '$' || c == ':' || (c >= '0' && c <= '9')
  1165.         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
  1166.        c = tokstart[++namelen]);

  1168.   /* The token "if" terminates the expression and is NOT
  1169.      removed from the input stream.  */

  1171.   if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
  1172.     return 0;

  1174.   lexptr += namelen;

  1176.   /* Catch specific keywords.  */

  1178.   for (i = 0; f77_keywords[i].operator != NULL; i++)
  1179.     if (strlen (f77_keywords[i].operator) == namelen
  1180.         && strncmp (tokstart, f77_keywords[i].operator, namelen) == 0)
  1181.       {
  1182.         /*         lexptr += strlen(f77_keywords[i].operator); */
  1183.         yylval.opcode = f77_keywords[i].opcode;
  1184.         return f77_keywords[i].token;
  1185.       }

  1187.   yylval.sval.ptr = tokstart;
  1188.   yylval.sval.length = namelen;

  1190.   if (*tokstart == '$')
  1191.     {
  1192.       write_dollar_variable (pstate, yylval.sval);
  1193.       return VARIABLE;
  1194.     }

  1196.   /* Use token-type TYPENAME for symbols that happen to be defined
  1197.      currently as names of types; NAME for other symbols.
  1198.      The caller is not constrained to care about the distinction.  */
  1199.   {
  1200.     char *tmp = copy_name (yylval.sval);
  1201.     struct symbol *sym;
  1202.     struct field_of_this_result is_a_field_of_this;
  1203.     enum domain_enum_tag lookup_domains[] =
  1204.     {
  1205.       STRUCT_DOMAIN,
  1206.       VAR_DOMAIN,
  1207.       MODULE_DOMAIN
  1208.     };
  1209.     int i;
  1210.     int hextype;

  1212.     for (i = 0; i < ARRAY_SIZE (lookup_domains); ++i)
  1213.       {
  1214.         /* Initialize this in case we *don't* use it in this call; that
  1215.            way we can refer to it unconditionally below.  */
  1216.         memset (&is_a_field_of_this, 0, sizeof (is_a_field_of_this));

  1218.         sym = lookup_symbol (tmp, expression_context_block,
  1219.                              lookup_domains[i],
  1220.                              parse_language (pstate)->la_language
  1221.                              == language_cplus ? &is_a_field_of_this : NULL);
  1222.         if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
  1223.           {
  1224.             yylval.tsym.type = SYMBOL_TYPE (sym);
  1225.             return TYPENAME;
  1226.           }

  1228.         if (sym)
  1229.           break;
  1230.       }

  1232.     yylval.tsym.type
  1233.       = language_lookup_primitive_type (parse_language (pstate),
  1234.                                         parse_gdbarch (pstate), tmp);
  1235.     if (yylval.tsym.type != NULL)
  1236.       return TYPENAME;

  1238.     /* Input names that aren't symbols but ARE valid hex numbers,
  1239.        when the input radix permits them, can be names or numbers
  1240.        depending on the parse.  Note we support radixes > 16 here.  */
  1241.     if (!sym
  1242.         && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
  1243.             || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
  1244.       {
  1245.          YYSTYPE newlval;        /* Its value is ignored.  */
  1246.         hextype = parse_number (pstate, tokstart, namelen, 0, &newlval);
  1247.         if (hextype == INT)
  1248.           {
  1249.             yylval.ssym.sym = sym;
  1250.             yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
  1251.             return NAME_OR_INT;
  1252.           }
  1253.       }

  1255.     /* Any other kind of symbol */
  1256.     yylval.ssym.sym = sym;
  1257.     yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
  1258.     return NAME;
  1259.   }
  1260. }

  1262. int
  1263. f_parse (struct parser_state *par_state)
  1264. {
  1265.   int result;
  1266.   struct cleanup *c = make_cleanup_clear_parser_state (&pstate);

  1268.   /* Setting up the parser state.  */
  1269.   gdb_assert (par_state != NULL);
  1270.   pstate = par_state;

  1272.   result = yyparse ();
  1273.   do_cleanups (c);
  1274.   return result;
  1275. }

  1277. void
  1278. yyerror (char *msg)
  1279. {
  1280.   if (prev_lexptr)
  1281.     lexptr = prev_lexptr;

  1283.   error (_("A %s in expression, near `%s'."), (msg ? msg : "error"), lexptr);
  1284. }