X-Git-Url: http://git.efficios.com/?a=blobdiff_plain;f=gdb%2Ff-exp.y;h=6608831a9a53807692f0225d185a30b8644363c9;hb=5e6741a157e645d4d5bce1cabae5f89117809b40;hp=522751d2263ae74366740347ff902000e349dfbd;hpb=8621b685bfdcb8773b8177fb2b89e45499902868;p=deliverable%2Fbinutils-gdb.git

diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 522751d226..6608831a9a 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -1,6 +1,6 @@
 
 /* YACC parser for Fortran expressions, for GDB.
-   Copyright (C) 1986-2019 Free Software Foundation, Inc.
+   Copyright (C) 1986-2021 Free Software Foundation, Inc.
 
    Contributed by Motorola.  Adapted from the C parser by Farooq Butt
    (fmbutt@engage.sps.mot.com).
@@ -54,6 +54,8 @@
 #include "block.h"
 #include <ctype.h>
 #include <algorithm>
+#include "type-stack.h"
+#include "f-exp.h"
 
 #define parse_type(ps) builtin_type (ps->gdbarch ())
 #define parse_f_type(ps) builtin_f_type (ps->gdbarch ())
@@ -71,6 +73,9 @@ static struct parser_state *pstate = NULL;
 /* Depth of parentheses.  */
 static int paren_depth;
 
+/* The current type stack.  */
+static struct type_stack *type_stack;
+
 int yyparse (void);
 
 static int yylex (void);
@@ -85,6 +90,7 @@ static void push_kind_type (LONGEST val, struct type *type);
 
 static struct type *convert_to_kind_type (struct type *basetype, int kind);
 
+using namespace expr;
 %}
 
 /* Although the yacc "value" of an expression is not used,
@@ -145,6 +151,7 @@ static int parse_number (struct parser_state *, const char *, int,
 %token <lval> BOOLEAN_LITERAL
 %token <ssym> NAME 
 %token <tsym> TYPENAME
+%token <voidval> COMPLETE
 %type <sval> name
 %type <ssym> name_not_typename
 
@@ -163,14 +170,17 @@ static int parse_number (struct parser_state *, const char *, int,
 %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_KEYWORD
 %token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD 
 %token BOOL_AND BOOL_OR BOOL_NOT   
+%token SINGLE DOUBLE PRECISION
 %token <lval> CHARACTER 
 
-%token <voidval> DOLLAR_VARIABLE
+%token <sval> DOLLAR_VARIABLE
 
 %token <opcode> ASSIGN_MODIFY
-%token <opcode> UNOP_INTRINSIC
+%token <opcode> UNOP_INTRINSIC BINOP_INTRINSIC
+%token <opcode> UNOP_OR_BINOP_INTRINSIC
 
 %left ','
 %left ABOVE_COMMA
@@ -201,42 +211,88 @@ start   :	exp
 	;
 
 type_exp:	type
-			{ write_exp_elt_opcode (pstate, OP_TYPE);
-			  write_exp_elt_type (pstate, $1);
-			  write_exp_elt_opcode (pstate, OP_TYPE); }
+			{ pstate->push_new<type_operation> ($1); }
 	;
 
 exp     :       '(' exp ')'
-        		{ }
-        ;
+			{ }
+	;
 
 /* Expressions, not including the comma operator.  */
 exp	:	'*' exp    %prec UNARY
-			{ write_exp_elt_opcode (pstate, UNOP_IND); }
+			{ pstate->wrap<unop_ind_operation> (); }
 	;
 
 exp	:	'&' exp    %prec UNARY
-			{ write_exp_elt_opcode (pstate, UNOP_ADDR); }
+			{ pstate->wrap<unop_addr_operation> (); }
 	;
 
 exp	:	'-' exp    %prec UNARY
-			{ write_exp_elt_opcode (pstate, UNOP_NEG); }
+			{ pstate->wrap<unary_neg_operation> (); }
 	;
 
 exp	:	BOOL_NOT exp    %prec UNARY
-			{ write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
+			{ pstate->wrap<unary_logical_not_operation> (); }
 	;
 
 exp	:	'~' exp    %prec UNARY
-			{ write_exp_elt_opcode (pstate, UNOP_COMPLEMENT); }
+			{ pstate->wrap<unary_complement_operation> (); }
 	;
 
 exp	:	SIZEOF exp       %prec UNARY
-			{ write_exp_elt_opcode (pstate, UNOP_SIZEOF); }
+			{ pstate->wrap<unop_sizeof_operation> (); }
 	;
 
 exp	:	KIND '(' exp ')'       %prec UNARY
-			{ write_exp_elt_opcode (pstate, UNOP_KIND); }
+			{ pstate->wrap<fortran_kind_operation> (); }
+	;
+
+exp	:	UNOP_OR_BINOP_INTRINSIC '('
+			{ pstate->start_arglist (); }
+		one_or_two_args ')'
+			{
+			  int n = pstate->end_arglist ();
+			  gdb_assert (n == 1 || n == 2);
+			  if ($1 == FORTRAN_ASSOCIATED)
+			    {
+			      if (n == 1)
+				pstate->wrap<fortran_associated_1arg> ();
+			      else
+				pstate->wrap2<fortran_associated_2arg> ();
+			    }
+			  else if ($1 == FORTRAN_ARRAY_SIZE)
+			    {
+			      if (n == 1)
+				pstate->wrap<fortran_array_size_1arg> ();
+			      else
+				pstate->wrap2<fortran_array_size_2arg> ();
+			    }
+			  else
+			    {
+			      std::vector<operation_up> args
+				= pstate->pop_vector (n);
+			      gdb_assert ($1 == FORTRAN_LBOUND
+					  || $1 == FORTRAN_UBOUND);
+			      operation_up op;
+			      if (n == 1)
+				op.reset
+				  (new fortran_bound_1arg ($1,
+							   std::move (args[0])));
+			      else
+				op.reset
+				  (new fortran_bound_2arg ($1,
+							   std::move (args[0]),
+							   std::move (args[1])));
+			      pstate->push (std::move (op));
+			    }
+			}
+	;
+
+one_or_two_args
+	:	exp
+			{ pstate->arglist_len = 1; }
+	|	exp ',' exp
+			{ pstate->arglist_len = 2; }
 	;
 
 /* No more explicit array operators, we treat everything in F77 as 
@@ -245,265 +301,377 @@ exp	:	KIND '(' exp ')'       %prec UNARY
    later in eval.c.  */
 
 exp	:	exp '(' 
-			{ start_arglist (); }
+			{ pstate->start_arglist (); }
 		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); }
