public inbox for gdb-patches@sourceware.org
 help / color / mirror / Atom feed
From: "Ludovic Courtès" <ludo@gnu.org>
To: gdb-patches@sourceware.org
Cc: "Doug Evans" <xdje42@gmail.com>, "Ludovic Courtès" <ludo@gnu.org>
Subject: [PATCH v2 1/2] guile: Add support for Guile 2.2.
Date: Mon, 15 Jun 2020 17:14:52 +0200	[thread overview]
Message-ID: <20200615151453.795-2-ludo@gnu.org> (raw)
In-Reply-To: <20200615151453.795-1-ludo@gnu.org>

This primarily updates code that uses the I/O port API of Guile.

gdb/ChangeLog
2020-06-15  Ludovic Courtès  <ludo@gnu.org>
            Doug Evans  <dje@google.com>

	PR gdb/21104
	* guile/scm-ports.c (USING_GUILE_BEFORE_2_2): New macro.
	(ioscm_memory_port)[read_buf_size, write_buf_size]: Wrap in #if
	USING_GUILE_BEFORE_2_2.
	(stdio_port_desc, memory_port_desc) [!USING_GUILE_BEFORE_2_2]:
	Change type to 'scm_t_port_type *'.
	(natural_buffer_size) [!USING_GUILE_BEFORE_2_2]: New variable.
	(ioscm_open_port) [USING_GUILE_BEFORE_2_2]: Add 'stream'
	parameter and honor it.  Update callers.
	(ioscm_open_port) [!USING_GUILE_BEFORE_2_2]: New function.
	(ioscm_read_from_port, ioscm_write) [!USING_GUILE_BEFORE_2_2]: New
	functions.
	(ioscm_fill_input, ioscm_input_waiting, ioscm_flush): Wrap in #if
	USING_GUILE_BEFORE_2_2.
	(ioscm_init_gdb_stdio_port) [!USING_GUILE_BEFORE_2_2]: Use
	'ioscm_read_from_port'.  Call 'scm_set_port_read_wait_fd'.
	(ioscm_init_stdio_buffers) [!USING_GUILE_BEFORE_2_2]: New function.
	(gdbscm_stdio_port_p) [!USING_GUILE_BEFORE_2_2]: Use 'SCM_PORTP'
	and 'SCM_PORT_TYPE'.
	(gdbscm_memory_port_end_input, gdbscm_memory_port_seek)
	(ioscm_reinit_memory_port): Wrap in #if USING_GUILE_BEFORE_2_2.
	(gdbscm_memory_port_read, gdbscm_memory_port_write)
	(gdbscm_memory_port_seek, gdbscm_memory_port_close)
	[!USING_GUILE_BEFORE_2_2]: New functions.
	(gdbscm_memory_port_print): Remove use of 'SCM_PTOB_NAME'.
	(ioscm_init_memory_port_type) [!USING_GUILE_BEFORE_2_2]: Use
	'gdbscm_memory_port_read'.
	Wrap 'scm_set_port_end_input', 'scm_set_port_flush', and
	'scm_set_port_free' calls in #if USING_GUILE_BEFORE_2_2.
	(gdbscm_get_natural_buffer_sizes) [!USING_GUILE_BEFORE_2_2]: New
	function.
	(ioscm_init_memory_port): Remove.
	(ioscm_init_memory_port_stream): New function
	(ioscm_init_memory_port_buffers) [USING_GUILE_BEFORE_2_2]: New
	function.
	(gdbscm_memory_port_read_buffer_size) [!USING_GUILE_BEFORE_2_2]:
	Return scm_from_uint (0).
	(gdbscm_set_memory_port_read_buffer_size_x)
	[!USING_GUILE_BEFORE_2_2]: Call 'scm_setvbuf'.
	(gdbscm_memory_port_write_buffer_size) [!USING_GUILE_BEFORE_2_2]:
	Return scm_from_uint (0).
	(gdbscm_set_memory_port_write_buffer_size_x)
	[!USING_GUILE_BEFORE_2_2]: Call 'scm_setvbuf'.
	* testsuite/gdb.guile/scm-error.exp ("source
	$remote_guile_file_1"): Relax error regexp to match on Guile 2.2.
	* configure.ac (try_guile_versions): Add "guile-2.2".
	* configure: Regenerate.
	* NEWS: Add entry.

gdb/doc/ChangeLog
2020-06-15  Ludovic Courtès  <ludo@gnu.org>

	* guile.texi (Memory Ports in Guile): Remove
	documentation of 'memory-port-read-buffer-size',
	'set-memory-port-read-buffer-size!',
	'memory-port-write-buffer-size',
	'set-memory-port-read-buffer-size!', which are no longer
	supported with Guile 2.2/3.0 and superseded by 'setvbuf'.
	* doc/guile.texi (Guile Introduction): Clarify which Guile
	versions are supported.
---
 gdb/NEWS                              |  10 +
 gdb/configure                         |   2 +-
 gdb/configure.ac                      |   2 +-
 gdb/doc/guile.texi                    |  23 +-
 gdb/guile/scm-ports.c                 | 619 +++++++++++++++++++-------
 gdb/testsuite/gdb.guile/scm-error.exp |   2 +-
 6 files changed, 463 insertions(+), 195 deletions(-)

diff --git a/gdb/NEWS b/gdb/NEWS
index 9ef85ab3ca..d8a9de4179 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -83,6 +83,16 @@ GNU/Linux/RISC-V (gdbserver)	riscv*-*-linux*
   ** Commands written in Python can be in the "TUI" help class by
      registering with the new constant gdb.COMMAND_TUI.
 
+* Guile API
+
+  ** GDB can now be built with GNU Guile 2.2 in addition to 2.0.
+
+  ** Procedures 'memory-port-read-buffer-size',
+     'set-memory-port-read-buffer-size!', 'memory-port-write-buffer-size',
+     and 'set-memory-port-write-buffer-size!' are deprecated.  When
+     using Guile 2.2 and later, users who need to control the size of
+     a memory port's internal buffer can use the 'setvbuf' procedure.
+
 *** Changes in GDB 9
 
 * 'thread-exited' event is now available in the annotations interface.
diff --git a/gdb/configure b/gdb/configure
index ef10aa717f..bd12695291 100755
--- a/gdb/configure
+++ b/gdb/configure
@@ -10954,7 +10954,7 @@ fi
 
 
 
-try_guile_versions="guile-2.0"
+try_guile_versions="guile-2.2 guile-2.0"
 have_libguile=no
 case "${with_guile}" in
 no)
