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.
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;
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. */
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;
}
{
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. */
_("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. */
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
{
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;
{
switch (*p)
{
+ case '0':
case 'b':
case '+':
break;
}
/* 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
{
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;
}
/* 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
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)
/* (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.
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. */
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)
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);
}
/* (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)
}
/* (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)
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"