+			{
+			  std::vector<operation_up> args
+			    = pstate->pop_vector (pstate->end_arglist ());
+			  pstate->push_new<fortran_undetermined>
+			    (pstate->pop (), std::move (args));
+			}
 	;
 
 exp	:	UNOP_INTRINSIC '(' exp ')'
-			{ write_exp_elt_opcode (pstate, $1); }
+			{
+			  switch ($1)
+			    {
+			    case UNOP_ABS:
+			      pstate->wrap<fortran_abs_operation> ();
+			      break;
+			    case UNOP_FORTRAN_FLOOR:
+			      pstate->wrap<fortran_floor_operation> ();
+			      break;
+			    case UNOP_FORTRAN_CEILING:
+			      pstate->wrap<fortran_ceil_operation> ();
+			      break;
+			    case UNOP_FORTRAN_ALLOCATED:
+			      pstate->wrap<fortran_allocated_operation> ();
+			      break;
+			    case UNOP_FORTRAN_RANK:
+			      pstate->wrap<fortran_rank_operation> ();
+			      break;
+			    case UNOP_FORTRAN_SHAPE:
+			      pstate->wrap<fortran_array_shape_operation> ();
+			      break;
+			    case UNOP_FORTRAN_LOC:
+			      pstate->wrap<fortran_loc_operation> ();
+			      break;
+			    default:
+			      gdb_assert_not_reached ("unhandled intrinsic");
+			    }
+			}
+	;
+
+exp	:	BINOP_INTRINSIC '(' exp ',' exp ')'
+			{
+			  switch ($1)
+			    {
+			    case BINOP_MOD:
+			      pstate->wrap2<fortran_mod_operation> ();
+			      break;
+			    case BINOP_FORTRAN_MODULO:
+			      pstate->wrap2<fortran_modulo_operation> ();
+			      break;
+			    case BINOP_FORTRAN_CMPLX:
+			      pstate->wrap2<fortran_cmplx_operation> ();
+			      break;
+			    default:
+			      gdb_assert_not_reached ("unhandled intrinsic");
+			    }
+			}
 	;
 
 arglist	:
 	;
 
 arglist	:	exp
-			{ arglist_len = 1; }
+			{ pstate->arglist_len = 1; }
 	;
 
 arglist :	subrange
-			{ arglist_len = 1; }
+			{ pstate->arglist_len = 1; }
 	;
    
 arglist	:	arglist ',' exp   %prec ABOVE_COMMA
-			{ arglist_len++; }
+			{ pstate->arglist_len++; }
+	;
+
+arglist	:	arglist ',' subrange   %prec ABOVE_COMMA
+			{ pstate->arglist_len++; }
 	;
 
 /* There are four sorts of subrange types in F90.  */
 
 subrange:	exp ':' exp	%prec ABOVE_COMMA
-			{ write_exp_elt_opcode (pstate, OP_RANGE); 
-			  write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT);
-			  write_exp_elt_opcode (pstate, OP_RANGE); }
+			{
+			  operation_up high = pstate->pop ();
+			  operation_up low = pstate->pop ();
+			  pstate->push_new<fortran_range_operation>
+			    (RANGE_STANDARD, std::move (low),
+			     std::move (high), operation_up ());
+			}
 	;
 
 subrange:	exp ':'	%prec ABOVE_COMMA
-			{ write_exp_elt_opcode (pstate, OP_RANGE);
-			  write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT);
-			  write_exp_elt_opcode (pstate, OP_RANGE); }
+			{
+			  operation_up low = pstate->pop ();
+			  pstate->push_new<fortran_range_operation>
+			    (RANGE_HIGH_BOUND_DEFAULT, std::move (low),
+			     operation_up (), operation_up ());
+			}
 	;
 
 subrange:	':' exp	%prec ABOVE_COMMA
-			{ write_exp_elt_opcode (pstate, OP_RANGE);
-			  write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT);
-			  write_exp_elt_opcode (pstate, OP_RANGE); }
+			{
+			  operation_up high = pstate->pop ();
+			  pstate->push_new<fortran_range_operation>
+			    (RANGE_LOW_BOUND_DEFAULT, operation_up (),
+			     std::move (high), operation_up ());
+			}
 	;
 
 subrange:	':'	%prec ABOVE_COMMA
