build_type_unit_groups and moved closer to only caller and renamed
[platform/upstream/binutils.git] / gdb / f-exp.y
index c04c8f4..c70da17 100644 (file)
@@ -1,7 +1,6 @@
+
 /* YACC parser for Fortran expressions, for GDB.
-   Copyright (C) 1986, 1989, 1990, 1991, 1993, 1994, 1995, 1996, 2000, 2001,
-   2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
-   Free Software Foundation, Inc.
+   Copyright (C) 1986-2014 Free Software Foundation, Inc.
 
    Contributed by Motorola.  Adapted from the C parser by Farooq Butt
    (fmbutt@engage.sps.mot.com).
@@ -44,7 +43,7 @@
 %{
 
 #include "defs.h"
-#include "gdb_string.h"
+#include <string.h>
 #include "expression.h"
 #include "value.h"
 #include "parser-defs.h"
 #include "block.h"
 #include <ctype.h>
 
-#define parse_type builtin_type (parse_gdbarch)
-#define parse_f_type builtin_f_type (parse_gdbarch)
+#define parse_type(ps) builtin_type (parse_gdbarch (ps))
+#define parse_f_type(ps) builtin_f_type (parse_gdbarch (ps))
 
 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
    as well as gratuitiously global symbol names, so we can have multiple
    yacc generated parsers in gdb.  Note that these are only the variables
    produced by yacc.  If other parser generators (bison, byacc, etc) produce
    additional global names that conflict at link time, then those parser
-   generators need to be fixed instead of adding those names to this list. */
+   generators need to be fixed instead of adding those names to this list.  */
 
 #define        yymaxdepth f_maxdepth
-#define        yyparse f_parse
+#define        yyparse f_parse_internal
 #define        yylex   f_lex
 #define        yyerror f_error
 #define        yylval  f_lval
 #define yygindex f_yygindex
 #define yytable         f_yytable
 #define yycheck         f_yycheck
+#define yyss   f_yyss
+#define yysslim        f_yysslim
+#define yyssp  f_yyssp
+#define yystacksize f_yystacksize
+#define yyvs   f_yyvs
+#define yyvsp  f_yyvsp
 
 #ifndef YYDEBUG
 #define        YYDEBUG 1               /* Default to yydebug support */
 
 #define YYFPRINTF parser_fprintf
 
+/* The state of the parser, used internally when we are parsing the
+   expression.  */
+
+static struct parser_state *pstate = NULL;
+
 int yyparse (void);
 
 static int yylex (void);
@@ -153,7 +163,8 @@ static int match_string_literal (void);
 
 %{
 /* YYSTYPE gets defined by %union */
-static int parse_number (char *, int, int, YYSTYPE *);
+static int parse_number (struct parser_state *, const char *, int,
+                        int, YYSTYPE *);
 %}
 
 %type <voidval> exp  type_exp start variable 
@@ -196,6 +207,7 @@ static int parse_number (char *, int, int, YYSTYPE *);
 /* Special type cases, put in to allow the parser to distinguish different
    legal basetypes.  */
 %token INT_KEYWORD INT_S2_KEYWORD LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD 
+%token LOGICAL_S8_KEYWORD
 %token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD 
 %token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD 
 %token BOOL_AND BOOL_OR BOOL_NOT   
@@ -234,9 +246,9 @@ start   :   exp
        ;
 
 type_exp:      type
-                       { write_exp_elt_opcode(OP_TYPE);
-                         write_exp_elt_type($1);
-                         write_exp_elt_opcode(OP_TYPE); }
+                       { write_exp_elt_opcode (pstate, OP_TYPE);
+                         write_exp_elt_type (pstate, $1);
+                         write_exp_elt_opcode (pstate, OP_TYPE); }
        ;
 
 exp     :       '(' exp ')'
@@ -245,27 +257,27 @@ exp     :       '(' exp ')'
 
 /* Expressions, not including the comma operator.  */
 exp    :       '*' exp    %prec UNARY
-                       { write_exp_elt_opcode (UNOP_IND); }
+                       { write_exp_elt_opcode (pstate, UNOP_IND); }
        ;
 
 exp    :       '&' exp    %prec UNARY
-                       { write_exp_elt_opcode (UNOP_ADDR); }
+                       { write_exp_elt_opcode (pstate, UNOP_ADDR); }
        ;
 
 exp    :       '-' exp    %prec UNARY
