gdb/fortran: Add Fortran 'loc' intrinic

Message ID 20190926030806.14177-1-tkulasek@sii.pl
State New
Headers show
Series
  • gdb/fortran: Add Fortran 'loc' intrinic
Related show

Commit Message

Tomasz Kulasek Sept. 26, 2019, 3:08 a.m.
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(-)

-- 
2.17.1

Comments

Andrew Burgess Sept. 26, 2019, 2:25 p.m. | #1
* 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

>

Patch

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.*/
+    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) */
 
 OP (UNOP_PLUS)			/* Unary plus */