-			{ write_exp_elt_opcode (pstate, OP_RANGE);
-			  write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT);
-			  write_exp_elt_opcode (pstate, OP_RANGE); }
+			{
+			  pstate->push_new<fortran_range_operation>
+			    (RANGE_LOW_BOUND_DEFAULT
+			     | RANGE_HIGH_BOUND_DEFAULT,
+			     operation_up (), operation_up (),
+			     operation_up ());
+			}
+	;
+
+/* And each of the four subrange types can also have a stride.  */
+subrange:	exp ':' exp ':' exp	%prec ABOVE_COMMA
+			{
+			  operation_up stride = pstate->pop ();
+			  operation_up high = pstate->pop ();
+			  operation_up low = pstate->pop ();
+			  pstate->push_new<fortran_range_operation>
+			    (RANGE_STANDARD | RANGE_HAS_STRIDE,
+			     std::move (low), std::move (high),
+			     std::move (stride));
+			}
+	;
+
+subrange:	exp ':' ':' exp	%prec ABOVE_COMMA
+			{
+			  operation_up stride = pstate->pop ();
+			  operation_up low = pstate->pop ();
+			  pstate->push_new<fortran_range_operation>
+			    (RANGE_HIGH_BOUND_DEFAULT
+			     | RANGE_HAS_STRIDE,
+			     std::move (low), operation_up (),
+			     std::move (stride));
+			}
+	;
+
+subrange:	':' exp ':' exp	%prec ABOVE_COMMA
+			{
+			  operation_up stride = pstate->pop ();
+			  operation_up high = pstate->pop ();
+			  pstate->push_new<fortran_range_operation>
+			    (RANGE_LOW_BOUND_DEFAULT
+			     | RANGE_HAS_STRIDE,
+			     operation_up (), std::move (high),
+			     std::move (stride));
+			}
+	;
+
+subrange:	':' ':' exp	%prec ABOVE_COMMA
+			{
+			  operation_up stride = pstate->pop ();
+			  pstate->push_new<fortran_range_operation>
+			    (RANGE_LOW_BOUND_DEFAULT
+			     | RANGE_HIGH_BOUND_DEFAULT
+			     | RANGE_HAS_STRIDE,
+			     operation_up (), operation_up (),
+			     std::move (stride));
+			}
 	;
 
 complexnum:     exp ',' exp 
-                	{ }                          
-        ;
+			{ }                          
+	;
 
 exp	:	'(' complexnum ')'
-			{ 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); }
+			{
+			  operation_up rhs = pstate->pop ();
+			  operation_up lhs = pstate->pop ();
+			  pstate->push_new<complex_operation>
+			    (std::move (lhs), std::move (rhs),
+			     parse_f_type (pstate)->builtin_complex_s16);
+			}
 	;
 
 exp	:	'(' type ')' exp  %prec UNARY
-			{ write_exp_elt_opcode (pstate, UNOP_CAST);
-			  write_exp_elt_type (pstate, $2);
-			  write_exp_elt_opcode (pstate, UNOP_CAST); }
+			{
+			  pstate->push_new<unop_cast_operation>
+			    (pstate->pop (), $2);
+			}
 	;
 
 exp     :       exp '%' name