-                       { write_exp_elt_opcode (UNOP_NEG); }
+                       { write_exp_elt_opcode (pstate, UNOP_NEG); }
        ;
 
 exp    :       BOOL_NOT exp    %prec UNARY
-                       { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
+                       { write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
        ;
 
 exp    :       '~' exp    %prec UNARY
-                       { write_exp_elt_opcode (UNOP_COMPLEMENT); }
+                       { write_exp_elt_opcode (pstate, UNOP_COMPLEMENT); }
        ;
 
 exp    :       SIZEOF exp       %prec UNARY
-                       { write_exp_elt_opcode (UNOP_SIZEOF); }
+                       { write_exp_elt_opcode (pstate, UNOP_SIZEOF); }
        ;
 
 /* No more explicit array operators, we treat everything in F77 as 
@@ -276,9 +288,12 @@ exp        :       SIZEOF exp       %prec UNARY
 exp    :       exp '(' 
                        { start_arglist (); }
                arglist ')'     
-                       { write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST);
-                         write_exp_elt_longcst ((LONGEST) end_arglist ());
-                         write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST); }
+                       { write_exp_elt_opcode (pstate,
+                                               OP_F77_UNDETERMINED_ARGLIST);
+                         write_exp_elt_longcst (pstate,
+                                                (LONGEST) end_arglist ());
+                         write_exp_elt_opcode (pstate,
+                                             OP_F77_UNDETERMINED_ARGLIST); }
        ;
 
 arglist        :
@@ -299,27 +314,27 @@ arglist   :       arglist ',' exp   %prec ABOVE_COMMA
 /* There are four sorts of subrange types in F90.  */
 
 subrange:      exp ':' exp     %prec ABOVE_COMMA
-                       { write_exp_elt_opcode (OP_F90_RANGE); 
-                         write_exp_elt_longcst (NONE_BOUND_DEFAULT);
-                         write_exp_elt_opcode (OP_F90_RANGE); }
+                       { write_exp_elt_opcode (pstate, OP_F90_RANGE); 
+                         write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT);
+                         write_exp_elt_opcode (pstate, OP_F90_RANGE); }
        ;
 
 subrange:      exp ':' %prec ABOVE_COMMA
-                       { write_exp_elt_opcode (OP_F90_RANGE);
-                         write_exp_elt_longcst (HIGH_BOUND_DEFAULT);
-                         write_exp_elt_opcode (OP_F90_RANGE); }
+                       { write_exp_elt_opcode (pstate, OP_F90_RANGE);
+                         write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT);
+                         write_exp_elt_opcode (pstate, OP_F90_RANGE); }
        ;
 
 subrange:      ':' exp %prec ABOVE_COMMA
-                       { write_exp_elt_opcode (OP_F90_RANGE);
-                         write_exp_elt_longcst (LOW_BOUND_DEFAULT);
-                         write_exp_elt_opcode (OP_F90_RANGE); }
+                       { write_exp_elt_opcode (pstate, OP_F90_RANGE);
+                         write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT);
+                         write_exp_elt_opcode (pstate, OP_F90_RANGE); }
        ;
 
 subrange:      ':'     %prec ABOVE_COMMA
-                       { write_exp_elt_opcode (OP_F90_RANGE);
-                         write_exp_elt_longcst (BOTH_BOUND_DEFAULT);
-                         write_exp_elt_opcode (OP_F90_RANGE); }
+                       { write_exp_elt_opcode (pstate, OP_F90_RANGE);
+                         write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT);
+                         write_exp_elt_opcode (pstate, OP_F90_RANGE); }
        ;
 
 complexnum:     exp ',' exp 
@@ -327,133 +342,139 @@ complexnum:     exp ',' exp
         ;
 
 exp    :       '(' complexnum ')'
-                       { write_exp_elt_opcode(OP_COMPLEX);
-                         write_exp_elt_type (parse_f_type->builtin_complex_s16);
-                         write_exp_elt_opcode(OP_COMPLEX); }
+                       { write_exp_elt_opcode (pstate, OP_COMPLEX);
+                         write_exp_elt_type (pstate,
+                                             parse_f_type (pstate)
+                                             ->builtin_complex_s16);
+                         write_exp_elt_opcode (pstate, OP_COMPLEX); }
        ;
 
 exp    :       '(' type ')' exp  %prec UNARY
