diff options
author | Felix Willgerodt <felix.willgerodt@intel.com> | 2021-03-09 11:34:55 +0100 |
---|---|---|
committer | Felix Willgerodt <felix.willgerodt@intel.com> | 2021-03-09 11:34:55 +0100 |
commit | 611aa09d994fc5a8a9444075e65f0d6d4ebf4922 (patch) | |
tree | effc6393a6e4c210d02a40ce547454402215ed99 /gdb | |
parent | eef32f59988bb0e4514d5395093c9e6d8d073ebb (diff) | |
download | binutils-611aa09d994fc5a8a9444075e65f0d6d4ebf4922.zip binutils-611aa09d994fc5a8a9444075e65f0d6d4ebf4922.tar.gz binutils-611aa09d994fc5a8a9444075e65f0d6d4ebf4922.tar.bz2 |
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/ChangeLog | 10 | ||||
-rw-r--r-- | gdb/f-exp.h | 7 | ||||
-rw-r--r-- | gdb/f-exp.y | 4 | ||||
-rw-r--r-- | gdb/f-lang.c | 19 | ||||
-rw-r--r-- | gdb/std-operator.def | 3 | ||||
-rw-r--r-- | gdb/testsuite/ChangeLog | 4 | ||||
-rw-r--r-- | gdb/testsuite/gdb.fortran/intrinsics.exp | 5 |
7 files changed, 51 insertions, 1 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 6ed71c2..048b409 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 11f19af..b3d0e0e 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 dcc28b8..ce11b09 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 d79c458c..0c49420 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 1b8581f..9dde7ba 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 ea1401c..9da8a9b 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 d0ac194..84f486f 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)?" |