-                        { write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
-                          write_exp_string (pstate, $3);
-                          write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
-        ;
+			{
+			  pstate->push_new<fortran_structop_operation>
+			    (pstate->pop (), copy_name ($3));
+			}
+	;
+
+exp     :       exp '%' name COMPLETE
+			{
+			  structop_base_operation *op
+			    = new fortran_structop_operation (pstate->pop (),
+							      copy_name ($3));
+			  pstate->mark_struct_expression (op);
+			  pstate->push (operation_up (op));
+			}
+	;
+
+exp     :       exp '%' COMPLETE
+			{
+			  structop_base_operation *op
+			    = new fortran_structop_operation (pstate->pop (),
+							      "");
+			  pstate->mark_struct_expression (op);
+			  pstate->push (operation_up (op));
+			}
+	;
 
 /* Binary operators in order of decreasing precedence.  */
 
 exp	:	exp '@' exp
-			{ write_exp_elt_opcode (pstate, BINOP_REPEAT); }
+			{ pstate->wrap2<repeat_operation> (); }
 	;
 
 exp	:	exp STARSTAR exp
-			{ write_exp_elt_opcode (pstate, BINOP_EXP); }
+			{ pstate->wrap2<exp_operation> (); }
 	;
 
 exp	:	exp '*' exp
-			{ write_exp_elt_opcode (pstate, BINOP_MUL); }
+			{ pstate->wrap2<mul_operation> (); }
 	;
 
 exp	:	exp '/' exp
-			{ write_exp_elt_opcode (pstate, BINOP_DIV); }
+			{ pstate->wrap2<div_operation> (); }
 	;
 
 exp	:	exp '+' exp
-			{ write_exp_elt_opcode (pstate, BINOP_ADD); }
+			{ pstate->wrap2<add_operation> (); }
 	;
 
 exp	:	exp '-' exp
-			{ write_exp_elt_opcode (pstate, BINOP_SUB); }
+			{ pstate->wrap2<sub_operation> (); }
 	;
 
 exp	:	exp LSH exp
-			{ write_exp_elt_opcode (pstate, BINOP_LSH); }
+			{ pstate->wrap2<lsh_operation> (); }
 	;
 
 exp	:	exp RSH exp
-			{ write_exp_elt_opcode (pstate, BINOP_RSH); }
+			{ pstate->wrap2<rsh_operation> (); }
 	;
 
 exp	:	exp EQUAL exp
-			{ write_exp_elt_opcode (pstate, BINOP_EQUAL); }
+			{ pstate->wrap2<equal_operation> (); }
 	;
 
 exp	:	exp NOTEQUAL exp
-			{ write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
+			{ pstate->wrap2<notequal_operation> (); }
 	;
 
 exp	:	exp LEQ exp
-			{ write_exp_elt_opcode (pstate, BINOP_LEQ); }
+			{ pstate->wrap2<leq_operation> (); }
 	;
 
 exp	:	exp GEQ exp
-			{ write_exp_elt_opcode (pstate, BINOP_GEQ); }
+			{ pstate->wrap2<geq_operation> (); }
 	;
 
 exp	:	exp LESSTHAN exp
-			{ write_exp_elt_opcode (pstate, BINOP_LESS); }
+			{ pstate->wrap2<less_operation> (); }
 	;
 
 exp	:	exp GREATERTHAN exp
-			{ write_exp_elt_opcode (pstate, BINOP_GTR); }
+			{ pstate->wrap2<gtr_operation> (); }
 	;
 
 exp	:	exp '&' exp
-			{ write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
+			{ pstate->wrap2<bitwise_and_operation> (); }
 	;
 
 exp	:	exp '^' exp
-			{ write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
+			{ pstate->wrap2<bitwise_xor_operation> (); }
 	;
 
 exp	:	exp '|' exp
-			{ write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
+			{ pstate->wrap2<bitwise_ior_operation> (); }
 	;
 
 exp     :       exp BOOL_AND exp
-			{ write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
+			{ pstate->wrap2<logical_and_operation> (); }
 	;
 
 
 exp	:	exp BOOL_OR exp
-			{ write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
+			{ pstate->wrap2<logical_or_operation> (); }
 	;
 
 exp	:	exp '=' exp
-			{ write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
+			{ pstate->wrap2<assign_operation> (); }
 	;
 
 exp	:	exp ASSIGN_MODIFY exp
-			{ write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY);
-			  write_exp_elt_opcode (pstate, $2);
-			  write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY); }
+			{
+			  operation_up rhs = pstate->pop ();
+			  operation_up lhs = pstate->pop ();
+			  pstate->push_new<assign_modify_operation>
+			    ($2, std::move (lhs), std::move (rhs));
+			}
 	;
 
 exp	:	INT
-			{ 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); }
+			{
+			  pstate->push_new<long_const_operation>
+			    ($1.type, $1.val);
+			}
 	;
 
 exp	:	NAME_OR_INT
 			{ YYSTYPE val;
 			  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); }
+			  pstate->push_new<long_const_operation>
+			    (val.typed_val.type,
+			     val.typed_val.val);
+			}
 	;
 
 exp	:	FLOAT
-			{ write_exp_elt_opcode (pstate, OP_FLOAT);
-			  write_exp_elt_type (pstate, $1.type);
-			  write_exp_elt_floatcst (pstate, $1.val);
-			  write_exp_elt_opcode (pstate, OP_FLOAT); }
+			{
+			  float_data data;
+			  std::copy (std::begin ($1.val), std::end ($1.val),
+				     std::begin (data));
+			  pstate->push_new<float_const_operation> ($1.type, data);
+			}
 	;
 
 exp	:	variable
 	;
 
 exp	:	DOLLAR_VARIABLE
+			{ pstate->push_dollar ($1); }
 	;
 
 exp	:	SIZEOF '(' type ')'	%prec UNARY
-			{ write_exp_elt_opcode (pstate, OP_LONG);
-			  write_exp_elt_type (pstate,
-					      parse_f_type (pstate)
-					      ->builtin_integer);
+			{
 			  $3 = check_typedef ($3);
-			  write_exp_elt_longcst (pstate,
-						 (LONGEST) TYPE_LENGTH ($3));
-			  write_exp_elt_opcode (pstate, OP_LONG); }
+			  pstate->push_new<long_const_operation>
+			    (parse_f_type (pstate)->builtin_integer,
+			     TYPE_LENGTH ($3));
+			}
 	;
 
 exp     :       BOOLEAN_LITERAL
-			{ write_exp_elt_opcode (pstate, OP_BOOL);
-			  write_exp_elt_longcst (pstate, (LONGEST) $1);
-			  write_exp_elt_opcode (pstate, OP_BOOL);
-			}
-        ;
+			{ pstate->push_new<bool_operation> ($1); }
+	;
 
 exp	:	STRING_LITERAL
 			{
-			  write_exp_elt_opcode (pstate, OP_STRING);
-			  write_exp_string (pstate, $1);
-			  write_exp_elt_opcode (pstate, OP_STRING);
+			  pstate->push_new<string_operation>
+			    (copy_name ($1));
 			}
 	;
 
 variable:	name_not_typename
 			{ struct block_symbol sym = $1.sym;
-
-			  if (sym.symbol)
-			    {
-			      if (symbol_read_needs_frame (sym.symbol))
-				innermost_block.update (sym);
-			      write_exp_elt_opcode (pstate, OP_VAR_VALUE);
-			      write_exp_elt_block (pstate, sym.block);
-			      write_exp_elt_sym (pstate, sym.symbol);
-			      write_exp_elt_opcode (pstate, OP_VAR_VALUE);
-			      break;
-			    }
-			  else
-			    {
-			      struct bound_minimal_symbol msymbol;
-			      char *arg = copy_name ($1.stoken);
-
-			      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."));
-			      else
-				error (_("No symbol \"%s\" in current context."),
-				       copy_name ($1.stoken));
-			    }
+			  std::string name = copy_name ($1.stoken);
+			  pstate->push_symbol (name.c_str (), sym);
 			}
 	;
 
 
 type    :       ptype
-        ;
+	;
 
 ptype	:	typebase
 	|	typebase abs_decl
@@ -515,7 +683,7 @@ ptype	:	typebase
 		  struct type *range_type;
 		  
 		  while (!done)
-		    switch (pop_type ())
+		    switch (type_stack->pop ())
 		      {
 		      case tp_end:
 			done = 1;
@@ -527,7 +695,7 @@ ptype	:	typebase
 			follow_type = lookup_lvalue_reference_type (follow_type);
 			break;
 		      case tp_array:
-			array_size = pop_type_int ();
+			array_size = type_stack->pop_int ();
 			if (array_size != -1)
 			  {
 			    range_type =
@@ -547,7 +715,7 @@ ptype	:	typebase
 			break;
 		      case tp_kind:
 			{
-			  int kind_val = pop_type_int ();
+			  int kind_val = type_stack->pop_int ();
 			  follow_type
 			    = convert_to_kind_type (follow_type, kind_val);
 			}
@@ -558,13 +726,13 @@ ptype	:	typebase
 	;
 
 abs_decl:	'*'
-			{ push_type (tp_pointer); $$ = 0; }
+			{ type_stack->push (tp_pointer); $$ = 0; }
 	|	'*' abs_decl
-			{ push_type (tp_pointer); $$ = $2; }
+			{ type_stack->push (tp_pointer); $$ = $2; }
 	|	'&'
-			{ push_type (tp_reference); $$ = 0; }
+			{ type_stack->push (tp_reference); $$ = 0; }
 	|	'&' abs_decl
-			{ push_type (tp_reference); $$ = $2; }
+			{ type_stack->push (tp_reference); $$ = $2; }
 	|	direct_abs_decl
 	;
 
@@ -575,9 +743,9 @@ direct_abs_decl: '(' abs_decl ')'
 	|	'*' INT
 			{ push_kind_type ($2.val, $2.type); }
 	| 	direct_abs_decl func_mod
-			{ push_type (tp_function); }
+			{ type_stack->push (tp_function); }
 	|	func_mod
-			{ push_type (tp_function); }
+			{ type_stack->push (tp_function); }
 	;
 
 func_mod:	'(' ')'
@@ -609,12 +777,22 @@ typebase  /* Implements (approximately): (type-qualifier)* type-specifier */
 			{ $$ = parse_f_type (pstate)->builtin_real_s8; }
 	|	REAL_S16_KEYWORD
 			{ $$ = parse_f_type (pstate)->builtin_real_s16; }
+	|	COMPLEX_KEYWORD
+			{ $$ = parse_f_type (pstate)->builtin_complex_s8; }
 	|	COMPLEX_S8_KEYWORD
 			{ $$ = parse_f_type (pstate)->builtin_complex_s8; }
 	|	COMPLEX_S16_KEYWORD 
 			{ $$ = parse_f_type (pstate)->builtin_complex_s16; }
 	|	COMPLEX_S32_KEYWORD 
 			{ $$ = parse_f_type (pstate)->builtin_complex_s32; }
+	|	SINGLE PRECISION
+			{ $$ = parse_f_type (pstate)->builtin_real;}
+	|	DOUBLE PRECISION
+			{ $$ = parse_f_type (pstate)->builtin_real_s8;}
+	|	SINGLE COMPLEX_KEYWORD
+			{ $$ = parse_f_type (pstate)->builtin_complex_s8;}
+	|	DOUBLE COMPLEX_KEYWORD
+			{ $$ = parse_f_type (pstate)->builtin_complex_s16;}
 	;
 
 nonempty_typelist
@@ -807,7 +985,7 @@ push_kind_type (LONGEST val, struct type *type)
 {
   int ival;
 
-  if (TYPE_UNSIGNED (type))
+  if (type->is_unsigned ())
     {
       ULONGEST uval = static_cast <ULONGEST> (val);
       if (uval > INT_MAX)
@@ -821,8 +999,8 @@ push_kind_type (LONGEST val, struct type *type)
       ival = static_cast <int> (val);
     }
 
-  push_type_int (ival);
-  push_type (tp_kind);
+  type_stack->push (ival);
+  type_stack->push (tp_kind);
 }
 
 /* Called when a type has a '(kind=N)' modifier after it, for example
@@ -901,19 +1079,29 @@ struct token
   bool case_sensitive;
 };
 
-static const struct token dot_ops[] =
+/* List of Fortran operators.  */
+
+static const struct token fortran_operators[] =
 {
-  { ".and.", BOOL_AND, BINOP_END, false },
-  { ".or.", BOOL_OR, BINOP_END, false },
-  { ".not.", BOOL_NOT, BINOP_END, false },
-  { ".eq.", EQUAL, BINOP_END, false },
-  { ".eqv.", EQUAL, BINOP_END, false },
-  { ".neqv.", NOTEQUAL, BINOP_END, false },
-  { ".ne.", NOTEQUAL, BINOP_END, false },
-  { ".le.", LEQ, BINOP_END, false },
-  { ".ge.", GEQ, BINOP_END, false },
-  { ".gt.", GREATERTHAN, BINOP_END, false },
-  { ".lt.", LESSTHAN, BINOP_END, false },
+  { ".and.", BOOL_AND, OP_NULL, false },
+  { ".or.", BOOL_OR, OP_NULL, false },
+  { ".not.", BOOL_NOT, OP_NULL, false },
+  { ".eq.", EQUAL, OP_NULL, false },
+  { ".eqv.", EQUAL, OP_NULL, false },
+  { ".neqv.", NOTEQUAL, OP_NULL, false },
+  { ".xor.", NOTEQUAL, OP_NULL, false },
+  { "==", EQUAL, OP_NULL, false },
+  { ".ne.", NOTEQUAL, OP_NULL, false },
+  { "/=", NOTEQUAL, OP_NULL, false },
+  { ".le.", LEQ, OP_NULL, false },
+  { "<=", LEQ, OP_NULL, false },
+  { ".ge.", GEQ, OP_NULL, false },
+  { ">=", GEQ, OP_NULL, false },
+  { ".gt.", GREATERTHAN, OP_NULL, false },
+  { ">", GREATERTHAN, OP_NULL, false },
+  { ".lt.", LESSTHAN, OP_NULL, false },
+  { "<", LESSTHAN, OP_NULL, false },
+  { "**", STARSTAR, BINOP_EXP, false },
 };
 
 /* Holds the Fortran representation of a boolean, and the integer value we
@@ -937,25 +1125,41 @@ static const struct f77_boolean_val boolean_values[]  =
 static const struct token f77_keywords[] =
 {
   /* Historically these have always been lowercase only in GDB.  */
-  { "complex_16", COMPLEX_S16_KEYWORD, BINOP_END, true },
-  { "complex_32", COMPLEX_S32_KEYWORD, BINOP_END, true },
-  { "character", CHARACTER, BINOP_END, true },
-  { "integer_2", INT_S2_KEYWORD, BINOP_END, true },
-  { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END, true },
-  { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END, true },
-  { "logical_8", LOGICAL_S8_KEYWORD, BINOP_END, true },
-  { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END, true },
-  { "integer", INT_KEYWORD, BINOP_END, true },
-  { "logical", LOGICAL_KEYWORD, BINOP_END, true },
-  { "real_16", REAL_S16_KEYWORD, BINOP_END, true },
-  { "complex", COMPLEX_S8_KEYWORD, BINOP_END, true },
-  { "sizeof", SIZEOF, BINOP_END, true },
-  { "real_8", REAL_S8_KEYWORD, BINOP_END, true },
-  { "real", REAL_KEYWORD, BINOP_END, true },
+  { "complex_16", COMPLEX_S16_KEYWORD, OP_NULL, true },
+  { "complex_32", COMPLEX_S32_KEYWORD, OP_NULL, true },
+  { "character", CHARACTER, OP_NULL, true },
+  { "integer_2", INT_S2_KEYWORD, OP_NULL, true },
+  { "logical_1", LOGICAL_S1_KEYWORD, OP_NULL, true },
+  { "logical_2", LOGICAL_S2_KEYWORD, OP_NULL, true },
+  { "logical_8", LOGICAL_S8_KEYWORD, OP_NULL, true },
+  { "complex_8", COMPLEX_S8_KEYWORD, OP_NULL, true },
+  { "integer", INT_KEYWORD, OP_NULL, true },
+  { "logical", LOGICAL_KEYWORD, OP_NULL, true },
+  { "real_16", REAL_S16_KEYWORD, OP_NULL, true },
+  { "complex", COMPLEX_KEYWORD, OP_NULL, true },
+  { "sizeof", SIZEOF, OP_NULL, true },
+  { "real_8", REAL_S8_KEYWORD, OP_NULL, true },
+  { "real", REAL_KEYWORD, OP_NULL, true },
+  { "single", SINGLE, OP_NULL, true },
+  { "double", DOUBLE, OP_NULL, true },
+  { "precision", PRECISION, OP_NULL, true },
   /* The following correspond to actual functions in Fortran and are case
      insensitive.  */
-  { "kind", KIND, BINOP_END, false },
-  { "abs", UNOP_INTRINSIC, UNOP_ABS, false }
+  { "kind", KIND, OP_NULL, false },
+  { "abs", UNOP_INTRINSIC, UNOP_ABS, false },
+  { "mod", BINOP_INTRINSIC, BINOP_MOD, false },
+  { "floor", UNOP_INTRINSIC, UNOP_FORTRAN_FLOOR, false },
+  { "ceiling", UNOP_INTRINSIC, UNOP_FORTRAN_CEILING, false },
+  { "modulo", BINOP_INTRINSIC, BINOP_FORTRAN_MODULO, false },
+  { "cmplx", BINOP_INTRINSIC, BINOP_FORTRAN_CMPLX, false },
+  { "lbound", UNOP_OR_BINOP_INTRINSIC, FORTRAN_LBOUND, false },
+  { "ubound", UNOP_OR_BINOP_INTRINSIC, FORTRAN_UBOUND, false },
+  { "allocated", UNOP_INTRINSIC, UNOP_FORTRAN_ALLOCATED, false },
+  { "associated", UNOP_OR_BINOP_INTRINSIC, FORTRAN_ASSOCIATED, false },
+  { "rank", UNOP_INTRINSIC, UNOP_FORTRAN_RANK, false },
+  { "size", UNOP_OR_BINOP_INTRINSIC, FORTRAN_ARRAY_SIZE, false },
+  { "shape", UNOP_INTRINSIC, UNOP_FORTRAN_SHAPE, false },
+  { "loc", UNOP_INTRINSIC, UNOP_FORTRAN_LOC, false },
 };
 
 /* Implementation of a dynamically expandable buffer for processing input
@@ -1005,14 +1209,14 @@ growbuf_by_size (int count)
 static int
 match_string_literal (void)
 {
-  const char *tokptr = lexptr;
+  const char *tokptr = pstate->lexptr;
 
   for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
     {
       CHECKBUF (1);
-      if (*tokptr == *lexptr)
+      if (*tokptr == *pstate->lexptr)
 	{
-	  if (*(tokptr + 1) == *lexptr)
+	  if (*(tokptr + 1) == *pstate->lexptr)
 	    tokptr++;
 	  else
 	    break;
@@ -1027,11 +1231,20 @@ match_string_literal (void)
       tempbuf[tempbufindex] = '\0';
       yylval.sval.ptr = tempbuf;
       yylval.sval.length = tempbufindex;
-      lexptr = ++tokptr;
+      pstate->lexptr = ++tokptr;
       return STRING_LITERAL;
     }
 }
 
+/* This is set if a NAME token appeared at the very end of the input
+   string, with no whitespace separating the name from the EOF.  This
+   is used only when parsing to do field name completion.  */
+static bool saw_name_at_eof;
+
+/* This is set if the previously-returned token was a structure
+   operator '%'.  */
+static bool last_was_structop;
+
 /* Read one token, getting characters through lexptr.  */
 
 static int
@@ -1041,59 +1254,60 @@ yylex (void)
   int namelen;
   unsigned int token;
   const char *tokstart;
-  
+  bool saw_structop = last_was_structop;
+
+  last_was_structop = false;
+
  retry:
  
-  prev_lexptr = lexptr;
+  pstate->prev_lexptr = pstate->lexptr;
  
-  tokstart = lexptr;
+  tokstart = pstate->lexptr;
 
   /* First of all, let us make sure we are not dealing with the
      special tokens .true. and .false. which evaluate to 1 and 0.  */
 
-  if (*lexptr == '.')
+  if (*pstate->lexptr == '.')
     {
       for (int i = 0; i < ARRAY_SIZE (boolean_values); i++)
 	{
 	  if (strncasecmp (tokstart, boolean_values[i].name,
 			   strlen (boolean_values[i].name)) == 0)
 	    {
-	      lexptr += strlen (boolean_values[i].name);
+	      pstate->lexptr += strlen (boolean_values[i].name);
 	      yylval.lval = boolean_values[i].value;
 	      return BOOLEAN_LITERAL;
 	    }
 	}
     }
 
-  /* See if it is a special .foo. operator.  */
-  for (int i = 0; i < ARRAY_SIZE (dot_ops); i++)
-    if (strncasecmp (tokstart, dot_ops[i].oper,
-		     strlen (dot_ops[i].oper)) == 0)
+  /* See if it is a Fortran operator.  */
+  for (int i = 0; i < ARRAY_SIZE (fortran_operators); i++)
+    if (strncasecmp (tokstart, fortran_operators[i].oper,
+		     strlen (fortran_operators[i].oper)) == 0)
       {
-	gdb_assert (!dot_ops[i].case_sensitive);
-	lexptr += strlen (dot_ops[i].oper);
-	yylval.opcode = dot_ops[i].opcode;
-	return dot_ops[i].token;
+	gdb_assert (!fortran_operators[i].case_sensitive);
+	pstate->lexptr += strlen (fortran_operators[i].oper);
+	yylval.opcode = fortran_operators[i].opcode;
+	return fortran_operators[i].token;
       }
 
-  /* See if it is an exponentiation operator.  */
-
-  if (strncmp (tokstart, "**", 2) == 0)
-    {
-      lexptr += 2;
-      yylval.opcode = BINOP_EXP;
-      return STARSTAR;
-    }
-
   switch (c = *tokstart)
     {
     case 0:
+      if (saw_name_at_eof)
+	{
+	  saw_name_at_eof = false;
+	  return COMPLETE;
+	}
+      else if (pstate->parse_completion && saw_structop)
+	return COMPLETE;
       return 0;
       
     case ' ':
     case '\t':
     case '\n':
-      lexptr++;
+      pstate->lexptr++;
       goto retry;
       
     case '\'':
@@ -1104,25 +1318,25 @@ yylex (void)
       
     case '(':
       paren_depth++;
-      lexptr++;
+      pstate->lexptr++;
       return c;
       
     case ')':
       if (paren_depth == 0)
 	return 0;
       paren_depth--;
-      lexptr++;
+      pstate->lexptr++;
       return c;
       
     case ',':
       if (pstate->comma_terminates && paren_depth == 0)
 	return 0;
-      lexptr++;
+      pstate->lexptr++;
       return c;
       
     case '.':
       /* Might be a floating point number.  */
-      if (lexptr[1] < '0' || lexptr[1] > '9')
+      if (pstate->lexptr[1] < '0' || pstate->lexptr[1] > '9')
 	goto symbol;		/* Nope, must be a symbol.  */
       /* FALL THRU.  */
       
@@ -1137,7 +1351,7 @@ yylex (void)
     case '8':
     case '9':
       {
-        /* It's a number.  */
+	/* It's a number.  */
 	int got_dot = 0, got_e = 0, got_d = 0, toktype;
 	const char *p = tokstart;
 	int hex = input_radix > 10;
@@ -1178,23 +1392,25 @@ yylex (void)
 	toktype = parse_number (pstate, tokstart, p - tokstart,
 				got_dot|got_e|got_d,
 				&yylval);
-        if (toktype == ERROR)
-          {
+	if (toktype == ERROR)
+	  {
 	    char *err_copy = (char *) alloca (p - tokstart + 1);
 	    
 	    memcpy (err_copy, tokstart, p - tokstart);
 	    err_copy[p - tokstart] = 0;
 	    error (_("Invalid number \"%s\"."), err_copy);
 	  }
-	lexptr = p;
+	pstate->lexptr = p;
 	return toktype;
       }
-      
+
+    case '%':
+      last_was_structop = true;
+      /* Fall through.  */
     case '+':
     case '-':
     case '*':
     case '/':
-    case '%':
     case '|':
     case '&':
     case '^':
@@ -1211,7 +1427,7 @@ yylex (void)
     case '{':
     case '}':
     symbol:
-      lexptr++;
+      pstate->lexptr++;
       return c;
     }
   
@@ -1232,7 +1448,7 @@ yylex (void)
   if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
     return 0;
   
-  lexptr += namelen;
+  pstate->lexptr += namelen;
   
   /* Catch specific keywords.  */
 
@@ -1251,18 +1467,14 @@ yylex (void)
   yylval.sval.length = namelen;
   
   if (*tokstart == '$')
-    {
-      write_dollar_variable (pstate, yylval.sval);
-      return DOLLAR_VARIABLE;
-    }
-  
+    return DOLLAR_VARIABLE;
+
   /* Use token-type TYPENAME for symbols that happen to be defined
      currently as names of types; NAME for other symbols.
      The caller is not constrained to care about the distinction.  */
   {
-    char *tmp = copy_name (yylval.sval);
+    std::string tmp = copy_name (yylval.sval);
     struct block_symbol result;
-    struct field_of_this_result is_a_field_of_this;
     enum domain_enum_tag lookup_domains[] =
     {
       STRUCT_DOMAIN,
@@ -1273,15 +1485,8 @@ yylex (void)
 
     for (int i = 0; i < ARRAY_SIZE (lookup_domains); ++i)
       {
-	/* 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));
-
-	result = lookup_symbol (tmp, pstate->expression_context_block,
-				lookup_domains[i],
-				pstate->language ()->la_language
-				== language_cplus
-				  ? &is_a_field_of_this : NULL);
+	result = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
+				lookup_domains[i], NULL);
 	if (result.symbol && SYMBOL_CLASS (result.symbol) == LOC_TYPEDEF)
 	  {
 	    yylval.tsym.type = SYMBOL_TYPE (result.symbol);
@@ -1294,7 +1499,7 @@ yylex (void)
 
     yylval.tsym.type
       = language_lookup_primitive_type (pstate->language (),
-					pstate->gdbarch (), tmp);
+					pstate->gdbarch (), tmp.c_str ());
     if (yylval.tsym.type != NULL)
       return TYPENAME;
     
@@ -1310,20 +1515,23 @@ yylex (void)
 	if (hextype == INT)
 	  {
 	    yylval.ssym.sym = result;
-	    yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
+	    yylval.ssym.is_a_field_of_this = false;
 	    return NAME_OR_INT;
 	  }
       }
-    
+
+    if (pstate->parse_completion && *pstate->lexptr == '\0')
+      saw_name_at_eof = true;
+
     /* Any other kind of symbol */
     yylval.ssym.sym = result;
-    yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
+    yylval.ssym.is_a_field_of_this = false;
     return NAME;
   }
 }
 
 int
-f_parse (struct parser_state *par_state)
+f_language::parser (struct parser_state *par_state) const
 {
   /* Setting up the parser state.  */
   scoped_restore pstate_restore = make_scoped_restore (&pstate);
@@ -1331,16 +1539,25 @@ f_parse (struct parser_state *par_state)
 							parser_debug);
   gdb_assert (par_state != NULL);
   pstate = par_state;
+  last_was_structop = false;
+  saw_name_at_eof = false;
   paren_depth = 0;
 
-  return yyparse ();
+  struct type_stack stack;
+  scoped_restore restore_type_stack = make_scoped_restore (&type_stack,
+							   &stack);
+
+  int result = yyparse ();
+  if (!result)
+    pstate->set_operation (pstate->pop ());
+  return result;
 }
 
 static void
 yyerror (const char *msg)
 {
-  if (prev_lexptr)
-    lexptr = prev_lexptr;
+  if (pstate->prev_lexptr)
+    pstate->lexptr = pstate->prev_lexptr;
 
-  error (_("A %s in expression, near `%s'."), msg, lexptr);
+  error (_("A %s in expression, near `%s'."), msg, pstate->lexptr);
 }