diff mbox

Handle unbuffered Guile memory ports, and zero sized ports

Message ID m31tk8k7x8.fsf@sspiff.org
State New
Headers show

Commit Message

Doug Evans March 28, 2015, 11:40 p.m. UTC
Hi.

This patch adds support for unbuffered Guile memory supports,
and allows for zero sized ports.

Regression tested on amd64-linux.

2015-03-28  Doug Evans  <xdje42@gmail.com>

	* NEWS: Mention support for unbuffered Guile memory ports.
	* scm-ports.c (ioscm_memory_port): Update comments on end, size.
	(ioscm_lseek_address): Improve overflow calculation.
	(gdbscm_memory_port_fill_input): Add assert.
	(gdbscm_memory_port_write): Handle unbuffered ports.
	Handle large writes identical to Guile's fport_write.
	(gdbscm_memory_port_seek): Fix seeking past end check.
	(gdbscm_memory_port_close): Handle closing unbuffered port.
	(ioscm_parse_mode_bits): Recognize "0" for unbuffered ports.
	(ioscm_init_memory_port): Handle unbuffered ports.
	(ioscm_reinit_memory_port): Ditto.
	(ioscm_init_memory_port): Update size calculation.
	(gdbscm_open_memory): Support zero sized ports.

	testsuite/
	* gdb.guile/scm-ports.c: New file.
	* gdb.guile/scm-ports.exp: Add memory port tests.

	doc/
	* guile.texi (Memory Ports in Guile): Document support for unbuffered
	memory ports.

Comments

Eli Zaretskii March 29, 2015, 3:36 p.m. UTC | #1
> From: Doug Evans <xdje42@gmail.com>
> Date: Sat, 28 Mar 2015 16:40:19 -0700
> 
> This patch adds support for unbuffered Guile memory supports,
> and allows for zero sized ports.
> 
> Regression tested on amd64-linux.
> 
> 2015-03-28  Doug Evans  <xdje42@gmail.com>
> 
> 	* NEWS: Mention support for unbuffered Guile memory ports.
> 	* scm-ports.c (ioscm_memory_port): Update comments on end, size.
> 	(ioscm_lseek_address): Improve overflow calculation.
> 	(gdbscm_memory_port_fill_input): Add assert.
> 	(gdbscm_memory_port_write): Handle unbuffered ports.
> 	Handle large writes identical to Guile's fport_write.
> 	(gdbscm_memory_port_seek): Fix seeking past end check.
> 	(gdbscm_memory_port_close): Handle closing unbuffered port.
> 	(ioscm_parse_mode_bits): Recognize "0" for unbuffered ports.
> 	(ioscm_init_memory_port): Handle unbuffered ports.
> 	(ioscm_reinit_memory_port): Ditto.
> 	(ioscm_init_memory_port): Update size calculation.
> 	(gdbscm_open_memory): Support zero sized ports.
> 
> 	testsuite/
> 	* gdb.guile/scm-ports.c: New file.
> 	* gdb.guile/scm-ports.exp: Add memory port tests.
> 
> 	doc/
> 	* guile.texi (Memory Ports in Guile): Document support for unbuffered
> 	memory ports.

OK for the documentation parts.

Thanks.
Doug Evans May 16, 2015, 7:21 p.m. UTC | #2
Eli Zaretskii <eliz@gnu.org> writes:
>> From: Doug Evans <xdje42@gmail.com>
>> Date: Sat, 28 Mar 2015 16:40:19 -0700
>> 
>> This patch adds support for unbuffered Guile memory supports,
>> and allows for zero sized ports.
>> 
>> Regression tested on amd64-linux.
>> 
>> 2015-03-28  Doug Evans  <xdje42@gmail.com>
>> 
>> 	* NEWS: Mention support for unbuffered Guile memory ports.
>> 	* scm-ports.c (ioscm_memory_port): Update comments on end, size.
>> 	(ioscm_lseek_address): Improve overflow calculation.
>> 	(gdbscm_memory_port_fill_input): Add assert.
>> 	(gdbscm_memory_port_write): Handle unbuffered ports.
>> 	Handle large writes identical to Guile's fport_write.
>> 	(gdbscm_memory_port_seek): Fix seeking past end check.
>> 	(gdbscm_memory_port_close): Handle closing unbuffered port.
>> 	(ioscm_parse_mode_bits): Recognize "0" for unbuffered ports.
>> 	(ioscm_init_memory_port): Handle unbuffered ports.
>> 	(ioscm_reinit_memory_port): Ditto.
>> 	(ioscm_init_memory_port): Update size calculation.
>> 	(gdbscm_open_memory): Support zero sized ports.
>> 
>> 	testsuite/
>> 	* gdb.guile/scm-ports.c: New file.
>> 	* gdb.guile/scm-ports.exp: Add memory port tests.
>> 
>> 	doc/
>> 	* guile.texi (Memory Ports in Guile): Document support for unbuffered
>> 	memory ports.
>
> OK for the documentation parts.
>
> Thanks.