diff --git a/gdb/configure.ac b/gdb/configure.ac
index 62750804fa..87afc26581 100644
--- a/gdb/configure.ac
+++ b/gdb/configure.ac
@@ -1088,7 +1088,7 @@ AC_MSG_RESULT([$with_guile])
 dnl We check guile with pkg-config.
 AC_PATH_PROG(pkg_config_prog_path, pkg-config, missing)
 
-try_guile_versions="guile-2.0"
+try_guile_versions="guile-2.2 guile-2.0"
 have_libguile=no
 case "${with_guile}" in
 no)
diff --git a/gdb/doc/guile.texi b/gdb/doc/guile.texi
index c0bff7972f..0e6c74ef8b 100644
--- a/gdb/doc/guile.texi
+++ b/gdb/doc/guile.texi
@@ -38,8 +38,7 @@ Guile support in @value{GDBN} follows the Python support in @value{GDBN}
 reasonably closely, so concepts there should carry over.
 However, some things are done differently where it makes sense.
 
-@value{GDBN} requires Guile version 2.0 or greater.
-Older versions are not supported.
+@value{GDBN} requires Guile version 2.2 or 2.0.
 
 @cindex guile scripts directory
 Guile scripts used by @value{GDBN} should be installed in
@@ -3556,26 +3555,6 @@ of two elements: @code{(start end)}.  The range is @var{start} to @var{end}
 inclusive.
 @end deffn
 
-@deffn {Scheme Procedure} memory-port-read-buffer-size memory-port
-Return the size of the read buffer of @code{<gdb:memory-port>}
-@var{memory-port}.
-@end deffn
-
-@deffn {Scheme Procedure} set-memory-port-read-buffer-size! memory-port size
-Set the size of the read buffer of @code{<gdb:memory-port>}
-@var{memory-port} to @var{size}.  The result is unspecified.
-@end deffn
-
-@deffn {Scheme Procedure} memory-port-write-buffer-size memory-port
-Return the size of the write buffer of @code{<gdb:memory-port>}
-@var{memory-port}.
-@end deffn
-
-@deffn {Scheme Procedure} set-memory-port-write-buffer-size! memory-port size
-Set the size of the write buffer of @code{<gdb:memory-port>}
-@var{memory-port} to @var{size}.  The result is unspecified.
-@end deffn
-
 A memory port is closed like any other port, with @code{close-port}.
 
 Combined with Guile's @code{bytevectors}, memory ports provide a lot
diff --git a/gdb/guile/scm-ports.c b/gdb/guile/scm-ports.c
index 407d1d36f1..36b339ecff 100644
--- a/gdb/guile/scm-ports.c
+++ b/gdb/guile/scm-ports.c
@@ -36,6 +36,13 @@
 #endif
 #endif
 
+/* Whether we're using Guile < 2.2 and its clumsy port API.  */
+
+#define USING_GUILE_BEFORE_2_2					\
+  (SCM_MAJOR_VERSION < 2					\
+   || (SCM_MAJOR_VERSION == 2 && SCM_MINOR_VERSION == 0))
+
+
 /* A ui-file for sending output to Guile.  */
 
 class ioscm_file_port : public ui_file
@@ -66,12 +73,14 @@ typedef struct
      This value is always in the range [0, size].  */
   ULONGEST current;
 
+#if USING_GUILE_BEFORE_2_2
   /* The size of the internal r/w buffers.
      Scheme ports aren't a straightforward mapping to memory r/w.
      Generally the user specifies how much to r/w and all access is
      unbuffered.  We don't try to provide equivalent access, but we allow
      the user to specify these values to help get something similar.  */
   unsigned read_buf_size, write_buf_size;
+#endif
 } ioscm_memory_port;
 
 /* Copies of the original system input/output/error ports.
@@ -81,7 +90,11 @@ static SCM orig_output_port_scm;
 static SCM orig_error_port_scm;
 
 /* This is the stdio port descriptor, scm_ptob_descriptor.  */
+#if USING_GUILE_BEFORE_2_2
 static scm_t_bits stdio_port_desc;
+#else
+static scm_t_port_type *stdio_port_desc;
+#endif
 
 /* Note: scm_make_port_type takes a char * instead of a const char *.  */
 static /*const*/ char stdio_port_desc_name[] = "gdb:stdio-port";
@@ -102,11 +115,17 @@ static SCM error_port_scm;
 enum oport { GDB_STDOUT, GDB_STDERR };
 
 /* This is the memory port descriptor, scm_ptob_descriptor.  */
+#if USING_GUILE_BEFORE_2_2
 static scm_t_bits memory_port_desc;
+#else
+static scm_t_port_type *memory_port_desc;
+#endif
 
 /* Note: scm_make_port_type takes a char * instead of a const char *.  */
 static /*const*/ char memory_port_desc_name[] = "gdb:memory-port";
 
+#if USING_GUILE_BEFORE_2_2
+
 /* The default amount of memory to fetch for each read/write request.
    Scheme ports don't provide a way to specify the size of a read,
    which is important to us to minimize the number of inferior interactions,
@@ -123,16 +142,24 @@ static const unsigned max_memory_port_buf_size = 4096;
 /* "out of range" error message for buf sizes.  */
 static char *out_of_range_buf_size;
 