-                       { write_exp_elt_opcode (UNOP_CAST);
-                         write_exp_elt_type ($2);
-                         write_exp_elt_opcode (UNOP_CAST); }
+                       { write_exp_elt_opcode (pstate, UNOP_CAST);
+                         write_exp_elt_type (pstate, $2);
+                         write_exp_elt_opcode (pstate, UNOP_CAST); }
        ;
 
 exp     :       exp '%' name
-                        { write_exp_elt_opcode (STRUCTOP_STRUCT);
-                          write_exp_string ($3);
-                          write_exp_elt_opcode (STRUCTOP_STRUCT); }
+                        { write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
+                          write_exp_string (pstate, $3);
+                          write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
         ;
 
 /* Binary operators in order of decreasing precedence.  */
 
 exp    :       exp '@' exp
-                       { write_exp_elt_opcode (BINOP_REPEAT); }
+                       { write_exp_elt_opcode (pstate, BINOP_REPEAT); }
        ;
 
 exp    :       exp STARSTAR exp
-                       { write_exp_elt_opcode (BINOP_EXP); }
+                       { write_exp_elt_opcode (pstate, BINOP_EXP); }
        ;
 
 exp    :       exp '*' exp
-                       { write_exp_elt_opcode (BINOP_MUL); }
+                       { write_exp_elt_opcode (pstate, BINOP_MUL); }
        ;
 
 exp    :       exp '/' exp
-                       { write_exp_elt_opcode (BINOP_DIV); }
+                       { write_exp_elt_opcode (pstate, BINOP_DIV); }
        ;
 
 exp    :       exp '+' exp
-                       { write_exp_elt_opcode (BINOP_ADD); }
+                       { write_exp_elt_opcode (pstate, BINOP_ADD); }
        ;
 
 exp    :       exp '-' exp
-                       { write_exp_elt_opcode (BINOP_SUB); }
+                       { write_exp_elt_opcode (pstate, BINOP_SUB); }
        ;
 
 exp    :       exp LSH exp
-                       { write_exp_elt_opcode (BINOP_LSH); }
+                       { write_exp_elt_opcode (pstate, BINOP_LSH); }
        ;
 
 exp    :       exp RSH exp
-                       { write_exp_elt_opcode (BINOP_RSH); }
+                       { write_exp_elt_opcode (pstate, BINOP_RSH); }
        ;
 
 exp    :       exp EQUAL exp
-                       { write_exp_elt_opcode (BINOP_EQUAL); }
+                       { write_exp_elt_opcode (pstate, BINOP_EQUAL); }
        ;
 
 exp    :       exp NOTEQUAL exp
-                       { write_exp_elt_opcode (BINOP_NOTEQUAL); }
+                       { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
        ;
 
 exp    :       exp LEQ exp
-                       { write_exp_elt_opcode (BINOP_LEQ); }
+                       { write_exp_elt_opcode (pstate, BINOP_LEQ); }
        ;
 
 exp    :       exp GEQ exp
-                       { write_exp_elt_opcode (BINOP_GEQ); }
+                       { write_exp_elt_opcode (pstate, BINOP_GEQ); }
        ;
 
 exp    :       exp LESSTHAN exp
-                       { write_exp_elt_opcode (BINOP_LESS); }
+                       { write_exp_elt_opcode (pstate, BINOP_LESS); }
        ;
 
 exp    :       exp GREATERTHAN exp
-                       { write_exp_elt_opcode (BINOP_GTR); }
+                       { write_exp_elt_opcode (pstate, BINOP_GTR); }
        ;
 
 exp    :       exp '&' exp
-                       { write_exp_elt_opcode (BINOP_BITWISE_AND); }
+                       { write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
        ;
 
 exp    :       exp '^' exp
-                       { write_exp_elt_opcode (BINOP_BITWISE_XOR); }
+                       { write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
        ;
 
 exp    :       exp '|' exp
-                       { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
+                       { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
        ;
 
 exp     :       exp BOOL_AND exp
-                       { write_exp_elt_opcode (BINOP_LOGICAL_AND); }
+                       { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
        ;
 
 
 exp    :       exp BOOL_OR exp
-                       { write_exp_elt_opcode (BINOP_LOGICAL_OR); }
+                       { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
        ;
 
 exp    :       exp '=' exp
-                       { write_exp_elt_opcode (BINOP_ASSIGN); }
+                       { write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
        ;
 
 exp    :       exp ASSIGN_MODIFY exp
-                       { write_exp_elt_opcode (BINOP_ASSIGN_MODIFY);
-                         write_exp_elt_opcode ($2);
-                         write_exp_elt_opcode (BINOP_ASSIGN_MODIFY); }
+                       { write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY);
+                         write_exp_elt_opcode (pstate, $2);
+                         write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY); }
        ;
 
 exp    :       INT
-                       { write_exp_elt_opcode (OP_LONG);
-                         write_exp_elt_type ($1.type);
-                         write_exp_elt_longcst ((LONGEST)($1.val));
-                         write_exp_elt_opcode (OP_LONG); }
+                       { write_exp_elt_opcode (pstate, OP_LONG);
+                         write_exp_elt_type (pstate, $1.type);
+                         write_exp_elt_longcst (pstate, (LONGEST) ($1.val));
+                         write_exp_elt_opcode (pstate, OP_LONG); }
        ;
 
 exp    :       NAME_OR_INT
                        { YYSTYPE val;
-                         parse_number ($1.stoken.ptr, $1.stoken.length, 0, &val);
-                         write_exp_elt_opcode (OP_LONG);
-                         write_exp_elt_type (val.typed_val.type);
-                         write_exp_elt_longcst ((LONGEST)val.typed_val.val);
-                         write_exp_elt_opcode (OP_LONG); }
+                         parse_number (pstate, $1.stoken.ptr,
+                                       $1.stoken.length, 0, &val);
+                         write_exp_elt_opcode (pstate, OP_LONG);
+                         write_exp_elt_type (pstate, val.typed_val.type);
+                         write_exp_elt_longcst (pstate,
+                                                (LONGEST)val.typed_val.val);
+                         write_exp_elt_opcode (pstate, OP_LONG); }
        ;
 
 exp    :       FLOAT
-                       { write_exp_elt_opcode (OP_DOUBLE);
-                         write_exp_elt_type (parse_f_type->builtin_real_s8);
-                         write_exp_elt_dblcst ($1);
-                         write_exp_elt_opcode (OP_DOUBLE); }
+                       { write_exp_elt_opcode (pstate, OP_DOUBLE);
+                         write_exp_elt_type (pstate,
+                                             parse_f_type (pstate)
+                                             ->builtin_real_s8);
+                         write_exp_elt_dblcst (pstate, $1);
+                         write_exp_elt_opcode (pstate, OP_DOUBLE); }
        ;
 
 exp    :       variable
@@ -463,25 +484,28 @@ exp       :       VARIABLE
        ;
 
 exp    :       SIZEOF '(' type ')'     %prec UNARY
-                       { write_exp_elt_opcode (OP_LONG);
-                         write_exp_elt_type (parse_f_type->builtin_integer);
+                       { write_exp_elt_opcode (pstate, OP_LONG);
+                         write_exp_elt_type (pstate,
+                                             parse_f_type (pstate)
+                                             ->builtin_integer);
                          CHECK_TYPEDEF ($3);
-                         write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
-                         write_exp_elt_opcode (OP_LONG); }
+                         write_exp_elt_longcst (pstate,
+                                                (LONGEST) TYPE_LENGTH ($3));
+                         write_exp_elt_opcode (pstate, OP_LONG); }
        ;
 
 exp     :       BOOLEAN_LITERAL
-                       { write_exp_elt_opcode (OP_BOOL);
-                         write_exp_elt_longcst ((LONGEST) $1);
-                         write_exp_elt_opcode (OP_BOOL);
+                       { write_exp_elt_opcode (pstate, OP_BOOL);
+                         write_exp_elt_longcst (pstate, (LONGEST) $1);
+                         write_exp_elt_opcode (pstate, OP_BOOL);
                        }
         ;
 
 exp    :       STRING_LITERAL
                        {
-                         write_exp_elt_opcode (OP_STRING);
-                         write_exp_string ($1);
-                         write_exp_elt_opcode (OP_STRING);
+                         write_exp_elt_opcode (pstate, OP_STRING);
+                         write_exp_string (pstate, $1);
+                         write_exp_elt_opcode (pstate, OP_STRING);
                        }
        ;
 
@@ -492,33 +516,33 @@ variable: name_not_typename
                            {
                              if (symbol_read_needs_frame (sym))
                                {
-                                 if (innermost_block == 0 ||
-                                     contained_in (block_found, 
-                                                   innermost_block))
+                                 if (innermost_block == 0
+                                     || contained_in (block_found, 
+                                                      innermost_block))
                                    innermost_block = block_found;
                                }
-                             write_exp_elt_opcode (OP_VAR_VALUE);
+                             write_exp_elt_opcode (pstate, OP_VAR_VALUE);
                              /* We want to use the selected frame, not
                                 another more inner frame which happens to
                                 be in the same block.  */
-                             write_exp_elt_block (NULL);
-                             write_exp_elt_sym (sym);
-                             write_exp_elt_opcode (OP_VAR_VALUE);
+                             write_exp_elt_block (pstate, NULL);
+                             write_exp_elt_sym (pstate, sym);
+                             write_exp_elt_opcode (pstate, OP_VAR_VALUE);
                              break;
                            }
                          else
                            {
-                             struct minimal_symbol *msymbol;
+                             struct bound_minimal_symbol msymbol;
                              char *arg = copy_name ($1.stoken);
 
                              msymbol =
-                               lookup_minimal_symbol (arg, NULL, NULL);
-                             if (msymbol != NULL)
-                               write_exp_msymbol (msymbol);
+                               lookup_bound_minimal_symbol (arg);
+                             if (msymbol.minsym != NULL)
+                               write_exp_msymbol (pstate, msymbol);
                              else if (!have_full_symbols () && !have_partial_symbols ())
-                               error ("No symbol table is loaded.  Use the \"file\" command.");
+                               error (_("No symbol table is loaded.  Use the \"file\" command."));
                              else
-                               error ("No symbol \"%s\" in current context.",
+                               error (_("No symbol \"%s\" in current context."),
                                       copy_name ($1.stoken));
                            }
                        }
@@ -554,9 +578,10 @@ ptype      :       typebase
                        if (array_size != -1)
                          {
                            range_type =
-                             create_range_type ((struct type *) NULL,
-                                                parse_f_type->builtin_integer,
-                                                0, array_size - 1);
+                             create_static_range_type ((struct type *) NULL,
+                                                       parse_f_type (pstate)
+                                                       ->builtin_integer,
+                                                       0, array_size - 1);
                            follow_type =
                              create_array_type ((struct type *) NULL,
                                                 follow_type, range_type);
@@ -601,29 +626,31 @@ typebase  /* Implements (approximately): (type-qualifier)* type-specifier */
        :       TYPENAME
                        { $$ = $1.type; }
        |       INT_KEYWORD
-                       { $$ = parse_f_type->builtin_integer; }
+                       { $$ = parse_f_type (pstate)->builtin_integer; }
        |       INT_S2_KEYWORD 
-                       { $$ = parse_f_type->builtin_integer_s2; }
+                       { $$ = parse_f_type (pstate)->builtin_integer_s2; }
        |       CHARACTER 
-                       { $$ = parse_f_type->builtin_character; }
+                       { $$ = parse_f_type (pstate)->builtin_character; }
+       |       LOGICAL_S8_KEYWORD
+                       { $$ = parse_f_type (pstate)->builtin_logical_s8; }
        |       LOGICAL_KEYWORD 
-                       { $$ = parse_f_type->builtin_logical; }
+                       { $$ = parse_f_type (pstate)->builtin_logical; }
        |       LOGICAL_S2_KEYWORD
-                       { $$ = parse_f_type->builtin_logical_s2; }
+                       { $$ = parse_f_type (pstate)->builtin_logical_s2; }
        |       LOGICAL_S1_KEYWORD 
-                       { $$ = parse_f_type->builtin_logical_s1; }
+                       { $$ = parse_f_type (pstate)->builtin_logical_s1; }
        |       REAL_KEYWORD 
-                       { $$ = parse_f_type->builtin_real; }
+                       { $$ = parse_f_type (pstate)->builtin_real; }
        |       REAL_S8_KEYWORD
-                       { $$ = parse_f_type->builtin_real_s8; }
+                       { $$ = parse_f_type (pstate)->builtin_real_s8; }
        |       REAL_S16_KEYWORD
-                       { $$ = parse_f_type->builtin_real_s16; }
+                       { $$ = parse_f_type (pstate)->builtin_real_s16; }
        |       COMPLEX_S8_KEYWORD
-                       { $$ = parse_f_type->builtin_complex_s8; }
+                       { $$ = parse_f_type (pstate)->builtin_complex_s8; }
        |       COMPLEX_S16_KEYWORD 
-                       { $$ = parse_f_type->builtin_complex_s16; }
+                       { $$ = parse_f_type (pstate)->builtin_complex_s16; }
        |       COMPLEX_S32_KEYWORD 
-                       { $$ = parse_f_type->builtin_complex_s32; }
+                       { $$ = parse_f_type (pstate)->builtin_complex_s32; }
        ;
 
 nonempty_typelist
@@ -662,11 +689,8 @@ name_not_typename :        NAME
 /*** Needs some error checking for the float case ***/
 
 static int
-parse_number (p, len, parsed_float, putithere)
-     char *p;
-     int len;
-     int parsed_float;
-     YYSTYPE *putithere;
+parse_number (struct parser_state *par_state,
+             const char *p, int len, int parsed_float, YYSTYPE *putithere)
 {
   LONGEST n = 0;
   LONGEST prevn = 0;
@@ -755,14 +779,14 @@ parse_number (p, len, parsed_float, putithere)
       if (RANGE_CHECK && n != 0)
        {
          if ((unsigned_p && (unsigned)prevn >= (unsigned)n))
-           range_error("Overflow on numeric constant.");        
+           range_error (_("Overflow on numeric constant."));
        }
       prevn = n;
     }
   
   /* If the number is too big to be an int, or it's got an l suffix
      then it's a long.  Work out if this has to be a long by
-     shifting right and and seeing if anything remains, and the
+     shifting right and seeing if anything remains, and the
      target int size is different to the target long size.
      
      In the expression below, we could have tested
@@ -772,26 +796,30 @@ parse_number (p, len, parsed_float, putithere)
      are the same size.  So we shift it twice, with fewer bits
      each time, for the same result.  */
   
-  if ((gdbarch_int_bit (parse_gdbarch) != gdbarch_long_bit (parse_gdbarch)
+  if ((gdbarch_int_bit (parse_gdbarch (par_state))
+       != gdbarch_long_bit (parse_gdbarch (par_state))
        && ((n >> 2)
-          >> (gdbarch_int_bit (parse_gdbarch)-2))) /* Avoid shift warning */
+          >> (gdbarch_int_bit (parse_gdbarch (par_state))-2))) /* Avoid
+                                                           shift warning */
       || long_p)
     {
-      high_bit = ((ULONGEST)1) << (gdbarch_long_bit (parse_gdbarch)-1);
-      unsigned_type = parse_type->builtin_unsigned_long;
-      signed_type = parse_type->builtin_long;
+      high_bit = ((ULONGEST)1)
+      << (gdbarch_long_bit (parse_gdbarch (par_state))-1);
+      unsigned_type = parse_type (par_state)->builtin_unsigned_long;
+      signed_type = parse_type (par_state)->builtin_long;
     }
   else 
     {
-      high_bit = ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch)-1);
-      unsigned_type = parse_type->builtin_unsigned_int;
-      signed_type = parse_type->builtin_int;
+      high_bit =
+       ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch (par_state)) - 1);
+      unsigned_type = parse_type (par_state)->builtin_unsigned_int;
+      signed_type = parse_type (par_state)->builtin_int;
     }    
   
   putithere->typed_val.val = n;
   
   /* If the high bit of the worked out type is set then this number
-     has to be unsigned. */
+     has to be unsigned.  */
   
   if (unsigned_p || (n & high_bit)) 
     putithere->typed_val.type = unsigned_type;
@@ -858,6 +886,7 @@ static const struct token f77_keywords[] =
   { "integer_2", INT_S2_KEYWORD, BINOP_END },
   { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END },
   { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END },
+  { "logical_8", LOGICAL_S8_KEYWORD, BINOP_END },
   { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END },
   { "integer", INT_KEYWORD, BINOP_END },
   { "logical", LOGICAL_KEYWORD, BINOP_END },
@@ -871,7 +900,7 @@ static const struct token f77_keywords[] =
 
 /* Implementation of a dynamically expandable buffer for processing input
    characters acquired through lexptr and building a value to return in
-   yylval. Ripped off from ch-exp.y */ 
+   yylval.  Ripped off from ch-exp.y */ 
 
 static char *tempbuf;          /* Current buffer contents */
 static int tempbufsize;                /* Size of allocated buffer */
@@ -888,12 +917,11 @@ static int tempbufindex;  /* Current index into buffer */
   } while (0);
 
 
-/* Grow the static temp buffer if necessary, including allocating the first one
-   on demand. */
+/* Grow the static temp buffer if necessary, including allocating the
+   first one on demand.  */
 
 static void
-growbuf_by_size (count)
-     int count;
+growbuf_by_size (int count)
 {
   int growby;
 
@@ -906,7 +934,7 @@ growbuf_by_size (count)
 }
 
 /* Blatantly ripped off from ch-exp.y. This routine recognizes F77 
-   string-literals. 
+   string-literals.
    
    Recognize a string literal.  A string literal is a nonzero sequence
    of characters enclosed in matching single quotes, except that
@@ -915,9 +943,9 @@ growbuf_by_size (count)
    a string, it is simply doubled (I.E. 'this''is''one''string') */
 
 static int
-match_string_literal ()
+match_string_literal (void)
 {
-  char *tokptr = lexptr;
+  const char *tokptr = lexptr;
 
   for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
     {
@@ -947,12 +975,12 @@ match_string_literal ()
 /* Read one token, getting characters through lexptr.  */
 
 static int
-yylex ()
+yylex (void)
 {
   int c;
   int namelen;
   unsigned int i,token;
-  char *tokstart;
+  const char *tokstart;
   
  retry:
  
@@ -980,7 +1008,8 @@ yylex ()
   /* See if it is a special .foo. operator.  */
   
   for (i = 0; dot_ops[i].operator != NULL; i++)
-    if (strncmp (tokstart, dot_ops[i].operator, strlen (dot_ops[i].operator)) == 0)
+    if (strncmp (tokstart, dot_ops[i].operator,
+                strlen (dot_ops[i].operator)) == 0)
       {
        lexptr += strlen (dot_ops[i].operator);
        yylval.opcode = dot_ops[i].opcode;
@@ -1034,7 +1063,7 @@ yylex ()
     case '.':
       /* Might be a floating point number.  */
       if (lexptr[1] < '0' || lexptr[1] > '9')
-       goto symbol;            /* Nope, must be a symbol. */
+       goto symbol;            /* Nope, must be a symbol.  */
       /* FALL THRU into number case.  */
       
     case '0':
@@ -1050,7 +1079,7 @@ yylex ()
       {
         /* It's a number.  */
        int got_dot = 0, got_e = 0, got_d = 0, toktype;
-       char *p = tokstart;
+       const char *p = tokstart;
        int hex = input_radix > 10;
        
        if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
@@ -1058,7 +1087,8 @@ yylex ()
            p += 2;
            hex = 1;
          }
-       else if (c == '0' && (p[1]=='t' || p[1]=='T' || p[1]=='d' || p[1]=='D'))
+       else if (c == '0' && (p[1]=='t' || p[1]=='T'
+                             || p[1]=='d' || p[1]=='D'))
          {
            p += 2;
            hex = 0;
@@ -1085,7 +1115,8 @@ yylex ()
                         && (*p < 'A' || *p > 'Z')))
              break;
          }
-       toktype = parse_number (tokstart, p - tokstart, got_dot|got_e|got_d,
+       toktype = parse_number (pstate, tokstart, p - tokstart,
+                               got_dot|got_e|got_d,
                                &yylval);
         if (toktype == ERROR)
           {
@@ -1093,7 +1124,7 @@ yylex ()
            
            memcpy (err_copy, tokstart, p - tokstart);
            err_copy[p - tokstart] = 0;
-           error ("Invalid number \"%s\".", err_copy);
+           error (_("Invalid number \"%s\"."), err_copy);
          }
        lexptr = p;
        return toktype;
@@ -1124,14 +1155,14 @@ yylex ()
       return c;
     }
   
-  if (!(c == '_' || c == '$'
+  if (!(c == '_' || c == '$' || c ==':'
        || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
     /* We must have come across a bad character (e.g. ';').  */
-    error ("Invalid character '%c' in expression.", c);
+    error (_("Invalid character '%c' in expression."), c);
   
   namelen = 0;
   for (c = tokstart[namelen];
-       (c == '_' || c == '$' || (c >= '0' && c <= '9') 
+       (c == '_' || c == '$' || c == ':' || (c >= '0' && c <= '9')
        || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')); 
        c = tokstart[++namelen]);
   
@@ -1146,8 +1177,8 @@ yylex ()
   /* Catch specific keywords.  */
   
   for (i = 0; f77_keywords[i].operator != NULL; i++)
-    if (strncmp (tokstart, f77_keywords[i].operator,
-                strlen(f77_keywords[i].operator)) == 0)
+    if (strlen (f77_keywords[i].operator) == namelen
+       && strncmp (tokstart, f77_keywords[i].operator, namelen) == 0)
       {
        /*      lexptr += strlen(f77_keywords[i].operator); */ 
        yylval.opcode = f77_keywords[i].opcode;
@@ -1159,7 +1190,7 @@ yylex ()
   
   if (*tokstart == '$')
     {
-      write_dollar_variable (yylval.sval);
+      write_dollar_variable (pstate, yylval.sval);
       return VARIABLE;
     }
   
@@ -1169,21 +1200,39 @@ yylex ()
   {
     char *tmp = copy_name (yylval.sval);
     struct symbol *sym;
-    int is_a_field_of_this = 0;
+    struct field_of_this_result is_a_field_of_this;
+    enum domain_enum_tag lookup_domains[] =
+    {
+      STRUCT_DOMAIN,
+      VAR_DOMAIN,
+      MODULE_DOMAIN
+    };
+    int i;
     int hextype;
-    
-    sym = lookup_symbol (tmp, expression_context_block,
-                        VAR_DOMAIN,
-                        parse_language->la_language == language_cplus
-                        ? &is_a_field_of_this : NULL);
-    if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
+
+    for (i = 0; i < ARRAY_SIZE (lookup_domains); ++i)
       {
-       yylval.tsym.type = SYMBOL_TYPE (sym);
-       return TYPENAME;
+       /* Initialize this in case we *don't* use it in this call; that
+          way we can refer to it unconditionally below.  */
+       memset (&is_a_field_of_this, 0, sizeof (is_a_field_of_this));
+
+       sym = lookup_symbol (tmp, expression_context_block,
+                            lookup_domains[i],
+                            parse_language (pstate)->la_language
+                            == language_cplus ? &is_a_field_of_this : NULL);
+       if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
+         {
+           yylval.tsym.type = SYMBOL_TYPE (sym);
+           return TYPENAME;
+         }
+
+       if (sym)
+         break;
       }
+
     yylval.tsym.type
-      = language_lookup_primitive_type_by_name (parse_language,
-                                               parse_gdbarch, tmp);
+      = language_lookup_primitive_type_by_name (parse_language (pstate),
+                                               parse_gdbarch (pstate), tmp);
     if (yylval.tsym.type != NULL)
       return TYPENAME;
     
@@ -1195,28 +1244,42 @@ yylex ()
            || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
       {
        YYSTYPE newlval;        /* Its value is ignored.  */
-       hextype = parse_number (tokstart, namelen, 0, &newlval);
+       hextype = parse_number (pstate, tokstart, namelen, 0, &newlval);
        if (hextype == INT)
          {
            yylval.ssym.sym = sym;
-           yylval.ssym.is_a_field_of_this = is_a_field_of_this;
+           yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
            return NAME_OR_INT;
          }
       }
     
     /* Any other kind of symbol */
     yylval.ssym.sym = sym;
-    yylval.ssym.is_a_field_of_this = is_a_field_of_this;
+    yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
     return NAME;
   }
 }
 
+int
+f_parse (struct parser_state *par_state)
+{
+  int result;
+  struct cleanup *c = make_cleanup_clear_parser_state (&pstate);
+
+  /* Setting up the parser state.  */
+  gdb_assert (par_state != NULL);
+  pstate = par_state;
+
+  result = yyparse ();
+  do_cleanups (c);
+  return result;
+}
+
 void
-yyerror (msg)
-     char *msg;
+yyerror (char *msg)
 {
   if (prev_lexptr)
     lexptr = prev_lexptr;
 
-  error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
+  error (_("A %s in expression, near `%s'."), (msg ? msg : "error"), lexptr);
 }