Thanks. Committed.
diff mbox

Patch

diff --git a/gdb/NEWS b/gdb/NEWS
index 3fa33c9..2957f5c 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -11,6 +11,10 @@ 
   present in the debug info.  This typically includes the compiler version
   and may include things like its command line arguments.
 
+* Guile Scripting
+
+  ** Memory ports can now be unbuffered.
+
 * Python Scripting
 
   ** gdb.Objfile objects have a new attribute "username",
diff --git a/gdb/doc/guile.texi b/gdb/doc/guile.texi
index 4a4365c..47e5d64 100644
--- a/gdb/doc/guile.texi
+++ b/gdb/doc/guile.texi
@@ -3520,11 +3520,13 @@  returns a port object.  One can then read/write memory using that object.
 @deffn {Scheme Procedure} open-memory @r{[}#:mode mode{]} @r{[}#:start address{]} @r{[}#:size size{]}
 Return a port object that can be used for reading and writing memory.
 The port will be open according to @var{mode}, which is the standard
-mode argument to Guile port open routines, except that it is
-restricted to one of @samp{"r"}, @samp{"w"}, or @samp{"r+"}.  For
-compatibility @samp{"b"} (binary) may also be present, but we ignore
-it: memory ports are binary only.  The default is @samp{"r"},
-read-only.
+mode argument to Guile port open routines, except that the @samp{"a"}
+and @samp{"l"} modes are not supported.
+@xref{File Ports,,, guile, GNU Guile Reference Manual}.
+The @samp{"b"} (binary) character may be present, but is ignored:
+memory ports are binary only.  If @samp{"0"} is appended then
+the port is marked as unbuffered.
+The default is @samp{"r"}, read-only and buffered.
 
 The chunk of memory that can be accessed can be bounded.
 If both @var{start} and @var{size} are unspecified, all of memory can be
diff --git a/gdb/guile/scm-ports.c b/gdb/guile/scm-ports.c
index 8967b92..622507b 100644
<--- a/gdb/guile/scm-ports.c
+++ b/gdb/guile/scm-ports.c
@@ -47,13 +47,11 @@  typedef struct
 
 typedef struct
 {
-  /* Bounds of memory range this port is allowed to access, inclusive.
-     To simplify overflow handling, an END of 0xff..ff is not allowed.
-     This also means a start address of 0xff..ff is also not allowed.
-     I can live with that.  */
+  /* Bounds of memory range this port is allowed to access: [start, end).
+     This means that 0xff..ff is not accessible.  I can live with that.  */
   CORE_ADDR start, end;
 
-  /* (end - start + 1), recorded for convenience.  */
+  /* (end - start), recorded for convenience.  */
   ULONGEST size;
 
   /* Think of this as the lseek value maintained by the kernel.
@@ -595,7 +593,7 @@  ioscm_lseek_address (ioscm_memory_port *iomem, LONGEST offset, int whence)
     case SEEK_CUR:
       /* Catch over/underflow.  */
       if ((offset < 0 && iomem->current + offset > iomem->current)
-	  || (offset >= 0 && iomem->current + offset < iomem->current))
+	  || (offset > 0 && iomem->current + offset < iomem->current))
 	return 0;
       new_current = iomem->current + offset;
       break;
@@ -630,7 +628,8 @@  gdbscm_memory_port_fill_input (SCM port)
   size_t to_read;
 
   /* "current" is the offset of the first byte we want to read.  */
-  if (iomem->current >= iomem->size)
+  gdb_assert (iomem->current <= iomem->size);
+  if (iomem->current == iomem->size)
     return EOF;
 
   /* Don't read outside the allowed memory range.  */
@@ -642,9 +641,9 @@  gdbscm_memory_port_fill_input (SCM port)
 			  to_read) != 0)
     gdbscm_memory_error (FUNC_NAME, _("error reading memory"), SCM_EOL);
 
