From 611aa09d994fc5a8a9444075e65f0d6d4ebf4922 Mon Sep 17 00:00:00 2001 From: Felix Willgerodt Date: Tue, 9 Mar 2021 11:34:55 +0100 Subject: [PATCH] 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 * 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 * gdb.fortran/intrinsics.exp: Add LOC tests. --- gdb/ChangeLog | 10 ++++++++++ gdb/f-exp.h | 7 +++++++ gdb/f-exp.y | 4 ++++ gdb/f-lang.c | 19 +++++++++++++++++++ gdb/std-operator.def | 3 ++- gdb/testsuite/ChangeLog | 4 ++++ gdb/testsuite/gdb.fortran/intrinsics.exp | 5 +++++ 7 files changed, 51 insertions(+), 1 deletion(-) diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 6ed71c2724b..048b4091929 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,13 @@ +2021-03-09 Felix Willgerodt + + * 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 * f-exp.h (eval_op_f_array_shape): Declare. diff --git a/gdb/f-exp.h b/gdb/f-exp.h index 11f19af979f..b3d0e0e9d54 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; using fortran_allocated_operation = unop_operation; +using fortran_loc_operation = unop_operation; using fortran_mod_operation = binop_operation; using fortran_modulo_operation = binop_operationwrap (); break; + case UNOP_FORTRAN_LOC: + pstate->wrap (); + 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 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 { diff --git a/gdb/std-operator.def b/gdb/std-operator.def index 1b8581f319e..9dde7bab2c9 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 ea1401c52c3..9da8a9b6468 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2020-03-04 Felix Willgerodt + + * gdb.fortran/intrinsics.exp: Add LOC tests. + 2021-03-09 Andrew Burgess * gdb.fortran/shape.exp: New file. diff --git a/gdb/testsuite/gdb.fortran/intrinsics.exp b/gdb/testsuite/gdb.fortran/intrinsics.exp index d0ac1944aab..84f486f4d7b 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)?" -- 2.30.2