Fix DW_OP_GNU_regval_type with FP registers

Consider the following code, compiled at -O2 on ppc-linux:

    procedure Increment (Val : in out Float; Msg : String);

The implementation does not really matter in this case). In our example,
this function is being called from a function with Param_1 set to 99.0.
Trying to break inside that function, and running until reaching that
breakpoint yields:

    (gdb) b increment
    Breakpoint 1 at 0x100014b4: file callee.adb, line 6.
    (gdb) run
    Starting program: /[...]/foo

    Breakpoint 1, callee.increment (val=99.0, val@entry=0.0, msg=...)
        at callee.adb:6
    6             if Val > 200.0 then

The @entry value for parameter "val" is incorrect, it should be 99.0.

The associated call-site parameter DIE looks like this:

        .uleb128 0xc     # (DIE (0x115) DW_TAG_GNU_call_site_parameter)
        .byte   0x2      # DW_AT_location
        .byte   0x90     # DW_OP_regx
        .uleb128 0x21
        .byte   0x3      # DW_AT_GNU_call_site_value
        .byte   0xf5     # DW_OP_GNU_regval_type
        .uleb128 0x3f
        .uleb128 0x25

The DW_AT_GNU_call_site_value uses a DW_OP_GNU_regval_type
operation, referencing register 0x3f=63, which is $f31,
an 8-byte floating register. In that register, the value is
stored using the usual 8-byte float format:

    (gdb) info float
    f31            99.0 (raw 0x4058c00000000000)

The current code evaluating DW_OP_GNU_regval_type operations
currently is (dwarf2expr.c:execute_stack_op):

            result = (ctx->funcs->read_reg) (ctx->baton, reg);
            result_val = value_from_ulongest (address_type, result);
            result_val = value_from_contents (type,
                                              value_contents_all (result_val));

What the ctx->funcs->read_reg function does is read the contents
of the register as if it contained an address. The rest of the code
continues that assumption, thinking it's OK to then use that to
create an address/ulongest struct value, which we then re-type
to the type specified by DW_OP_GNU_regval_type.

We're getting 0.0 above because the read_reg implementations
end up treating the contents of the FP register as an integral,
reading only 4 out of the 8 bytes. Being a big-endian target,
we read the high-order ones, which gives us zero.

This patch fixes the problem by introducing a new callback to
read the contents of a register as a given type, and then adjust
the handling of DW_OP_GNU_regval_type to use that new callback.

gdb/ChangeLog:

        * dwarf2expr.h (struct dwarf_expr_context_funcs) <read_reg>:
        Extend the documentation a bit.
        <get_reg_value>: New field.
        * dwarf2loc.c (dwarf_expr_get_reg_value)
        (needs_frame_get_reg_value): New functions.
        (dwarf_expr_ctx_funcs, needs_frame_ctx_funcs): Add "get_reg_value"
        callback.
        * dwarf2-frame.c (get_reg_value): New function.
        (dwarf2_frame_ctx_funcs): Add "get_reg_value" callback.
        * dwarf2expr.c (execute_stack_op) <DW_OP_GNU_regval_type>:
        Use new callback to compute result_val.

gdb/testsuite/ChangeLog:

        * gdb.ada/O2_float_param: New testcase.

gdb/ChangeLog

@@ -1,3 +1,17 @@
+2013-11-15  Joel Brobecker  <brobecker@adacore.com>
+
+	* dwarf2expr.h (struct dwarf_expr_context_funcs) <read_reg>:
+	Extend the documentation a bit.
+	<get_reg_value>: New field.
+	* dwarf2loc.c (dwarf_expr_get_reg_value)
+	(needs_frame_get_reg_value): New functions.
+	(dwarf_expr_ctx_funcs, needs_frame_ctx_funcs): Add "get_reg_value"
+	callback.
+	* dwarf2-frame.c (get_reg_value): New function.
+	(dwarf2_frame_ctx_funcs): Add "get_reg_value" callback.
+	* dwarf2expr.c (execute_stack_op) <DW_OP_GNU_regval_type>:
+	Use new callback to compute result_val.
+
 2013-11-15  Alan Modra  <amodra@gmail.com>
 
 	* ppc64-tdep.c (ppc64_plt_entry_point): Renamed from..