+#else
+
+/* The maximum values to use for get_natural_buffer_sizes.  */
+static const unsigned natural_buf_size = 16;
+
+#endif
+
 /* Keywords used by open-memory.  */
 static SCM mode_keyword;
 static SCM start_keyword;
 static SCM size_keyword;
 \f
-/* Helper to do the low level work of opening a port.
-   Newer versions of Guile (2.1.x) have scm_c_make_port.  */
+/* Helper to do the low level work of opening a port.  */
+
+#if USING_GUILE_BEFORE_2_2
 
 static SCM
-ioscm_open_port (scm_t_bits port_type, long mode_bits)
+ioscm_open_port (scm_t_bits port_type, long mode_bits, scm_t_bits stream)
 {
   SCM port;
 
@@ -143,6 +170,7 @@ ioscm_open_port (scm_t_bits port_type, long mode_bits)
   port = scm_new_port_table_entry (port_type);
 
   SCM_SET_CELL_TYPE (port, port_type | mode_bits);
+  SCM_SETSTREAM (port, stream);
 
 #if 0 /* TODO: Guile doesn't export this.  What to do?  */
   scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
@@ -150,9 +178,39 @@ ioscm_open_port (scm_t_bits port_type, long mode_bits)
 
   return port;
 }
+
+#else
+
+static SCM
+ioscm_open_port (scm_t_port_type *port_type, long mode_bits, scm_t_bits stream)
+{
+  return scm_c_make_port (port_type, mode_bits, stream);
+}
+
+#endif
+
 \f
 /* Support for connecting Guile's stdio ports to GDB's stdio ports.  */
 
+/* Like fputstrn_filtered, but don't escape characters, except nul.
+   Also like fputs_filtered, but a length is specified.  */
+
+static void
+fputsn_filtered (const char *s, size_t size, struct ui_file *stream)
+{
+  size_t i;
+
+  for (i = 0; i < size; ++i)
+    {
+      if (s[i] == '\0')
+	fputs_filtered ("\\000", stream);
+      else
+	fputc_filtered (s[i], stream);
+    }
+}
+
+#if USING_GUILE_BEFORE_2_2
+
 /* The scm_t_ptob_descriptor.input_waiting "method".
    Return a lower bound on the number of bytes available for input.  */
 
@@ -245,23 +303,6 @@ ioscm_fill_input (SCM port)
   return *pt->read_buf;
 }
 
-/* Like fputstrn_filtered, but don't escape characters, except nul.
-   Also like fputs_filtered, but a length is specified.  */
-
-static void
-fputsn_filtered (const char *s, size_t size, struct ui_file *stream)
-{
-  size_t i;
-
-  for (i = 0; i < size; ++i)
-    {
-      if (s[i] == '\0')
-	fputs_filtered ("\\000", stream);
-      else
-	fputc_filtered (s[i], stream);
-    }
-}
-
 /* Write to gdb's stdout or stderr.  */
 
 static void
@@ -302,6 +343,62 @@ ioscm_flush (SCM port)
     gdb_flush (gdb_stdout);
 }
 
+#else /* !USING_GUILE_BEFORE_2_2 */
+
+/* Read up to COUNT bytes into bytevector DST at offset START.  Return the
+   number of bytes read, zero for the end of file.  */
+
+static size_t
+ioscm_read_from_port (SCM port, SCM dst, size_t start, size_t count)
+{
+  long read;
+  char *read_buf;
+
+  /* If we're called on stdout,stderr, punt.  */
+  if (! scm_is_eq (port, input_port_scm))
+    return 0;
+
+  gdb_flush (gdb_stdout);
+  gdb_flush (gdb_stderr);
+
+  read_buf = (char *) SCM_BYTEVECTOR_CONTENTS (dst) + start;
+  read = gdb_stdin->read (read_buf, count);
+  if (read == -1)
+    scm_syserror (FUNC_NAME);
+
+  return (size_t) read;
+}
+
+/* Write to gdb's stdout or stderr.  */
+
+static size_t
+ioscm_write (SCM port, SCM src, size_t start, size_t count)
+{
+  const char *data = (char *) SCM_BYTEVECTOR_CONTENTS (src) + start;
+
+  /* If we're called on stdin, punt.  */
+  if (scm_is_eq (port, input_port_scm))
+    return 0;
+
+  gdbscm_gdb_exception exc {};
+  try
+    {
+      if (scm_is_eq (port, error_port_scm))
+	fputsn_filtered ((const char *) data, count, gdb_stderr);
+      else
+	fputsn_filtered ((const char *) data, count, gdb_stdout);
+    }
+  catch (const gdb_exception &except)
+    {
+      exc = unpack (except);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (exc);
+
+  return count;
+}
+
+#endif /* !USING_GUILE_BEFORE_2_2 */
+
 /* Initialize the gdb stdio port type.
 
    N.B. isatty? will fail on these ports, it is only supported for file
@@ -311,12 +408,25 @@ static void
 ioscm_init_gdb_stdio_port (void)
 {
   stdio_port_desc = scm_make_port_type (stdio_port_desc_name,
-					ioscm_fill_input, ioscm_write);
+#if USING_GUILE_BEFORE_2_2
+					ioscm_fill_input,
+#else
+					ioscm_read_from_port,
+#endif
+					ioscm_write);
 
+#if USING_GUILE_BEFORE_2_2
   scm_set_port_input_waiting (stdio_port_desc, ioscm_input_waiting);
   scm_set_port_flush (stdio_port_desc, ioscm_flush);
+#else
+  scm_set_port_read_wait_fd (stdio_port_desc, STDIN_FILENO);
+#endif
 }
 
+#define GDB_STDIO_BUFFER_DEFAULT_SIZE 1024
+
+#if USING_GUILE_BEFORE_2_2
+
 /* Subroutine of ioscm_make_gdb_stdio_port to simplify it.
    Set up the buffers of port PORT.
    MODE_BITS are the mode bits of PORT.  */
@@ -325,7 +435,6 @@ static void
 ioscm_init_stdio_buffers (SCM port, long mode_bits)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
-#define GDB_STDIO_BUFFER_DEFAULT_SIZE 1024
   int size = mode_bits & SCM_BUF0 ? 0 : GDB_STDIO_BUFFER_DEFAULT_SIZE;
   int writing = (mode_bits & SCM_WRTNG) != 0;
 
@@ -359,6 +468,20 @@ ioscm_init_stdio_buffers (SCM port, long mode_bits)
   pt->write_end = pt->write_buf + pt->write_buf_size;
 }
 
