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.

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 6ed71c2724b35a020ae38df99390d28ee8ae3f7a..048b40919299c1b600d643c1674291563701f2b5 100644 (file)
--- 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 11f19af979f76de332fa9c21f61d895529e19e05..b3d0e0e9d54f635590ae641ac29b7637e79e32b1 100644 (file)
--- 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 dcc28b8e600567803c38c37db92dedcd2e98af50..ce11b09b18e7ba92212a22ce28b0b76ac720efaf 100644 (file)
--- 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 d79c458c5e0be14f8f0955c213a79f73a72f1dc5..0c49420e1f1fe82a7abb562b4f22992437aef600 100644 (file)
--- 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 1b8581f319e583943684d2620b47ee957d769a9d..9dde7bab2c9255f4c9bdc5e83f43d95ff4afb52d 100644 (file)
--- 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 ea1401c52c31bc7f606783925b7648ce61045aec..9da8a9b64684dbfcf3f461012da3263fad3e03c9 100644 (file)
--- 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 d0ac1944aab59a8dcb6069a1b5c1ab8291cfdd67..84f486f4d7b1f82fc61c3713568c625d5e4fff1e 100644 (file)
--- 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)?"