gdb/dwarf2-frame.c

@@ -306,6 +306,18 @@ read_reg (void *baton, int reg)
   return unpack_long (register_type (gdbarch, regnum), buf);
 }
 
+/* Implement struct dwarf_expr_context_funcs' "get_reg_value" callback.  */
+
+static struct value *
+get_reg_value (void *baton, struct type *type, int reg)
+{
+  struct frame_info *this_frame = (struct frame_info *) baton;
+  struct gdbarch *gdbarch = get_frame_arch (this_frame);
+  int regnum = gdbarch_dwarf2_reg_to_regnum (gdbarch, reg);
+
+  return value_from_register (type, regnum, this_frame);
+}
+
 static void
 read_mem (void *baton, gdb_byte *buf, CORE_ADDR addr, size_t len)
 {
@@ -347,6 +359,7 @@ register %s (#%d) at %s"),
 static const struct dwarf_expr_context_funcs dwarf2_frame_ctx_funcs =
 {
   read_reg,
+  get_reg_value,
   read_mem,
   ctx_no_get_frame_base,
   ctx_no_get_frame_cfa,

gdb/dwarf2expr.c

@@ -1439,10 +1439,7 @@ execute_stack_op (struct dwarf_expr_context *ctx,
 	    type_die.cu_off = uoffset;
 
 	    type = dwarf_get_base_type (ctx, type_die, 0);
-	    result = (ctx->funcs->read_reg) (ctx->baton, reg);
-	    result_val = value_from_ulongest (address_type, result);
-	    result_val = value_from_contents (type,
-					      value_contents_all (result_val));
+	    result_val = ctx->funcs->get_reg_value (ctx->baton, type, reg);
 	  }
 	  break;
 

gdb/dwarf2expr.h

@@ -31,9 +31,16 @@ struct dwarf_expr_context;
 
 struct dwarf_expr_context_funcs
 {
-  /* Return the value of register number REGNUM.  */
+  /* Return the value of register number REGNUM (a DWARF register number),
+     read as an address.  */
   CORE_ADDR (*read_reg) (void *baton, int regnum);
 
+  /* Return a value of type TYPE, stored in register number REGNUM
+     of the frame associated to the given BATON.
+
+     REGNUM is a DWARF register number.  */
+  struct value *(*get_reg_value) (void *baton, struct type *type, int regnum);
+
   /* Read LENGTH bytes at ADDR into BUF.  */
   void (*read_mem) (void *baton, gdb_byte *buf, CORE_ADDR addr, size_t length);
 

gdb/dwarf2loc.c

@@ -326,6 +326,18 @@ dwarf_expr_read_reg (void *baton, int dwarf_regnum)
   return result;
 }
 
+/* Implement struct dwarf_expr_context_funcs' "get_reg_value" callback.  */
+
+static struct value *
+dwarf_expr_get_reg_value (void *baton, struct type *type, int dwarf_regnum)
+{
+  struct dwarf_expr_baton *debaton = (struct dwarf_expr_baton *) baton;
+  struct gdbarch *gdbarch = get_frame_arch (debaton->frame);
+  int regnum = gdbarch_dwarf2_reg_to_regnum (gdbarch, dwarf_regnum);
+
+  return value_from_register (type, regnum, debaton->frame);
+}
+
 /* Read memory at ADDR (length LEN) into BUF.  */
 
 static void
@@ -2182,6 +2194,7 @@ static const struct lval_funcs pieced_value_funcs = {
 static const struct dwarf_expr_context_funcs dwarf_expr_ctx_funcs =
 {
   dwarf_expr_read_reg,
+  dwarf_expr_get_reg_value,
   dwarf_expr_read_mem,
   dwarf_expr_frame_base,
   dwarf_expr_frame_cfa,
@@ -2435,6 +2448,18 @@ needs_frame_read_reg (void *baton, int regnum)
   return 1;
 }
 
+/* struct dwarf_expr_context_funcs' "get_reg_value" callback:
+   Reads from registers do require a frame.  */
+
+static struct value *
+needs_frame_get_reg_value (void *baton, struct type *type, int regnum)
+{
+  struct needs_frame_baton *nf_baton = baton;
+
+  nf_baton->needs_frame = 1;
+  return value_zero (type, not_lval);
+}
+
 /* Reads from memory do not require a frame.  */
 static void
 needs_frame_read_mem (void *baton, gdb_byte *buf, CORE_ADDR addr, size_t len)
@@ -2516,6 +2541,7 @@ needs_get_addr_index (void *baton, unsigned int index)
 static const struct dwarf_expr_context_funcs needs_frame_ctx_funcs =
 {
   needs_frame_read_reg,
+  needs_frame_get_reg_value,
   needs_frame_read_mem,
   needs_frame_frame_base,
   needs_frame_frame_cfa,

gdb/testsuite/ChangeLog

@@ -1,3 +1,7 @@
+2013-11-15  Joel Brobecker  <brobecker@adacore.com>
+
+	* gdb.ada/O2_float_param: New testcase.
+
 2013-11-14  Tom Tromey  <tromey@redhat.com>
 
 	* Makefile.in (check-parallel): Print summary from gdb.sum.

gdb/testsuite/gdb.ada/O2_float_param.exp

@@ -0,0 +1,31 @@
+# Copyright 2013 Free Software Foundation, Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+load_lib "ada.exp"
+
+if { [skip_ada_tests] } { return -1 }
+
+standard_ada_testfile foo
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug optimize=-O2}] != ""} {
+    return -1
+}
+
+clean_restart ${testfile}
+
+runto "increment"
+
+gdb_test "frame" \
+         "#0\\s+callee\\.increment \\(val(=val@entry)?=99\\.0, msg=\\.\\.\\.\\).*"

gdb/testsuite/gdb.ada/O2_float_param/callee.adb

@@ -0,0 +1,26 @@
+--  Copyright 2013 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+with IO; use IO;
+
+package body Callee is
+   procedure Increment (Val : in out Float; Msg: String) is
+   begin
+      if Val > 200.0 then
+         Put_Line (Msg);
+      end if;
+      Val := Val + 1.0;
+   end Increment;
+end Callee;

gdb/testsuite/gdb.ada/O2_float_param/callee.ads

@@ -0,0 +1,18 @@
+--  Copyright 2013 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+package Callee is
+   procedure Increment (Val : in out Float; Msg : String);
+end Callee;

gdb/testsuite/gdb.ada/O2_float_param/caller.adb

@@ -0,0 +1,26 @@
+--  Copyright 2013 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+with IO; use IO;
+with Callee; use Callee;
+
+package body Caller is
+   procedure Verbose_Increment (Val : in out Float; Msg : String) is
+   begin
+      Put_Line ("DEBUG: " & Msg);
+      Increment (Val, "Verbose_Increment");
+   end Verbose_Increment;
+end Caller;
+

gdb/testsuite/gdb.ada/O2_float_param/caller.ads

@@ -0,0 +1,19 @@
+--  Copyright 2013 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+package Caller is
+   procedure Verbose_Increment (Val : in out Float; Msg : String);
+end Caller;
+

gdb/testsuite/gdb.ada/O2_float_param/foo.adb

@@ -0,0 +1,22 @@
+--  Copyright 2013 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+with Caller; use Caller;
+
+procedure Foo is
+   Num : Float := 99.0;
+begin
+   Verbose_Increment (Num, "Foo");
+end Foo;

gdb/testsuite/gdb.ada/O2_float_param/io.adb

@@ -0,0 +1,21 @@
+--  Copyright 2013 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+package body IO is
+   procedure Put_Line (S : String) is
+   begin
+      null;
+   end Put_Line;
+end IO;

gdb/testsuite/gdb.ada/O2_float_param/io.ads

@@ -0,0 +1,18 @@
+--  Copyright 2013 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+package IO is
+   procedure Put_Line (S : String);
+end IO;