+#else
+
+static void
+ioscm_init_stdio_buffers (SCM port, long mode_bits)
+{
+  if (mode_bits & SCM_BUF0)
+    scm_setvbuf (port, scm_from_utf8_symbol ("none"), scm_from_size_t (0));
+  else
+    scm_setvbuf (port, scm_from_utf8_symbol ("block"),
+		 scm_from_size_t (GDB_STDIO_BUFFER_DEFAULT_SIZE));
+}
+
+#endif
+
 /* Create a gdb stdio port.  */
 
 static SCM
@@ -389,7 +512,7 @@ ioscm_make_gdb_stdio_port (int fd)
     }
 
   mode_bits = scm_mode_bits ((char *) mode_str);
-  port = ioscm_open_port (stdio_port_desc, mode_bits);
+  port = ioscm_open_port (stdio_port_desc, mode_bits, 0);
 
   scm_set_port_filename_x (port, gdbscm_scm_from_c_string (name));
 
@@ -403,9 +526,14 @@ ioscm_make_gdb_stdio_port (int fd)
 static SCM
 gdbscm_stdio_port_p (SCM scm)
 {
+#if USING_GUILE_BEFORE_2_2
   /* This is copied from SCM_FPORTP.  */
   return scm_from_bool (!SCM_IMP (scm)
 			&& (SCM_TYP16 (scm) == stdio_port_desc));
+#else
+  return scm_from_bool (SCM_PORTP (scm)
+			&& (SCM_PORT_TYPE (scm) == stdio_port_desc));
+#endif
 }
 \f
 /* GDB's ports are accessed via functions to keep them read-only.  */
@@ -568,6 +696,8 @@ ioscm_lseek_address (ioscm_memory_port *iomem, LONGEST offset, int whence)
   return 1;
 }
 
+#if USING_GUILE_BEFORE_2_2
+
 /* "fill_input" method for memory ports.  */
 
 static int
@@ -661,73 +791,6 @@ gdbscm_memory_port_flush (SCM port)
   pt->rw_active = SCM_PORT_NEITHER;
 }
 
-/* "write" method for memory ports.  */
-
-static void
-gdbscm_memory_port_write (SCM port, const void *void_data, size_t size)
-{
-  scm_t_port *pt = SCM_PTAB_ENTRY (port);
-  ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
-  const gdb_byte *data = (const gdb_byte *) void_data;
-
-  /* There's no way to indicate a short write, so if the request goes past
-     the end of the port's memory range, flag an error.  */
-  if (size > iomem->size - iomem->current)
-    {
-      gdbscm_out_of_range_error (FUNC_NAME, 0, gdbscm_scm_from_ulongest (size),
-				 _("writing beyond end of memory range"));
-    }
-
-  if (pt->write_buf == &pt->shortbuf)
-    {
-      /* Unbuffered port.  */
-      if (target_write_memory (iomem->start + iomem->current, data, size) != 0)
-	gdbscm_memory_error (FUNC_NAME, _("error writing memory"), SCM_EOL);
-      iomem->current += size;
-      return;
-    }
-
-  /* Note: The edge case of what to do when the buffer exactly fills is
-     debatable.  Guile flushes when the buffer exactly fills up, so we
-     do too.  It's counter-intuitive to my mind, but in case there's a
-     subtlety somewhere that depends on this, we do the same.  */
-
-  {
-    size_t space = pt->write_end - pt->write_pos;
-
-    if (size < space)
-      {
-	/* Data fits in buffer, and does not fill it.  */
-	memcpy (pt->write_pos, data, size);
-	pt->write_pos += size;
-      }
-    else
-      {
-	memcpy (pt->write_pos, data, space);
-	pt->write_pos = pt->write_end;
-	gdbscm_memory_port_flush (port);
-	{
-	  const gdb_byte *ptr = data + space;
-	  size_t remaining = size - space;
-
-	  if (remaining >= pt->write_buf_size)
-	    {
-	      if (target_write_memory (iomem->start + iomem->current, ptr,
-				       remaining) != 0)
-		gdbscm_memory_error (FUNC_NAME, _("error writing memory"),
-				     SCM_EOL);
-	      iomem->current += remaining;
-	    }
-	  else
-	    {
-	      memcpy (pt->write_pos, ptr, remaining);
-	      pt->write_pos += remaining;
-	    }
-	}
-      }
-  }
-}
-
 /* "seek" method for memory ports.  */
 
 static scm_t_off
@@ -820,6 +883,73 @@ gdbscm_memory_port_seek (SCM port, scm_t_off offset, int whence)
   return result;
 }
 