+  iomem->current += to_read;
   pt->read_pos = pt->read_buf;
   pt->read_end = pt->read_buf + to_read;
-  iomem->current += to_read;
   return *pt->read_buf;
 }
 
@@ -719,13 +718,6 @@  gdbscm_memory_port_write (SCM port, const void *data, size_t size)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
   ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
-  const char *input = (char *) data;
-
-  /* We could get fancy here, and try to buffer the request since we're
-     buffering anyway.  But there's currently no need.  */
-
-  /* First flush what's currently buffered.  */
-  gdbscm_memory_port_flush (port);
 
   /* 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.  */
@@ -735,10 +727,54 @@  gdbscm_memory_port_write (SCM port, const void *data, size_t size)
 				 _("writing beyond end of memory range"));
     }
 
-  if (target_write_memory (iomem->start + iomem->current, data, size) != 0)
-    gdbscm_memory_error (FUNC_NAME, _("error writing memory"), SCM_EOL);
+  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 void *ptr = ((const char *) data) + space;
+	  size_t remaining = size - space;
 
-  iomem->current += size;
+	  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.  */
@@ -768,7 +804,7 @@  gdbscm_memory_port_seek (SCM port, scm_t_off offset, int whence)
 	  size_t delta = pt->write_pos - pt->write_buf;
 
 	  if (current + delta < current
-	      || current + delta > iomem->size + 1)
+	      || current + delta > iomem->size)
 	    rc = 0;
 	  else
 	    {
@@ -845,8 +881,10 @@  gdbscm_memory_port_close (SCM port)
 
   if (pt->read_buf == pt->putback_buf)
     pt->read_buf = pt->saved_read_buf;
-  xfree (pt->read_buf);
-  xfree (pt->write_buf);
+  if (pt->read_buf != &pt->shortbuf)
+    xfree (pt->read_buf);
+  if (pt->write_buf != &pt->shortbuf)
+    xfree (pt->write_buf);
   scm_gc_free (iomem, sizeof (*iomem), "memory port");
 
   return 0;
@@ -915,6 +953,7 @@  ioscm_parse_mode_bits (const char *func_name, const char *mode)
     {
       switch (*p)
 	{
+	case '0':
 	case 'b':
 	case '+':
 	  break;
@@ -933,9 +972,8 @@  ioscm_parse_mode_bits (const char *func_name, const char *mode)
 }
 
 /* Helper for gdbscm_open_memory to finish initializing the port.
-   The port has address range [start,end].
-   To simplify overflow handling, an END of 0xff..ff is not allowed.
-   This also means a start address of 0xff..f is also not allowed.
+   The port has address range [start,end).
+   This means that address of 0xff..ff is not accessible.
    I can live with that.  */
 
 static void
@@ -943,29 +981,45 @@  ioscm_init_memory_port (SCM port, 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);
-  gdb_assert (end < ~(CORE_ADDR) 0);
 
   iomem = (ioscm_memory_port *) scm_gc_malloc_pointerless (sizeof (*iomem),
 							   "memory port");
 
   iomem->start = start;
   iomem->end = end;
-  iomem->size = end - start + 1;
+  iomem->size = end - start;
   iomem->current = 0;
-  iomem->read_buf_size = default_read_buf_size;
-  iomem->write_buf_size = default_write_buf_size;
+  if (buffered)
+    {
+      iomem->read_buf_size = default_read_buf_size;
+      iomem->write_buf_size = default_write_buf_size;
+    }
+  else
+    {
+      iomem->read_buf_size = 1;
+      iomem->write_buf_size = 1;
+    }
 
   pt = SCM_PTAB_ENTRY (port);
   /* Match the expectation of `binary-port?'.  */
   pt->encoding = NULL;
   pt->rw_random = 1;
   pt->read_buf_size = iomem->read_buf_size;
-  pt->read_buf = xmalloc (pt->read_buf_size);
-  pt->read_pos = pt->read_end = pt->read_buf;
   pt->write_buf_size = iomem->write_buf_size;
-  pt->write_buf = xmalloc (pt->write_buf_size);
+  if (buffered)
+    {
+      pt->read_buf = xmalloc (pt->read_buf_size);
+      pt->write_buf = xmalloc (pt->write_buf_size);
+    }
+  else
+    {
+      pt->read_buf = &pt->shortbuf;
+      pt->write_buf = &pt->shortbuf;
+    }
+  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;
 
@@ -973,7 +1027,9 @@  ioscm_init_memory_port (SCM port, CORE_ADDR start, CORE_ADDR end)
 }
 
 /* Re-initialize a memory port, updating its read/write buffer sizes.
-   An exception is thrown if data is still buffered, except in the case
+   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
@@ -988,7 +1044,16 @@  ioscm_reinit_memory_port (SCM port, size_t read_buf_size,
   gdb_assert (write_buf_size >= min_memory_port_buf_size
 	      && write_buf_size <= max_memory_port_buf_size);
 
-  /* First check if anything is buffered.  */
+  /* 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)
@@ -1029,17 +1094,16 @@  ioscm_reinit_memory_port (SCM port, size_t read_buf_size,
 /* (open-memory [#:mode string] [#:start address] [#:size integer]) -> port
    Return a port that can be used for reading and writing memory.
    MODE is a string, and must be one of "r", "w", or "r+".
-   For compatibility "b" (binary) may also be present, but we ignore it:
+   "0" may be appended to MODE to mark the port as unbuffered.
+   For compatibility "b" (binary) may also be appended, but we ignore it:
    memory ports are binary only.
 
-   TODO: Support "0" (unbuffered)?  Only support "0" (always unbuffered)?
-
    The chunk of memory that can be accessed can be bounded.
-   If both START,SIZE are unspecified, all of memory can be accessed.
-   If only START is specified, all of memory from that point on can be
-   accessed.  If only SIZE if specified, all memory in [0,SIZE) can be
-   accessed.  If both are specified, all memory in [START,START+SIZE) can be
-   accessed.
+   If both START,SIZE are unspecified, all of memory can be accessed
+   (except 0xff..ff).  If only START is specified, all of memory from that
+   point on can be accessed (except 0xff..ff).  If only SIZE if specified,
+   all memory in [0,SIZE) can be accessed.  If both are specified, all memory
+   in [START,START+SIZE) can be accessed.
 
    Note: If it becomes useful enough we can later add #:end as an alternative
    to #:size.  For now it is left out.
@@ -1047,7 +1111,7 @@  ioscm_reinit_memory_port (SCM port, size_t read_buf_size,
    The result is a Scheme port, and its semantics are a bit odd for accessing
    memory (e.g., unget), but we don't try to hide this.  It's a port.
 
-   N.B. Seeks on the port must be in the range [0,size).
+   N.B. Seeks on the port must be in the range [0,size].
    This is for similarity with bytevector ports, and so that one can seek
    to the first byte.  */
 
@@ -1076,19 +1140,8 @@  gdbscm_open_memory (SCM rest)
     mode = xstrdup ("r");
   scm_dynwind_free (mode);
 
-  if (start == ~(CORE_ADDR) 0)
-    {
-      gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, scm_from_int (-1),
-				 _("start address of 0xff..ff not allowed"));
-    }
-
   if (size_arg_pos > 0)
     {
-      if (size == 0)
-	{
-	  gdbscm_out_of_range_error (FUNC_NAME, 0, scm_from_int (0),
-				     "zero size");
-	}
       /* For now be strict about start+size overflowing.  If it becomes
 	 a nuisance we can relax things later.  */
       if (start + size < start)
@@ -1098,17 +1151,10 @@  gdbscm_open_memory (SCM rest)
 					    gdbscm_scm_from_ulongest (size)),
 				     _("start+size overflows"));
 	}
