summaryrefslogtreecommitdiff
path: root/gdb
diff options
context:
space:
mode:
authorFelix Willgerodt <felix.willgerodt@intel.com>2021-03-09 11:34:55 +0100
committerFelix Willgerodt <felix.willgerodt@intel.com>2021-03-09 11:34:55 +0100
commit611aa09d994fc5a8a9444075e65f0d6d4ebf4922 (patch)
treeeffc6393a6e4c210d02a40ce547454402215ed99 /gdb
parenteef32f59988bb0e4514d5395093c9e6d8d073ebb (diff)
gdb/fortran: Add 'LOC' intrinsic support.
LOC(X) returns the address of X as an integer: https://gcc.gnu.org/onlinedocs/gfortran/LOC.html Before: (gdb) p LOC(r) No symbol "LOC" in current context. After: (gdb) p LOC(r) $1 = 0xffffdf48 gdb/ChangeLog: 2021-03-09 Felix Willgerodt <felix.willgerodt@intel.com> * f-exp.h (eval_op_f_loc): Declare. (expr::fortran_loc_operation): New typedef. * f-exp.y (exp): Handle UNOP_FORTRAN_LOC after parsing an UNOP_INTRINSIC. (f77_keywords): Add LOC keyword. * f-lang.c (eval_op_f_loc): New function. * std-operator.def (UNOP_FORTRAN_LOC): New operator. gdb/testsuite/ChangeLog: 2020-03-09 Felix Willgerodt <felix.willgerodt@intel.com> * gdb.fortran/intrinsics.exp: Add LOC tests.
Diffstat (limited to 'gdb')
-rw-r--r--gdb/ChangeLog10
-rw-r--r--gdb/f-exp.h7
-rw-r--r--gdb/f-exp.y4
-rw-r--r--gdb/f-lang.c19
-rw-r--r--gdb/std-operator.def3
-rw-r--r--gdb/testsuite/ChangeLog4
-rw-r--r--gdb/testsuite/gdb.fortran/intrinsics.exp5
7 files changed, 51 insertions, 1 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 6ed71c2724..048b409192 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,13 @@
+2021-03-09 Felix Willgerodt <felix.willgerodt@intel.com>
+
+ * f-exp.h (eval_op_f_loc): Declare.
+ (expr::fortran_loc_operation): New typedef.
+ * f-exp.y (exp): Handle UNOP_FORTRAN_LOC after parsing an
+ UNOP_INTRINSIC.
+ (f77_keywords): Add LOC keyword.
+ * f-lang.c (eval_op_f_loc): New function.
+ * std-operator.def (UNOP_FORTRAN_LOC): New operator.
+
2021-03-09 Andrew Burgess <andrew.burgess@embecosm.com>
* f-exp.h (eval_op_f_array_shape): Declare.
diff --git a/gdb/f-exp.h b/gdb/f-exp.h
index 11f19af979..b3d0e0e9d5 100644
--- a/gdb/f-exp.h
+++ b/gdb/f-exp.h
@@ -73,6 +73,11 @@ extern struct value * eval_op_f_allocated (struct type *expect_type,
enum noside noside,
enum exp_opcode op,
struct value *arg1);
+extern struct value * eval_op_f_loc (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside,
+ enum exp_opcode op,
+ struct value *arg1);
/* Implement the evaluation of UNOP_FORTRAN_RANK. EXPECTED_TYPE, EXP, and
NOSIDE are as for expression::evaluate (see expression.h). OP will
@@ -131,6 +136,8 @@ using fortran_kind_operation = unop_operation<UNOP_FORTRAN_KIND,
eval_op_f_kind>;
using fortran_allocated_operation = unop_operation<UNOP_FORTRAN_ALLOCATED,
eval_op_f_allocated>;
+using fortran_loc_operation = unop_operation<UNOP_FORTRAN_LOC,
+ eval_op_f_loc>;
using fortran_mod_operation = binop_operation<BINOP_MOD, eval_op_f_mod>;
using fortran_modulo_operation = binop_operation<BINOP_FORTRAN_MODULO,
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index dcc28b8e60..ce11b09b18 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -333,6 +333,9 @@ exp : UNOP_INTRINSIC '(' exp ')'
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");
}
@@ -1155,6 +1158,7 @@ static const struct token f77_keywords[] =
{ "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
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index d79c458c5e..0c49420e1f 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -971,6 +971,25 @@ eval_op_f_rank (struct type *expect_type,
return value_from_longest (result_type, ndim);
}
+/* A helper function for UNOP_FORTRAN_LOC. */
+
+struct value *
+eval_op_f_loc (struct type *expect_type, struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1)
+{
+ struct type *result_type;
+ if (gdbarch_ptr_bit (exp->gdbarch) == 16)
+ result_type = builtin_f_type (exp->gdbarch)->builtin_integer_s2;
+ else if (gdbarch_ptr_bit (exp->gdbarch) == 32)
+ result_type = builtin_f_type (exp->gdbarch)->builtin_integer;
+ else
+ result_type = builtin_f_type (exp->gdbarch)->builtin_integer_s8;
+
+ LONGEST result_value = value_address (arg1);
+ return value_from_longest (result_type, result_value);
+}
+
namespace expr
{
diff --git a/gdb/std-operator.def b/gdb/std-operator.def
index 1b8581f319..9dde7bab2c 100644
--- a/gdb/std-operator.def
+++ b/gdb/std-operator.def
@@ -380,6 +380,7 @@ OP (UNOP_FORTRAN_CEILING)
OP (UNOP_FORTRAN_ALLOCATED)
OP (UNOP_FORTRAN_RANK)
OP (UNOP_FORTRAN_SHAPE)
+OP (UNOP_FORTRAN_LOC)
/* Two operand builtins. */
OP (BINOP_FORTRAN_CMPLX)
@@ -389,4 +390,4 @@ OP (BINOP_FORTRAN_MODULO)
OP (FORTRAN_LBOUND)
OP (FORTRAN_UBOUND)
OP (FORTRAN_ASSOCIATED)
-OP (FORTRAN_ARRAY_SIZE) \ No newline at end of file
+OP (FORTRAN_ARRAY_SIZE)
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index ea1401c52c..9da8a9b646 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2020-03-04 Felix Willgerodt <felix.willgerodt@intel.com>
+
+ * gdb.fortran/intrinsics.exp: Add LOC tests.
+
2021-03-09 Andrew Burgess <andrew.burgess@embecosm.com>
* gdb.fortran/shape.exp: New file.
diff --git a/gdb/testsuite/gdb.fortran/intrinsics.exp b/gdb/testsuite/gdb.fortran/intrinsics.exp
index d0ac1944aa..84f486f4d7 100644
--- a/gdb/testsuite/gdb.fortran/intrinsics.exp
+++ b/gdb/testsuite/gdb.fortran/intrinsics.exp
@@ -84,3 +84,8 @@ gdb_test "ptype MODULO (3.0,2.0)" "type = real\\*8"
# Test CMPLX
gdb_test "p CMPLX (4.1, 2.0)" " = \\(4.$decimal,2\\)"
+
+# Test LOC
+
+gdb_test "p/x LOC(l)" "= $hex"
+gdb_test "ptype loc(l)" "type = integer(\\*$decimal)?"