gdb/fortran: Add Fortran 'loc' intrinic

  From: Abhishek Aggarwal <abhishek.a.aggarwal@intel.com>

 - LOC() intrinsic can be used now during debugging the
   Fortran Applications using GDB

Signed-off-by: Abhishek Aggarwal <abhishek.a.aggarwal@intel.com>
Signed-off-by: Felix Willgerodt <felix.willgerodt@intel.com>
---
 gdb/ax-gdb.c         | 35 +++++++++++++++++++++++++++++++++++
 gdb/eval.c           | 13 +++++++++++++
 gdb/expprint.c       |  1 +
 gdb/f-exp.y          |  7 ++++++-
 gdb/std-operator.def |  1 +
 5 files changed, 56 insertions(+), 1 deletion(-)
  

* Tomasz Kulasek <tomek.kulasek@gmail.com> [2019-09-26 05:08:06 +0200]:

> From: Abhishek Aggarwal <abhishek.a.aggarwal@intel.com>
> 
>  - LOC() intrinsic can be used now during debugging the
>    Fortran Applications using GDB

Thanks for working on this.

As with the previous patch, I'm unsure about the copyright assignment
status, so I can't approve this being merged, but I do have some
feedback.

> 
> Signed-off-by: Abhishek Aggarwal <abhishek.a.aggarwal@intel.com>
> Signed-off-by: Felix Willgerodt <felix.willgerodt@intel.com>
> ---
>  gdb/ax-gdb.c         | 35 +++++++++++++++++++++++++++++++++++
>  gdb/eval.c           | 13 +++++++++++++
>  gdb/expprint.c       |  1 +
>  gdb/f-exp.y          |  7 ++++++-
>  gdb/std-operator.def |  1 +
>  5 files changed, 56 insertions(+), 1 deletion(-)
> 
> diff --git a/gdb/ax-gdb.c b/gdb/ax-gdb.c
> index 9f1b7a1e88..ae0b4c325b 100644
> --- a/gdb/ax-gdb.c
> +++ b/gdb/ax-gdb.c
> @@ -131,6 +131,7 @@ static void gen_logical_not (struct agent_expr *ax, struct axs_value *value,
>  static void gen_complement (struct agent_expr *ax, struct axs_value *value);
>  static void gen_deref (struct axs_value *);
>  static void gen_address_of (struct axs_value *);
> +static void gen_loc (struct agent_expr *, struct axs_value *);
>  static void gen_bitfield_ref (struct agent_expr *ax, struct axs_value *value,
>  			      struct type *type, int start, int end);
>  static void gen_primitive_field (struct agent_expr *ax,
> @@ -1248,6 +1249,34 @@ gen_address_of (struct axs_value *value)
>        }
>  }
>  
> +/* Produce the output of LOC intrinsic.
> +   (i.e. produce address of lvalue on the top of the stack)  */
> +static void
> +gen_loc (struct agent_expr *ax, struct axs_value *value)
> +{
> +  /* LOC is not a Standard Fortran Intrinsic. However, different vendors have
> +     different definition for LOC. Some definitions accept function name
> +     also as an argument of LOC (apart from a variable name).
> +     Hence, Address of Function is taken care of separately like this. */
> +  if (TYPE_CODE (value->type) == TYPE_CODE_FUNC)
> +    /* The value's already an rvalue on the stack, so just change the type.*/

In all of the above there should be two whitespace after a full stop,
and looking at the header comment, it should end with a full stop.

> +    value->type = lookup_pointer_type (value->type);
> +  else
> +    switch (value->kind)
> +      {
> +      case axs_rvalue:
> +	error (_("Operand of `loc' is an rvalue, which has no address."));
> +
> +      case axs_lvalue_register:
> +	error (_("Operand of `loc' is in a register, and has no address."));
> +
> +      case axs_lvalue_memory:
> +	value->kind = axs_rvalue;
> +	value->type = lookup_pointer_type (value->type);
> +	break;
> +      }
> +}
> +
>  /* Generate code to push the value of a bitfield of a structure whose
>     address is on the top of the stack.  START and END give the
>     starting and one-past-ending *bit* numbers of the field within the
> @@ -2192,6 +2221,12 @@ gen_expr (struct expression *exp, union exp_element **pc,
>        gen_address_of (value);
>        break;
>  
> +    case UNOP_LOC:
> +      (*pc)++;
> +      gen_expr (exp, pc, ax, value);
> +      gen_loc (ax, value);
> +      break;
> +
>      case UNOP_SIZEOF:
>        (*pc)++;
>        /* Notice that gen_sizeof handles its own operand, unlike most
> diff --git a/gdb/eval.c b/gdb/eval.c
> index aed89e5f85..d5a306d078 100644
> --- a/gdb/eval.c
> +++ b/gdb/eval.c
> @@ -2730,6 +2730,19 @@ evaluate_subexp_standard (struct type *expect_type,
>  	return value_from_longest (size_type, align);
>        }
>  
> +    case UNOP_LOC:
> +      if (noside == EVAL_SKIP)
> +	{
> +	  evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
> +	  return eval_skip_value (exp);
> +	}
> +      else
> +	{
> +	  struct value *retvalp = evaluate_subexp_for_address (exp, pos,
> +							       noside);
> +	  return retvalp;
> +	}
> +
>      case UNOP_CAST:
>        (*pos) += 2;
>        type = exp->elts[pc + 1].type;
> diff --git a/gdb/expprint.c b/gdb/expprint.c
> index d7ad1a7187..82d6587e0d 100644
> --- a/gdb/expprint.c
> +++ b/gdb/expprint.c
> @@ -858,6 +858,7 @@ dump_subexp_body_standard (struct expression *exp,
>      case UNOP_POSTDECREMENT:
>      case UNOP_SIZEOF:
>      case UNOP_ALIGNOF:
> +    case UNOP_LOC:
>      case UNOP_PLUS:
>      case UNOP_CAP:
>      case UNOP_CHR:
> diff --git a/gdb/f-exp.y b/gdb/f-exp.y
> index 9784ad57d8..eb93da5f82 100644
> --- a/gdb/f-exp.y
> +++ b/gdb/f-exp.y
> @@ -159,7 +159,7 @@ static int parse_number (struct parser_state *, const char *, int,
>  
>  %token <ssym> NAME_OR_INT 
>  
> -%token SIZEOF KIND
> +%token SIZEOF KIND LOC
>  %token ERROR
>  
>  /* Special type cases, put in to allow the parser to distinguish different
> @@ -239,6 +239,10 @@ exp	:	SIZEOF exp       %prec UNARY
>  			{ write_exp_elt_opcode (pstate, UNOP_SIZEOF); }
>  	;
>  
> +exp	:	LOC exp       %prec UNARY
> +			{ write_exp_elt_opcode (pstate, UNOP_LOC); }
> +	;
> +
>  exp	:	KIND '(' exp ')'       %prec UNARY
>  			{ write_exp_elt_opcode (pstate, UNOP_FORTRAN_KIND); }
>  	;
> @@ -969,6 +973,7 @@ static const struct token f77_keywords[] =
>    { "ceiling", UNOP_INTRINSIC, UNOP_FORTRAN_CEILING, false },
>    { "modulo", BINOP_INTRINSIC, BINOP_FORTRAN_MODULO, false },
>    { "cmplx", BINOP_INTRINSIC, BINOP_FORTRAN_CMPLX, false },
> +  { "loc", LOC, BINOP_END, false },
>  };
>  
>  /* Implementation of a dynamically expandable buffer for processing input
> diff --git a/gdb/std-operator.def b/gdb/std-operator.def
> index a5247ab940..847ab56d94 100644
> --- a/gdb/std-operator.def
> +++ b/gdb/std-operator.def
> @@ -235,6 +235,7 @@ OP (UNOP_PREDECREMENT)		/* -- before an expression */
>  OP (UNOP_POSTDECREMENT)		/* -- after an expression */
>  OP (UNOP_SIZEOF)		/* Unary sizeof (followed by expression) */
>  OP (UNOP_ALIGNOF)		/* Unary alignof (followed by expression) */
> +OP (UNOP_LOC)			/* Unary loc (followed by expression) */

I wonder if we could get away with reusing UNOP_ADDR instead of
introducing UNOP_LOC?  The only advantage I see with adding UNOP_LOC
is in ax-gdb.c where we can say 'LOC' instead of '&' in the error
messages.  Maybe we can live with always saying '&'?

If you really feel we should add UNOP_LOC then I'd prefer that it be
added into fortran-operator.def, and be renamed UNOP_FORTRAN_LOC, to
make it clear that it's Fortran specific.  The changes in eval.c and
expprint.c would then move into f-lang.c, finally the ax-gdb.c code
should share an implementation between UNOP_ADDR and
UNOP_FORTRAN_LOC.

You'll also need to add some tests for this new functionality.

Thanks,
Andrew



>  
>  OP (UNOP_PLUS)			/* Unary plus */
>  
> -- 
> 2.17.1
>