-      end = start + size - 1;
-      if (end == ~(CORE_ADDR) 0)
-	{
-	  gdbscm_out_of_range_error (FUNC_NAME, 0,
-				scm_list_2 (gdbscm_scm_from_ulongest (start),
-					    gdbscm_scm_from_ulongest (size)),
-				     _("end address of 0xff..ff not allowed"));
-	}
+      end = start + size;
     }
   else
-    end = (~(CORE_ADDR) 0) - 1;
+    end = ~(CORE_ADDR) 0;
 
   mode_bits = ioscm_parse_mode_bits (FUNC_NAME, mode);
 
@@ -1168,7 +1214,8 @@  gdbscm_memory_port_read_buffer_size (SCM port)
 }
 
 /* (set-memory-port-read-buffer-size! port size) -> unspecified
-   An exception is thrown if read data is still buffered.  */
+   An exception is thrown if read data is still buffered or if the port
+   is unbuffered.  */
 
 static SCM
 gdbscm_set_memory_port_read_buffer_size_x (SCM port, SCM size)
@@ -1209,7 +1256,8 @@  gdbscm_memory_port_write_buffer_size (SCM port)
 }
 
 /* (set-memory-port-write-buffer-size! port size) -> unspecified
-   An exception is thrown if write data is still buffered.  */
+   An exception is thrown if write data is still buffered or if the port
+   is unbuffered.  */
 
 static SCM
 gdbscm_set_memory_port_write_buffer_size_x (SCM port, SCM size)
