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 "gdbsupport/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
))
275 gdbscm_gdb_exception exc
{};
278 if (scm_is_eq (port
, error_port_scm
))
279 fputsn_filtered ((const char *) data
, size
, gdb_stderr
);
281 fputsn_filtered ((const char *) data
, size
, gdb_stdout
);
283 catch (const gdb_exception
&except
)
285 exc
= unpack (except
);
287 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
290 /* Flush gdb's stdout or stderr. */
293 ioscm_flush (SCM port
)
295 /* If we're called on stdin, punt. */
296 if (scm_is_eq (port
, input_port_scm
))
299 if (scm_is_eq (port
, error_port_scm
))
300 gdb_flush (gdb_stderr
);
302 gdb_flush (gdb_stdout
);
305 /* Initialize the gdb stdio port type.
307 N.B. isatty? will fail on these ports, it is only supported for file
308 ports. IWBN if we could "subclass" file ports. */
311 ioscm_init_gdb_stdio_port (void)
313 stdio_port_desc
= scm_make_port_type (stdio_port_desc_name
,
314 ioscm_fill_input
, ioscm_write
);
316 scm_set_port_input_waiting (stdio_port_desc
, ioscm_input_waiting
);
317 scm_set_port_flush (stdio_port_desc
, ioscm_flush
);
320 /* Subroutine of ioscm_make_gdb_stdio_port to simplify it.
321 Set up the buffers of port PORT.
322 MODE_BITS are the mode bits of PORT. */
325 ioscm_init_stdio_buffers (SCM port
, long mode_bits
)
327 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
328 #define GDB_STDIO_BUFFER_DEFAULT_SIZE 1024
329 int size
= mode_bits
& SCM_BUF0
? 0 : GDB_STDIO_BUFFER_DEFAULT_SIZE
;
330 int writing
= (mode_bits
& SCM_WRTNG
) != 0;
332 /* This is heavily copied from scm_fport_buffer_add. */
334 if (!writing
&& size
> 0)
337 = (unsigned char *) scm_gc_malloc_pointerless (size
, "port buffer");
338 pt
->read_pos
= pt
->read_end
= pt
->read_buf
;
339 pt
->read_buf_size
= size
;
343 pt
->read_pos
= pt
->read_buf
= pt
->read_end
= &pt
->shortbuf
;
344 pt
->read_buf_size
= 1;
347 if (writing
&& size
> 0)
350 = (unsigned char *) scm_gc_malloc_pointerless (size
, "port buffer");
351 pt
->write_pos
= pt
->write_buf
;
352 pt
->write_buf_size
= size
;
356 pt
->write_buf
= pt
->write_pos
= &pt
->shortbuf
;
357 pt
->write_buf_size
= 1;
359 pt
->write_end
= pt
->write_buf
+ pt
->write_buf_size
;
362 /* Create a gdb stdio port. */
365 ioscm_make_gdb_stdio_port (int fd
)
367 int is_a_tty
= isatty (fd
);
369 const char *mode_str
;
376 name
= input_port_name
;
377 mode_str
= is_a_tty
? "r0" : "r";
380 name
= output_port_name
;
381 mode_str
= is_a_tty
? "w0" : "w";
384 name
= error_port_name
;
385 mode_str
= is_a_tty
? "w0" : "w";
388 gdb_assert_not_reached ("bad stdio file descriptor");
391 mode_bits
= scm_mode_bits ((char *) mode_str
);
392 port
= ioscm_open_port (stdio_port_desc
, mode_bits
);
394 scm_set_port_filename_x (port
, gdbscm_scm_from_c_string (name
));
396 ioscm_init_stdio_buffers (port
, mode_bits
);
401 /* (stdio-port? object) -> boolean */
404 gdbscm_stdio_port_p (SCM scm
)
406 /* This is copied from SCM_FPORTP. */
407 return scm_from_bool (!SCM_IMP (scm
)
408 && (SCM_TYP16 (scm
) == stdio_port_desc
));
411 /* GDB's ports are accessed via functions to keep them read-only. */
413 /* (input-port) -> port */
416 gdbscm_input_port (void)
418 return input_port_scm
;
421 /* (output-port) -> port */
424 gdbscm_output_port (void)
426 return output_port_scm
;
429 /* (error-port) -> port */
432 gdbscm_error_port (void)
434 return error_port_scm
;
437 /* Support for sending GDB I/O to Guile ports. */
439 ioscm_file_port::ioscm_file_port (SCM port
)
444 ioscm_file_port::flush ()
449 ioscm_file_port::write (const char *buffer
, long length_buffer
)
451 scm_c_write (m_port
, buffer
, length_buffer
);
455 /* Helper routine for with-{output,error}-to-port. */
458 ioscm_with_output_to_port_worker (SCM port
, SCM thunk
, enum oport oport
,
459 const char *func_name
)
463 SCM_ASSERT_TYPE (gdbscm_is_true (scm_output_port_p (port
)), port
,
464 SCM_ARG1
, func_name
, _("output port"));
465 SCM_ASSERT_TYPE (gdbscm_is_true (scm_thunk_p (thunk
)), thunk
,
466 SCM_ARG2
, func_name
, _("thunk"));
468 set_batch_flag_and_restore_page_info save_page_info
;
470 scoped_restore restore_async
= make_scoped_restore (¤t_ui
->async
, 0);
472 ui_file_up
port_file (new ioscm_file_port (port
));
474 scoped_restore save_file
= make_scoped_restore (oport
== GDB_STDERR
475 ? &gdb_stderr
: &gdb_stdout
);
478 gdb::optional
<ui_out_redirect_pop
> redirect_popper
;
479 if (oport
== GDB_STDERR
)
480 gdb_stderr
= port_file
.get ();
483 current_uiout
->redirect (port_file
.get ());
484 redirect_popper
.emplace (current_uiout
);
486 gdb_stdout
= port_file
.get ();
489 result
= gdbscm_safe_call_0 (thunk
, NULL
);
492 if (gdbscm_is_exception (result
))
493 gdbscm_throw (result
);
498 /* (%with-gdb-output-to-port port thunk) -> object
499 This function is experimental.
500 IWBN to not include "gdb" in the name, but it would collide with a standard
501 procedure, and it's common to import the gdb module without a prefix.
502 There are ways around this, but they're more cumbersome.
504 This has % in the name because it's experimental, and we want the
505 user-visible version to come from module (gdb experimental). */
508 gdbscm_percent_with_gdb_output_to_port (SCM port
, SCM thunk
)
510 return ioscm_with_output_to_port_worker (port
, thunk
, GDB_STDOUT
, FUNC_NAME
);
513 /* (%with-gdb-error-to-port port thunk) -> object
514 This function is experimental.
515 IWBN to not include "gdb" in the name, but it would collide with a standard
516 procedure, and it's common to import the gdb module without a prefix.
517 There are ways around this, but they're more cumbersome.
519 This has % in the name because it's experimental, and we want the
520 user-visible version to come from module (gdb experimental). */
523 gdbscm_percent_with_gdb_error_to_port (SCM port
, SCM thunk
)
525 return ioscm_with_output_to_port_worker (port
, thunk
, GDB_STDERR
, FUNC_NAME
);
528 /* Support for r/w memory via ports. */
530 /* Perform an "lseek" to OFFSET,WHENCE on memory port IOMEM.
531 OFFSET must be in the range [0,size].
532 The result is non-zero for success, zero for failure. */
535 ioscm_lseek_address (ioscm_memory_port
*iomem
, LONGEST offset
, int whence
)
537 CORE_ADDR new_current
;
539 gdb_assert (iomem
->current
<= iomem
->size
);
544 /* Catch over/underflow. */
545 if ((offset
< 0 && iomem
->current
+ offset
> iomem
->current
)
546 || (offset
> 0 && iomem
->current
+ offset
< iomem
->current
))
548 new_current
= iomem
->current
+ offset
;
551 new_current
= offset
;
556 new_current
= iomem
->size
;
559 /* TODO: Not supported yet. */
565 if (new_current
> iomem
->size
)
567 iomem
->current
= new_current
;
571 /* "fill_input" method for memory ports. */
574 gdbscm_memory_port_fill_input (SCM port
)
576 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
577 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
580 /* "current" is the offset of the first byte we want to read. */
581 gdb_assert (iomem
->current
<= iomem
->size
);
582 if (iomem
->current
== iomem
->size
)
585 /* Don't read outside the allowed memory range. */
586 to_read
= pt
->read_buf_size
;
587 if (to_read
> iomem
->size
- iomem
->current
)
588 to_read
= iomem
->size
- iomem
->current
;
590 if (target_read_memory (iomem
->start
+ iomem
->current
, pt
->read_buf
,
592 gdbscm_memory_error (FUNC_NAME
, _("error reading memory"), SCM_EOL
);
594 iomem
->current
+= to_read
;
595 pt
->read_pos
= pt
->read_buf
;
596 pt
->read_end
= pt
->read_buf
+ to_read
;
597 return *pt
->read_buf
;
600 /* "end_input" method for memory ports.
601 Clear the read buffer and adjust the file position for unread bytes. */
604 gdbscm_memory_port_end_input (SCM port
, int offset
)
606 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
607 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
608 size_t remaining
= pt
->read_end
- pt
->read_pos
;
610 /* Note: Use of "int offset" is specified by Guile ports API. */
611 if ((offset
< 0 && remaining
+ offset
> remaining
)
612 || (offset
> 0 && remaining
+ offset
< remaining
))
614 gdbscm_out_of_range_error (FUNC_NAME
, 0, scm_from_int (offset
),
615 _("overflow in offset calculation"));
621 pt
->read_pos
= pt
->read_end
;
622 /* Throw error if unread-char used at beginning of file
623 then attempting to write. Seems correct. */
624 if (!ioscm_lseek_address (iomem
, -offset
, SEEK_CUR
))
626 gdbscm_out_of_range_error (FUNC_NAME
, 0, scm_from_int (offset
),
631 pt
->rw_active
= SCM_PORT_NEITHER
;
634 /* "flush" method for memory ports. */
637 gdbscm_memory_port_flush (SCM port
)
639 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
640 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
641 size_t to_write
= pt
->write_pos
- pt
->write_buf
;
646 /* There's no way to indicate a short write, so if the request goes past
647 the end of the port's memory range, flag an error. */
648 if (to_write
> iomem
->size
- iomem
->current
)
650 gdbscm_out_of_range_error (FUNC_NAME
, 0,
651 gdbscm_scm_from_ulongest (to_write
),
652 _("writing beyond end of memory range"));
655 if (target_write_memory (iomem
->start
+ iomem
->current
, pt
->write_buf
,
657 gdbscm_memory_error (FUNC_NAME
, _("error writing memory"), SCM_EOL
);
659 iomem
->current
+= to_write
;
660 pt
->write_pos
= pt
->write_buf
;
661 pt
->rw_active
= SCM_PORT_NEITHER
;
664 /* "write" method for memory ports. */
667 gdbscm_memory_port_write (SCM port
, const void *void_data
, size_t size
)
669 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
670 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
671 const gdb_byte
*data
= (const gdb_byte
*) void_data
;
673 /* There's no way to indicate a short write, so if the request goes past
674 the end of the port's memory range, flag an error. */
675 if (size
> iomem
->size
- iomem
->current
)
677 gdbscm_out_of_range_error (FUNC_NAME
, 0, gdbscm_scm_from_ulongest (size
),
678 _("writing beyond end of memory range"));
681 if (pt
->write_buf
== &pt
->shortbuf
)
683 /* Unbuffered port. */
684 if (target_write_memory (iomem
->start
+ iomem
->current
, data
, size
) != 0)
685 gdbscm_memory_error (FUNC_NAME
, _("error writing memory"), SCM_EOL
);
686 iomem
->current
+= size
;
690 /* Note: The edge case of what to do when the buffer exactly fills is
691 debatable. Guile flushes when the buffer exactly fills up, so we
692 do too. It's counter-intuitive to my mind, but in case there's a
693 subtlety somewhere that depends on this, we do the same. */
696 size_t space
= pt
->write_end
- pt
->write_pos
;
700 /* Data fits in buffer, and does not fill it. */
701 memcpy (pt
->write_pos
, data
, size
);
702 pt
->write_pos
+= size
;
706 memcpy (pt
->write_pos
, data
, space
);
707 pt
->write_pos
= pt
->write_end
;
708 gdbscm_memory_port_flush (port
);
710 const gdb_byte
*ptr
= data
+ space
;
711 size_t remaining
= size
- space
;
713 if (remaining
>= pt
->write_buf_size
)
715 if (target_write_memory (iomem
->start
+ iomem
->current
, ptr
,
717 gdbscm_memory_error (FUNC_NAME
, _("error writing memory"),
719 iomem
->current
+= remaining
;
723 memcpy (pt
->write_pos
, ptr
, remaining
);
724 pt
->write_pos
+= remaining
;
731 /* "seek" method for memory ports. */
734 gdbscm_memory_port_seek (SCM port
, scm_t_off offset
, int whence
)
736 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
737 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
741 if (pt
->rw_active
== SCM_PORT_WRITE
)
743 if (offset
!= 0 || whence
!= SEEK_CUR
)
745 gdbscm_memory_port_flush (port
);
746 rc
= ioscm_lseek_address (iomem
, offset
, whence
);
747 result
= iomem
->current
;
751 /* Read current position without disturbing the buffer,
752 but flag an error if what's in the buffer goes outside the
754 CORE_ADDR current
= iomem
->current
;
755 size_t delta
= pt
->write_pos
- pt
->write_buf
;
757 if (current
+ delta
< current
758 || current
+ delta
> iomem
->size
)
762 result
= current
+ delta
;
767 else if (pt
->rw_active
== SCM_PORT_READ
)
769 if (offset
!= 0 || whence
!= SEEK_CUR
)
771 scm_end_input (port
);
772 rc
= ioscm_lseek_address (iomem
, offset
, whence
);
773 result
= iomem
->current
;
777 /* Read current position without disturbing the buffer
778 (particularly the unread-char buffer). */
779 CORE_ADDR current
= iomem
->current
;
780 size_t remaining
= pt
->read_end
- pt
->read_pos
;
782 if (current
- remaining
> current
783 || current
- remaining
< iomem
->start
)
787 result
= current
- remaining
;
791 if (rc
!= 0 && pt
->read_buf
== pt
->putback_buf
)
793 size_t saved_remaining
= pt
->saved_read_end
- pt
->saved_read_pos
;
795 if (result
- saved_remaining
> result
796 || result
- saved_remaining
< iomem
->start
)
799 result
-= saved_remaining
;
803 else /* SCM_PORT_NEITHER */
805 rc
= ioscm_lseek_address (iomem
, offset
, whence
);
806 result
= iomem
->current
;
811 gdbscm_out_of_range_error (FUNC_NAME
, 0,
812 gdbscm_scm_from_longest (offset
),
816 /* TODO: The Guile API doesn't support 32x64. We can't fix that here,
817 and there's no need to throw an error if the new address can't be
818 represented in a scm_t_off. But we could return something less
823 /* "close" method for memory ports. */
826 gdbscm_memory_port_close (SCM port
)
828 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
829 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
831 gdbscm_memory_port_flush (port
);
833 if (pt
->read_buf
== pt
->putback_buf
)
834 pt
->read_buf
= pt
->saved_read_buf
;
835 if (pt
->read_buf
!= &pt
->shortbuf
)
836 xfree (pt
->read_buf
);
837 if (pt
->write_buf
!= &pt
->shortbuf
)
838 xfree (pt
->write_buf
);
839 scm_gc_free (iomem
, sizeof (*iomem
), "memory port");
844 /* "free" method for memory ports. */
847 gdbscm_memory_port_free (SCM port
)
849 gdbscm_memory_port_close (port
);
854 /* "print" method for memory ports. */
857 gdbscm_memory_port_print (SCM exp
, SCM port
, scm_print_state
*pstate
)
859 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (exp
);
860 char *type
= SCM_PTOBNAME (SCM_PTOBNUM (exp
));
862 scm_puts ("#<", port
);
863 scm_print_port_mode (exp
, port
);
864 /* scm_print_port_mode includes a trailing space. */
865 gdbscm_printf (port
, "%s %s-%s", type
,
866 hex_string (iomem
->start
), hex_string (iomem
->end
));
867 scm_putc ('>', port
);
871 /* Create the port type used for memory. */
874 ioscm_init_memory_port_type (void)
876 memory_port_desc
= scm_make_port_type (memory_port_desc_name
,
877 gdbscm_memory_port_fill_input
,
878 gdbscm_memory_port_write
);
880 scm_set_port_end_input (memory_port_desc
, gdbscm_memory_port_end_input
);
881 scm_set_port_flush (memory_port_desc
, gdbscm_memory_port_flush
);
882 scm_set_port_seek (memory_port_desc
, gdbscm_memory_port_seek
);
883 scm_set_port_close (memory_port_desc
, gdbscm_memory_port_close
);
884 scm_set_port_free (memory_port_desc
, gdbscm_memory_port_free
);
885 scm_set_port_print (memory_port_desc
, gdbscm_memory_port_print
);
888 /* Helper for gdbscm_open_memory to parse the mode bits.
889 An exception is thrown if MODE is invalid. */
892 ioscm_parse_mode_bits (const char *func_name
, const char *mode
)
897 if (*mode
!= 'r' && *mode
!= 'w')
899 gdbscm_out_of_range_error (func_name
, 0,
900 gdbscm_scm_from_c_string (mode
),
901 _("bad mode string"));
903 for (p
= mode
+ 1; *p
!= '\0'; ++p
)
912 gdbscm_out_of_range_error (func_name
, 0,
913 gdbscm_scm_from_c_string (mode
),
914 _("bad mode string"));
918 /* Kinda awkward to convert the mode from SCM -> string only to have Guile
919 convert it back to SCM, but that's the API we have to work with. */
920 mode_bits
= scm_mode_bits ((char *) mode
);
925 /* Helper for gdbscm_open_memory to finish initializing the port.
926 The port has address range [start,end).
927 This means that address of 0xff..ff is not accessible.
928 I can live with that. */
931 ioscm_init_memory_port (SCM port
, CORE_ADDR start
, CORE_ADDR end
)
934 ioscm_memory_port
*iomem
;
935 int buffered
= (SCM_CELL_WORD_0 (port
) & SCM_BUF0
) == 0;
937 gdb_assert (start
<= end
);
939 iomem
= (ioscm_memory_port
*) scm_gc_malloc_pointerless (sizeof (*iomem
),
942 iomem
->start
= start
;
944 iomem
->size
= end
- start
;
948 iomem
->read_buf_size
= default_read_buf_size
;
949 iomem
->write_buf_size
= default_write_buf_size
;
953 iomem
->read_buf_size
= 1;
954 iomem
->write_buf_size
= 1;
957 pt
= SCM_PTAB_ENTRY (port
);
958 /* Match the expectation of `binary-port?'. */
961 pt
->read_buf_size
= iomem
->read_buf_size
;
962 pt
->write_buf_size
= iomem
->write_buf_size
;
965 pt
->read_buf
= (unsigned char *) xmalloc (pt
->read_buf_size
);
966 pt
->write_buf
= (unsigned char *) xmalloc (pt
->write_buf_size
);
970 pt
->read_buf
= &pt
->shortbuf
;
971 pt
->write_buf
= &pt
->shortbuf
;
973 pt
->read_pos
= pt
->read_end
= pt
->read_buf
;
974 pt
->write_pos
= pt
->write_buf
;
975 pt
->write_end
= pt
->write_buf
+ pt
->write_buf_size
;
977 SCM_SETSTREAM (port
, iomem
);
980 /* Re-initialize a memory port, updating its read/write buffer sizes.
981 An exception is thrown if the port is unbuffered.
982 TODO: Allow switching buffered/unbuffered.
983 An exception is also thrown if data is still buffered, except in the case
984 where the buffer size isn't changing (since that's just a nop). */
987 ioscm_reinit_memory_port (SCM port
, size_t read_buf_size
,
988 size_t write_buf_size
, const char *func_name
)
990 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
991 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
993 gdb_assert (read_buf_size
>= min_memory_port_buf_size
994 && read_buf_size
<= max_memory_port_buf_size
);
995 gdb_assert (write_buf_size
>= min_memory_port_buf_size
996 && write_buf_size
<= max_memory_port_buf_size
);
998 /* First check if the port is unbuffered. */
1000 if (pt
->read_buf
== &pt
->shortbuf
)
1002 gdb_assert (pt
->write_buf
== &pt
->shortbuf
);
1003 scm_misc_error (func_name
, _("port is unbuffered: ~a"),
1007 /* Next check if anything is buffered. */
1009 if (read_buf_size
!= pt
->read_buf_size
1010 && pt
->read_end
!= pt
->read_buf
)
1012 scm_misc_error (func_name
, _("read buffer not empty: ~a"),
1016 if (write_buf_size
!= pt
->write_buf_size
1017 && pt
->write_pos
!= pt
->write_buf
)
1019 scm_misc_error (func_name
, _("write buffer not empty: ~a"),
1023 /* Now we can update the buffer sizes, but only if the size has changed. */
1025 if (read_buf_size
!= pt
->read_buf_size
)
1027 iomem
->read_buf_size
= read_buf_size
;
1028 pt
->read_buf_size
= read_buf_size
;
1029 xfree (pt
->read_buf
);
1030 pt
->read_buf
= (unsigned char *) xmalloc (pt
->read_buf_size
);
1031 pt
->read_pos
= pt
->read_end
= pt
->read_buf
;
1034 if (write_buf_size
!= pt
->write_buf_size
)
1036 iomem
->write_buf_size
= write_buf_size
;
1037 pt
->write_buf_size
= write_buf_size
;
1038 xfree (pt
->write_buf
);
1039 pt
->write_buf
= (unsigned char *) xmalloc (pt
->write_buf_size
);
1040 pt
->write_pos
= pt
->write_buf
;
1041 pt
->write_end
= pt
->write_buf
+ pt
->write_buf_size
;
1045 /* (open-memory [#:mode string] [#:start address] [#:size integer]) -> port
1046 Return a port that can be used for reading and writing memory.
1047 MODE is a string, and must be one of "r", "w", or "r+".
1048 "0" may be appended to MODE to mark the port as unbuffered.
1049 For compatibility "b" (binary) may also be appended, but we ignore it:
1050 memory ports are binary only.
1052 The chunk of memory that can be accessed can be bounded.
1053 If both START,SIZE are unspecified, all of memory can be accessed
1054 (except 0xff..ff). If only START is specified, all of memory from that
1055 point on can be accessed (except 0xff..ff). If only SIZE if specified,
1056 all memory in [0,SIZE) can be accessed. If both are specified, all memory
1057 in [START,START+SIZE) can be accessed.
1059 Note: If it becomes useful enough we can later add #:end as an alternative
1060 to #:size. For now it is left out.
1062 The result is a Scheme port, and its semantics are a bit odd for accessing
1063 memory (e.g., unget), but we don't try to hide this. It's a port.
1065 N.B. Seeks on the port must be in the range [0,size].
1066 This is for similarity with bytevector ports, and so that one can seek
1067 to the first byte. */
1070 gdbscm_open_memory (SCM rest
)
1072 const SCM keywords
[] = {
1073 mode_keyword
, start_keyword
, size_keyword
, SCM_BOOL_F
1076 CORE_ADDR start
= 0;
1078 int mode_arg_pos
= -1, start_arg_pos
= -1, size_arg_pos
= -1;
1083 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, keywords
, "#sUU", rest
,
1084 &mode_arg_pos
, &mode
,
1085 &start_arg_pos
, &start
,
1086 &size_arg_pos
, &size
);
1088 scm_dynwind_begin ((scm_t_dynwind_flags
) 0);
1091 mode
= xstrdup ("r");
1092 scm_dynwind_free (mode
);
1094 if (size_arg_pos
> 0)
1096 /* For now be strict about start+size overflowing. If it becomes
1097 a nuisance we can relax things later. */
1098 if (start
+ size
< start
)
1100 gdbscm_out_of_range_error (FUNC_NAME
, 0,
1101 scm_list_2 (gdbscm_scm_from_ulongest (start
),
1102 gdbscm_scm_from_ulongest (size
)),
1103 _("start+size overflows"));
1108 end
= ~(CORE_ADDR
) 0;
1110 mode_bits
= ioscm_parse_mode_bits (FUNC_NAME
, mode
);
1112 port
= ioscm_open_port (memory_port_desc
, mode_bits
);
1114 ioscm_init_memory_port (port
, start
, end
);
1118 /* TODO: Set the file name as "memory-start-end"? */
1122 /* Return non-zero if OBJ is a memory port. */
1125 gdbscm_is_memory_port (SCM obj
)
1127 return !SCM_IMP (obj
) && (SCM_TYP16 (obj
) == memory_port_desc
);
1130 /* (memory-port? obj) -> boolean */
1133 gdbscm_memory_port_p (SCM obj
)
1135 return scm_from_bool (gdbscm_is_memory_port (obj
));
1138 /* (memory-port-range port) -> (start end) */
1141 gdbscm_memory_port_range (SCM port
)
1143 ioscm_memory_port
*iomem
;
1145 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port
), port
, SCM_ARG1
, FUNC_NAME
,
1146 memory_port_desc_name
);
1148 iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
1149 return scm_list_2 (gdbscm_scm_from_ulongest (iomem
->start
),
1150 gdbscm_scm_from_ulongest (iomem
->end
));
1153 /* (memory-port-read-buffer-size port) -> integer */
1156 gdbscm_memory_port_read_buffer_size (SCM port
)
1158 ioscm_memory_port
*iomem
;
1160 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port
), port
, SCM_ARG1
, FUNC_NAME
,
1161 memory_port_desc_name
);
1163 iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
1164 return scm_from_uint (iomem
->read_buf_size
);
1167 /* (set-memory-port-read-buffer-size! port size) -> unspecified
1168 An exception is thrown if read data is still buffered or if the port
1172 gdbscm_set_memory_port_read_buffer_size_x (SCM port
, SCM size
)
1174 ioscm_memory_port
*iomem
;
1176 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port
), port
, SCM_ARG1
, FUNC_NAME
,
1177 memory_port_desc_name
);
1178 SCM_ASSERT_TYPE (scm_is_integer (size
), size
, SCM_ARG2
, FUNC_NAME
,
1181 if (!scm_is_unsigned_integer (size
, min_memory_port_buf_size
,
1182 max_memory_port_buf_size
))
1184 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG2
, size
,
1185 out_of_range_buf_size
);
1188 iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
1189 ioscm_reinit_memory_port (port
, scm_to_uint (size
), iomem
->write_buf_size
,
1192 return SCM_UNSPECIFIED
;
1195 /* (memory-port-write-buffer-size port) -> integer */
1198 gdbscm_memory_port_write_buffer_size (SCM port
)
1200 ioscm_memory_port
*iomem
;
1202 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port
), port
, SCM_ARG1
, FUNC_NAME
,
1203 memory_port_desc_name
);
1205 iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
1206 return scm_from_uint (iomem
->write_buf_size
);
1209 /* (set-memory-port-write-buffer-size! port size) -> unspecified
1210 An exception is thrown if write data is still buffered or if the port
1214 gdbscm_set_memory_port_write_buffer_size_x (SCM port
, SCM size
)
1216 ioscm_memory_port
*iomem
;
1218 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port
), port
, SCM_ARG1
, FUNC_NAME
,
1219 memory_port_desc_name
);
1220 SCM_ASSERT_TYPE (scm_is_integer (size
), size
, SCM_ARG2
, FUNC_NAME
,
1223 if (!scm_is_unsigned_integer (size
, min_memory_port_buf_size
,
1224 max_memory_port_buf_size
))
1226 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG2
, size
,
1227 out_of_range_buf_size
);
1230 iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
1231 ioscm_reinit_memory_port (port
, iomem
->read_buf_size
, scm_to_uint (size
),
1234 return SCM_UNSPECIFIED
;
1237 /* Initialize gdb ports. */
1239 static const scheme_function port_functions
[] =
1241 { "input-port", 0, 0, 0, as_a_scm_t_subr (gdbscm_input_port
),
1243 Return gdb's input port." },
1245 { "output-port", 0, 0, 0, as_a_scm_t_subr (gdbscm_output_port
),
1247 Return gdb's output port." },
1249 { "error-port", 0, 0, 0, as_a_scm_t_subr (gdbscm_error_port
),
1251 Return gdb's error port." },
1253 { "stdio-port?", 1, 0, 0, as_a_scm_t_subr (gdbscm_stdio_port_p
),
1255 Return #t if the object is a gdb:stdio-port." },
1257 { "open-memory", 0, 0, 1, as_a_scm_t_subr (gdbscm_open_memory
),
1259 Return a port that can be used for reading/writing inferior memory.\n\
1261 Arguments: [#:mode string] [#:start address] [#:size integer]\n\
1262 Returns: A port object." },
1264 { "memory-port?", 1, 0, 0, as_a_scm_t_subr (gdbscm_memory_port_p
),
1266 Return #t if the object is a memory port." },
1268 { "memory-port-range", 1, 0, 0, as_a_scm_t_subr (gdbscm_memory_port_range
),
1270 Return the memory range of the port as (start end)." },
1272 { "memory-port-read-buffer-size", 1, 0, 0,
1273 as_a_scm_t_subr (gdbscm_memory_port_read_buffer_size
),
1275 Return the size of the read buffer for the memory port." },
1277 { "set-memory-port-read-buffer-size!", 2, 0, 0,
1278 as_a_scm_t_subr (gdbscm_set_memory_port_read_buffer_size_x
),
1280 Set the size of the read buffer for the memory port.\n\
1282 Arguments: port integer\n\
1283 Returns: unspecified." },
1285 { "memory-port-write-buffer-size", 1, 0, 0,
1286 as_a_scm_t_subr (gdbscm_memory_port_write_buffer_size
),
1288 Return the size of the write buffer for the memory port." },
1290 { "set-memory-port-write-buffer-size!", 2, 0, 0,
1291 as_a_scm_t_subr (gdbscm_set_memory_port_write_buffer_size_x
),
1293 Set the size of the write buffer for the memory port.\n\
1295 Arguments: port integer\n\
1296 Returns: unspecified." },
1301 static const scheme_function private_port_functions
[] =
1304 { "%with-gdb-input-from-port", 2, 0, 0,
1305 as_a_scm_t_subr (gdbscm_percent_with_gdb_input_from_port
),
1307 Temporarily set GDB's input port to PORT and then invoke THUNK.\n\
1309 Arguments: port thunk\n\
1310 Returns: The result of calling THUNK.\n\
1312 This procedure is experimental." },
1315 { "%with-gdb-output-to-port", 2, 0, 0,
1316 as_a_scm_t_subr (gdbscm_percent_with_gdb_output_to_port
),
1318 Temporarily set GDB's output port to PORT and then invoke THUNK.\n\
1320 Arguments: port thunk\n\
1321 Returns: The result of calling THUNK.\n\
1323 This procedure is experimental." },
1325 { "%with-gdb-error-to-port", 2, 0, 0,
1326 as_a_scm_t_subr (gdbscm_percent_with_gdb_error_to_port
),
1328 Temporarily set GDB's error port to PORT and then invoke THUNK.\n\
1330 Arguments: port thunk\n\
1331 Returns: The result of calling THUNK.\n\
1333 This procedure is experimental." },
1339 gdbscm_initialize_ports (void)
1341 /* Save the original stdio ports for debugging purposes. */
1343 orig_input_port_scm
= scm_current_input_port ();
1344 orig_output_port_scm
= scm_current_output_port ();
1345 orig_error_port_scm
= scm_current_error_port ();
1347 /* Set up the stdio ports. */
1349 ioscm_init_gdb_stdio_port ();
1350 input_port_scm
= ioscm_make_gdb_stdio_port (0);
1351 output_port_scm
= ioscm_make_gdb_stdio_port (1);
1352 error_port_scm
= ioscm_make_gdb_stdio_port (2);
1354 /* Set up memory ports. */
1356 ioscm_init_memory_port_type ();
1358 /* Install the accessor functions. */
1360 gdbscm_define_functions (port_functions
, 1);
1361 gdbscm_define_functions (private_port_functions
, 0);
1363 /* Keyword args for open-memory. */
1365 mode_keyword
= scm_from_latin1_keyword ("mode");
1366 start_keyword
= scm_from_latin1_keyword ("start");
1367 size_keyword
= scm_from_latin1_keyword ("size");
1369 /* Error message text for "out of range" memory port buffer sizes. */
1371 out_of_range_buf_size
= xstrprintf ("size not between %u - %u",
1372 min_memory_port_buf_size
,
1373 max_memory_port_buf_size
);