+/* "write" method for memory ports.  */
+
+static void
+gdbscm_memory_port_write (SCM port, const void *void_data, size_t size)
+{
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
+  const gdb_byte *data = (const gdb_byte *) void_data;
+
+  /* There's no way to indicate a short write, so if the request goes past
+     the end of the port's memory range, flag an error.  */
+  if (size > iomem->size - iomem->current)
+    {
+      gdbscm_out_of_range_error (FUNC_NAME, 0, gdbscm_scm_from_ulongest (size),
+				 _("writing beyond end of memory range"));
+    }
+
+  if (pt->write_buf == &pt->shortbuf)
+    {
+      /* Unbuffered port.  */
+      if (target_write_memory (iomem->start + iomem->current, data, size) != 0)
+	gdbscm_memory_error (FUNC_NAME, _("error writing memory"), SCM_EOL);
+      iomem->current += size;
+      return;
+    }
+
+  /* Note: The edge case of what to do when the buffer exactly fills is
+     debatable.  Guile flushes when the buffer exactly fills up, so we
+     do too.  It's counter-intuitive to my mind, but in case there's a
+     subtlety somewhere that depends on this, we do the same.  */
+
+  {
+    size_t space = pt->write_end - pt->write_pos;
+
+    if (size < space)
+      {
+	/* Data fits in buffer, and does not fill it.  */
+	memcpy (pt->write_pos, data, size);
+	pt->write_pos += size;
+      }
+    else
+      {
+	memcpy (pt->write_pos, data, space);
+	pt->write_pos = pt->write_end;
+	gdbscm_memory_port_flush (port);
+	{
+	  const gdb_byte *ptr = data + space;
+	  size_t remaining = size - space;
+
+	  if (remaining >= pt->write_buf_size)
+	    {
+	      if (target_write_memory (iomem->start + iomem->current, ptr,
+				       remaining) != 0)
+		gdbscm_memory_error (FUNC_NAME, _("error writing memory"),
+				     SCM_EOL);
+	      iomem->current += remaining;
+	    }
+	  else
+	    {
+	      memcpy (pt->write_pos, ptr, remaining);
+	      pt->write_pos += remaining;
+	    }
+	}
+      }
+  }
+}
+
 /* "close" method for memory ports.  */
 
 static int
@@ -851,18 +981,178 @@ gdbscm_memory_port_free (SCM port)
   return 0;
 }
 