diff --git a/gdb/testsuite/gdb.guile/scm-ports.c b/gdb/testsuite/gdb.guile/scm-ports.c
new file mode 100644
index 0000000..b92fefb
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-ports.c
@@ -0,0 +1,22 @@ 
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 2015 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-ports.exp b/gdb/testsuite/gdb.guile/scm-ports.exp
index 099f5e6..420f183 100644
--- a/gdb/testsuite/gdb.guile/scm-ports.exp
+++ b/gdb/testsuite/gdb.guile/scm-ports.exp
@@ -18,20 +18,150 @@ 
 
 load_lib gdb-guile.exp
 
-# Start with a fresh gdb.
-gdb_exit
-gdb_start
+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
+}
+
 gdb_reinitialize_dir $srcdir/$subdir
 
 gdb_install_guile_utils
 gdb_install_guile_module
 
+gdb_scm_test_silent_cmd "guile (use-modules (rnrs io ports) (rnrs bytevectors))" \
+    "import (rnrs io ports) (rnrs bytevectors)"
+
 gdb_test "guile (print (stdio-port? 42))" "= #f"
 gdb_test "guile (print (stdio-port? (%make-void-port \"r\")))" "= #f"
 gdb_test "guile (print (stdio-port? (input-port)))" "= #t"
 gdb_test "guile (print (stdio-port? (output-port)))" "= #t"
 gdb_test "guile (print (stdio-port? (error-port)))" "= #t"
