1 /* Support for connecting Guile's stdio to GDB's.
2 as well as r/w memory via ports.
4 Copyright (C) 2014-2015 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"
31 #if defined (HAVE_POLL_H)
33 #elif defined (HAVE_SYS_POLL_H)
38 /* A ui-file for sending output to Guile. */
46 /* Data for a memory port. */
50 /* Bounds of memory range this port is allowed to access: [start, end).
51 This means that 0xff..ff is not accessible. I can live with that. */
54 /* (end - start), recorded for convenience. */
57 /* Think of this as the lseek value maintained by the kernel.
58 This value is always in the range [0, size]. */
61 /* The size of the internal r/w buffers.
62 Scheme ports aren't a straightforward mapping to memory r/w.
63 Generally the user specifies how much to r/w and all access is
64 unbuffered. We don't try to provide equivalent access, but we allow
65 the user to specify these values to help get something similar. */
66 unsigned read_buf_size
, write_buf_size
;
69 /* Copies of the original system input/output/error ports.
70 These are recorded for debugging purposes. */
71 static SCM orig_input_port_scm
;
72 static SCM orig_output_port_scm
;
73 static SCM orig_error_port_scm
;
75 /* This is the stdio port descriptor, scm_ptob_descriptor. */
76 static scm_t_bits stdio_port_desc
;
78 /* Note: scm_make_port_type takes a char * instead of a const char *. */
79 static /*const*/ char stdio_port_desc_name
[] = "gdb:stdio-port";
81 /* Names of each gdb port. */
82 static const char input_port_name
[] = "gdb:stdin";
83 static const char output_port_name
[] = "gdb:stdout";
84 static const char error_port_name
[] = "gdb:stderr";
86 /* This is the actual port used from Guile.
87 We don't expose these to the user though, to ensure they're not
89 static SCM input_port_scm
;
90 static SCM output_port_scm
;
91 static SCM error_port_scm
;
93 /* Magic number to identify port ui-files.
94 Actually, the address of this variable is the magic number. */
95 static int file_port_magic
;
97 /* Internal enum for specifying output port. */
98 enum oport
{ GDB_STDOUT
, GDB_STDERR
};
100 /* This is the memory port descriptor, scm_ptob_descriptor. */
101 static scm_t_bits memory_port_desc
;
103 /* Note: scm_make_port_type takes a char * instead of a const char *. */
104 static /*const*/ char memory_port_desc_name
[] = "gdb:memory-port";
106 /* The default amount of memory to fetch for each read/write request.
107 Scheme ports don't provide a way to specify the size of a read,
108 which is important to us to minimize the number of inferior interactions,
109 which over a remote link can be important. To compensate we augment the
110 port API with a new function that let's the user specify how much the next
111 read request should fetch. This is the initial value for each new port. */
112 static const unsigned default_read_buf_size
= 16;
113 static const unsigned default_write_buf_size
= 16;
115 /* Arbitrarily limit memory port buffers to 1 byte to 4K. */
116 static const unsigned min_memory_port_buf_size
= 1;
117 static const unsigned max_memory_port_buf_size
= 4096;
119 /* "out of range" error message for buf sizes. */
120 static char *out_of_range_buf_size
;
122 /* Keywords used by open-memory. */
123 static SCM mode_keyword
;
124 static SCM start_keyword
;
125 static SCM size_keyword
;
127 /* Helper to do the low level work of opening a port.
128 Newer versions of Guile (2.1.x) have scm_c_make_port. */
131 ioscm_open_port (scm_t_bits port_type
, long mode_bits
)
135 #if 0 /* TODO: Guile doesn't export this. What to do? */
136 scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex
);
139 port
= scm_new_port_table_entry (port_type
);
141 SCM_SET_CELL_TYPE (port
, port_type
| mode_bits
);
143 #if 0 /* TODO: Guile doesn't export this. What to do? */
144 scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex
);
150 /* Support for connecting Guile's stdio ports to GDB's stdio ports. */
152 /* The scm_t_ptob_descriptor.input_waiting "method".
153 Return a lower bound on the number of bytes available for input. */
156 ioscm_input_waiting (SCM port
)
160 if (! scm_is_eq (port
, input_port_scm
))
165 /* This is copied from libguile/fports.c. */
166 struct pollfd pollfd
= { fdes
, POLLIN
, 0 };
167 static int use_poll
= -1;
171 /* This is copied from event-loop.c: poll cannot be used for stdin on
172 m68k-motorola-sysv. */
173 struct pollfd test_pollfd
= { fdes
, POLLIN
, 0 };
175 if (poll (&test_pollfd
, 1, 0) == 1 && (test_pollfd
.revents
& POLLNVAL
))
183 /* Guile doesn't export SIGINT hooks like Python does.
184 For now pass EINTR to scm_syserror, that's what fports.c does. */
185 if (poll (&pollfd
, 1, 0) < 0)
186 scm_syserror (FUNC_NAME
);
188 return pollfd
.revents
& POLLIN
? 1 : 0;
195 struct timeval timeout
;
197 int num_fds
= fdes
+ 1;
200 memset (&timeout
, 0, sizeof (timeout
));
201 FD_ZERO (&input_fds
);
202 FD_SET (fdes
, &input_fds
);
204 num_found
= gdb_select (num_fds
, &input_fds
, NULL
, NULL
, &timeout
);
207 /* Guile doesn't export SIGINT hooks like Python does.
208 For now pass EINTR to scm_syserror, that's what fports.c does. */
209 scm_syserror (FUNC_NAME
);
211 return num_found
> 0 && FD_ISSET (fdes
, &input_fds
);
215 /* The scm_t_ptob_descriptor.fill_input "method". */
218 ioscm_fill_input (SCM port
)
220 /* Borrowed from libguile/fports.c. */
222 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
224 /* If we're called on stdout,stderr, punt. */
225 if (! scm_is_eq (port
, input_port_scm
))
226 return (scm_t_wchar
) EOF
; /* Set errno and return -1? */
228 gdb_flush (gdb_stdout
);
229 gdb_flush (gdb_stderr
);
231 count
= ui_file_read (gdb_stdin
, (char *) pt
->read_buf
, pt
->read_buf_size
);
233 scm_syserror (FUNC_NAME
);
235 return (scm_t_wchar
) EOF
;
237 pt
->read_pos
= pt
->read_buf
;
238 pt
->read_end
= pt
->read_buf
+ count
;
239 return *pt
->read_buf
;
242 /* Like fputstrn_filtered, but don't escape characters, except nul.
243 Also like fputs_filtered, but a length is specified. */
246 fputsn_filtered (const char *s
, size_t size
, struct ui_file
*stream
)
250 for (i
= 0; i
< size
; ++i
)
253 fputs_filtered ("\\000", stream
);
255 fputc_filtered (s
[i
], stream
);
259 /* Write to gdb's stdout or stderr. */
262 ioscm_write (SCM port
, const void *data
, size_t size
)
265 /* If we're called on stdin, punt. */
266 if (scm_is_eq (port
, input_port_scm
))
271 if (scm_is_eq (port
, error_port_scm
))
272 fputsn_filtered (data
, size
, gdb_stderr
);
274 fputsn_filtered (data
, size
, gdb_stdout
);
276 CATCH (except
, RETURN_MASK_ALL
)
278 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
283 /* Flush gdb's stdout or stderr. */
286 ioscm_flush (SCM port
)
288 /* If we're called on stdin, punt. */
289 if (scm_is_eq (port
, input_port_scm
))
292 if (scm_is_eq (port
, error_port_scm
))
293 gdb_flush (gdb_stderr
);
295 gdb_flush (gdb_stdout
);
298 /* Initialize the gdb stdio port type.
300 N.B. isatty? will fail on these ports, it is only supported for file
301 ports. IWBN if we could "subclass" file ports. */
304 ioscm_init_gdb_stdio_port (void)
306 stdio_port_desc
= scm_make_port_type (stdio_port_desc_name
,
307 ioscm_fill_input
, ioscm_write
);
309 scm_set_port_input_waiting (stdio_port_desc
, ioscm_input_waiting
);
310 scm_set_port_flush (stdio_port_desc
, ioscm_flush
);
313 /* Subroutine of ioscm_make_gdb_stdio_port to simplify it.
314 Set up the buffers of port PORT.
315 MODE_BITS are the mode bits of PORT. */
318 ioscm_init_stdio_buffers (SCM port
, long mode_bits
)
320 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
321 #define GDB_STDIO_BUFFER_DEFAULT_SIZE 1024
322 int size
= mode_bits
& SCM_BUF0
? 0 : GDB_STDIO_BUFFER_DEFAULT_SIZE
;
323 int writing
= (mode_bits
& SCM_WRTNG
) != 0;
325 /* This is heavily copied from scm_fport_buffer_add. */
327 if (!writing
&& size
> 0)
329 pt
->read_buf
= scm_gc_malloc_pointerless (size
, "port buffer");
330 pt
->read_pos
= pt
->read_end
= pt
->read_buf
;
331 pt
->read_buf_size
= size
;
335 pt
->read_pos
= pt
->read_buf
= pt
->read_end
= &pt
->shortbuf
;
336 pt
->read_buf_size
= 1;
339 if (writing
&& size
> 0)
341 pt
->write_buf
= scm_gc_malloc_pointerless (size
, "port buffer");
342 pt
->write_pos
= pt
->write_buf
;
343 pt
->write_buf_size
= size
;
347 pt
->write_buf
= pt
->write_pos
= &pt
->shortbuf
;
348 pt
->write_buf_size
= 1;
350 pt
->write_end
= pt
->write_buf
+ pt
->write_buf_size
;
353 /* Create a gdb stdio port. */
356 ioscm_make_gdb_stdio_port (int fd
)
358 int is_a_tty
= isatty (fd
);
366 name
= input_port_name
;
367 mode_bits
= scm_mode_bits (is_a_tty
? "r0" : "r");
370 name
= output_port_name
;
371 mode_bits
= scm_mode_bits (is_a_tty
? "w0" : "w");
374 name
= error_port_name
;
375 mode_bits
= scm_mode_bits (is_a_tty
? "w0" : "w");
378 gdb_assert_not_reached ("bad stdio file descriptor");
381 port
= ioscm_open_port (stdio_port_desc
, mode_bits
);
383 scm_set_port_filename_x (port
, gdbscm_scm_from_c_string (name
));
385 ioscm_init_stdio_buffers (port
, mode_bits
);
390 /* (stdio-port? object) -> boolean */
393 gdbscm_stdio_port_p (SCM scm
)
395 /* This is copied from SCM_FPORTP. */
396 return scm_from_bool (!SCM_IMP (scm
)
397 && (SCM_TYP16 (scm
) == stdio_port_desc
));
400 /* GDB's ports are accessed via functions to keep them read-only. */
402 /* (input-port) -> port */
405 gdbscm_input_port (void)
407 return input_port_scm
;
410 /* (output-port) -> port */
413 gdbscm_output_port (void)
415 return output_port_scm
;
418 /* (error-port) -> port */
421 gdbscm_error_port (void)
423 return error_port_scm
;
426 /* Support for sending GDB I/O to Guile ports. */
429 ioscm_file_port_delete (struct ui_file
*file
)
431 ioscm_file_port
*stream
= ui_file_data (file
);
433 if (stream
->magic
!= &file_port_magic
)
434 internal_error (__FILE__
, __LINE__
,
435 _("ioscm_file_port_delete: bad magic number"));
440 ioscm_file_port_rewind (struct ui_file
*file
)
442 ioscm_file_port
*stream
= ui_file_data (file
);
444 if (stream
->magic
!= &file_port_magic
)
445 internal_error (__FILE__
, __LINE__
,
446 _("ioscm_file_port_rewind: bad magic number"));
448 scm_truncate_file (stream
->port
, 0);
452 ioscm_file_port_put (struct ui_file
*file
,
453 ui_file_put_method_ftype
*write
,
456 ioscm_file_port
*stream
= ui_file_data (file
);
458 if (stream
->magic
!= &file_port_magic
)
459 internal_error (__FILE__
, __LINE__
,
460 _("ioscm_file_port_put: bad magic number"));
462 /* This function doesn't meld with ports very well. */
466 ioscm_file_port_write (struct ui_file
*file
,
470 ioscm_file_port
*stream
= ui_file_data (file
);
472 if (stream
->magic
!= &file_port_magic
)
473 internal_error (__FILE__
, __LINE__
,
474 _("ioscm_pot_file_write: bad magic number"));
476 scm_c_write (stream
->port
, buffer
, length_buffer
);
479 /* Return a ui_file that writes to PORT. */
481 static struct ui_file
*
482 ioscm_file_port_new (SCM port
)
484 ioscm_file_port
*stream
= XCNEW (ioscm_file_port
);
485 struct ui_file
*file
= ui_file_new ();
487 set_ui_file_data (file
, stream
, ioscm_file_port_delete
);
488 set_ui_file_rewind (file
, ioscm_file_port_rewind
);
489 set_ui_file_put (file
, ioscm_file_port_put
);
490 set_ui_file_write (file
, ioscm_file_port_write
);
491 stream
->magic
= &file_port_magic
;
497 /* Helper routine for with-{output,error}-to-port. */
500 ioscm_with_output_to_port_worker (SCM port
, SCM thunk
, enum oport oport
,
501 const char *func_name
)
503 struct ui_file
*port_file
;
504 struct cleanup
*cleanups
;
507 SCM_ASSERT_TYPE (gdbscm_is_true (scm_output_port_p (port
)), port
,
508 SCM_ARG1
, func_name
, _("output port"));
509 SCM_ASSERT_TYPE (gdbscm_is_true (scm_thunk_p (thunk
)), thunk
,
510 SCM_ARG2
, func_name
, _("thunk"));
512 cleanups
= set_batch_flag_and_make_cleanup_restore_page_info ();
514 make_cleanup_restore_integer (&interpreter_async
);
515 interpreter_async
= 0;
517 port_file
= ioscm_file_port_new (port
);
519 make_cleanup_ui_file_delete (port_file
);
521 if (oport
== GDB_STDERR
)
523 make_cleanup_restore_ui_file (&gdb_stderr
);
524 gdb_stderr
= port_file
;
528 make_cleanup_restore_ui_file (&gdb_stdout
);
530 if (ui_out_redirect (current_uiout
, port_file
) < 0)
531 warning (_("Current output protocol does not support redirection"));
533 make_cleanup_ui_out_redirect_pop (current_uiout
);
535 gdb_stdout
= port_file
;
538 result
= gdbscm_safe_call_0 (thunk
, NULL
);
540 do_cleanups (cleanups
);
542 if (gdbscm_is_exception (result
))
543 gdbscm_throw (result
);
548 /* (%with-gdb-output-to-port port thunk) -> object
549 This function is experimental.
550 IWBN to not include "gdb" in the name, but it would collide with a standard
551 procedure, and it's common to import the gdb module without a prefix.
552 There are ways around this, but they're more cumbersome.
554 This has % in the name because it's experimental, and we want the
555 user-visible version to come from module (gdb experimental). */
558 gdbscm_percent_with_gdb_output_to_port (SCM port
, SCM thunk
)
560 return ioscm_with_output_to_port_worker (port
, thunk
, GDB_STDOUT
, FUNC_NAME
);
563 /* (%with-gdb-error-to-port port thunk) -> object
564 This function is experimental.
565 IWBN to not include "gdb" in the name, but it would collide with a standard
566 procedure, and it's common to import the gdb module without a prefix.
567 There are ways around this, but they're more cumbersome.
569 This has % in the name because it's experimental, and we want the
570 user-visible version to come from module (gdb experimental). */
573 gdbscm_percent_with_gdb_error_to_port (SCM port
, SCM thunk
)
575 return ioscm_with_output_to_port_worker (port
, thunk
, GDB_STDERR
, FUNC_NAME
);
578 /* Support for r/w memory via ports. */
580 /* Perform an "lseek" to OFFSET,WHENCE on memory port IOMEM.
581 OFFSET must be in the range [0,size].
582 The result is non-zero for success, zero for failure. */
585 ioscm_lseek_address (ioscm_memory_port
*iomem
, LONGEST offset
, int whence
)
587 CORE_ADDR new_current
;
589 gdb_assert (iomem
->current
<= iomem
->size
);
594 /* Catch over/underflow. */
595 if ((offset
< 0 && iomem
->current
+ offset
> iomem
->current
)
596 || (offset
> 0 && iomem
->current
+ offset
< iomem
->current
))
598 new_current
= iomem
->current
+ offset
;
601 new_current
= offset
;
606 new_current
= iomem
->size
;
609 /* TODO: Not supported yet. */
615 if (new_current
> iomem
->size
)
617 iomem
->current
= new_current
;
621 /* "fill_input" method for memory ports. */
624 gdbscm_memory_port_fill_input (SCM port
)
626 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
627 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
630 /* "current" is the offset of the first byte we want to read. */
631 gdb_assert (iomem
->current
<= iomem
->size
);
632 if (iomem
->current
== iomem
->size
)
635 /* Don't read outside the allowed memory range. */
636 to_read
= pt
->read_buf_size
;
637 if (to_read
> iomem
->size
- iomem
->current
)
638 to_read
= iomem
->size
- iomem
->current
;
640 if (target_read_memory (iomem
->start
+ iomem
->current
, pt
->read_buf
,
642 gdbscm_memory_error (FUNC_NAME
, _("error reading memory"), SCM_EOL
);
644 iomem
->current
+= to_read
;
645 pt
->read_pos
= pt
->read_buf
;
646 pt
->read_end
= pt
->read_buf
+ to_read
;
647 return *pt
->read_buf
;
650 /* "end_input" method for memory ports.
651 Clear the read buffer and adjust the file position for unread bytes. */
654 gdbscm_memory_port_end_input (SCM port
, int offset
)
656 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
657 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
658 size_t remaining
= pt
->read_end
- pt
->read_pos
;
660 /* Note: Use of "int offset" is specified by Guile ports API. */
661 if ((offset
< 0 && remaining
+ offset
> remaining
)
662 || (offset
> 0 && remaining
+ offset
< remaining
))
664 gdbscm_out_of_range_error (FUNC_NAME
, 0, scm_from_int (offset
),
665 _("overflow in offset calculation"));
671 pt
->read_pos
= pt
->read_end
;
672 /* Throw error if unread-char used at beginning of file
673 then attempting to write. Seems correct. */
674 if (!ioscm_lseek_address (iomem
, -offset
, SEEK_CUR
))
676 gdbscm_out_of_range_error (FUNC_NAME
, 0, scm_from_int (offset
),
681 pt
->rw_active
= SCM_PORT_NEITHER
;
684 /* "flush" method for memory ports. */
687 gdbscm_memory_port_flush (SCM port
)
689 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
690 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
691 size_t to_write
= pt
->write_pos
- pt
->write_buf
;
696 /* There's no way to indicate a short write, so if the request goes past
697 the end of the port's memory range, flag an error. */
698 if (to_write
> iomem
->size
- iomem
->current
)
700 gdbscm_out_of_range_error (FUNC_NAME
, 0,
701 gdbscm_scm_from_ulongest (to_write
),
702 _("writing beyond end of memory range"));
705 if (target_write_memory (iomem
->start
+ iomem
->current
, pt
->write_buf
,
707 gdbscm_memory_error (FUNC_NAME
, _("error writing memory"), SCM_EOL
);
709 iomem
->current
+= to_write
;
710 pt
->write_pos
= pt
->write_buf
;
711 pt
->rw_active
= SCM_PORT_NEITHER
;
714 /* "write" method for memory ports. */
717 gdbscm_memory_port_write (SCM port
, const void *data
, size_t size
)
719 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
720 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
722 /* There's no way to indicate a short write, so if the request goes past
723 the end of the port's memory range, flag an error. */
724 if (size
> iomem
->size
- iomem
->current
)
726 gdbscm_out_of_range_error (FUNC_NAME
, 0, gdbscm_scm_from_ulongest (size
),
727 _("writing beyond end of memory range"));
730 if (pt
->write_buf
== &pt
->shortbuf
)
732 /* Unbuffered port. */
733 if (target_write_memory (iomem
->start
+ iomem
->current
, data
, size
) != 0)
734 gdbscm_memory_error (FUNC_NAME
, _("error writing memory"), SCM_EOL
);
735 iomem
->current
+= size
;
739 /* Note: The edge case of what to do when the buffer exactly fills is
740 debatable. Guile flushes when the buffer exactly fills up, so we
741 do too. It's counter-intuitive to my mind, but in case there's a
742 subtlety somewhere that depends on this, we do the same. */
745 size_t space
= pt
->write_end
- pt
->write_pos
;
749 /* Data fits in buffer, and does not fill it. */
750 memcpy (pt
->write_pos
, data
, size
);
751 pt
->write_pos
+= size
;
755 memcpy (pt
->write_pos
, data
, space
);
756 pt
->write_pos
= pt
->write_end
;
757 gdbscm_memory_port_flush (port
);
759 const void *ptr
= ((const char *) data
) + space
;
760 size_t remaining
= size
- space
;
762 if (remaining
>= pt
->write_buf_size
)
764 if (target_write_memory (iomem
->start
+ iomem
->current
, ptr
,
766 gdbscm_memory_error (FUNC_NAME
, _("error writing memory"),
768 iomem
->current
+= remaining
;
772 memcpy (pt
->write_pos
, ptr
, remaining
);
773 pt
->write_pos
+= remaining
;
780 /* "seek" method for memory ports. */
783 gdbscm_memory_port_seek (SCM port
, scm_t_off offset
, int whence
)
785 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
786 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
790 if (pt
->rw_active
== SCM_PORT_WRITE
)
792 if (offset
!= 0 || whence
!= SEEK_CUR
)
794 gdbscm_memory_port_flush (port
);
795 rc
= ioscm_lseek_address (iomem
, offset
, whence
);
796 result
= iomem
->current
;
800 /* Read current position without disturbing the buffer,
801 but flag an error if what's in the buffer goes outside the
803 CORE_ADDR current
= iomem
->current
;
804 size_t delta
= pt
->write_pos
- pt
->write_buf
;
806 if (current
+ delta
< current
807 || current
+ delta
> iomem
->size
)
811 result
= current
+ delta
;
816 else if (pt
->rw_active
== SCM_PORT_READ
)
818 if (offset
!= 0 || whence
!= SEEK_CUR
)
820 scm_end_input (port
);
821 rc
= ioscm_lseek_address (iomem
, offset
, whence
);
822 result
= iomem
->current
;
826 /* Read current position without disturbing the buffer
827 (particularly the unread-char buffer). */
828 CORE_ADDR current
= iomem
->current
;
829 size_t remaining
= pt
->read_end
- pt
->read_pos
;
831 if (current
- remaining
> current
832 || current
- remaining
< iomem
->start
)
836 result
= current
- remaining
;
840 if (rc
!= 0 && pt
->read_buf
== pt
->putback_buf
)
842 size_t saved_remaining
= pt
->saved_read_end
- pt
->saved_read_pos
;
844 if (result
- saved_remaining
> result
845 || result
- saved_remaining
< iomem
->start
)
848 result
-= saved_remaining
;
852 else /* SCM_PORT_NEITHER */
854 rc
= ioscm_lseek_address (iomem
, offset
, whence
);
855 result
= iomem
->current
;
860 gdbscm_out_of_range_error (FUNC_NAME
, 0,
861 gdbscm_scm_from_longest (offset
),
865 /* TODO: The Guile API doesn't support 32x64. We can't fix that here,
866 and there's no need to throw an error if the new address can't be
867 represented in a scm_t_off. But we could return something less
872 /* "close" method for memory ports. */
875 gdbscm_memory_port_close (SCM port
)
877 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
878 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
880 gdbscm_memory_port_flush (port
);
882 if (pt
->read_buf
== pt
->putback_buf
)
883 pt
->read_buf
= pt
->saved_read_buf
;
884 if (pt
->read_buf
!= &pt
->shortbuf
)
885 xfree (pt
->read_buf
);
886 if (pt
->write_buf
!= &pt
->shortbuf
)
887 xfree (pt
->write_buf
);
888 scm_gc_free (iomem
, sizeof (*iomem
), "memory port");
893 /* "free" method for memory ports. */
896 gdbscm_memory_port_free (SCM port
)
898 gdbscm_memory_port_close (port
);
903 /* "print" method for memory ports. */
906 gdbscm_memory_port_print (SCM exp
, SCM port
, scm_print_state
*pstate
)
908 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (exp
);
909 char *type
= SCM_PTOBNAME (SCM_PTOBNUM (exp
));
911 scm_puts ("#<", port
);
912 scm_print_port_mode (exp
, port
);
913 /* scm_print_port_mode includes a trailing space. */
914 gdbscm_printf (port
, "%s %s-%s", type
,
915 hex_string (iomem
->start
), hex_string (iomem
->end
));
916 scm_putc ('>', port
);
920 /* Create the port type used for memory. */
923 ioscm_init_memory_port_type (void)
925 memory_port_desc
= scm_make_port_type (memory_port_desc_name
,
926 gdbscm_memory_port_fill_input
,
927 gdbscm_memory_port_write
);
929 scm_set_port_end_input (memory_port_desc
, gdbscm_memory_port_end_input
);
930 scm_set_port_flush (memory_port_desc
, gdbscm_memory_port_flush
);
931 scm_set_port_seek (memory_port_desc
, gdbscm_memory_port_seek
);
932 scm_set_port_close (memory_port_desc
, gdbscm_memory_port_close
);
933 scm_set_port_free (memory_port_desc
, gdbscm_memory_port_free
);
934 scm_set_port_print (memory_port_desc
, gdbscm_memory_port_print
);
937 /* Helper for gdbscm_open_memory to parse the mode bits.
938 An exception is thrown if MODE is invalid. */
941 ioscm_parse_mode_bits (const char *func_name
, const char *mode
)
946 if (*mode
!= 'r' && *mode
!= 'w')
948 gdbscm_out_of_range_error (func_name
, 0,
949 gdbscm_scm_from_c_string (mode
),
950 _("bad mode string"));
952 for (p
= mode
+ 1; *p
!= '\0'; ++p
)
961 gdbscm_out_of_range_error (func_name
, 0,
962 gdbscm_scm_from_c_string (mode
),
963 _("bad mode string"));
967 /* Kinda awkward to convert the mode from SCM -> string only to have Guile
968 convert it back to SCM, but that's the API we have to work with. */
969 mode_bits
= scm_mode_bits ((char *) mode
);
974 /* Helper for gdbscm_open_memory to finish initializing the port.
975 The port has address range [start,end).
976 This means that address of 0xff..ff is not accessible.
977 I can live with that. */
980 ioscm_init_memory_port (SCM port
, CORE_ADDR start
, CORE_ADDR end
)
983 ioscm_memory_port
*iomem
;
984 int buffered
= (SCM_CELL_WORD_0 (port
) & SCM_BUF0
) == 0;
986 gdb_assert (start
<= end
);
988 iomem
= (ioscm_memory_port
*) scm_gc_malloc_pointerless (sizeof (*iomem
),
991 iomem
->start
= start
;
993 iomem
->size
= end
- start
;
997 iomem
->read_buf_size
= default_read_buf_size
;
998 iomem
->write_buf_size
= default_write_buf_size
;
1002 iomem
->read_buf_size
= 1;
1003 iomem
->write_buf_size
= 1;
1006 pt
= SCM_PTAB_ENTRY (port
);
1007 /* Match the expectation of `binary-port?'. */
1008 pt
->encoding
= NULL
;
1010 pt
->read_buf_size
= iomem
->read_buf_size
;
1011 pt
->write_buf_size
= iomem
->write_buf_size
;
1014 pt
->read_buf
= xmalloc (pt
->read_buf_size
);
1015 pt
->write_buf
= xmalloc (pt
->write_buf_size
);
1019 pt
->read_buf
= &pt
->shortbuf
;
1020 pt
->write_buf
= &pt
->shortbuf
;
1022 pt
->read_pos
= pt
->read_end
= pt
->read_buf
;
1023 pt
->write_pos
= pt
->write_buf
;
1024 pt
->write_end
= pt
->write_buf
+ pt
->write_buf_size
;
1026 SCM_SETSTREAM (port
, iomem
);
1029 /* Re-initialize a memory port, updating its read/write buffer sizes.
1030 An exception is thrown if the port is unbuffered.
1031 TODO: Allow switching buffered/unbuffered.
1032 An exception is also thrown if data is still buffered, except in the case
1033 where the buffer size isn't changing (since that's just a nop). */
1036 ioscm_reinit_memory_port (SCM port
, size_t read_buf_size
,
1037 size_t write_buf_size
, const char *func_name
)
1039 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
1040 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
1042 gdb_assert (read_buf_size
>= min_memory_port_buf_size
1043 && read_buf_size
<= max_memory_port_buf_size
);
1044 gdb_assert (write_buf_size
>= min_memory_port_buf_size
1045 && write_buf_size
<= max_memory_port_buf_size
);
1047 /* First check if the port is unbuffered. */
1049 if (pt
->read_buf
== &pt
->shortbuf
)
1051 gdb_assert (pt
->write_buf
== &pt
->shortbuf
);
1052 scm_misc_error (func_name
, _("port is unbuffered: ~a"),
1056 /* Next check if anything is buffered. */
1058 if (read_buf_size
!= pt
->read_buf_size
1059 && pt
->read_end
!= pt
->read_buf
)
1061 scm_misc_error (func_name
, _("read buffer not empty: ~a"),
1065 if (write_buf_size
!= pt
->write_buf_size
1066 && pt
->write_pos
!= pt
->write_buf
)
1068 scm_misc_error (func_name
, _("write buffer not empty: ~a"),
1072 /* Now we can update the buffer sizes, but only if the size has changed. */
1074 if (read_buf_size
!= pt
->read_buf_size
)
1076 iomem
->read_buf_size
= read_buf_size
;
1077 pt
->read_buf_size
= read_buf_size
;
1078 xfree (pt
->read_buf
);
1079 pt
->read_buf
= xmalloc (pt
->read_buf_size
);
1080 pt
->read_pos
= pt
->read_end
= pt
->read_buf
;
1083 if (write_buf_size
!= pt
->write_buf_size
)
1085 iomem
->write_buf_size
= write_buf_size
;
1086 pt
->write_buf_size
= write_buf_size
;
1087 xfree (pt
->write_buf
);
1088 pt
->write_buf
= xmalloc (pt
->write_buf_size
);
1089 pt
->write_pos
= pt
->write_buf
;
1090 pt
->write_end
= pt
->write_buf
+ pt
->write_buf_size
;
1094 /* (open-memory [#:mode string] [#:start address] [#:size integer]) -> port
1095 Return a port that can be used for reading and writing memory.
1096 MODE is a string, and must be one of "r", "w", or "r+".
1097 "0" may be appended to MODE to mark the port as unbuffered.
1098 For compatibility "b" (binary) may also be appended, but we ignore it:
1099 memory ports are binary only.
1101 The chunk of memory that can be accessed can be bounded.
1102 If both START,SIZE are unspecified, all of memory can be accessed
1103 (except 0xff..ff). If only START is specified, all of memory from that
1104 point on can be accessed (except 0xff..ff). If only SIZE if specified,
1105 all memory in [0,SIZE) can be accessed. If both are specified, all memory
1106 in [START,START+SIZE) can be accessed.
1108 Note: If it becomes useful enough we can later add #:end as an alternative
1109 to #:size. For now it is left out.
1111 The result is a Scheme port, and its semantics are a bit odd for accessing
1112 memory (e.g., unget), but we don't try to hide this. It's a port.
1114 N.B. Seeks on the port must be in the range [0,size].
1115 This is for similarity with bytevector ports, and so that one can seek
1116 to the first byte. */
1119 gdbscm_open_memory (SCM rest
)
1121 const SCM keywords
[] = {
1122 mode_keyword
, start_keyword
, size_keyword
, SCM_BOOL_F
1125 CORE_ADDR start
= 0;
1127 int mode_arg_pos
= -1, start_arg_pos
= -1, size_arg_pos
= -1;
1132 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, keywords
, "#sUU", rest
,
1133 &mode_arg_pos
, &mode
,
1134 &start_arg_pos
, &start
,
1135 &size_arg_pos
, &size
);
1137 scm_dynwind_begin (0);
1140 mode
= xstrdup ("r");
1141 scm_dynwind_free (mode
);
1143 if (size_arg_pos
> 0)
1145 /* For now be strict about start+size overflowing. If it becomes
1146 a nuisance we can relax things later. */
1147 if (start
+ size
< start
)
1149 gdbscm_out_of_range_error (FUNC_NAME
, 0,
1150 scm_list_2 (gdbscm_scm_from_ulongest (start
),
1151 gdbscm_scm_from_ulongest (size
)),
1152 _("start+size overflows"));
1157 end
= ~(CORE_ADDR
) 0;
1159 mode_bits
= ioscm_parse_mode_bits (FUNC_NAME
, mode
);
1161 port
= ioscm_open_port (memory_port_desc
, mode_bits
);
1163 ioscm_init_memory_port (port
, start
, end
);
1167 /* TODO: Set the file name as "memory-start-end"? */
1171 /* Return non-zero if OBJ is a memory port. */
1174 gdbscm_is_memory_port (SCM obj
)
1176 return !SCM_IMP (obj
) && (SCM_TYP16 (obj
) == memory_port_desc
);
1179 /* (memory-port? obj) -> boolean */
1182 gdbscm_memory_port_p (SCM obj
)
1184 return scm_from_bool (gdbscm_is_memory_port (obj
));
1187 /* (memory-port-range port) -> (start end) */
1190 gdbscm_memory_port_range (SCM port
)
1192 ioscm_memory_port
*iomem
;
1194 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port
), port
, SCM_ARG1
, FUNC_NAME
,
1195 memory_port_desc_name
);
1197 iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
1198 return scm_list_2 (gdbscm_scm_from_ulongest (iomem
->start
),
1199 gdbscm_scm_from_ulongest (iomem
->end
));
1202 /* (memory-port-read-buffer-size port) -> integer */
1205 gdbscm_memory_port_read_buffer_size (SCM port
)
1207 ioscm_memory_port
*iomem
;
1209 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port
), port
, SCM_ARG1
, FUNC_NAME
,
1210 memory_port_desc_name
);
1212 iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
1213 return scm_from_uint (iomem
->read_buf_size
);
1216 /* (set-memory-port-read-buffer-size! port size) -> unspecified
1217 An exception is thrown if read data is still buffered or if the port
1221 gdbscm_set_memory_port_read_buffer_size_x (SCM port
, SCM size
)
1223 ioscm_memory_port
*iomem
;
1225 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port
), port
, SCM_ARG1
, FUNC_NAME
,
1226 memory_port_desc_name
);
1227 SCM_ASSERT_TYPE (scm_is_integer (size
), size
, SCM_ARG2
, FUNC_NAME
,
1230 if (!scm_is_unsigned_integer (size
, min_memory_port_buf_size
,
1231 max_memory_port_buf_size
))
1233 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG2
, size
,
1234 out_of_range_buf_size
);
1237 iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
1238 ioscm_reinit_memory_port (port
, scm_to_uint (size
), iomem
->write_buf_size
,
1241 return SCM_UNSPECIFIED
;
1244 /* (memory-port-write-buffer-size port) -> integer */
1247 gdbscm_memory_port_write_buffer_size (SCM port
)
1249 ioscm_memory_port
*iomem
;
1251 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port
), port
, SCM_ARG1
, FUNC_NAME
,
1252 memory_port_desc_name
);
1254 iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
1255 return scm_from_uint (iomem
->write_buf_size
);
1258 /* (set-memory-port-write-buffer-size! port size) -> unspecified
1259 An exception is thrown if write data is still buffered or if the port
1263 gdbscm_set_memory_port_write_buffer_size_x (SCM port
, SCM size
)
1265 ioscm_memory_port
*iomem
;
1267 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port
), port
, SCM_ARG1
, FUNC_NAME
,
1268 memory_port_desc_name
);
1269 SCM_ASSERT_TYPE (scm_is_integer (size
), size
, SCM_ARG2
, FUNC_NAME
,
1272 if (!scm_is_unsigned_integer (size
, min_memory_port_buf_size
,
1273 max_memory_port_buf_size
))
1275 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG2
, size
,
1276 out_of_range_buf_size
);
1279 iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
1280 ioscm_reinit_memory_port (port
, iomem
->read_buf_size
, scm_to_uint (size
),
1283 return SCM_UNSPECIFIED
;
1286 /* Initialize gdb ports. */
1288 static const scheme_function port_functions
[] =
1290 { "input-port", 0, 0, 0, gdbscm_input_port
,
1292 Return gdb's input port." },
1294 { "output-port", 0, 0, 0, gdbscm_output_port
,
1296 Return gdb's output port." },
1298 { "error-port", 0, 0, 0, gdbscm_error_port
,
1300 Return gdb's error port." },
1302 { "stdio-port?", 1, 0, 0, gdbscm_stdio_port_p
,
1304 Return #t if the object is a gdb:stdio-port." },
1306 { "open-memory", 0, 0, 1, gdbscm_open_memory
,
1308 Return a port that can be used for reading/writing inferior memory.\n\
1310 Arguments: [#:mode string] [#:start address] [#:size integer]\n\
1311 Returns: A port object." },
1313 { "memory-port?", 1, 0, 0, gdbscm_memory_port_p
,
1315 Return #t if the object is a memory port." },
1317 { "memory-port-range", 1, 0, 0, gdbscm_memory_port_range
,
1319 Return the memory range of the port as (start end)." },
1321 { "memory-port-read-buffer-size", 1, 0, 0,
1322 gdbscm_memory_port_read_buffer_size
,
1324 Return the size of the read buffer for the memory port." },
1326 { "set-memory-port-read-buffer-size!", 2, 0, 0,
1327 gdbscm_set_memory_port_read_buffer_size_x
,
1329 Set the size of the read buffer for the memory port.\n\
1331 Arguments: port integer\n\
1332 Returns: unspecified." },
1334 { "memory-port-write-buffer-size", 1, 0, 0,
1335 gdbscm_memory_port_write_buffer_size
,
1337 Return the size of the write buffer for the memory port." },
1339 { "set-memory-port-write-buffer-size!", 2, 0, 0,
1340 gdbscm_set_memory_port_write_buffer_size_x
,
1342 Set the size of the write buffer for the memory port.\n\
1344 Arguments: port integer\n\
1345 Returns: unspecified." },
1350 static const scheme_function private_port_functions
[] =
1353 { "%with-gdb-input-from-port", 2, 0, 0,
1354 gdbscm_percent_with_gdb_input_from_port
,
1356 Temporarily set GDB's input port to PORT and then invoke THUNK.\n\
1358 Arguments: port thunk\n\
1359 Returns: The result of calling THUNK.\n\
1361 This procedure is experimental." },
1364 { "%with-gdb-output-to-port", 2, 0, 0,
1365 gdbscm_percent_with_gdb_output_to_port
,
1367 Temporarily set GDB's output port to PORT and then invoke THUNK.\n\
1369 Arguments: port thunk\n\
1370 Returns: The result of calling THUNK.\n\
1372 This procedure is experimental." },
1374 { "%with-gdb-error-to-port", 2, 0, 0,
1375 gdbscm_percent_with_gdb_error_to_port
,
1377 Temporarily set GDB's error port to PORT and then invoke THUNK.\n\
1379 Arguments: port thunk\n\
1380 Returns: The result of calling THUNK.\n\
1382 This procedure is experimental." },
1388 gdbscm_initialize_ports (void)
1390 /* Save the original stdio ports for debugging purposes. */
1392 orig_input_port_scm
= scm_current_input_port ();
1393 orig_output_port_scm
= scm_current_output_port ();
1394 orig_error_port_scm
= scm_current_error_port ();
1396 /* Set up the stdio ports. */
1398 ioscm_init_gdb_stdio_port ();
1399 input_port_scm
= ioscm_make_gdb_stdio_port (0);
1400 output_port_scm
= ioscm_make_gdb_stdio_port (1);
1401 error_port_scm
= ioscm_make_gdb_stdio_port (2);
1403 /* Set up memory ports. */
1405 ioscm_init_memory_port_type ();
1407 /* Install the accessor functions. */
1409 gdbscm_define_functions (port_functions
, 1);
1410 gdbscm_define_functions (private_port_functions
, 0);
1412 /* Keyword args for open-memory. */
1414 mode_keyword
= scm_from_latin1_keyword ("mode");
1415 start_keyword
= scm_from_latin1_keyword ("start");
1416 size_keyword
= scm_from_latin1_keyword ("size");
1418 /* Error message text for "out of range" memory port buffer sizes. */
1420 out_of_range_buf_size
= xstrprintf ("size not between %u - %u",
1421 min_memory_port_buf_size
,
1422 max_memory_port_buf_size
);