+/* Re-initialize a memory port, updating its read/write buffer sizes.
+   An exception is thrown if the port is unbuffered.
+   TODO: Allow switching buffered/unbuffered.
+   An exception is also thrown if data is still buffered, except in the case
+   where the buffer size isn't changing (since that's just a nop).  */
+
+static void
+ioscm_reinit_memory_port (SCM port, size_t read_buf_size,
+			  size_t write_buf_size, const char *func_name)
+{
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
+
+  gdb_assert (read_buf_size >= min_memory_port_buf_size
+	      && read_buf_size <= max_memory_port_buf_size);
+  gdb_assert (write_buf_size >= min_memory_port_buf_size
+	      && write_buf_size <= max_memory_port_buf_size);
+
+  /* First check if the port is unbuffered.  */
+
+  if (pt->read_buf == &pt->shortbuf)
+    {
+      gdb_assert (pt->write_buf == &pt->shortbuf);
+      scm_misc_error (func_name, _("port is unbuffered: ~a"),
+		      scm_list_1 (port));
+    }
+
+  /* Next check if anything is buffered.  */
+
+  if (read_buf_size != pt->read_buf_size
+      && pt->read_end != pt->read_buf)
+    {
+      scm_misc_error (func_name, _("read buffer not empty: ~a"),
+		      scm_list_1 (port));
+    }
+
+  if (write_buf_size != pt->write_buf_size
+      && pt->write_pos != pt->write_buf)
+    {
+      scm_misc_error (func_name, _("write buffer not empty: ~a"),
+		      scm_list_1 (port));
+    }
+
+  /* Now we can update the buffer sizes, but only if the size has changed.  */
+
+  if (read_buf_size != pt->read_buf_size)
+    {
+      iomem->read_buf_size = read_buf_size;
+      pt->read_buf_size = read_buf_size;
+      xfree (pt->read_buf);
+      pt->read_buf = (unsigned char *) xmalloc (pt->read_buf_size);
+      pt->read_pos = pt->read_end = pt->read_buf;
+    }
+
+  if (write_buf_size != pt->write_buf_size)
+    {
+      iomem->write_buf_size = write_buf_size;
+      pt->write_buf_size = write_buf_size;
+      xfree (pt->write_buf);
+      pt->write_buf = (unsigned char *) xmalloc (pt->write_buf_size);
+      pt->write_pos = pt->write_buf;
+      pt->write_end = pt->write_buf + pt->write_buf_size;
+    }
+}
+
+#else /* !USING_GUILE_BEFORE_2_2 */
+
+/* The semantics get weird if the buffer size is larger than the port range,
+   so provide a better default buffer size.  */
+
+static void
+gdbscm_get_natural_buffer_sizes (SCM port, size_t *read_size,
+				 size_t *write_size)
+{
+  ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
+
+  size_t size = natural_buf_size;
+  if (iomem != NULL && iomem->size < size)
+    size = iomem->size;
+  *read_size = *write_size = size;
+}
+
+/* Read up to COUNT bytes into bytevector DST at offset START.  Return the
+   number of bytes read, zero for the end of file.  */
+
+static size_t
+gdbscm_memory_port_read (SCM port, SCM dst, size_t start, size_t count)
+{
+  gdb_byte *read_buf;
+  ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
+
+  /* "current" is the offset of the first byte we want to read.  */
+  gdb_assert (iomem->current <= iomem->size);
+  if (iomem->current == iomem->size)
+    return 0;
+
+  /* Don't read outside the allowed memory range.  */
+  if (count > iomem->size - iomem->current)
+    count = iomem->size - iomem->current;
+
+  read_buf = (gdb_byte *) SCM_BYTEVECTOR_CONTENTS (dst) + start;
+  if (target_read_memory (iomem->start + iomem->current, read_buf,
+			  count) != 0)
+    gdbscm_memory_error (FUNC_NAME, _("error reading memory"), SCM_EOL);
+
+  iomem->current += count;
+  return count;
+}
+
+static size_t
+gdbscm_memory_port_write (SCM port, SCM src, size_t start, size_t count)
+{
+  ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
+  const gdb_byte *data =
+    (const gdb_byte *) SCM_BYTEVECTOR_CONTENTS (src) + start;
+
+  /* If the request goes past the end of the port's memory range, flag an
+     error.  */
+  if (count > iomem->size - iomem->current)
+    gdbscm_out_of_range_error (FUNC_NAME, 0, scm_from_size_t (count),
+			       _("writing beyond end of memory range"));
+
+  if (target_write_memory (iomem->start + iomem->current, data,
+			   count) != 0)
+    gdbscm_memory_error (FUNC_NAME, _("error writing memory"),
+			 SCM_EOL);
+
+  iomem->current += count;
+
+  return count;
+}
+
+static scm_t_off
+gdbscm_memory_port_seek (SCM port, scm_t_off offset, int whence)
+{
+  ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
+  int rc;
+
+  rc = ioscm_lseek_address (iomem, offset, whence);
+  if (rc == 0)
+    gdbscm_out_of_range_error (FUNC_NAME, 0,
+			       gdbscm_scm_from_longest (offset),
+			       _("bad seek"));
+
+  /* TODO: The Guile API doesn't support 32x64.  We can't fix that here,
+     and there's no need to throw an error if the new address can't be
+     represented in a scm_t_off.  But we could return something less
+     clumsy.  */
+  return iomem->current;
+}
+
+static void
+gdbscm_memory_port_close (SCM port)
+{
+  ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
+  scm_gc_free (iomem, sizeof (*iomem), "memory port");
+  SCM_SETSTREAM (port, NULL);
+}
+
+#endif /* !USING_GUILE_BEFORE_2_2 */
+
 /* "print" method for memory ports.  */
 
 static int
 gdbscm_memory_port_print (SCM exp, SCM port, scm_print_state *pstate)
 {
   ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (exp);
-  char *type = SCM_PTOBNAME (SCM_PTOBNUM (exp));
 
   scm_puts ("#<", port);
   scm_print_port_mode (exp, port);
   /* scm_print_port_mode includes a trailing space.  */
-  gdbscm_printf (port, "%s %s-%s", type,
+  gdbscm_printf (port, "%s %s-%s", memory_port_desc_name,
 		 hex_string (iomem->start), hex_string (iomem->end));
   scm_putc ('>', port);
   return 1;
@@ -874,14 +1164,23 @@ static void
 ioscm_init_memory_port_type (void)
 {
   memory_port_desc = scm_make_port_type (memory_port_desc_name,
+#if USING_GUILE_BEFORE_2_2
 					 gdbscm_memory_port_fill_input,
+#else
+					 gdbscm_memory_port_read,
+#endif
 					 gdbscm_memory_port_write);
 
+#if USING_GUILE_BEFORE_2_2
   scm_set_port_end_input (memory_port_desc, gdbscm_memory_port_end_input);
   scm_set_port_flush (memory_port_desc, gdbscm_memory_port_flush);
+  scm_set_port_free (memory_port_desc, gdbscm_memory_port_free);
+#else
+  scm_set_port_get_natural_buffer_sizes (memory_port_desc,
+					 gdbscm_get_natural_buffer_sizes);
+#endif
   scm_set_port_seek (memory_port_desc, gdbscm_memory_port_seek);
   scm_set_port_close (memory_port_desc, gdbscm_memory_port_close);
-  scm_set_port_free (memory_port_desc, gdbscm_memory_port_free);
   scm_set_port_print (memory_port_desc, gdbscm_memory_port_print);
 }
 
@@ -922,17 +1221,13 @@ ioscm_parse_mode_bits (const char *func_name, const char *mode)
   return mode_bits;
 }
 
-/* Helper for gdbscm_open_memory to finish initializing the port.
-   The port has address range [start,end).
-   This means that address of 0xff..ff is not accessible.
-   I can live with that.  */
+/* Return the memory object to be used as a "stream" associated with a memory
+   port for the START--END range.  */
 
-static void
-ioscm_init_memory_port (SCM port, CORE_ADDR start, CORE_ADDR end)
+static ioscm_memory_port *
+ioscm_init_memory_port_stream (CORE_ADDR start, CORE_ADDR end)
 {
-  scm_t_port *pt;
   ioscm_memory_port *iomem;
-  int buffered = (SCM_CELL_WORD_0 (port) & SCM_BUF0) == 0;
 
   gdb_assert (start <= end);
 
@@ -943,6 +1238,23 @@ ioscm_init_memory_port (SCM port, CORE_ADDR start, CORE_ADDR end)
   iomem->end = end;
   iomem->size = end - start;
   iomem->current = 0;
+
+  return iomem;
+}
+
+#if USING_GUILE_BEFORE_2_2
+
+/* Helper for gdbscm_open_memory to finish initializing the port.
+   The port has address range [start,end).
+   This means that address of 0xff..ff is not accessible.
+   I can live with that.  */
+
+static void
+ioscm_init_memory_port_buffers (SCM port)
+{
+  ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
+
+  int buffered = (SCM_CELL_WORD_0 (port) & SCM_BUF0) == 0;
   if (buffered)
     {
       iomem->read_buf_size = default_read_buf_size;
@@ -954,7 +1266,7 @@ ioscm_init_memory_port (SCM port, CORE_ADDR start, CORE_ADDR end)
       iomem->write_buf_size = 1;
     }
 
-  pt = SCM_PTAB_ENTRY (port);
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
   /* Match the expectation of `binary-port?'.  */
   pt->encoding = NULL;
   pt->rw_random = 1;
@@ -973,74 +1285,9 @@ ioscm_init_memory_port (SCM port, CORE_ADDR start, CORE_ADDR end)
   pt->read_pos = pt->read_end = pt->read_buf;
   pt->write_pos = pt->write_buf;
   pt->write_end = pt->write_buf + pt->write_buf_size;
-
-  SCM_SETSTREAM (port, iomem);
 }
 
-/* Re-initialize a memory port, updating its read/write buffer sizes.
-   An exception is thrown if the port is unbuffered.
-   TODO: Allow switching buffered/unbuffered.
-   An exception is also thrown if data is still buffered, except in the case
-   where the buffer size isn't changing (since that's just a nop).  */
-
-static void
-ioscm_reinit_memory_port (SCM port, size_t read_buf_size,
-			  size_t write_buf_size, const char *func_name)
-{
-  scm_t_port *pt = SCM_PTAB_ENTRY (port);
-  ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
-
-  gdb_assert (read_buf_size >= min_memory_port_buf_size
-	      && read_buf_size <= max_memory_port_buf_size);
-  gdb_assert (write_buf_size >= min_memory_port_buf_size
-	      && write_buf_size <= max_memory_port_buf_size);
-
-  /* First check if the port is unbuffered.  */
-
-  if (pt->read_buf == &pt->shortbuf)
-    {
-      gdb_assert (pt->write_buf == &pt->shortbuf);
-      scm_misc_error (func_name, _("port is unbuffered: ~a"),
-		      scm_list_1 (port));
-    }
-
-  /* Next check if anything is buffered.  */
-
-  if (read_buf_size != pt->read_buf_size
-      && pt->read_end != pt->read_buf)
-    {
-      scm_misc_error (func_name, _("read buffer not empty: ~a"),
-		      scm_list_1 (port));
-    }
-
-  if (write_buf_size != pt->write_buf_size
-      && pt->write_pos != pt->write_buf)
-    {
-      scm_misc_error (func_name, _("write buffer not empty: ~a"),
-		      scm_list_1 (port));
-    }
-
-  /* Now we can update the buffer sizes, but only if the size has changed.  */
-
-  if (read_buf_size != pt->read_buf_size)
-    {
-      iomem->read_buf_size = read_buf_size;
-      pt->read_buf_size = read_buf_size;
-      xfree (pt->read_buf);
-      pt->read_buf = (unsigned char *) xmalloc (pt->read_buf_size);
-      pt->read_pos = pt->read_end = pt->read_buf;
-    }
-
-  if (write_buf_size != pt->write_buf_size)
-    {
-      iomem->write_buf_size = write_buf_size;
-      pt->write_buf_size = write_buf_size;
-      xfree (pt->write_buf);
-      pt->write_buf = (unsigned char *) xmalloc (pt->write_buf_size);
-      pt->write_pos = pt->write_buf;
-      pt->write_end = pt->write_buf + pt->write_buf_size;
-    }
-}
+#endif
 
 /* (open-memory [#:mode string] [#:start address] [#:size integer]) -> port
    Return a port that can be used for reading and writing memory.
@@ -1109,9 +1356,19 @@ gdbscm_open_memory (SCM rest)
 
   mode_bits = ioscm_parse_mode_bits (FUNC_NAME, mode);
 
-  port = ioscm_open_port (memory_port_desc, mode_bits);
+  /* Edge case: empty range -> unbuffered.
+     There's no need to disallow empty ranges, but we need an unbuffered port
+     to get the semantics right.  */
+  if (size == 0)
+    mode_bits |= SCM_BUF0;
+
+  auto stream = ioscm_init_memory_port_stream (start, end);
+  port = ioscm_open_port (memory_port_desc, mode_bits,
+			  (scm_t_bits) stream);
 
-  ioscm_init_memory_port (port, start, end);
+#if USING_GUILE_BEFORE_2_2
+  ioscm_init_memory_port_buffers (port);
+#endif
 
   scm_dynwind_end ();
 
@@ -1124,7 +1381,11 @@ gdbscm_open_memory (SCM rest)
 static int
 gdbscm_is_memory_port (SCM obj)
 {
+#if USING_GUILE_BEFORE_2_2
   return !SCM_IMP (obj) && (SCM_TYP16 (obj) == memory_port_desc);
+#else
+  return SCM_PORTP (obj) && (SCM_PORT_TYPE (obj) == memory_port_desc);
+#endif
 }
 
 /* (memory-port? obj) -> boolean */
@@ -1155,6 +1416,7 @@ gdbscm_memory_port_range (SCM port)
 static SCM
 gdbscm_memory_port_read_buffer_size (SCM port)
 {
+#if USING_GUILE_BEFORE_2_2
   ioscm_memory_port *iomem;
 
   SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME,
@@ -1162,6 +1424,9 @@ gdbscm_memory_port_read_buffer_size (SCM port)
 
   iomem = (ioscm_memory_port *) SCM_STREAM (port);
   return scm_from_uint (iomem->read_buf_size);
+#else
+  return scm_from_uint (0);
+#endif
 }
 
 /* (set-memory-port-read-buffer-size! port size) -> unspecified
@@ -1171,6 +1436,7 @@ gdbscm_memory_port_read_buffer_size (SCM port)
 static SCM
 gdbscm_set_memory_port_read_buffer_size_x (SCM port, SCM size)
 {
+#if USING_GUILE_BEFORE_2_2
   ioscm_memory_port *iomem;
 
   SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME,
@@ -1190,6 +1456,9 @@ gdbscm_set_memory_port_read_buffer_size_x (SCM port, SCM size)
 			    FUNC_NAME);
 
   return SCM_UNSPECIFIED;
+#else
+  return scm_setvbuf (port, scm_from_utf8_symbol ("block"), size);
+#endif
 }
 
 /* (memory-port-write-buffer-size port) -> integer */
@@ -1197,6 +1466,7 @@ gdbscm_set_memory_port_read_buffer_size_x (SCM port, SCM size)
 static SCM
 gdbscm_memory_port_write_buffer_size (SCM port)
 {
+#if USING_GUILE_BEFORE_2_2
   ioscm_memory_port *iomem;
 
   SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME,
@@ -1204,6 +1474,9 @@ gdbscm_memory_port_write_buffer_size (SCM port)
 
   iomem = (ioscm_memory_port *) SCM_STREAM (port);
   return scm_from_uint (iomem->write_buf_size);
+#else
+  return scm_from_uint (0);
+#endif
 }
 
 /* (set-memory-port-write-buffer-size! port size) -> unspecified
@@ -1213,6 +1486,7 @@ gdbscm_memory_port_write_buffer_size (SCM port)
 static SCM
 gdbscm_set_memory_port_write_buffer_size_x (SCM port, SCM size)
 {
+#if USING_GUILE_BEFORE_2_2
   ioscm_memory_port *iomem;
 
   SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME,
@@ -1232,6 +1506,9 @@ gdbscm_set_memory_port_write_buffer_size_x (SCM port, SCM size)
 			    FUNC_NAME);
 
   return SCM_UNSPECIFIED;
+#else
+  return scm_setvbuf (port, scm_from_utf8_symbol ("block"), size);
+#endif
 }
 \f
 /* Initialize gdb ports.  */
@@ -1366,9 +1643,11 @@ gdbscm_initialize_ports (void)
   start_keyword = scm_from_latin1_keyword ("start");
   size_keyword = scm_from_latin1_keyword ("size");
 
+#if USING_GUILE_BEFORE_2_2
   /* Error message text for "out of range" memory port buffer sizes.  */
 
   out_of_range_buf_size = xstrprintf ("size not between %u - %u",
 				      min_memory_port_buf_size,
 				      max_memory_port_buf_size);
+#endif
 }