+
+# Test memory port open/close.
+
+proc test_port { mode } {
+    with_test_prefix "basic $mode tests" {
+	gdb_test_no_output "guile (define my-port (open-memory #:mode \"$mode\"))" \
+	    "create memory port"
+	gdb_test "guile (print (memory-port? my-port))" "= #t"
+	switch -glob $mode {
+	    "r+*" {
+		gdb_test "guile (print (input-port? my-port))" "= #t"
+		gdb_test "guile (print (output-port? my-port))" "= #t"
+	    }
+	    "r*" {
+		gdb_test "guile (print (input-port? my-port))" "= #t"
+		gdb_test "guile (print (output-port? my-port))" "= #f"
+	    }
+	    "w*" {
+		gdb_test "guile (print (input-port? my-port))" "= #f"
+		gdb_test "guile (print (output-port? my-port))" "= #t"
+	    }
+	    default {
+		error "bad test mode"
+	    }
+	}
+	gdb_test "guile (print (port-closed? my-port))" "= #f" \
+	    "test port-closed? before it's closed"
+	gdb_test "guile (print (close-port my-port))" "= #t"
+	gdb_test "guile (print (port-closed? my-port))" "= #t" \
+	    "test port-closed? after it's closed"
+    }
+}
+
+set port_variations { r w r+ rb wb r+b r0 w0 r+0 }
+foreach variation $port_variations {
+    test_port $variation
+}
+
+# Test read/write of memory ports.
+
+proc test_mem_port_rw { kind } {
+    if { "$kind" == "buffered" } {
+	set buffered 1
+    } else {
+	set buffered 0
+    }
+    with_test_prefix $kind {
+	if $buffered {
+	    set mode "r+"
+	} else {
+	    set mode "r+0"
+	}
+	gdb_test_no_output "guile (define rw-mem-port (open-memory #:mode \"$mode\"))" \
+	    "create r/w memory port"
+	gdb_test "guile (print rw-mem-port)" \
+	    "#<input-output: gdb:memory-port 0x0-0xf+>"
+	gdb_test_no_output "guile (define sp-reg (parse-and-eval \"\$sp\"))" \
+	    "get sp reg"
+	# Note: Only use $sp_reg for gdb_test result matching, don't use it in
+	# gdb commands.  Otherwise transcript.N becomes unusable.
+	set sp_reg [get_integer_valueof "\$sp" 0]
+	gdb_test_no_output "guile (define byte-at-sp (parse-and-eval \"*(char*) \$sp\"))" \
+	    "save current value at sp"
+	# Pass the result of parse-and-eval through value-fetch-lazy!,
+	# otherwise the value gets left as a lazy reference to memory, which
+	# when re-evaluated after we flush the write will yield the newly
+	# written value.  PR 18175
+	gdb_test_no_output "guile (value-fetch-lazy! byte-at-sp)" \
+	    "un-lazyify byte-at-sp"
+	gdb_test "guile (print (seek rw-mem-port (value->integer sp-reg) SEEK_SET))" \
+	    "= $sp_reg" \
+	    "seek to \$sp"
+	gdb_test_no_output "guile (define old-value (value->integer byte-at-sp))" \
+	    "define old-value"
+	gdb_test_no_output "guile (define new-value (logxor old-value 1))" \
+	    "define new-value"
+	gdb_test "guile (print (put-bytevector rw-mem-port (make-bytevector 1 new-value)))" \
+	    "= #<unspecified>"
+	if $buffered {
+	    # Value shouldn't be in memory yet.
+	    gdb_test "guile (print (value=? (parse-and-eval \"*(char*) \$sp\") byte-at-sp))" \
+		"= #t" \
+		"test byte at sp, before flush"
+	    gdb_test_no_output "guile (force-output rw-mem-port)" \
+		"flush port"
+	}
+	# Value should be in memory now.
+	gdb_test "guile (print (value=? (parse-and-eval \"*(char*) \$sp\") byte-at-sp))" \
+	    "= #f" \
+	    "test byte at sp, after flush"
+	# Restore the value for cleanliness sake, and to verify close-port
+	# flushes the buffer.
+	gdb_test "guile (print (seek rw-mem-port (value->integer sp-reg) SEEK_SET))" \
+	    "= $sp_reg" \
+	    "seek to \$sp for restore"
+	gdb_test "guile (print (put-bytevector rw-mem-port (make-bytevector 1 old-value)))" \
+	    "= #<unspecified>"
+	gdb_test "guile (print (close-port rw-mem-port))" \
+	    "= #t"
+	gdb_test "guile (print (value=? (parse-and-eval \"*(char*) \$sp\") byte-at-sp))" \
+	    "= #t" \
+	    "test byte at sp, after close"
+    }
+}
+
+test_mem_port_rw buffered
+test_mem_port_rw unbuffered
+
+# Test zero-length memory ports.
+
+gdb_test_no_output "guile (define zero-mem-port (open-memory #:start 0 #:size 0 #:mode \"r+\"))" \
+    "create zero length memory port"
+gdb_test "guile (print (read-char zero-mem-port))" \
+    "= #<eof>"
+gdb_test "guile (print (write-char #\\a zero-mem-port))" \
+    "ERROR: .*Out of range: writing beyond end of memory range.*Error while executing Scheme code."
+gdb_test "guile (print (get-bytevector-n zero-mem-port 0))" \
+    "= #vu8\\(\\)"
+gdb_test "guile (print (put-bytevector zero-mem-port (make-bytevector 0)))" \
+    "= #<unspecified>"
+gdb_test "guile (print (close-port zero-mem-port))" "= #t"