1 /* Support for connecting Guile's stdio to GDB's.
2 as well as r/w memory via ports.
4 Copyright (C) 2014 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, inclusive.
51 To simplify overflow handling, an END of 0xff..ff is not allowed.
52 This also means a start address of 0xff..ff is also not allowed.
53 I can live with that. */
56 /* (end - start + 1), recorded for convenience. */
59 /* Think of this as the lseek value maintained by the kernel.
60 This value is always in the range [0, size]. */
63 /* The size of the internal r/w buffers.
64 Scheme ports aren't a straightforward mapping to memory r/w.
65 Generally the user specifies how much to r/w and all access is
66 unbuffered. We don't try to provide equivalent access, but we allow
67 the user to specify these values to help get something similar. */
68 unsigned read_buf_size
, write_buf_size
;
71 /* Copies of the original system input/output/error ports.
72 These are recorded for debugging purposes. */
73 static SCM orig_input_port_scm
;
74 static SCM orig_output_port_scm
;
75 static SCM orig_error_port_scm
;
77 /* This is the stdio port descriptor, scm_ptob_descriptor. */
78 static scm_t_bits stdio_port_desc
;
80 /* Note: scm_make_port_type takes a char * instead of a const char *. */
81 static /*const*/ char stdio_port_desc_name
[] = "gdb:stdio-port";
83 /* Names of each gdb port. */
84 static const char input_port_name
[] = "gdb:stdin";
85 static const char output_port_name
[] = "gdb:stdout";
86 static const char error_port_name
[] = "gdb:stderr";
88 /* This is the actual port used from Guile.
89 We don't expose these to the user though, to ensure they're not
91 static SCM input_port_scm
;
92 static SCM output_port_scm
;
93 static SCM error_port_scm
;
95 /* Magic number to identify port ui-files.
96 Actually, the address of this variable is the magic number. */
97 static int file_port_magic
;
99 /* Internal enum for specifying output port. */
100 enum oport
{ GDB_STDOUT
, GDB_STDERR
};
102 /* This is the memory port descriptor, scm_ptob_descriptor. */
103 static scm_t_bits memory_port_desc
;
105 /* Note: scm_make_port_type takes a char * instead of a const char *. */
106 static /*const*/ char memory_port_desc_name
[] = "gdb:memory-port";
108 /* The default amount of memory to fetch for each read/write request.
109 Scheme ports don't provide a way to specify the size of a read,
110 which is important to us to minimize the number of inferior interactions,
111 which over a remote link can be important. To compensate we augment the
112 port API with a new function that let's the user specify how much the next
113 read request should fetch. This is the initial value for each new port. */
114 static const unsigned default_read_buf_size
= 16;
115 static const unsigned default_write_buf_size
= 16;
117 /* Arbitrarily limit memory port buffers to 1 byte to 4K. */
118 static const unsigned min_memory_port_buf_size
= 1;
119 static const unsigned max_memory_port_buf_size
= 4096;
121 /* "out of range" error message for buf sizes. */
122 static char *out_of_range_buf_size
;
124 /* Keywords used by open-memory. */
125 static SCM mode_keyword
;
126 static SCM start_keyword
;
127 static SCM size_keyword
;
129 /* Helper to do the low level work of opening a port.
130 Newer versions of Guile (2.1.x) have scm_c_make_port. */
133 ioscm_open_port (scm_t_bits port_type
, long mode_bits
)
137 #if 0 /* TODO: Guile doesn't export this. What to do? */
138 scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex
);
141 port
= scm_new_port_table_entry (port_type
);
143 SCM_SET_CELL_TYPE (port
, port_type
| mode_bits
);
145 #if 0 /* TODO: Guile doesn't export this. What to do? */
146 scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex
);
152 /* Support for connecting Guile's stdio ports to GDB's stdio ports. */
154 /* The scm_t_ptob_descriptor.input_waiting "method".
155 Return a lower bound on the number of bytes available for input. */
158 ioscm_input_waiting (SCM port
)
162 if (! scm_is_eq (port
, input_port_scm
))
167 /* This is copied from libguile/fports.c. */
168 struct pollfd pollfd
= { fdes
, POLLIN
, 0 };
169 static int use_poll
= -1;
173 /* This is copied from event-loop.c: poll cannot be used for stdin on
174 m68k-motorola-sysv. */
175 struct pollfd test_pollfd
= { fdes
, POLLIN
, 0 };
177 if (poll (&test_pollfd
, 1, 0) == 1 && (test_pollfd
.revents
& POLLNVAL
))
185 /* Guile doesn't export SIGINT hooks like Python does.
186 For now pass EINTR to scm_syserror, that's what fports.c does. */
187 if (poll (&pollfd
, 1, 0) < 0)
188 scm_syserror (FUNC_NAME
);
190 return pollfd
.revents
& POLLIN
? 1 : 0;
197 struct timeval timeout
;
199 int num_fds
= fdes
+ 1;
202 memset (&timeout
, 0, sizeof (timeout
));
203 FD_ZERO (&input_fds
);
204 FD_SET (fdes
, &input_fds
);
206 num_found
= gdb_select (num_fds
, &input_fds
, NULL
, NULL
, &timeout
);
209 /* Guile doesn't export SIGINT hooks like Python does.
210 For now pass EINTR to scm_syserror, that's what fports.c does. */
211 scm_syserror (FUNC_NAME
);
213 return num_found
> 0 && FD_ISSET (fdes
, &input_fds
);
217 /* The scm_t_ptob_descriptor.fill_input "method". */
220 ioscm_fill_input (SCM port
)
222 /* Borrowed from libguile/fports.c. */
224 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
226 /* If we're called on stdout,stderr, punt. */
227 if (! scm_is_eq (port
, input_port_scm
))
228 return (scm_t_wchar
) EOF
; /* Set errno and return -1? */
230 gdb_flush (gdb_stdout
);
231 gdb_flush (gdb_stderr
);
233 count
= ui_file_read (gdb_stdin
, (char *) pt
->read_buf
, pt
->read_buf_size
);
235 scm_syserror (FUNC_NAME
);
237 return (scm_t_wchar
) EOF
;
239 pt
->read_pos
= pt
->read_buf
;
240 pt
->read_end
= pt
->read_buf
+ count
;
241 return *pt
->read_buf
;
244 /* Like fputstrn_filtered, but don't escape characters, except nul.
245 Also like fputs_filtered, but a length is specified. */
248 fputsn_filtered (const char *s
, size_t size
, struct ui_file
*stream
)
252 for (i
= 0; i
< size
; ++i
)
255 fputs_filtered ("\\000", stream
);
257 fputc_filtered (s
[i
], stream
);
261 /* Write to gdb's stdout or stderr. */
264 ioscm_write (SCM port
, const void *data
, size_t size
)
266 volatile struct gdb_exception except
;
268 /* If we're called on stdin, punt. */
269 if (scm_is_eq (port
, input_port_scm
))
272 TRY_CATCH (except
, RETURN_MASK_ALL
)
274 if (scm_is_eq (port
, error_port_scm
))
275 fputsn_filtered (data
, size
, gdb_stderr
);
277 fputsn_filtered (data
, size
, gdb_stdout
);
279 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
282 /* Flush gdb's stdout or stderr. */
285 ioscm_flush (SCM port
)
287 /* If we're called on stdin, punt. */
288 if (scm_is_eq (port
, input_port_scm
))
291 if (scm_is_eq (port
, error_port_scm
))
292 gdb_flush (gdb_stderr
);
294 gdb_flush (gdb_stdout
);
297 /* Initialize the gdb stdio port type.
299 N.B. isatty? will fail on these ports, it is only supported for file
300 ports. IWBN if we could "subclass" file ports. */
303 ioscm_init_gdb_stdio_port (void)
305 stdio_port_desc
= scm_make_port_type (stdio_port_desc_name
,
306 ioscm_fill_input
, ioscm_write
);
308 scm_set_port_input_waiting (stdio_port_desc
, ioscm_input_waiting
);
309 scm_set_port_flush (stdio_port_desc
, ioscm_flush
);
312 /* Subroutine of ioscm_make_gdb_stdio_port to simplify it.
313 Set up the buffers of port PORT.
314 MODE_BITS are the mode bits of PORT. */
317 ioscm_init_stdio_buffers (SCM port
, long mode_bits
)
319 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
320 #define GDB_STDIO_BUFFER_DEFAULT_SIZE 1024
321 int size
= mode_bits
& SCM_BUF0
? 0 : GDB_STDIO_BUFFER_DEFAULT_SIZE
;
322 int writing
= (mode_bits
& SCM_WRTNG
) != 0;
324 /* This is heavily copied from scm_fport_buffer_add. */
326 if (!writing
&& size
> 0)
328 pt
->read_buf
= scm_gc_malloc_pointerless (size
, "port buffer");
329 pt
->read_pos
= pt
->read_end
= pt
->read_buf
;
330 pt
->read_buf_size
= size
;
334 pt
->read_pos
= pt
->read_buf
= pt
->read_end
= &pt
->shortbuf
;
335 pt
->read_buf_size
= 1;
338 if (writing
&& size
> 0)
340 pt
->write_buf
= scm_gc_malloc_pointerless (size
, "port buffer");
341 pt
->write_pos
= pt
->write_buf
;
342 pt
->write_buf_size
= size
;
346 pt
->write_buf
= pt
->write_pos
= &pt
->shortbuf
;
347 pt
->write_buf_size
= 1;
349 pt
->write_end
= pt
->write_buf
+ pt
->write_buf_size
;
352 /* Create a gdb stdio port. */
355 ioscm_make_gdb_stdio_port (int fd
)
357 int is_a_tty
= isatty (fd
);
365 name
= input_port_name
;
366 mode_bits
= scm_mode_bits (is_a_tty
? "r0" : "r");
369 name
= output_port_name
;
370 mode_bits
= scm_mode_bits (is_a_tty
? "w0" : "w");
373 name
= error_port_name
;
374 mode_bits
= scm_mode_bits (is_a_tty
? "w0" : "w");
377 gdb_assert_not_reached ("bad stdio file descriptor");
380 port
= ioscm_open_port (stdio_port_desc
, mode_bits
);
382 scm_set_port_filename_x (port
, gdbscm_scm_from_c_string (name
));
384 ioscm_init_stdio_buffers (port
, mode_bits
);
389 /* (stdio-port? object) -> boolean */
392 gdbscm_stdio_port_p (SCM scm
)
394 /* This is copied from SCM_FPORTP. */
395 return scm_from_bool (!SCM_IMP (scm
)
396 && (SCM_TYP16 (scm
) == stdio_port_desc
));
399 /* GDB's ports are accessed via functions to keep them read-only. */
401 /* (input-port) -> port */
404 gdbscm_input_port (void)
406 return input_port_scm
;
409 /* (output-port) -> port */
412 gdbscm_output_port (void)
414 return output_port_scm
;
417 /* (error-port) -> port */
420 gdbscm_error_port (void)
422 return error_port_scm
;
425 /* Support for sending GDB I/O to Guile ports. */
428 ioscm_file_port_delete (struct ui_file
*file
)
430 ioscm_file_port
*stream
= ui_file_data (file
);
432 if (stream
->magic
!= &file_port_magic
)
433 internal_error (__FILE__
, __LINE__
,
434 _("ioscm_file_port_delete: bad magic number"));
439 ioscm_file_port_rewind (struct ui_file
*file
)
441 ioscm_file_port
*stream
= ui_file_data (file
);
443 if (stream
->magic
!= &file_port_magic
)
444 internal_error (__FILE__
, __LINE__
,
445 _("ioscm_file_port_rewind: bad magic number"));
447 scm_truncate_file (stream
->port
, 0);
451 ioscm_file_port_put (struct ui_file
*file
,
452 ui_file_put_method_ftype
*write
,
455 ioscm_file_port
*stream
= ui_file_data (file
);
457 if (stream
->magic
!= &file_port_magic
)
458 internal_error (__FILE__
, __LINE__
,
459 _("ioscm_file_port_put: bad magic number"));
461 /* This function doesn't meld with ports very well. */
465 ioscm_file_port_write (struct ui_file
*file
,
469 ioscm_file_port
*stream
= ui_file_data (file
);
471 if (stream
->magic
!= &file_port_magic
)
472 internal_error (__FILE__
, __LINE__
,
473 _("ioscm_pot_file_write: bad magic number"));
475 scm_c_write (stream
->port
, buffer
, length_buffer
);
478 /* Return a ui_file that writes to PORT. */
480 static struct ui_file
*
481 ioscm_file_port_new (SCM port
)
483 ioscm_file_port
*stream
= XCNEW (ioscm_file_port
);
484 struct ui_file
*file
= ui_file_new ();
486 set_ui_file_data (file
, stream
, ioscm_file_port_delete
);
487 set_ui_file_rewind (file
, ioscm_file_port_rewind
);
488 set_ui_file_put (file
, ioscm_file_port_put
);
489 set_ui_file_write (file
, ioscm_file_port_write
);
490 stream
->magic
= &file_port_magic
;
496 /* Helper routine for with-{output,error}-to-port. */
499 ioscm_with_output_to_port_worker (SCM port
, SCM thunk
, enum oport oport
,
500 const char *func_name
)
502 struct ui_file
*port_file
;
503 struct cleanup
*cleanups
;
506 SCM_ASSERT_TYPE (gdbscm_is_true (scm_output_port_p (port
)), port
,
507 SCM_ARG1
, func_name
, _("output port"));
508 SCM_ASSERT_TYPE (gdbscm_is_true (scm_thunk_p (thunk
)), thunk
,
509 SCM_ARG2
, func_name
, _("thunk"));
511 cleanups
= set_batch_flag_and_make_cleanup_restore_page_info ();
513 make_cleanup_restore_integer (&interpreter_async
);
514 interpreter_async
= 0;
516 port_file
= ioscm_file_port_new (port
);
518 make_cleanup_ui_file_delete (port_file
);
520 if (oport
== GDB_STDERR
)
522 make_cleanup_restore_ui_file (&gdb_stderr
);
523 gdb_stderr
= port_file
;
527 make_cleanup_restore_ui_file (&gdb_stdout
);
529 if (ui_out_redirect (current_uiout
, port_file
) < 0)
530 warning (_("Current output protocol does not support redirection"));
532 make_cleanup_ui_out_redirect_pop (current_uiout
);
534 gdb_stdout
= port_file
;
537 result
= gdbscm_safe_call_0 (thunk
, NULL
);
539 do_cleanups (cleanups
);
541 if (gdbscm_is_exception (result
))
542 gdbscm_throw (result
);
547 /* (%with-gdb-output-to-port port thunk) -> object
548 This function is experimental.
549 IWBN to not include "gdb" in the name, but it would collide with a standard
550 procedure, and it's common to import the gdb module without a prefix.
551 There are ways around this, but they're more cumbersome.
553 This has % in the name because it's experimental, and we want the
554 user-visible version to come from module (gdb experimental). */
557 gdbscm_percent_with_gdb_output_to_port (SCM port
, SCM thunk
)
559 return ioscm_with_output_to_port_worker (port
, thunk
, GDB_STDOUT
, FUNC_NAME
);
562 /* (%with-gdb-error-to-port port thunk) -> object
563 This function is experimental.
564 IWBN to not include "gdb" in the name, but it would collide with a standard
565 procedure, and it's common to import the gdb module without a prefix.
566 There are ways around this, but they're more cumbersome.
568 This has % in the name because it's experimental, and we want the
569 user-visible version to come from module (gdb experimental). */
572 gdbscm_percent_with_gdb_error_to_port (SCM port
, SCM thunk
)
574 return ioscm_with_output_to_port_worker (port
, thunk
, GDB_STDERR
, FUNC_NAME
);
577 /* Support for r/w memory via ports. */
579 /* Perform an "lseek" to OFFSET,WHENCE on memory port IOMEM.
580 OFFSET must be in the range [0,size].
581 The result is non-zero for success, zero for failure. */
584 ioscm_lseek_address (ioscm_memory_port
*iomem
, LONGEST offset
, int whence
)
586 CORE_ADDR new_current
;
588 gdb_assert (iomem
->current
<= iomem
->size
);
593 /* Catch over/underflow. */
594 if ((offset
< 0 && iomem
->current
+ offset
> iomem
->current
)
595 || (offset
>= 0 && iomem
->current
+ offset
< iomem
->current
))
597 new_current
= iomem
->current
+ offset
;
600 new_current
= offset
;
605 new_current
= iomem
->size
;
608 /* TODO: Not supported yet. */
614 if (new_current
> iomem
->size
)
616 iomem
->current
= new_current
;
620 /* "fill_input" method for memory ports. */
623 gdbscm_memory_port_fill_input (SCM port
)
625 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
626 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
629 /* "current" is the offset of the first byte we want to read. */
630 if (iomem
->current
>= iomem
->size
)
633 /* Don't read outside the allowed memory range. */
634 to_read
= pt
->read_buf_size
;
635 if (to_read
> iomem
->size
- iomem
->current
)
636 to_read
= iomem
->size
- iomem
->current
;
638 if (target_read_memory (iomem
->start
+ iomem
->current
, pt
->read_buf
,
640 gdbscm_memory_error (FUNC_NAME
, _("error reading memory"), SCM_EOL
);
642 pt
->read_pos
= pt
->read_buf
;
643 pt
->read_end
= pt
->read_buf
+ to_read
;
644 iomem
->current
+= to_read
;
645 return *pt
->read_buf
;
648 /* "end_input" method for memory ports.
649 Clear the read buffer and adjust the file position for unread bytes. */
652 gdbscm_memory_port_end_input (SCM port
, int offset
)
654 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
655 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
656 size_t remaining
= pt
->read_end
- pt
->read_pos
;
658 /* Note: Use of "int offset" is specified by Guile ports API. */
659 if ((offset
< 0 && remaining
+ offset
> remaining
)
660 || (offset
> 0 && remaining
+ offset
< remaining
))
662 gdbscm_out_of_range_error (FUNC_NAME
, 0, scm_from_int (offset
),
663 _("overflow in offset calculation"));
669 pt
->read_pos
= pt
->read_end
;
670 /* Throw error if unread-char used at beginning of file
671 then attempting to write. Seems correct. */
672 if (!ioscm_lseek_address (iomem
, -offset
, SEEK_CUR
))
674 gdbscm_out_of_range_error (FUNC_NAME
, 0, scm_from_int (offset
),
679 pt
->rw_active
= SCM_PORT_NEITHER
;
682 /* "flush" method for memory ports. */
685 gdbscm_memory_port_flush (SCM port
)
687 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
688 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
689 size_t to_write
= pt
->write_pos
- pt
->write_buf
;
694 /* There's no way to indicate a short write, so if the request goes past
695 the end of the port's memory range, flag an error. */
696 if (to_write
> iomem
->size
- iomem
->current
)
698 gdbscm_out_of_range_error (FUNC_NAME
, 0,
699 gdbscm_scm_from_ulongest (to_write
),
700 _("writing beyond end of memory range"));
703 if (target_write_memory (iomem
->start
+ iomem
->current
, pt
->write_buf
,
705 gdbscm_memory_error (FUNC_NAME
, _("error writing memory"), SCM_EOL
);
707 iomem
->current
+= to_write
;
708 pt
->write_pos
= pt
->write_buf
;
709 pt
->rw_active
= SCM_PORT_NEITHER
;
712 /* "write" method for memory ports. */
715 gdbscm_memory_port_write (SCM port
, const void *data
, size_t size
)
717 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
718 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
719 const char *input
= (char *) data
;
721 /* We could get fancy here, and try to buffer the request since we're
722 buffering anyway. But there's currently no need. */
724 /* First flush what's currently buffered. */
725 gdbscm_memory_port_flush (port
);
727 /* There's no way to indicate a short write, so if the request goes past
728 the end of the port's memory range, flag an error. */
729 if (size
> iomem
->size
- iomem
->current
)
731 gdbscm_out_of_range_error (FUNC_NAME
, 0, gdbscm_scm_from_ulongest (size
),
732 _("writing beyond end of memory range"));
735 if (target_write_memory (iomem
->start
+ iomem
->current
, data
, size
) != 0)
736 gdbscm_memory_error (FUNC_NAME
, _("error writing memory"), SCM_EOL
);
738 iomem
->current
+= size
;
741 /* "seek" method for memory ports. */
744 gdbscm_memory_port_seek (SCM port
, scm_t_off offset
, int whence
)
746 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
747 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
751 if (pt
->rw_active
== SCM_PORT_WRITE
)
753 if (offset
!= 0 || whence
!= SEEK_CUR
)
755 gdbscm_memory_port_flush (port
);
756 rc
= ioscm_lseek_address (iomem
, offset
, whence
);
757 result
= iomem
->current
;
761 /* Read current position without disturbing the buffer,
762 but flag an error if what's in the buffer goes outside the
764 CORE_ADDR current
= iomem
->current
;
765 size_t delta
= pt
->write_pos
- pt
->write_buf
;
767 if (current
+ delta
< current
768 || current
+ delta
> iomem
->size
+ 1)
772 result
= current
+ delta
;
777 else if (pt
->rw_active
== SCM_PORT_READ
)
779 if (offset
!= 0 || whence
!= SEEK_CUR
)
781 scm_end_input (port
);
782 rc
= ioscm_lseek_address (iomem
, offset
, whence
);
783 result
= iomem
->current
;
787 /* Read current position without disturbing the buffer
788 (particularly the unread-char buffer). */
789 CORE_ADDR current
= iomem
->current
;
790 size_t remaining
= pt
->read_end
- pt
->read_pos
;
792 if (current
- remaining
> current
793 || current
- remaining
< iomem
->start
)
797 result
= current
- remaining
;
801 if (rc
!= 0 && pt
->read_buf
== pt
->putback_buf
)
803 size_t saved_remaining
= pt
->saved_read_end
- pt
->saved_read_pos
;
805 if (result
- saved_remaining
> result
806 || result
- saved_remaining
< iomem
->start
)
809 result
-= saved_remaining
;
813 else /* SCM_PORT_NEITHER */
815 rc
= ioscm_lseek_address (iomem
, offset
, whence
);
816 result
= iomem
->current
;
821 gdbscm_out_of_range_error (FUNC_NAME
, 0,
822 gdbscm_scm_from_longest (offset
),
826 /* TODO: The Guile API doesn't support 32x64. We can't fix that here,
827 and there's no need to throw an error if the new address can't be
828 represented in a scm_t_off. But we could return something less
833 /* "close" method for memory ports. */
836 gdbscm_memory_port_close (SCM port
)
838 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
839 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
841 gdbscm_memory_port_flush (port
);
843 if (pt
->read_buf
== pt
->putback_buf
)
844 pt
->read_buf
= pt
->saved_read_buf
;
845 xfree (pt
->read_buf
);
846 xfree (pt
->write_buf
);
847 scm_gc_free (iomem
, sizeof (*iomem
), "memory port");
852 /* "free" method for memory ports. */
855 gdbscm_memory_port_free (SCM port
)
857 gdbscm_memory_port_close (port
);
862 /* "print" method for memory ports. */
865 gdbscm_memory_port_print (SCM exp
, SCM port
, scm_print_state
*pstate
)
867 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (exp
);
868 char *type
= SCM_PTOBNAME (SCM_PTOBNUM (exp
));
870 scm_puts ("#<", port
);
871 scm_print_port_mode (exp
, port
);
872 /* scm_print_port_mode includes a trailing space. */
873 gdbscm_printf (port
, "%s %s-%s", type
,
874 hex_string (iomem
->start
), hex_string (iomem
->end
));
875 scm_putc ('>', port
);
879 /* Create the port type used for memory. */
882 ioscm_init_memory_port_type (void)
884 memory_port_desc
= scm_make_port_type (memory_port_desc_name
,
885 gdbscm_memory_port_fill_input
,
886 gdbscm_memory_port_write
);
888 scm_set_port_end_input (memory_port_desc
, gdbscm_memory_port_end_input
);
889 scm_set_port_flush (memory_port_desc
, gdbscm_memory_port_flush
);
890 scm_set_port_seek (memory_port_desc
, gdbscm_memory_port_seek
);
891 scm_set_port_close (memory_port_desc
, gdbscm_memory_port_close
);
892 scm_set_port_free (memory_port_desc
, gdbscm_memory_port_free
);
893 scm_set_port_print (memory_port_desc
, gdbscm_memory_port_print
);
896 /* Helper for gdbscm_open_memory to parse the mode bits.
897 An exception is thrown if MODE is invalid. */
900 ioscm_parse_mode_bits (const char *func_name
, const char *mode
)
905 if (*mode
!= 'r' && *mode
!= 'w')
907 gdbscm_out_of_range_error (func_name
, 0,
908 gdbscm_scm_from_c_string (mode
),
909 _("bad mode string"));
911 for (p
= mode
+ 1; *p
!= '\0'; ++p
)
919 gdbscm_out_of_range_error (func_name
, 0,
920 gdbscm_scm_from_c_string (mode
),
921 _("bad mode string"));
925 /* Kinda awkward to convert the mode from SCM -> string only to have Guile
926 convert it back to SCM, but that's the API we have to work with. */
927 mode_bits
= scm_mode_bits ((char *) mode
);
932 /* Helper for gdbscm_open_memory to finish initializing the port.
933 The port has address range [start,end].
934 To simplify overflow handling, an END of 0xff..ff is not allowed.
935 This also means a start address of 0xff..f is also not allowed.
936 I can live with that. */
939 ioscm_init_memory_port (SCM port
, CORE_ADDR start
, CORE_ADDR end
)
942 ioscm_memory_port
*iomem
;
944 gdb_assert (start
<= end
);
945 gdb_assert (end
< ~(CORE_ADDR
) 0);
947 iomem
= (ioscm_memory_port
*) scm_gc_malloc_pointerless (sizeof (*iomem
),
950 iomem
->start
= start
;
952 iomem
->size
= end
- start
+ 1;
954 iomem
->read_buf_size
= default_read_buf_size
;
955 iomem
->write_buf_size
= default_write_buf_size
;
957 pt
= SCM_PTAB_ENTRY (port
);
958 /* Match the expectation of `binary-port?'. */
961 pt
->read_buf_size
= iomem
->read_buf_size
;
962 pt
->read_buf
= xmalloc (pt
->read_buf_size
);
963 pt
->read_pos
= pt
->read_end
= pt
->read_buf
;
964 pt
->write_buf_size
= iomem
->write_buf_size
;
965 pt
->write_buf
= xmalloc (pt
->write_buf_size
);
966 pt
->write_pos
= pt
->write_buf
;
967 pt
->write_end
= pt
->write_buf
+ pt
->write_buf_size
;
969 SCM_SETSTREAM (port
, iomem
);
972 /* Re-initialize a memory port, updating its read/write buffer sizes.
973 An exception is thrown if data is still buffered, except in the case
974 where the buffer size isn't changing (since that's just a nop). */
977 ioscm_reinit_memory_port (SCM port
, size_t read_buf_size
,
978 size_t write_buf_size
, const char *func_name
)
980 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
981 ioscm_memory_port
*iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
983 gdb_assert (read_buf_size
>= min_memory_port_buf_size
984 && read_buf_size
<= max_memory_port_buf_size
);
985 gdb_assert (write_buf_size
>= min_memory_port_buf_size
986 && write_buf_size
<= max_memory_port_buf_size
);
988 /* First check if anything is buffered. */
990 if (read_buf_size
!= pt
->read_buf_size
991 && pt
->read_end
!= pt
->read_buf
)
993 scm_misc_error (func_name
, _("read buffer not empty: ~a"),
997 if (write_buf_size
!= pt
->write_buf_size
998 && pt
->write_pos
!= pt
->write_buf
)
1000 scm_misc_error (func_name
, _("write buffer not empty: ~a"),
1004 /* Now we can update the buffer sizes, but only if the size has changed. */
1006 if (read_buf_size
!= pt
->read_buf_size
)
1008 iomem
->read_buf_size
= read_buf_size
;
1009 pt
->read_buf_size
= read_buf_size
;
1010 xfree (pt
->read_buf
);
1011 pt
->read_buf
= xmalloc (pt
->read_buf_size
);
1012 pt
->read_pos
= pt
->read_end
= pt
->read_buf
;
1015 if (write_buf_size
!= pt
->write_buf_size
)
1017 iomem
->write_buf_size
= write_buf_size
;
1018 pt
->write_buf_size
= write_buf_size
;
1019 xfree (pt
->write_buf
);
1020 pt
->write_buf
= xmalloc (pt
->write_buf_size
);
1021 pt
->write_pos
= pt
->write_buf
;
1022 pt
->write_end
= pt
->write_buf
+ pt
->write_buf_size
;
1026 /* (open-memory [#:mode string] [#:start address] [#:size integer]) -> port
1027 Return a port that can be used for reading and writing memory.
1028 MODE is a string, and must be one of "r", "w", or "r+".
1029 For compatibility "b" (binary) may also be present, but we ignore it:
1030 memory ports are binary only.
1032 TODO: Support "0" (unbuffered)? Only support "0" (always unbuffered)?
1034 The chunk of memory that can be accessed can be bounded.
1035 If both START,SIZE are unspecified, all of memory can be accessed.
1036 If only START is specified, all of memory from that point on can be
1037 accessed. If only SIZE if specified, all memory in [0,SIZE) can be
1038 accessed. If both are specified, all memory in [START,START+SIZE) can be
1041 Note: If it becomes useful enough we can later add #:end as an alternative
1042 to #:size. For now it is left out.
1044 The result is a Scheme port, and its semantics are a bit odd for accessing
1045 memory (e.g., unget), but we don't try to hide this. It's a port.
1047 N.B. Seeks on the port must be in the range [0,size).
1048 This is for similarity with bytevector ports, and so that one can seek
1049 to the first byte. */
1052 gdbscm_open_memory (SCM rest
)
1054 const SCM keywords
[] = {
1055 mode_keyword
, start_keyword
, size_keyword
, SCM_BOOL_F
1058 CORE_ADDR start
= 0;
1060 int mode_arg_pos
= -1, start_arg_pos
= -1, size_arg_pos
= -1;
1065 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, keywords
, "#sUU", rest
,
1066 &mode_arg_pos
, &mode
,
1067 &start_arg_pos
, &start
,
1068 &size_arg_pos
, &size
);
1070 scm_dynwind_begin (0);
1073 mode
= xstrdup ("r");
1074 scm_dynwind_free (mode
);
1076 if (start
== ~(CORE_ADDR
) 0)
1078 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG1
, scm_from_int (-1),
1079 _("start address of 0xff..ff not allowed"));
1082 if (size_arg_pos
> 0)
1086 gdbscm_out_of_range_error (FUNC_NAME
, 0, scm_from_int (0),
1089 /* For now be strict about start+size overflowing. If it becomes
1090 a nuisance we can relax things later. */
1091 if (start
+ size
< start
)
1093 gdbscm_out_of_range_error (FUNC_NAME
, 0,
1094 scm_list_2 (gdbscm_scm_from_ulongest (start
),
1095 gdbscm_scm_from_ulongest (size
)),
1096 _("start+size overflows"));
1098 end
= start
+ size
- 1;
1099 if (end
== ~(CORE_ADDR
) 0)
1101 gdbscm_out_of_range_error (FUNC_NAME
, 0,
1102 scm_list_2 (gdbscm_scm_from_ulongest (start
),
1103 gdbscm_scm_from_ulongest (size
)),
1104 _("end address of 0xff..ff not allowed"));
1108 end
= (~(CORE_ADDR
) 0) - 1;
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. */
1171 gdbscm_set_memory_port_read_buffer_size_x (SCM port
, SCM size
)
1173 ioscm_memory_port
*iomem
;
1175 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port
), port
, SCM_ARG1
, FUNC_NAME
,
1176 memory_port_desc_name
);
1177 SCM_ASSERT_TYPE (scm_is_integer (size
), size
, SCM_ARG2
, FUNC_NAME
,
1180 if (!scm_is_unsigned_integer (size
, min_memory_port_buf_size
,
1181 max_memory_port_buf_size
))
1183 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG2
, size
,
1184 out_of_range_buf_size
);
1187 iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
1188 ioscm_reinit_memory_port (port
, scm_to_uint (size
), iomem
->write_buf_size
,
1191 return SCM_UNSPECIFIED
;
1194 /* (memory-port-write-buffer-size port) -> integer */
1197 gdbscm_memory_port_write_buffer_size (SCM port
)
1199 ioscm_memory_port
*iomem
;
1201 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port
), port
, SCM_ARG1
, FUNC_NAME
,
1202 memory_port_desc_name
);
1204 iomem
= (ioscm_memory_port
*) SCM_STREAM (port
);
1205 return scm_from_uint (iomem
->write_buf_size
);
1208 /* (set-memory-port-write-buffer-size! port size) -> unspecified
1209 An exception is thrown if write data is still buffered. */
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, gdbscm_input_port
,
1241 Return gdb's input port." },
1243 { "output-port", 0, 0, 0, gdbscm_output_port
,
1245 Return gdb's output port." },
1247 { "error-port", 0, 0, 0, gdbscm_error_port
,
1249 Return gdb's error port." },
1251 { "stdio-port?", 1, 0, 0, gdbscm_stdio_port_p
,
1253 Return #t if the object is a gdb:stdio-port." },
1255 { "open-memory", 0, 0, 1, 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, gdbscm_memory_port_p
,
1264 Return #t if the object is a memory port." },
1266 { "memory-port-range", 1, 0, 0, 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 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 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 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 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 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 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 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
);