diff --git a/gdb/testsuite/gdb.guile/scm-error.exp b/gdb/testsuite/gdb.guile/scm-error.exp
index 799bfe5db0..f073200b6e 100644
--- a/gdb/testsuite/gdb.guile/scm-error.exp
+++ b/gdb/testsuite/gdb.guile/scm-error.exp
@@ -34,7 +34,7 @@ set remote_guile_file_2 [gdb_remote_download host \
 			     ${srcdir}/${subdir}/${testfile}-2.scm]
 
 gdb_test "source $remote_guile_file_1" \
-    "(ERROR: )?In procedure \[+\]: Wrong type: #f.*" \
+    "(ERROR: )?In procedure \[+\]: Wrong type.*: #f.*" \
     "error loading scm file caught"
 
 gdb_test "p 1" " = 1" "no delayed error"
-- 
2.26.2


  reply	other threads:[~2020-06-15 15:15 UTC|newest]

Thread overview: 40+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2020-06-12 13:27 [PATCH 0/2] Add support for Guile 3.0 and 2.2 Ludovic Courtès
2020-06-12 13:27 ` [PATCH 1/2] guile: Add support for Guile 2.2 Ludovic Courtès
2020-06-12 13:50   ` Eli Zaretskii
2020-06-12 14:04     ` Ludovic Courtès
2020-06-13  6:44       ` Eli Zaretskii
2020-06-13 15:04         ` Ludovic Courtès
2020-06-15 15:14           ` [PATCH v2 0/2] Add support for Guile 3.0 and 2.2 Ludovic Courtès
2020-06-15 15:14             ` Ludovic Courtès [this message]
2020-06-15 17:00               ` [PATCH v2 1/2] guile: Add support for Guile 2.2 Eli Zaretskii
2020-06-18 20:31                 ` Tom Tromey
2020-06-19  6:08                   ` Eli Zaretskii
2020-06-19  7:37                     ` Ludovic Courtès
2020-06-26  8:13                       ` [PATCH v3 0/2] Add support for Guile 3.0 and 2.2 Ludovic Courtès
2020-06-26  8:13                         ` [PATCH v3 1/2] guile: Add support for Guile 2.2 Ludovic Courtès
2020-06-26 10:23                           ` Eli Zaretskii
2020-06-28 14:20                             ` Ludovic Courtès
2020-06-28 14:25                               ` [PATCH v4 " Ludovic Courtès
2020-06-28 16:40                                 ` Eli Zaretskii
2020-07-03  0:31                                 ` Simon Marchi
2020-07-03  7:06                                   ` Ludovic Courtès
2020-07-18 19:00                                   ` Joel Brobecker
2020-07-19 15:45                                     ` Simon Marchi
2020-07-20  8:05                                       ` Ludovic Courtès
2020-07-20 15:01                                         ` Simon Marchi
2020-07-21 21:10                                           ` Ludovic Courtès
2020-06-28 14:25                               ` [PATCH v4 2/2] guile: Add support for Guile 3.0 Ludovic Courtès
2020-06-28 16:38                               ` [PATCH v3 1/2] guile: Add support for Guile 2.2 Eli Zaretskii
2020-06-28 16:51                                 ` Ludovic Courtès
2020-07-02 12:57                               ` [PING] Add support for Guile 2.2/3.0 Ludovic Courtès
2020-07-13 15:36                                 ` Tom Tromey
2020-06-26  8:13                         ` [PATCH v3 2/2] guile: Add support for Guile 3.0 Ludovic Courtès
2020-06-26 10:13                           ` Eli Zaretskii
2020-06-15 15:14             ` [PATCH v2 " Ludovic Courtès
2020-06-12 14:14   ` [PATCH 1/2] guile: Add support for Guile 2.2 Tom de Vries
2020-06-12 14:36     ` Ludovic Courtès
2020-06-12 13:27 ` [PATCH 2/2] guile: Add support for Guile 3.0 Ludovic Courtès
2020-06-15 15:02   ` Tom Tromey
2020-06-15 15:17     ` Ludovic Courtès
2020-06-17 16:58     ` Ludovic Courtès
2020-06-17 17:21       ` Eli Zaretskii

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20200615151453.795-2-ludo@gnu.org \
    --to=ludo@gnu.org \
    --cc=gdb-patches@sourceware.org \
    --cc=xdje42@gmail.com \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).