summaryrefslogtreecommitdiff
path: root/gdb/f-lang.c
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/f-lang.c
parenteef32f59988bb0e4514d5395093c9e6d8d073ebb (diff)
downloadbinutils-gdb-611aa09d994fc5a8a9444075e65f0d6d4ebf4922.tar.gz
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/f-lang.c')
-rw-r--r--gdb/f-lang.c19
1 files changed, 19 insertions, 0 deletions
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index d79c458c5e0..0c49420e1f1 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
{