From: "Ludovic Courtès" <ludo@gnu.org>
To: gdb-patches@sourceware.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [PATCH 1/2] guile: Add support for Guile 2.2.
Date: Fri, 12 Jun 2020 15:27:09 +0200 [thread overview]
Message-ID: <20200612132710.14364-2-ludo@gnu.org> (raw)
In-Reply-To: <20200612132710.14364-1-ludo@gnu.org>
This primarily updates code that uses the I/O port API of Guile.
gdb/ChangeLog:
* 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 *'.
(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.
(ioscm_init_memory_port): Wrap buffer-related code in #if
USING_GUILE_BEFORE_2_2.
(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.
* testsuite/gdb.guile/scm-ports.exp (test_mem_port_rw): Pass
"r0+" instead of "r+" to 'open-memory' so make it explicitly
unbuffered (it's buffered by default on 2.2/3.0).
* configure.ac (try_guile_versions): Add "guile-2.2".
* configure: Regenerate.
* doc/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/configure | 2 +-
gdb/configure.ac | 2 +-
gdb/doc/guile.texi | 23 +-
gdb/guile/scm-ports.c | 545 ++++++++++++++++++--------
gdb/testsuite/gdb.guile/scm-error.exp | 2 +-
gdb/testsuite/gdb.guile/scm-ports.exp | 2 +-
6 files changed, 394 insertions(+), 182 deletions(-)
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..5c39cc1ddf 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,7 +115,11 @@ 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";
@@ -131,6 +148,8 @@ static SCM size_keyword;
/* Helper to do the low level work of opening a port.
Newer versions of Guile (2.1.x) have scm_c_make_port. */
+#if USING_GUILE_BEFORE_2_2
+
static SCM
ioscm_open_port (scm_t_bits port_type, long mode_bits)
{
@@ -150,9 +169,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)
+{
+ return scm_c_make_port (port_type, mode_bits, 0);
+}
+
+#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 +294,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 +334,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 +399,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 +426,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 +459,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
@@ -403,9 +517,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 +687,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 +782,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 +874,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 +972,166 @@ 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 */
+
+/* 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);
+ CORE_ADDR result;
+ int rc;
+
+ rc = ioscm_lseek_address (iomem, offset, whence);
+ result = iomem->current;
+
+ 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 result;
+}
+
+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 +1143,20 @@ 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);
+#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);
}
@@ -930,9 +1205,7 @@ ioscm_parse_mode_bits (const char *func_name, const char *mode)
static void
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);
@@ -943,6 +1216,9 @@ ioscm_init_memory_port (SCM port, CORE_ADDR start, CORE_ADDR end)
iomem->end = end;
iomem->size = end - start;
iomem->current = 0;
+
+#if USING_GUILE_BEFORE_2_2
+ int buffered = (SCM_CELL_WORD_0 (port) & SCM_BUF0) == 0;
if (buffered)
{
iomem->read_buf_size = default_read_buf_size;
@@ -954,7 +1230,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 +1249,11 @@ 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;
+#endif
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;
- }
-}
/* (open-memory [#:mode string] [#:start address] [#:size integer]) -> port
Return a port that can be used for reading and writing memory.
@@ -1124,7 +1337,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 +1372,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 +1380,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 +1392,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 +1412,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 +1422,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 +1430,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 +1442,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 +1462,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. */
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"
diff --git a/gdb/testsuite/gdb.guile/scm-ports.exp b/gdb/testsuite/gdb.guile/scm-ports.exp
index b2835ddc75..47da3d43d3 100644
--- a/gdb/testsuite/gdb.guile/scm-ports.exp
+++ b/gdb/testsuite/gdb.guile/scm-ports.exp
@@ -154,7 +154,7 @@ 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+\"))" \
+gdb_test_no_output "guile (define zero-mem-port (open-memory #:start 0 #:size 0 #:mode \"r0+\"))" \
"create zero length memory port"
gdb_test "guile (print (read-char zero-mem-port))" \
"= #<eof>"
--
2.26.2
next prev parent reply other threads:[~2020-06-12 13:27 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 ` Ludovic Courtès [this message]
2020-06-12 13:50 ` [PATCH 1/2] guile: Add support for Guile 2.2 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 ` [PATCH v2 1/2] guile: Add support for Guile 2.2 Ludovic Courtès
2020-06-15 17:00 ` 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=20200612132710.14364-2-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=gdb-patches@sourceware.org \
/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).