[PATCH v2 21/36] Guile extension language: scm-disasm.c

[Doug Evans <xdje42 at gmail dot com>]

This patch adds the interface to the disassembler.

2014-01-20  Doug Evans  <xdje42@gmail.com>

	* disasm.c (gdb_disassemble_info): Make non-static.
	* disasm.h: #include "dis-asm.h".
	(struct gdbarch): Add forward decl.
	(gdb_disassemble_info): Declare.
	* guile/scm-disasm.c: New file.

	testsuite/
	* gdb.guile/scm-disasm.c: New file.
	* gdb.guile/scm-disasm.exp: New file.

diff --git a/gdb/disasm.c b/gdb/disasm.c
index 064ae05..d94225b 100644
--- a/gdb/disasm.c
+++ b/gdb/disasm.c
@@ -376,7 +376,7 @@ fprintf_disasm (void *stream, const char *format, ...)
   return 0;
 }
 
-static struct disassemble_info
+struct disassemble_info
 gdb_disassemble_info (struct gdbarch *gdbarch, struct ui_file *file)
 {
   struct disassemble_info di;
diff --git a/gdb/disasm.h b/gdb/disasm.h
index d2d5f51..9c6777c 100644
--- a/gdb/disasm.h
+++ b/gdb/disasm.h
@@ -19,15 +19,23 @@
 #ifndef DISASM_H
 #define DISASM_H
 
+#include "dis-asm.h"
+
 #define DISASSEMBLY_SOURCE	(0x1 << 0)
 #define DISASSEMBLY_RAW_INSN	(0x1 << 1)
 #define DISASSEMBLY_OMIT_FNAME	(0x1 << 2)
 #define DISASSEMBLY_FILENAME	(0x1 << 3)
 #define DISASSEMBLY_OMIT_PC	(0x1 << 4)
 
+struct gdbarch;
 struct ui_out;
 struct ui_file;
 
+/* Return a filled in disassemble_info object for use by gdb.  */
+
+extern struct disassemble_info gdb_disassemble_info (struct gdbarch *gdbarch,
+						     struct ui_file *file);
+
 extern void gdb_disassembly (struct gdbarch *gdbarch, struct ui_out *uiout,
 			     char *file_string, int flags, int how_many,
 			     CORE_ADDR low, CORE_ADDR high);
diff --git a/gdb/guile/scm-disasm.c b/gdb/guile/scm-disasm.c
new file mode 100644
index 0000000..dc76b98
--- /dev/null
+++ b/gdb/guile/scm-disasm.c
@@ -0,0 +1,355 @@
+/* Scheme interface to architecture.
+
+   Copyright (C) 2014 Free Software Foundation, Inc.
+
+   This file is part of GDB.
+
+   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/>.  */
+
+/* See README file in this directory for implementation notes, coding
+   conventions, et.al.  */
+
+#include "defs.h"
+#include "arch-utils.h"
+#include "disasm.h"
+#include "dis-asm.h"
+#include "gdbarch.h"
+#include "gdbcore.h" /* Why is memory_error here? */
+#include "guile-internal.h"
+
+static SCM port_keyword;
+static SCM offset_keyword;
+static SCM size_keyword;
+static SCM count_keyword;
+
+static SCM address_symbol;
+static SCM asm_symbol;
+static SCM length_symbol;
+
+/* Struct used to pass "application data" in disassemble_info.  */
+
+struct gdbscm_disasm_data
+{
+  struct gdbarch *gdbarch;
+  SCM port;
+  /* The offset of the address of the first instruction in PORT.  */
+  ULONGEST offset;
+};
+
+/* Struct used to pass data from gdbscm_disasm_read_memory to
+   gdbscm_disasm_read_memory_worker.  */
+
+struct gdbscm_disasm_read_data
+{
+  bfd_vma memaddr;
+  bfd_byte *myaddr;
+  unsigned int length;
+  struct disassemble_info *dinfo;
+};
+
+/* Subroutine of gdbscm_arch_disassemble to simplify it.
+   Return the result for one instruction.  */
+
+static SCM
+dascm_make_insn (CORE_ADDR pc, const char *assembly, int insn_len)
+{
+  return scm_list_3 (scm_cons (address_symbol,
+			       gdbscm_scm_from_ulongest (pc)),
+		     scm_cons (asm_symbol,
+			       gdbscm_scm_from_c_string (assembly)),
+		     scm_cons (length_symbol,
+			       scm_from_int (insn_len)));
+}
+
+/* Helper function for gdbscm_disasm_read_memory to safely read from a
+   Scheme port.  Called via gdbscm_call_guile.
+   The result is a statically allocated error message or NULL if success.  */
+
+static void *
+gdbscm_disasm_read_memory_worker (void *datap)
+{
+  struct gdbscm_disasm_read_data *data = datap;
+  struct disassemble_info *dinfo = data->dinfo;
+  struct gdbscm_disasm_data *disasm_data = dinfo->application_data;
+  SCM seekto, newpos, port = disasm_data->port;
+  size_t bytes_read;
+
+  seekto = gdbscm_scm_from_ulongest (data->memaddr - disasm_data->offset);
+  newpos = scm_seek (port, seekto, scm_from_int (SEEK_SET));
+  if (!scm_is_eq (seekto, newpos))
+    return "seek error";
+
+  bytes_read = scm_c_read (port, data->myaddr, data->length);
+
+  if (bytes_read != data->length)
+    return "short read";
+
+  /* If we get here the read succeeded.  */
+  return NULL;
+}
+
+/* disassemble_info.read_memory_func for gdbscm_print_insn_from_port.  */
+
+static int
+gdbscm_disasm_read_memory (bfd_vma memaddr, bfd_byte *myaddr,
+			   unsigned int length,
+			   struct disassemble_info *dinfo)
+{
+  struct gdbscm_disasm_read_data data;
+  void *status;
+
+  data.memaddr = memaddr;
+  data.myaddr = myaddr;
+  data.length = length;
+  data.dinfo = dinfo;
+
+  status = gdbscm_with_guile (gdbscm_disasm_read_memory_worker, &data);
+
+  /* TODO: IWBN to distinguish problems reading target memory versus problems
+     with the port (e.g., EOF).
+     We return TARGET_XFER_E_IO here as that's what memory_error looks for.  */
+  return status != NULL ? TARGET_XFER_E_IO : 0;
+}
+
+/* disassemble_info.memory_error_func for gdbscm_print_insn_from_port.
+   Technically speaking, we don't need our own memory_error_func,
+   but to not provide one would leave a subtle dependency in the code.
+   This function exists to keep a clear boundary.  */
+
+static void
+gdbscm_disasm_memory_error (int status, bfd_vma memaddr,
+			    struct disassemble_info *info)
+{
+  memory_error (status, memaddr);
+}
+
+/* disassemble_info.print_address_func for gdbscm_print_insn_from_port.
+   Since we need to use our own application_data value, we need to supply
+   this routine as well.  */
+
+static void
+gdbscm_disasm_print_address (bfd_vma addr, struct disassemble_info *info)
+{
+  struct gdbscm_disasm_data *data = info->application_data;
+  struct gdbarch *gdbarch = data->gdbarch;
+
+  print_address (gdbarch, addr, info->stream);
+}
+
+/* Subroutine of gdbscm_arch_disassemble to simplify it.
+   Call gdbarch_print_insn using a port for input.
+   PORT must be seekable.
+   OFFSET is the offset in PORT from which addresses begin.
+   For example, when printing from a bytevector, addresses passed to the
+   bv seek routines must be in the range [0,size).  However, the bytevector
+   may represent an instruction at address 0x1234.  To handle this case pass
+   0x1234 for OFFSET.
+   This is based on gdb_print_insn, see it for details.  */
+
+static int
+gdbscm_print_insn_from_port (struct gdbarch *gdbarch,
+			     SCM port, ULONGEST offset, CORE_ADDR memaddr,
+			     struct ui_file *stream, int *branch_delay_insns)
+{
+  struct disassemble_info di;
+  int length;
+  struct gdbscm_disasm_data data;
+
+  di = gdb_disassemble_info (gdbarch, stream);
+  data.gdbarch = gdbarch;
+  data.port = port;
+  data.offset = offset;
+  di.application_data = &data;
+  di.read_memory_func = gdbscm_disasm_read_memory;
+  di.memory_error_func = gdbscm_disasm_memory_error;
+  di.print_address_func = gdbscm_disasm_print_address;
+
+  length = gdbarch_print_insn (gdbarch, memaddr, &di);
+
+  if (branch_delay_insns)
+    {
+      if (di.insn_info_valid)
+	*branch_delay_insns = di.branch_delay_insns;
+      else
+	*branch_delay_insns = 0;
+    }
+
+  return length;
+}
+
+/* (arch-disassemble <gdb:arch> address
+     [#:port port] [#:offset address] [#:size integer] [#:count integer])
+     -> list
+
+   Returns a list of disassembled instructions.
+   If PORT is provided, read bytes from it.  Otherwise read target memory.
+   If PORT is #f, read target memory.
+   PORT must be seekable.  IWBN to remove this restriction, and a future
+   release may.  For now the restriction is in place because it's not clear
+   all disassemblers are strictly sequential.
+   If SIZE is provided, limit the number of bytes read to this amount.
+   If COUNT is provided, limit the number of instructions to this amount.
+
+   Each instruction in the result is an alist:
+   (('address . address) ('asm . disassembly) ('length . length)).
+   We could use a hash table (dictionary) but there aren't that many fields. */
+
+static SCM
+gdbscm_arch_disassemble (SCM self, SCM start_scm, SCM rest)
+{
+  arch_smob *a_smob
+    = arscm_get_arch_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct gdbarch *gdbarch = arscm_get_gdbarch (a_smob);
+  const SCM keywords[] = {
+    port_keyword, offset_keyword, size_keyword, count_keyword, SCM_BOOL_F
+  };
+  int port_arg_pos = -1, offset_arg_pos = -1;
+  int size_arg_pos = -1, count_arg_pos = -1;
+  SCM port = SCM_BOOL_F;
+  ULONGEST offset = 0;
+  unsigned int count = 1;
+  unsigned int size;
+  ULONGEST start_arg;
+  CORE_ADDR start, end;
+  CORE_ADDR pc;
+  unsigned int i;
+  int using_port;
+  SCM result;
+
+  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "U#OUuu",
+			      start_scm, &start_arg, rest,
+			      &port_arg_pos, &port,
+			      &offset_arg_pos, &offset,
+			      &size_arg_pos, &size,
+			      &count_arg_pos, &count);
+  /* START is first stored in a ULONGEST because we don't have a format char
+     for CORE_ADDR, and it's not really worth it to have one yet.  */
+  start = start_arg;
+
+  if (port_arg_pos > 0)
+    {
+      SCM_ASSERT_TYPE (gdbscm_is_false (port)
+		       || gdbscm_is_true (scm_input_port_p (port)),
+		       port, port_arg_pos, FUNC_NAME, _("input port"));
+    }
+  using_port = gdbscm_is_true (port);
+
+  if (offset_arg_pos > 0
+      && (port_arg_pos < 0
+	  || gdbscm_is_false (port)))
+    {
+      gdbscm_out_of_range_error (FUNC_NAME, offset_arg_pos,
+				 gdbscm_scm_from_ulongest (offset),
+				 _("offset provided but port is missing"));
+    }
+
+  if (size_arg_pos > 0)
+    {
+      if (size == 0)
+	return SCM_EOL;
+      /* For now be strict about start+size overflowing.  If it becomes
+	 a nuisance we can relax things later.  */
+      if (start + size < start)
+	{
+	  gdbscm_out_of_range_error (FUNC_NAME, 0,
+				scm_list_2 (gdbscm_scm_from_ulongest (start),
+					    gdbscm_scm_from_ulongest (size)),
+				     _("start+size overflows"));
+	}
+      end = start + size - 1;
+    }
+  else
+    end = ~(CORE_ADDR) 0;
+
+  if (count == 0)
+    return SCM_EOL;
+
+  result = SCM_EOL;
+
+  for (pc = start, i = 0; pc <= end && i < count; )
+    {
+      int insn_len = 0;
+      char *as = NULL;
+      struct ui_file *memfile = mem_fileopen ();
+      struct cleanup *cleanups = make_cleanup_ui_file_delete (memfile);
+      volatile struct gdb_exception except;
+
+      TRY_CATCH (except, RETURN_MASK_ALL)
+	{
+	  if (using_port)
+	    {
+	      insn_len = gdbscm_print_insn_from_port (gdbarch, port, offset,
+						      pc, memfile, NULL);
+	    }
+	  else
+	    insn_len = gdb_print_insn (gdbarch, pc, memfile, NULL);
+	}
+      GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
+
+      as = ui_file_xstrdup (memfile, NULL);
+
+      result = scm_cons (dascm_make_insn (pc, as, insn_len),
+			 result);
+
+      pc += insn_len;
+      i++;
+      do_cleanups (cleanups);
+      xfree (as);
+    }
+
+  return scm_reverse_x (result, SCM_EOL);
+}
+
+/* Initialize the Scheme architecture support.  */
+
+static const scheme_function disasm_functions[] =
+{
+  { "arch-disassemble", 2, 0, 1, gdbscm_arch_disassemble,
+    "\
+Return list of disassembled instructions in memory.\n\
+\n\
+  Arguments: <gdb:arch> start-address\n\
+      [#:port port] [#:offset address]\n\
+      [#:size <integer>] [#:count <integer>]\n\
+    port: If non-#f, it is an input port to read bytes from.\n\
+    offset: Specifies the address offset of the first byte in the port.\n\
+      This is useful if the input is from something other than memory\n\
+      (e.g., a bytevector) and you want the result to be as if the bytes\n\
+      came from that address.  The value to pass for start-address is\n\
+      then also the desired disassembly address, not the offset in, e.g.,\n\
+      the bytevector.\n\
+    size: Limit the number of bytes read to this amount.\n\
+    count: Limit the number of instructions to this amount.\n\
+\n\
+  Returns:\n\
+    Each instruction in the result is an alist:\n\
+      (('address . address) ('asm . disassembly) ('length . length))." },
+
+  END_FUNCTIONS
+};
+
+void
+gdbscm_initialize_disasm (void)
+{
+  gdbscm_define_functions (disasm_functions, 1);
+
+  port_keyword = scm_from_latin1_keyword ("port");
+  offset_keyword = scm_from_latin1_keyword ("offset");
+  size_keyword = scm_from_latin1_keyword ("size");
+  count_keyword = scm_from_latin1_keyword ("count");
+
+  address_symbol = scm_from_latin1_symbol ("address");
+  asm_symbol = scm_from_latin1_symbol ("asm");
+  length_symbol = scm_from_latin1_symbol ("length");
+}
diff --git a/gdb/testsuite/gdb.guile/scm-disasm.c b/gdb/testsuite/gdb.guile/scm-disasm.c
new file mode 100644
index 0000000..6c0ef92
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-disasm.c
@@ -0,0 +1,22 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 2014 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/>.  */
+
+int
+main (void)
+{
+  return 0;
+}
diff --git a/gdb/testsuite/gdb.guile/scm-disasm.exp b/gdb/testsuite/gdb.guile/scm-disasm.exp
new file mode 100644
index 0000000..5a1dae3
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-disasm.exp
@@ -0,0 +1,133 @@
+# Copyright 2014 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 gdb-guile.exp
+
+standard_testfile
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile}] } {
+    return
+}
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+if ![gdb_guile_runto_main] {
+   return
+}
+
+# Disassemble one instruction at pc and verify the result.
+
+proc test_disassemble_1 { name address extra_args } {
+    with_test_prefix $name {
+	gdb_scm_test_silent_cmd "guile (define insn-list (arch-disassemble arch $address $extra_args #:size 1 #:count 1))" \
+	    "disassemble"
+
+	gdb_test "guile (print (length insn-list))" \
+	    "= 1" "test number of instructions"
+	gdb_scm_test_silent_cmd "guile (define insn (car insn-list))" \
+	    "get instruction"
+
+	# Verify all the fields are present.
+	gdb_test "guile (print (->bool (assq-ref insn 'address)))" \
+	    "= #t" "test key address"
+	gdb_test "guile (print (->bool (assq-ref insn 'asm)))" \
+	    "= #t" "test key asm"
+	gdb_test "guile (print (->bool (assq-ref insn 'length)))" \
+	    "= #t" "test key length"
+
+	# Verify the correct address is used.
+	gdb_test "guile (print (= $address (assq-ref insn 'address)))" \
+	    "= #t" "verify correct address"
+    }
+}
+
+gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" "get frame"
+gdb_scm_test_silent_cmd "guile (define arch (frame-arch frame))" "get arch"
+gdb_scm_test_silent_cmd "guile (define pc (frame-pc frame))" "get pc"
+
+gdb_test "guile (print (arch-disassemble arch pc #:size 0))" \
+    "= \\(\\)" "disassemble, zero size"
+gdb_test "guile (print (arch-disassemble arch pc #:count 0))" \
+    "= \\(\\)" "disassemble, zero count"
+
+gdb_scm_test_silent_cmd "guile (define insn-list1 (arch-disassemble arch pc #:size 1 #:count 1))" \
+    "disassemble"
+gdb_scm_test_silent_cmd "guile (define insn-list2 (arch-disassemble arch pc #:size 1))" \
+    "disassemble, no count"
+gdb_scm_test_silent_cmd "guile (define insn-list3 (arch-disassemble arch pc #:count 1))" \
+    "disassemble, no end"
+gdb_scm_test_silent_cmd "guile (define insn-list4 (arch-disassemble arch pc))" \
+    "disassemble, no end no count"
+
+gdb_test "guile (print (length insn-list1))" \
+    "= 1" "test number of instructions 1"
+gdb_test "guile (print (length insn-list2))" \
+    "= 1" "test number of instructions 2"
+gdb_test "guile (print (length insn-list3))" \
+    "= 1" "test number of instructions 3"
+gdb_test "guile (print (length insn-list4))" \
+    "= 1" "test number of instructions 4"
+
+test_disassemble_1 "basic" "pc" ""
+
+# Negative test
+gdb_test "guile (arch-disassemble arch 0 #:size 1)" \
+    "ERROR: Cannot access memory at address 0x.*" "test bad memory access"
+
+# Test disassembly through a port.
+
+gdb_scm_test_silent_cmd "guile (define mem (open-memory))" \
+    "open memory port"
+
+test_disassemble_1 "memory-port" "pc" "#:port mem"
+
+gdb_scm_test_silent_cmd "guile (define insn-list-mem (arch-disassemble arch pc #:port mem #:size 1 #:count 1))" \
+    "disassemble via memory port"
+
+# Test memory error reading from port.
+
+gdb_scm_test_silent_cmd "guile (define mem1 (open-memory #:start pc #:size 4))" \
+    "open restricted range memory port"
+
+# The x86 disassembler tries to be clever and will print "byte 0x42" if
+# there is insufficient memory for the entire instruction.
+# So we pass "#:count 5" to ensure the disassembler tries to read beyond
+# the end of the memory range.
+gdb_test "guile (arch-disassemble arch pc #:port mem1 #:count 5 #:offset pc)" \
+    "ERROR: Cannot access memory at address 0x.*" \
+    "test bad memory access from port"
+
+# Test disassembly of a bytevector.
+
+gdb_scm_test_silent_cmd "guile (use-modules (rnrs io ports))" \
+    "import (rnrs io ports)"
+
+# First fetch the length of the instruction at $pc.
+gdb_scm_test_silent_cmd "guile (define insn-list-for-bv (arch-disassemble arch pc))" \
+    "get insn for bytevector"
+gdb_test_no_output "guile (define insn-length (assq-ref (car insn-list-for-bv) 'length))" \
+    "get insn length for bytevector"
+
+# Read the insn into a bytevector.
+gdb_test_no_output "guile (define insn-bv (get-bytevector-n (open-memory #:start pc #:size insn-length) insn-length))" \
+    "read insn into bytevector"
+
+# Disassemble the bytevector.
+gdb_scm_test_silent_cmd "guile (define insn-list-from-bv (arch-disassemble arch pc #:port (open-bytevector-input-port insn-bv) #:offset pc))" \
+    "disassemble bytevector"
+
+gdb_test "guile (print (equal? insn-list-for-bv insn-list-from-bv))" \
+    "= #t" "verify bytevector disassembly"