1 /* Support for connecting Guile's stdio to GDB's.
2 as well as r/w memory via ports.
4 Copyright (C) 2014-2019 Free Software Foundation, Inc.
6 This file is part of GDB.
8 This program is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3 of the License, or
11 (at your option) any later version.
13 This program is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program. If not, see <http://www.gnu.org/licenses/>. */
21 /* See README file in this directory for implementation notes, coding
22 conventions, et.al. */
25 #include "gdb_select.h"
28 #include "guile-internal.h"
29 #include "common/gdb_optional.h"
32 #if defined (HAVE_POLL_H)
34 #elif defined (HAVE_SYS_POLL_H)
39 /* A ui-file for sending output to Guile. */
41 class ioscm_file_port : public ui_file
44 /* Return a ui_file that writes to PORT. */
45 explicit ioscm_file_port (SCM port);
47 void flush () override;
48 void write (const char *buf, long length_buf) override;
54 /* Data for a memory port. */
58 /* Bounds of memory range this port is allowed to access: [start, end).
59 This means that 0xff..ff is not accessible. I can live with that. */
62 /* (end - start), recorded for convenience. */
65 /* Think of this as the lseek value maintained by the kernel.
66 This value is always in the range [0, size]. */
69 /* The size of the internal r/w buffers.
70 Scheme ports aren't a straightforward mapping to memory r/w.
71 Generally the user specifies how much to r/w and all access is
72 unbuffered. We don't try to provide equivalent access, but we allow
73 the user to specify these values to help get something similar. */
74 unsigned read_buf_size, write_buf_size;
77 /* Copies of the original system input/output/error ports.
78 These are recorded for debugging purposes. */
79 static SCM orig_input_port_scm;
80 static SCM orig_output_port_scm;
81 static SCM orig_error_port_scm;
83 /* This is the stdio port descriptor, scm_ptob_descriptor. */
84 static scm_t_bits stdio_port_desc;
86 /* Note: scm_make_port_type takes a char * instead of a const char *. */
87 static /*const*/ char stdio_port_desc_name[] = "gdb:stdio-port";
89 /* Names of each gdb port. */
90 static const char input_port_name[] = "gdb:stdin";
91 static const char output_port_name[] = "gdb:stdout";
92 static const char error_port_name[] = "gdb:stderr";
94 /* This is the actual port used from Guile.
95 We don't expose these to the user though, to ensure they're not
97 static SCM input_port_scm;
98 static SCM output_port_scm;
99 static SCM error_port_scm;
101 /* Internal enum for specifying output port. */
102 enum oport { GDB_STDOUT, GDB_STDERR };
104 /* This is the memory port descriptor, scm_ptob_descriptor. */
105 static scm_t_bits memory_port_desc;
107 /* Note: scm_make_port_type takes a char * instead of a const char *. */
108 static /*const*/ char memory_port_desc_name[] = "gdb:memory-port";
110 /* The default amount of memory to fetch for each read/write request.
111 Scheme ports don't provide a way to specify the size of a read,
112 which is important to us to minimize the number of inferior interactions,
113 which over a remote link can be important. To compensate we augment the
114 port API with a new function that let's the user specify how much the next
115 read request should fetch. This is the initial value for each new port. */
116 static const unsigned default_read_buf_size = 16;
117 static const unsigned default_write_buf_size = 16;
119 /* Arbitrarily limit memory port buffers to 1 byte to 4K. */
120 static const unsigned min_memory_port_buf_size = 1;
121 static const unsigned max_memory_port_buf_size = 4096;
123 /* "out of range" error message for buf sizes. */
124 static char *out_of_range_buf_size;
126 /* Keywords used by open-memory. */
127 static SCM mode_keyword;
128 static SCM start_keyword;
129 static SCM size_keyword;
131 /* Helper to do the low level work of opening a port.
132 Newer versions of Guile (2.1.x) have scm_c_make_port. */
135 ioscm_open_port (scm_t_bits port_type, long mode_bits)
139 #if 0 /* TODO: Guile doesn't export this. What to do? */
140 scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
143 port = scm_new_port_table_entry (port_type);
145 SCM_SET_CELL_TYPE (port, port_type | mode_bits);
147 #if 0 /* TODO: Guile doesn't export this. What to do? */
148 scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
154 /* Support for connecting Guile's stdio ports to GDB's stdio ports. */
156 /* The scm_t_ptob_descriptor.input_waiting "method".
157 Return a lower bound on the number of bytes available for input. */
160 ioscm_input_waiting (SCM port)
164 if (! scm_is_eq (port, input_port_scm))
169 /* This is copied from libguile/fports.c. */
170 struct pollfd pollfd = { fdes, POLLIN, 0 };
171 static int use_poll = -1;
175 /* This is copied from event-loop.c: poll cannot be used for stdin on
176 m68k-motorola-sysv. */
177 struct pollfd test_pollfd = { fdes, POLLIN, 0 };
179 if (poll (&test_pollfd, 1, 0) == 1 && (test_pollfd.revents & POLLNVAL))
187 /* Guile doesn't export SIGINT hooks like Python does.
188 For now pass EINTR to scm_syserror, that's what fports.c does. */
189 if (poll (&pollfd, 1, 0) < 0)
190 scm_syserror (FUNC_NAME);
192 return pollfd.revents & POLLIN ? 1 : 0;
199 struct timeval timeout;
201 int num_fds = fdes + 1;
204 memset (&timeout, 0, sizeof (timeout));
205 FD_ZERO (&input_fds);
206 FD_SET (fdes, &input_fds);
208 num_found = interruptible_select (num_fds,
209 &input_fds, NULL, NULL,
213 /* Guile doesn't export SIGINT hooks like Python does.
214 For now pass EINTR to scm_syserror, that's what fports.c does. */
215 scm_syserror (FUNC_NAME);
217 return num_found > 0 && FD_ISSET (fdes, &input_fds);
221 /* The scm_t_ptob_descriptor.fill_input "method". */
224 ioscm_fill_input (SCM port)
226 /* Borrowed from libguile/fports.c. */
228 scm_t_port *pt = SCM_PTAB_ENTRY (port);
230 /* If we're called on stdout,stderr, punt. */
231 if (! scm_is_eq (port, input_port_scm))
232 return (scm_t_wchar) EOF; /* Set errno and return -1? */
234 gdb_flush (gdb_stdout);
235 gdb_flush (gdb_stderr);
237 count = ui_file_read (gdb_stdin, (char *) pt->read_buf, pt->read_buf_size);
239 scm_syserror (FUNC_NAME);
241 return (scm_t_wchar) EOF;
243 pt->read_pos = pt->read_buf;
244 pt->read_end = pt->read_buf + count;
245 return *pt->read_buf;
248 /* Like fputstrn_filtered, but don't escape characters, except nul.
249 Also like fputs_filtered, but a length is specified. */
252 fputsn_filtered (const char *s, size_t size, struct ui_file *stream)
256 for (i = 0; i < size; ++i)
259 fputs_filtered ("\\000", stream);
261 fputc_filtered (s[i], stream);
265 /* Write to gdb's stdout or stderr. */
268 ioscm_write (SCM port, const void *data, size_t size)
271 /* If we're called on stdin, punt. */
272 if (scm_is_eq (port, input_port_scm))
277 if (scm_is_eq (port, error_port_scm))
278 fputsn_filtered ((const char *) data, size, gdb_stderr);
280 fputsn_filtered ((const char *) data, size, gdb_stdout);
282 catch (const gdb_exception &except)
284 GDBSCM_HANDLE_GDB_EXCEPTION (except);
288 /* Flush gdb's stdout or stderr. */
291 ioscm_flush (SCM port)
293 /* If we're called on stdin, punt. */
294 if (scm_is_eq (port, input_port_scm))
297 if (scm_is_eq (port, error_port_scm))
298 gdb_flush (gdb_stderr);
300 gdb_flush (gdb_stdout);
303 /* Initialize the gdb stdio port type.
305 N.B. isatty? will fail on these ports, it is only supported for file
306 ports. IWBN if we could "subclass" file ports. */
309 ioscm_init_gdb_stdio_port (void)
311 stdio_port_desc = scm_make_port_type (stdio_port_desc_name,
312 ioscm_fill_input, ioscm_write);
314 scm_set_port_input_waiting (stdio_port_desc, ioscm_input_waiting);
315 scm_set_port_flush (stdio_port_desc, ioscm_flush);
318 /* Subroutine of ioscm_make_gdb_stdio_port to simplify it.
319 Set up the buffers of port PORT.
320 MODE_BITS are the mode bits of PORT. */
323 ioscm_init_stdio_buffers (SCM port, long mode_bits)
325 scm_t_port *pt = SCM_PTAB_ENTRY (port);
326 #define GDB_STDIO_BUFFER_DEFAULT_SIZE 1024
327 int size = mode_bits & SCM_BUF0 ? 0 : GDB_STDIO_BUFFER_DEFAULT_SIZE;
328 int writing = (mode_bits & SCM_WRTNG) != 0;
330 /* This is heavily copied from scm_fport_buffer_add. */
332 if (!writing && size > 0)
335 = (unsigned char *) scm_gc_malloc_pointerless (size, "port buffer");
336 pt->read_pos = pt->read_end = pt->read_buf;
337 pt->read_buf_size = size;
341 pt->read_pos = pt->read_buf = pt->read_end = &pt->shortbuf;
342 pt->read_buf_size = 1;
345 if (writing && size > 0)
348 = (unsigned char *) scm_gc_malloc_pointerless (size, "port buffer");
349 pt->write_pos = pt->write_buf;
350 pt->write_buf_size = size;
354 pt->write_buf = pt->write_pos = &pt->shortbuf;
355 pt->write_buf_size = 1;
357 pt->write_end = pt->write_buf + pt->write_buf_size;
360 /* Create a gdb stdio port. */
363 ioscm_make_gdb_stdio_port (int fd)
365 int is_a_tty = isatty (fd);
367 const char *mode_str;
374 name = input_port_name;
375 mode_str = is_a_tty ? "r0" : "r";
378 name = output_port_name;
379 mode_str = is_a_tty ? "w0" : "w";
382 name = error_port_name;
383 mode_str = is_a_tty ? "w0" : "w";
386 gdb_assert_not_reached ("bad stdio file descriptor");
389 mode_bits = scm_mode_bits ((char *) mode_str);
390 port = ioscm_open_port (stdio_port_desc, mode_bits);
392 scm_set_port_filename_x (port, gdbscm_scm_from_c_string (name));
394 ioscm_init_stdio_buffers (port, mode_bits);
399 /* (stdio-port? object) -> boolean */
402 gdbscm_stdio_port_p (SCM scm)
404 /* This is copied from SCM_FPORTP. */
405 return scm_from_bool (!SCM_IMP (scm)
406 && (SCM_TYP16 (scm) == stdio_port_desc));
409 /* GDB's ports are accessed via functions to keep them read-only. */
411 /* (input-port) -> port */
414 gdbscm_input_port (void)
416 return input_port_scm;
419 /* (output-port) -> port */
422 gdbscm_output_port (void)
424 return output_port_scm;
427 /* (error-port) -> port */
430 gdbscm_error_port (void)
432 return error_port_scm;
435 /* Support for sending GDB I/O to Guile ports. */
437 ioscm_file_port::ioscm_file_port (SCM port)
442 ioscm_file_port::flush ()
447 ioscm_file_port::write (const char *buffer, long length_buffer)
449 scm_c_write (m_port, buffer, length_buffer);
453 /* Helper routine for with-{output,error}-to-port. */
456 ioscm_with_output_to_port_worker (SCM port, SCM thunk, enum oport oport,
457 const char *func_name)
461 SCM_ASSERT_TYPE (gdbscm_is_true (scm_output_port_p (port)), port,
462 SCM_ARG1, func_name, _("output port"));
463 SCM_ASSERT_TYPE (gdbscm_is_true (scm_thunk_p (thunk)), thunk,
464 SCM_ARG2, func_name, _("thunk"));
466 set_batch_flag_and_restore_page_info save_page_info;
468 scoped_restore restore_async = make_scoped_restore (¤t_ui->async, 0);
470 ui_file_up port_file (new ioscm_file_port (port));
472 scoped_restore save_file = make_scoped_restore (oport == GDB_STDERR
473 ? &gdb_stderr : &gdb_stdout);
476 gdb::optional<ui_out_redirect_pop> redirect_popper;
477 if (oport == GDB_STDERR)
478 gdb_stderr = port_file.get ();
481 current_uiout->redirect (port_file.get ());
482 redirect_popper.emplace (current_uiout);
484 gdb_stdout = port_file.get ();
487 result = gdbscm_safe_call_0 (thunk, NULL);
490 if (gdbscm_is_exception (result))
491 gdbscm_throw (result);
496 /* (%with-gdb-output-to-port port thunk) -> object
497 This function is experimental.
498 IWBN to not include "gdb" in the name, but it would collide with a standard
499 procedure, and it's common to import the gdb module without a prefix.
500 There are ways around this, but they're more cumbersome.
502 This has % in the name because it's experimental, and we want the
503 user-visible version to come from module (gdb experimental). */
506 gdbscm_percent_with_gdb_output_to_port (SCM port, SCM thunk)
508 return ioscm_with_output_to_port_worker (port, thunk, GDB_STDOUT, FUNC_NAME);
511 /* (%with-gdb-error-to-port port thunk) -> object
512 This function is experimental.
513 IWBN to not include "gdb" in the name, but it would collide with a standard
514 procedure, and it's common to import the gdb module without a prefix.
515 There are ways around this, but they're more cumbersome.
517 This has % in the name because it's experimental, and we want the
518 user-visible version to come from module (gdb experimental). */
521 gdbscm_percent_with_gdb_error_to_port (SCM port, SCM thunk)
523 return ioscm_with_output_to_port_worker (port, thunk, GDB_STDERR, FUNC_NAME);
526 /* Support for r/w memory via ports. */
528 /* Perform an "lseek" to OFFSET,WHENCE on memory port IOMEM.
529 OFFSET must be in the range [0,size].
530 The result is non-zero for success, zero for failure. */
533 ioscm_lseek_address (ioscm_memory_port *iomem, LONGEST offset, int whence)
535 CORE_ADDR new_current;
537 gdb_assert (iomem->current <= iomem->size);
542 /* Catch over/underflow. */
543 if ((offset < 0 && iomem->current + offset > iomem->current)
544 || (offset > 0 && iomem->current + offset < iomem->current))
546 new_current = iomem->current + offset;
549 new_current = offset;
554 new_current = iomem->size;
557 /* TODO: Not supported yet. */
563 if (new_current > iomem->size)
565 iomem->current = new_current;
569 /* "fill_input" method for memory ports. */
572 gdbscm_memory_port_fill_input (SCM port)
574 scm_t_port *pt = SCM_PTAB_ENTRY (port);
575 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
578 /* "current" is the offset of the first byte we want to read. */
579 gdb_assert (iomem->current <= iomem->size);
580 if (iomem->current == iomem->size)
583 /* Don't read outside the allowed memory range. */
584 to_read = pt->read_buf_size;
585 if (to_read > iomem->size - iomem->current)
586 to_read = iomem->size - iomem->current;
588 if (target_read_memory (iomem->start + iomem->current, pt->read_buf,
590 gdbscm_memory_error (FUNC_NAME, _("error reading memory"), SCM_EOL);
592 iomem->current += to_read;
593 pt->read_pos = pt->read_buf;
594 pt->read_end = pt->read_buf + to_read;
595 return *pt->read_buf;
598 /* "end_input" method for memory ports.
599 Clear the read buffer and adjust the file position for unread bytes. */
602 gdbscm_memory_port_end_input (SCM port, int offset)
604 scm_t_port *pt = SCM_PTAB_ENTRY (port);
605 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
606 size_t remaining = pt->read_end - pt->read_pos;
608 /* Note: Use of "int offset" is specified by Guile ports API. */
609 if ((offset < 0 && remaining + offset > remaining)
610 || (offset > 0 && remaining + offset < remaining))
612 gdbscm_out_of_range_error (FUNC_NAME, 0, scm_from_int (offset),
613 _("overflow in offset calculation"));
619 pt->read_pos = pt->read_end;
620 /* Throw error if unread-char used at beginning of file
621 then attempting to write. Seems correct. */
622 if (!ioscm_lseek_address (iomem, -offset, SEEK_CUR))
624 gdbscm_out_of_range_error (FUNC_NAME, 0, scm_from_int (offset),
629 pt->rw_active = SCM_PORT_NEITHER;
632 /* "flush" method for memory ports. */
635 gdbscm_memory_port_flush (SCM port)
637 scm_t_port *pt = SCM_PTAB_ENTRY (port);
638 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
639 size_t to_write = pt->write_pos - pt->write_buf;
644 /* There's no way to indicate a short write, so if the request goes past
645 the end of the port's memory range, flag an error. */
646 if (to_write > iomem->size - iomem->current)
648 gdbscm_out_of_range_error (FUNC_NAME, 0,
649 gdbscm_scm_from_ulongest (to_write),
650 _("writing beyond end of memory range"));
653 if (target_write_memory (iomem->start + iomem->current, pt->write_buf,
655 gdbscm_memory_error (FUNC_NAME, _("error writing memory"), SCM_EOL);
657 iomem->current += to_write;
658 pt->write_pos = pt->write_buf;
659 pt->rw_active = SCM_PORT_NEITHER;
662 /* "write" method for memory ports. */
665 gdbscm_memory_port_write (SCM port, const void *void_data, size_t size)
667 scm_t_port *pt = SCM_PTAB_ENTRY (port);
668 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
669 const gdb_byte *data = (const gdb_byte *) void_data;
671 /* There's no way to indicate a short write, so if the request goes past
672 the end of the port's memory range, flag an error. */
673 if (size > iomem->size - iomem->current)
675 gdbscm_out_of_range_error (FUNC_NAME, 0, gdbscm_scm_from_ulongest (size),
676 _("writing beyond end of memory range"));
679 if (pt->write_buf == &pt->shortbuf)
681 /* Unbuffered port. */
682 if (target_write_memory (iomem->start + iomem->current, data, size) != 0)
683 gdbscm_memory_error (FUNC_NAME, _("error writing memory"), SCM_EOL);
684 iomem->current += size;
688 /* Note: The edge case of what to do when the buffer exactly fills is
689 debatable. Guile flushes when the buffer exactly fills up, so we
690 do too. It's counter-intuitive to my mind, but in case there's a
691 subtlety somewhere that depends on this, we do the same. */
694 size_t space = pt->write_end - pt->write_pos;
698 /* Data fits in buffer, and does not fill it. */
699 memcpy (pt->write_pos, data, size);
700 pt->write_pos += size;
704 memcpy (pt->write_pos, data, space);
705 pt->write_pos = pt->write_end;
706 gdbscm_memory_port_flush (port);
708 const gdb_byte *ptr = data + space;
709 size_t remaining = size - space;
711 if (remaining >= pt->write_buf_size)
713 if (target_write_memory (iomem->start + iomem->current, ptr,
715 gdbscm_memory_error (FUNC_NAME, _("error writing memory"),
717 iomem->current += remaining;
721 memcpy (pt->write_pos, ptr, remaining);
722 pt->write_pos += remaining;
729 /* "seek" method for memory ports. */
732 gdbscm_memory_port_seek (SCM port, scm_t_off offset, int whence)
734 scm_t_port *pt = SCM_PTAB_ENTRY (port);
735 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
739 if (pt->rw_active == SCM_PORT_WRITE)
741 if (offset != 0 || whence != SEEK_CUR)
743 gdbscm_memory_port_flush (port);
744 rc = ioscm_lseek_address (iomem, offset, whence);
745 result = iomem->current;
749 /* Read current position without disturbing the buffer,
750 but flag an error if what's in the buffer goes outside the
752 CORE_ADDR current = iomem->current;
753 size_t delta = pt->write_pos - pt->write_buf;
755 if (current + delta < current
756 || current + delta > iomem->size)
760 result = current + delta;
765 else if (pt->rw_active == SCM_PORT_READ)
767 if (offset != 0 || whence != SEEK_CUR)
769 scm_end_input (port);
770 rc = ioscm_lseek_address (iomem, offset, whence);
771 result = iomem->current;
775 /* Read current position without disturbing the buffer
776 (particularly the unread-char buffer). */
777 CORE_ADDR current = iomem->current;
778 size_t remaining = pt->read_end - pt->read_pos;
780 if (current - remaining > current
781 || current - remaining < iomem->start)
785 result = current - remaining;
789 if (rc != 0 && pt->read_buf == pt->putback_buf)
791 size_t saved_remaining = pt->saved_read_end - pt->saved_read_pos;
793 if (result - saved_remaining > result
794 || result - saved_remaining < iomem->start)
797 result -= saved_remaining;
801 else /* SCM_PORT_NEITHER */
803 rc = ioscm_lseek_address (iomem, offset, whence);
804 result = iomem->current;
809 gdbscm_out_of_range_error (FUNC_NAME, 0,
810 gdbscm_scm_from_longest (offset),
814 /* TODO: The Guile API doesn't support 32x64. We can't fix that here,
815 and there's no need to throw an error if the new address can't be
816 represented in a scm_t_off. But we could return something less
821 /* "close" method for memory ports. */
824 gdbscm_memory_port_close (SCM port)
826 scm_t_port *pt = SCM_PTAB_ENTRY (port);
827 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
829 gdbscm_memory_port_flush (port);
831 if (pt->read_buf == pt->putback_buf)
832 pt->read_buf = pt->saved_read_buf;
833 if (pt->read_buf != &pt->shortbuf)
834 xfree (pt->read_buf);
835 if (pt->write_buf != &pt->shortbuf)
836 xfree (pt->write_buf);
837 scm_gc_free (iomem, sizeof (*iomem), "memory port");
842 /* "free" method for memory ports. */
845 gdbscm_memory_port_free (SCM port)
847 gdbscm_memory_port_close (port);
852 /* "print" method for memory ports. */
855 gdbscm_memory_port_print (SCM exp, SCM port, scm_print_state *pstate)
857 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (exp);
858 char *type = SCM_PTOBNAME (SCM_PTOBNUM (exp));
860 scm_puts ("#<", port);
861 scm_print_port_mode (exp, port);
862 /* scm_print_port_mode includes a trailing space. */
863 gdbscm_printf (port, "%s %s-%s", type,
864 hex_string (iomem->start), hex_string (iomem->end));
865 scm_putc ('>', port);
869 /* Create the port type used for memory. */
872 ioscm_init_memory_port_type (void)
874 memory_port_desc = scm_make_port_type (memory_port_desc_name,
875 gdbscm_memory_port_fill_input,
876 gdbscm_memory_port_write);
878 scm_set_port_end_input (memory_port_desc, gdbscm_memory_port_end_input);
879 scm_set_port_flush (memory_port_desc, gdbscm_memory_port_flush);
880 scm_set_port_seek (memory_port_desc, gdbscm_memory_port_seek);
881 scm_set_port_close (memory_port_desc, gdbscm_memory_port_close);
882 scm_set_port_free (memory_port_desc, gdbscm_memory_port_free);
883 scm_set_port_print (memory_port_desc, gdbscm_memory_port_print);
886 /* Helper for gdbscm_open_memory to parse the mode bits.
887 An exception is thrown if MODE is invalid. */
890 ioscm_parse_mode_bits (const char *func_name, const char *mode)
895 if (*mode != 'r' && *mode != 'w')
897 gdbscm_out_of_range_error (func_name, 0,
898 gdbscm_scm_from_c_string (mode),
899 _("bad mode string"));
901 for (p = mode + 1; *p != '\0'; ++p)
910 gdbscm_out_of_range_error (func_name, 0,
911 gdbscm_scm_from_c_string (mode),
912 _("bad mode string"));
916 /* Kinda awkward to convert the mode from SCM -> string only to have Guile
917 convert it back to SCM, but that's the API we have to work with. */
918 mode_bits = scm_mode_bits ((char *) mode);
923 /* Helper for gdbscm_open_memory to finish initializing the port.
924 The port has address range [start,end).
925 This means that address of 0xff..ff is not accessible.
926 I can live with that. */
929 ioscm_init_memory_port (SCM port, CORE_ADDR start, CORE_ADDR end)
932 ioscm_memory_port *iomem;
933 int buffered = (SCM_CELL_WORD_0 (port) & SCM_BUF0) == 0;
935 gdb_assert (start <= end);
937 iomem = (ioscm_memory_port *) scm_gc_malloc_pointerless (sizeof (*iomem),
940 iomem->start = start;
942 iomem->size = end - start;
946 iomem->read_buf_size = default_read_buf_size;
947 iomem->write_buf_size = default_write_buf_size;
951 iomem->read_buf_size = 1;
952 iomem->write_buf_size = 1;
955 pt = SCM_PTAB_ENTRY (port);
956 /* Match the expectation of `binary-port?'. */
959 pt->read_buf_size = iomem->read_buf_size;
960 pt->write_buf_size = iomem->write_buf_size;
963 pt->read_buf = (unsigned char *) xmalloc (pt->read_buf_size);
964 pt->write_buf = (unsigned char *) xmalloc (pt->write_buf_size);
968 pt->read_buf = &pt->shortbuf;
969 pt->write_buf = &pt->shortbuf;
971 pt->read_pos = pt->read_end = pt->read_buf;
972 pt->write_pos = pt->write_buf;
973 pt->write_end = pt->write_buf + pt->write_buf_size;
975 SCM_SETSTREAM (port, iomem);
978 /* Re-initialize a memory port, updating its read/write buffer sizes.
979 An exception is thrown if the port is unbuffered.
980 TODO: Allow switching buffered/unbuffered.
981 An exception is also thrown if data is still buffered, except in the case
982 where the buffer size isn't changing (since that's just a nop). */
985 ioscm_reinit_memory_port (SCM port, size_t read_buf_size,
986 size_t write_buf_size, const char *func_name)
988 scm_t_port *pt = SCM_PTAB_ENTRY (port);
989 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
991 gdb_assert (read_buf_size >= min_memory_port_buf_size
992 && read_buf_size <= max_memory_port_buf_size);
993 gdb_assert (write_buf_size >= min_memory_port_buf_size
994 && write_buf_size <= max_memory_port_buf_size);
996 /* First check if the port is unbuffered. */
998 if (pt->read_buf == &pt->shortbuf)
1000 gdb_assert (pt->write_buf == &pt->shortbuf);
1001 scm_misc_error (func_name, _("port is unbuffered: ~a"),
1005 /* Next check if anything is buffered. */
1007 if (read_buf_size != pt->read_buf_size
1008 && pt->read_end != pt->read_buf)
1010 scm_misc_error (func_name, _("read buffer not empty: ~a"),
1014 if (write_buf_size != pt->write_buf_size
1015 && pt->write_pos != pt->write_buf)
1017 scm_misc_error (func_name, _("write buffer not empty: ~a"),
1021 /* Now we can update the buffer sizes, but only if the size has changed. */
1023 if (read_buf_size != pt->read_buf_size)
1025 iomem->read_buf_size = read_buf_size;
1026 pt->read_buf_size = read_buf_size;
1027 xfree (pt->read_buf);
1028 pt->read_buf = (unsigned char *) xmalloc (pt->read_buf_size);
1029 pt->read_pos = pt->read_end = pt->read_buf;
1032 if (write_buf_size != pt->write_buf_size)
1034 iomem->write_buf_size = write_buf_size;
1035 pt->write_buf_size = write_buf_size;
1036 xfree (pt->write_buf);
1037 pt->write_buf = (unsigned char *) xmalloc (pt->write_buf_size);
1038 pt->write_pos = pt->write_buf;
1039 pt->write_end = pt->write_buf + pt->write_buf_size;
1043 /* (open-memory [#:mode string] [#:start address] [#:size integer]) -> port
1044 Return a port that can be used for reading and writing memory.
1045 MODE is a string, and must be one of "r", "w", or "r+".
1046 "0" may be appended to MODE to mark the port as unbuffered.
1047 For compatibility "b" (binary) may also be appended, but we ignore it:
1048 memory ports are binary only.
1050 The chunk of memory that can be accessed can be bounded.
1051 If both START,SIZE are unspecified, all of memory can be accessed
1052 (except 0xff..ff). If only START is specified, all of memory from that
1053 point on can be accessed (except 0xff..ff). If only SIZE if specified,
1054 all memory in [0,SIZE) can be accessed. If both are specified, all memory
1055 in [START,START+SIZE) can be accessed.
1057 Note: If it becomes useful enough we can later add #:end as an alternative
1058 to #:size. For now it is left out.
1060 The result is a Scheme port, and its semantics are a bit odd for accessing
1061 memory (e.g., unget), but we don't try to hide this. It's a port.
1063 N.B. Seeks on the port must be in the range [0,size].
1064 This is for similarity with bytevector ports, and so that one can seek
1065 to the first byte. */
1068 gdbscm_open_memory (SCM rest)
1070 const SCM keywords[] = {
1071 mode_keyword, start_keyword, size_keyword, SCM_BOOL_F
1074 CORE_ADDR start = 0;
1076 int mode_arg_pos = -1, start_arg_pos = -1, size_arg_pos = -1;
1081 gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "#sUU", rest,
1082 &mode_arg_pos, &mode,
1083 &start_arg_pos, &start,
1084 &size_arg_pos, &size);
1086 scm_dynwind_begin ((scm_t_dynwind_flags) 0);
1089 mode = xstrdup ("r");
1090 scm_dynwind_free (mode);
1092 if (size_arg_pos > 0)
1094 /* For now be strict about start+size overflowing. If it becomes
1095 a nuisance we can relax things later. */
1096 if (start + size < start)
1098 gdbscm_out_of_range_error (FUNC_NAME, 0,
1099 scm_list_2 (gdbscm_scm_from_ulongest (start),
1100 gdbscm_scm_from_ulongest (size)),
1101 _("start+size overflows"));
1106 end = ~(CORE_ADDR) 0;
1108 mode_bits = ioscm_parse_mode_bits (FUNC_NAME, mode);
1110 port = ioscm_open_port (memory_port_desc, mode_bits);
1112 ioscm_init_memory_port (port, start, end);
1116 /* TODO: Set the file name as "memory-start-end"? */
1120 /* Return non-zero if OBJ is a memory port. */
1123 gdbscm_is_memory_port (SCM obj)
1125 return !SCM_IMP (obj) && (SCM_TYP16 (obj) == memory_port_desc);
1128 /* (memory-port? obj) -> boolean */
1131 gdbscm_memory_port_p (SCM obj)
1133 return scm_from_bool (gdbscm_is_memory_port (obj));
1136 /* (memory-port-range port) -> (start end) */
1139 gdbscm_memory_port_range (SCM port)
1141 ioscm_memory_port *iomem;
1143 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME,
1144 memory_port_desc_name);
1146 iomem = (ioscm_memory_port *) SCM_STREAM (port);
1147 return scm_list_2 (gdbscm_scm_from_ulongest (iomem->start),
1148 gdbscm_scm_from_ulongest (iomem->end));
1151 /* (memory-port-read-buffer-size port) -> integer */
1154 gdbscm_memory_port_read_buffer_size (SCM port)
1156 ioscm_memory_port *iomem;
1158 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME,
1159 memory_port_desc_name);
1161 iomem = (ioscm_memory_port *) SCM_STREAM (port);
1162 return scm_from_uint (iomem->read_buf_size);
1165 /* (set-memory-port-read-buffer-size! port size) -> unspecified
1166 An exception is thrown if read data is still buffered or if the port
1170 gdbscm_set_memory_port_read_buffer_size_x (SCM port, SCM size)
1172 ioscm_memory_port *iomem;
1174 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME,
1175 memory_port_desc_name);
1176 SCM_ASSERT_TYPE (scm_is_integer (size), size, SCM_ARG2, FUNC_NAME,
1179 if (!scm_is_unsigned_integer (size, min_memory_port_buf_size,
1180 max_memory_port_buf_size))
1182 gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, size,
1183 out_of_range_buf_size);
1186 iomem = (ioscm_memory_port *) SCM_STREAM (port);
1187 ioscm_reinit_memory_port (port, scm_to_uint (size), iomem->write_buf_size,
1190 return SCM_UNSPECIFIED;
1193 /* (memory-port-write-buffer-size port) -> integer */
1196 gdbscm_memory_port_write_buffer_size (SCM port)
1198 ioscm_memory_port *iomem;
1200 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME,
1201 memory_port_desc_name);
1203 iomem = (ioscm_memory_port *) SCM_STREAM (port);
1204 return scm_from_uint (iomem->write_buf_size);
1207 /* (set-memory-port-write-buffer-size! port size) -> unspecified
1208 An exception is thrown if write data is still buffered or if the port
1212 gdbscm_set_memory_port_write_buffer_size_x (SCM port, SCM size)
1214 ioscm_memory_port *iomem;
1216 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME,
1217 memory_port_desc_name);
1218 SCM_ASSERT_TYPE (scm_is_integer (size), size, SCM_ARG2, FUNC_NAME,
1221 if (!scm_is_unsigned_integer (size, min_memory_port_buf_size,
1222 max_memory_port_buf_size))
1224 gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, size,
1225 out_of_range_buf_size);
1228 iomem = (ioscm_memory_port *) SCM_STREAM (port);
1229 ioscm_reinit_memory_port (port, iomem->read_buf_size, scm_to_uint (size),
1232 return SCM_UNSPECIFIED;
1235 /* Initialize gdb ports. */
1237 static const scheme_function port_functions[] =
1239 { "input-port", 0, 0, 0, as_a_scm_t_subr (gdbscm_input_port),
1241 Return gdb's input port." },
1243 { "output-port", 0, 0, 0, as_a_scm_t_subr (gdbscm_output_port),
1245 Return gdb's output port." },
1247 { "error-port", 0, 0, 0, as_a_scm_t_subr (gdbscm_error_port),
1249 Return gdb's error port." },
1251 { "stdio-port?", 1, 0, 0, as_a_scm_t_subr (gdbscm_stdio_port_p),
1253 Return #t if the object is a gdb:stdio-port." },
1255 { "open-memory", 0, 0, 1, as_a_scm_t_subr (gdbscm_open_memory),
1257 Return a port that can be used for reading/writing inferior memory.\n\
1259 Arguments: [#:mode string] [#:start address] [#:size integer]\n\
1260 Returns: A port object." },
1262 { "memory-port?", 1, 0, 0, as_a_scm_t_subr (gdbscm_memory_port_p),
1264 Return #t if the object is a memory port." },
1266 { "memory-port-range", 1, 0, 0, as_a_scm_t_subr (gdbscm_memory_port_range),
1268 Return the memory range of the port as (start end)." },
1270 { "memory-port-read-buffer-size", 1, 0, 0,
1271 as_a_scm_t_subr (gdbscm_memory_port_read_buffer_size),
1273 Return the size of the read buffer for the memory port." },
1275 { "set-memory-port-read-buffer-size!", 2, 0, 0,
1276 as_a_scm_t_subr (gdbscm_set_memory_port_read_buffer_size_x),
1278 Set the size of the read buffer for the memory port.\n\
1280 Arguments: port integer\n\
1281 Returns: unspecified." },
1283 { "memory-port-write-buffer-size", 1, 0, 0,
1284 as_a_scm_t_subr (gdbscm_memory_port_write_buffer_size),
1286 Return the size of the write buffer for the memory port." },
1288 { "set-memory-port-write-buffer-size!", 2, 0, 0,
1289 as_a_scm_t_subr (gdbscm_set_memory_port_write_buffer_size_x),
1291 Set the size of the write buffer for the memory port.\n\
1293 Arguments: port integer\n\
1294 Returns: unspecified." },
1299 static const scheme_function private_port_functions[] =
1302 { "%with-gdb-input-from-port", 2, 0, 0,
1303 as_a_scm_t_subr (gdbscm_percent_with_gdb_input_from_port),
1305 Temporarily set GDB's input port to PORT and then invoke THUNK.\n\
1307 Arguments: port thunk\n\
1308 Returns: The result of calling THUNK.\n\
1310 This procedure is experimental." },
1313 { "%with-gdb-output-to-port", 2, 0, 0,
1314 as_a_scm_t_subr (gdbscm_percent_with_gdb_output_to_port),
1316 Temporarily set GDB's output port to PORT and then invoke THUNK.\n\
1318 Arguments: port thunk\n\
1319 Returns: The result of calling THUNK.\n\
1321 This procedure is experimental." },
1323 { "%with-gdb-error-to-port", 2, 0, 0,
1324 as_a_scm_t_subr (gdbscm_percent_with_gdb_error_to_port),
1326 Temporarily set GDB's error port to PORT and then invoke THUNK.\n\
1328 Arguments: port thunk\n\
1329 Returns: The result of calling THUNK.\n\
1331 This procedure is experimental." },
1337 gdbscm_initialize_ports (void)
1339 /* Save the original stdio ports for debugging purposes. */
1341 orig_input_port_scm = scm_current_input_port ();
1342 orig_output_port_scm = scm_current_output_port ();
1343 orig_error_port_scm = scm_current_error_port ();
1345 /* Set up the stdio ports. */
1347 ioscm_init_gdb_stdio_port ();
1348 input_port_scm = ioscm_make_gdb_stdio_port (0);
1349 output_port_scm = ioscm_make_gdb_stdio_port (1);
1350 error_port_scm = ioscm_make_gdb_stdio_port (2);
1352 /* Set up memory ports. */
1354 ioscm_init_memory_port_type ();
1356 /* Install the accessor functions. */
1358 gdbscm_define_functions (port_functions, 1);
1359 gdbscm_define_functions (private_port_functions, 0);
1361 /* Keyword args for open-memory. */
1363 mode_keyword = scm_from_latin1_keyword ("mode");
1364 start_keyword = scm_from_latin1_keyword ("start");
1365 size_keyword = scm_from_latin1_keyword ("size");
1367 /* Error message text for "out of range" memory port buffer sizes. */
1369 out_of_range_buf_size = xstrprintf ("size not between %u - %u",
1370 min_memory_port_buf_size,
1371 max_memory_port_buf_size);