1/* Support for connecting Guile's stdio to GDB's. 2 as well as r/w memory via ports. 3 4 Copyright (C) 2014-2020 Free Software Foundation, Inc. 5 6 This file is part of GDB. 7 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. 12 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. 17 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/>. */ 20 21/* See README file in this directory for implementation notes, coding 22 conventions, et.al. */ 23 24#include "defs.h" 25#include "gdbsupport/gdb_select.h" 26#include "top.h" 27#include "target.h" 28#include "guile-internal.h" 29#include "gdbsupport/gdb_optional.h" 30 31#ifdef HAVE_POLL 32#if defined (HAVE_POLL_H) 33#include <poll.h> 34#elif defined (HAVE_SYS_POLL_H) 35#include <sys/poll.h> 36#endif 37#endif 38 39/* Whether we're using Guile < 2.2 and its clumsy port API. */ 40 41#define USING_GUILE_BEFORE_2_2 \ 42 (SCM_MAJOR_VERSION == 2 && SCM_MINOR_VERSION == 0) 43 44 45/* A ui-file for sending output to Guile. */ 46 47class ioscm_file_port : public ui_file 48{ 49public: 50 /* Return a ui_file that writes to PORT. */ 51 explicit ioscm_file_port (SCM port); 52 53 void flush () override; 54 void write (const char *buf, long length_buf) override; 55 56private: 57 SCM m_port; 58}; 59 60/* Data for a memory port. */ 61 62typedef struct 63{ 64 /* Bounds of memory range this port is allowed to access: [start, end). 65 This means that 0xff..ff is not accessible. I can live with that. */ 66 CORE_ADDR start, end; 67 68 /* (end - start), recorded for convenience. */ 69 ULONGEST size; 70 71 /* Think of this as the lseek value maintained by the kernel. 72 This value is always in the range [0, size]. */ 73 ULONGEST current; 74 75#if USING_GUILE_BEFORE_2_2 76 /* The size of the internal r/w buffers. 77 Scheme ports aren't a straightforward mapping to memory r/w. 78 Generally the user specifies how much to r/w and all access is 79 unbuffered. We don't try to provide equivalent access, but we allow 80 the user to specify these values to help get something similar. */ 81 unsigned read_buf_size, write_buf_size; 82#endif 83} ioscm_memory_port; 84 85/* Copies of the original system input/output/error ports. 86 These are recorded for debugging purposes. */ 87static SCM orig_input_port_scm; 88static SCM orig_output_port_scm; 89static SCM orig_error_port_scm; 90 91/* This is the stdio port descriptor, scm_ptob_descriptor. */ 92#if USING_GUILE_BEFORE_2_2 93static scm_t_bits stdio_port_desc; 94#else 95static scm_t_port_type *stdio_port_desc; 96#endif 97 98/* Note: scm_make_port_type takes a char * instead of a const char *. */ 99static /*const*/ char stdio_port_desc_name[] = "gdb:stdio-port"; 100 101/* Names of each gdb port. */ 102static const char input_port_name[] = "gdb:stdin"; 103static const char output_port_name[] = "gdb:stdout"; 104static const char error_port_name[] = "gdb:stderr"; 105 106/* This is the actual port used from Guile. 107 We don't expose these to the user though, to ensure they're not 108 overwritten. */ 109static SCM input_port_scm; 110static SCM output_port_scm; 111static SCM error_port_scm; 112 113/* Internal enum for specifying output port. */ 114enum oport { GDB_STDOUT, GDB_STDERR }; 115 116/* This is the memory port descriptor, scm_ptob_descriptor. */ 117#if USING_GUILE_BEFORE_2_2 118static scm_t_bits memory_port_desc; 119#else 120static scm_t_port_type *memory_port_desc; 121#endif 122 123/* Note: scm_make_port_type takes a char * instead of a const char *. */ 124static /*const*/ char memory_port_desc_name[] = "gdb:memory-port"; 125 126#if USING_GUILE_BEFORE_2_2 127 128/* The default amount of memory to fetch for each read/write request. 129 Scheme ports don't provide a way to specify the size of a read, 130 which is important to us to minimize the number of inferior interactions, 131 which over a remote link can be important. To compensate we augment the 132 port API with a new function that let's the user specify how much the next 133 read request should fetch. This is the initial value for each new port. */ 134static const unsigned default_read_buf_size = 16; 135static const unsigned default_write_buf_size = 16; 136 137/* Arbitrarily limit memory port buffers to 1 byte to 4K. */ 138static const unsigned min_memory_port_buf_size = 1; 139static const unsigned max_memory_port_buf_size = 4096; 140 141/* "out of range" error message for buf sizes. */ 142static char *out_of_range_buf_size; 143 144#else 145 146/* The maximum values to use for get_natural_buffer_sizes. */ 147static const unsigned natural_buf_size = 16; 148 149#endif 150 151/* Keywords used by open-memory. */ 152static SCM mode_keyword; 153static SCM start_keyword; 154static SCM size_keyword; 155 156/* Helper to do the low level work of opening a port. */ 157 158#if USING_GUILE_BEFORE_2_2 159 160static SCM 161ioscm_open_port (scm_t_bits port_type, long mode_bits, scm_t_bits stream) 162{ 163 SCM port; 164 165#if 0 /* TODO: Guile doesn't export this. What to do? */ 166 scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex); 167#endif 168 169 port = scm_new_port_table_entry (port_type); 170 171 SCM_SET_CELL_TYPE (port, port_type | mode_bits); 172 SCM_SETSTREAM (port, stream); 173 174#if 0 /* TODO: Guile doesn't export this. What to do? */ 175 scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex); 176#endif 177 178 return port; 179} 180 181#else 182 183static SCM 184ioscm_open_port (scm_t_port_type *port_type, long mode_bits, scm_t_bits stream) 185{ 186 return scm_c_make_port (port_type, mode_bits, stream); 187} 188 189#endif 190 191 192/* Support for connecting Guile's stdio ports to GDB's stdio ports. */ 193 194/* Like fputstrn_filtered, but don't escape characters, except nul. 195 Also like fputs_filtered, but a length is specified. */ 196 197static void 198fputsn_filtered (const char *s, size_t size, struct ui_file *stream) 199{ 200 size_t i; 201 202 for (i = 0; i < size; ++i) 203 { 204 if (s[i] == '\0') 205 fputs_filtered ("\\000", stream); 206 else 207 fputc_filtered (s[i], stream); 208 } 209} 210 211#if USING_GUILE_BEFORE_2_2 212 213/* The scm_t_ptob_descriptor.input_waiting "method". 214 Return a lower bound on the number of bytes available for input. */ 215 216static int 217ioscm_input_waiting (SCM port) 218{ 219 int fdes = 0; 220 221 if (! scm_is_eq (port, input_port_scm)) 222 return 0; 223 224#ifdef HAVE_POLL 225 { 226 /* This is copied from libguile/fports.c. */ 227 struct pollfd pollfd = { fdes, POLLIN, 0 }; 228 static int use_poll = -1; 229 230 if (use_poll < 0) 231 { 232 /* This is copied from event-loop.c: poll cannot be used for stdin on 233 m68k-motorola-sysv. */ 234 struct pollfd test_pollfd = { fdes, POLLIN, 0 }; 235 236 if (poll (&test_pollfd, 1, 0) == 1 && (test_pollfd.revents & POLLNVAL)) 237 use_poll = 0; 238 else 239 use_poll = 1; 240 } 241 242 if (use_poll) 243 { 244 /* Guile doesn't export SIGINT hooks like Python does. 245 For now pass EINTR to scm_syserror, that's what fports.c does. */ 246 if (poll (&pollfd, 1, 0) < 0) 247 scm_syserror (FUNC_NAME); 248 249 return pollfd.revents & POLLIN ? 1 : 0; 250 } 251 } 252 /* Fall through. */ 253#endif 254 255 { 256 struct timeval timeout; 257 fd_set input_fds; 258 int num_fds = fdes + 1; 259 int num_found; 260 261 memset (&timeout, 0, sizeof (timeout)); 262 FD_ZERO (&input_fds); 263 FD_SET (fdes, &input_fds); 264 265 num_found = interruptible_select (num_fds, 266 &input_fds, NULL, NULL, 267 &timeout); 268 if (num_found < 0) 269 { 270 /* Guile doesn't export SIGINT hooks like Python does. 271 For now pass EINTR to scm_syserror, that's what fports.c does. */ 272 scm_syserror (FUNC_NAME); 273 } 274 return num_found > 0 && FD_ISSET (fdes, &input_fds); 275 } 276} 277 278/* The scm_t_ptob_descriptor.fill_input "method". */ 279 280static int 281ioscm_fill_input (SCM port) 282{ 283 /* Borrowed from libguile/fports.c. */ 284 long count; 285 scm_t_port *pt = SCM_PTAB_ENTRY (port); 286 287 /* If we're called on stdout,stderr, punt. */ 288 if (! scm_is_eq (port, input_port_scm)) 289 return (scm_t_wchar) EOF; /* Set errno and return -1? */ 290 291 gdb_flush (gdb_stdout); 292 gdb_flush (gdb_stderr); 293 294 count = gdb_stdin->read ((char *) pt->read_buf, pt->read_buf_size); 295 if (count == -1) 296 scm_syserror (FUNC_NAME); 297 if (count == 0) 298 return (scm_t_wchar) EOF; 299 300 pt->read_pos = pt->read_buf; 301 pt->read_end = pt->read_buf + count; 302 return *pt->read_buf; 303} 304 305/* Write to gdb's stdout or stderr. */ 306 307static void 308ioscm_write (SCM port, const void *data, size_t size) 309{ 310 311 /* If we're called on stdin, punt. */ 312 if (scm_is_eq (port, input_port_scm)) 313 return; 314 315 gdbscm_gdb_exception exc {}; 316 try 317 { 318 if (scm_is_eq (port, error_port_scm)) 319 fputsn_filtered ((const char *) data, size, gdb_stderr); 320 else 321 fputsn_filtered ((const char *) data, size, gdb_stdout); 322 } 323 catch (const gdb_exception &except) 324 { 325 exc = unpack (except); 326 } 327 GDBSCM_HANDLE_GDB_EXCEPTION (exc); 328} 329 330/* Flush gdb's stdout or stderr. */ 331 332static void 333ioscm_flush (SCM port) 334{ 335 /* If we're called on stdin, punt. */ 336 if (scm_is_eq (port, input_port_scm)) 337 return; 338 339 if (scm_is_eq (port, error_port_scm)) 340 gdb_flush (gdb_stderr); 341 else 342 gdb_flush (gdb_stdout); 343} 344 345#else /* !USING_GUILE_BEFORE_2_2 */ 346 347/* Read up to COUNT bytes into bytevector DST at offset START. Return the 348 number of bytes read, zero for the end of file. */ 349 350static size_t 351ioscm_read_from_port (SCM port, SCM dst, size_t start, size_t count) 352{ 353 long read; 354 char *read_buf; 355 356 /* If we're called on stdout,stderr, punt. */ 357 if (! scm_is_eq (port, input_port_scm)) 358 return 0; 359 360 gdb_flush (gdb_stdout); 361 gdb_flush (gdb_stderr); 362 363 read_buf = (char *) SCM_BYTEVECTOR_CONTENTS (dst) + start; 364 read = gdb_stdin->read (read_buf, count); 365 if (read == -1) 366 scm_syserror (FUNC_NAME); 367 368 return (size_t) read; 369} 370 371/* Write to gdb's stdout or stderr. */ 372 373static size_t 374ioscm_write (SCM port, SCM src, size_t start, size_t count) 375{ 376 const char *data = (char *) SCM_BYTEVECTOR_CONTENTS (src) + start; 377 378 /* If we're called on stdin, punt. */ 379 if (scm_is_eq (port, input_port_scm)) 380 return 0; 381 382 gdbscm_gdb_exception exc {}; 383 try 384 { 385 if (scm_is_eq (port, error_port_scm)) 386 fputsn_filtered ((const char *) data, count, gdb_stderr); 387 else 388 fputsn_filtered ((const char *) data, count, gdb_stdout); 389 } 390 catch (const gdb_exception &except) 391 { 392 exc = unpack (except); 393 } 394 GDBSCM_HANDLE_GDB_EXCEPTION (exc); 395 396 return count; 397} 398 399#endif /* !USING_GUILE_BEFORE_2_2 */ 400 401/* Initialize the gdb stdio port type. 402 403 N.B. isatty? will fail on these ports, it is only supported for file 404 ports. IWBN if we could "subclass" file ports. */ 405 406static void 407ioscm_init_gdb_stdio_port (void) 408{ 409 stdio_port_desc = scm_make_port_type (stdio_port_desc_name, 410#if USING_GUILE_BEFORE_2_2 411 ioscm_fill_input, 412#else 413 ioscm_read_from_port, 414#endif 415 ioscm_write); 416 417#if USING_GUILE_BEFORE_2_2 418 scm_set_port_input_waiting (stdio_port_desc, ioscm_input_waiting); 419 scm_set_port_flush (stdio_port_desc, ioscm_flush); 420#else 421 scm_set_port_read_wait_fd (stdio_port_desc, STDIN_FILENO); 422#endif 423} 424 425#define GDB_STDIO_BUFFER_DEFAULT_SIZE 1024 426 427#if USING_GUILE_BEFORE_2_2 428 429/* Subroutine of ioscm_make_gdb_stdio_port to simplify it. 430 Set up the buffers of port PORT. 431 MODE_BITS are the mode bits of PORT. */ 432 433static void 434ioscm_init_stdio_buffers (SCM port, long mode_bits) 435{ 436 scm_t_port *pt = SCM_PTAB_ENTRY (port); 437 int size = mode_bits & SCM_BUF0 ? 0 : GDB_STDIO_BUFFER_DEFAULT_SIZE; 438 int writing = (mode_bits & SCM_WRTNG) != 0; 439 440 /* This is heavily copied from scm_fport_buffer_add. */ 441 442 if (!writing && size > 0) 443 { 444 pt->read_buf 445 = (unsigned char *) scm_gc_malloc_pointerless (size, "port buffer"); 446 pt->read_pos = pt->read_end = pt->read_buf; 447 pt->read_buf_size = size; 448 } 449 else 450 { 451 pt->read_pos = pt->read_buf = pt->read_end = &pt->shortbuf; 452 pt->read_buf_size = 1; 453 } 454 455 if (writing && size > 0) 456 { 457 pt->write_buf 458 = (unsigned char *) scm_gc_malloc_pointerless (size, "port buffer"); 459 pt->write_pos = pt->write_buf; 460 pt->write_buf_size = size; 461 } 462 else 463 { 464 pt->write_buf = pt->write_pos = &pt->shortbuf; 465 pt->write_buf_size = 1; 466 } 467 pt->write_end = pt->write_buf + pt->write_buf_size; 468} 469 470#else 471 472static void 473ioscm_init_stdio_buffers (SCM port, long mode_bits) 474{ 475 if (mode_bits & SCM_BUF0) 476 scm_setvbuf (port, scm_from_utf8_symbol ("none"), scm_from_size_t (0)); 477 else 478 scm_setvbuf (port, scm_from_utf8_symbol ("block"), 479 scm_from_size_t (GDB_STDIO_BUFFER_DEFAULT_SIZE)); 480} 481 482#endif 483 484/* Create a gdb stdio port. */ 485 486static SCM 487ioscm_make_gdb_stdio_port (int fd) 488{ 489 int is_a_tty = isatty (fd); 490 const char *name; 491 const char *mode_str; 492 long mode_bits; 493 SCM port; 494 495 switch (fd) 496 { 497 case 0: 498 name = input_port_name; 499 mode_str = is_a_tty ? "r0" : "r"; 500 break; 501 case 1: 502 name = output_port_name; 503 mode_str = is_a_tty ? "w0" : "w"; 504 break; 505 case 2: 506 name = error_port_name; 507 mode_str = is_a_tty ? "w0" : "w"; 508 break; 509 default: 510 gdb_assert_not_reached ("bad stdio file descriptor"); 511 } 512 513 mode_bits = scm_mode_bits ((char *) mode_str); 514 port = ioscm_open_port (stdio_port_desc, mode_bits, 0); 515 516 scm_set_port_filename_x (port, gdbscm_scm_from_c_string (name)); 517 518 ioscm_init_stdio_buffers (port, mode_bits); 519 520 return port; 521} 522 523/* (stdio-port? object) -> boolean */ 524 525static SCM 526gdbscm_stdio_port_p (SCM scm) 527{ 528#if USING_GUILE_BEFORE_2_2 529 /* This is copied from SCM_FPORTP. */ 530 return scm_from_bool (!SCM_IMP (scm) 531 && (SCM_TYP16 (scm) == stdio_port_desc)); 532#else 533 return scm_from_bool (SCM_PORTP (scm) 534 && (SCM_PORT_TYPE (scm) == stdio_port_desc)); 535#endif 536} 537 538/* GDB's ports are accessed via functions to keep them read-only. */ 539 540/* (input-port) -> port */ 541 542static SCM 543gdbscm_input_port (void) 544{ 545 return input_port_scm; 546} 547 548/* (output-port) -> port */ 549 550static SCM 551gdbscm_output_port (void) 552{ 553 return output_port_scm; 554} 555 556/* (error-port) -> port */ 557 558static SCM 559gdbscm_error_port (void) 560{ 561 return error_port_scm; 562} 563 564/* Support for sending GDB I/O to Guile ports. */ 565 566ioscm_file_port::ioscm_file_port (SCM port) 567 : m_port (port) 568{} 569 570void 571ioscm_file_port::flush () 572{ 573} 574 575void 576ioscm_file_port::write (const char *buffer, long length_buffer) 577{ 578 scm_c_write (m_port, buffer, length_buffer); 579} 580 581 582/* Helper routine for with-{output,error}-to-port. */ 583 584static SCM 585ioscm_with_output_to_port_worker (SCM port, SCM thunk, enum oport oport, 586 const char *func_name) 587{ 588 SCM result; 589 590 SCM_ASSERT_TYPE (gdbscm_is_true (scm_output_port_p (port)), port, 591 SCM_ARG1, func_name, _("output port")); 592 SCM_ASSERT_TYPE (gdbscm_is_true (scm_thunk_p (thunk)), thunk, 593 SCM_ARG2, func_name, _("thunk")); 594 595 set_batch_flag_and_restore_page_info save_page_info; 596 597 scoped_restore restore_async = make_scoped_restore (¤t_ui->async, 0); 598 599 ui_file_up port_file (new ioscm_file_port (port)); 600 601 scoped_restore save_file = make_scoped_restore (oport == GDB_STDERR 602 ? &gdb_stderr : &gdb_stdout); 603 604 { 605 gdb::optional<ui_out_redirect_pop> redirect_popper; 606 if (oport == GDB_STDERR) 607 gdb_stderr = port_file.get (); 608 else 609 { 610 current_uiout->redirect (port_file.get ()); 611 redirect_popper.emplace (current_uiout); 612 613 gdb_stdout = port_file.get (); 614 } 615 616 result = gdbscm_safe_call_0 (thunk, NULL); 617 } 618 619 if (gdbscm_is_exception (result)) 620 gdbscm_throw (result); 621 622 return result; 623} 624 625/* (%with-gdb-output-to-port port thunk) -> object 626 This function is experimental. 627 IWBN to not include "gdb" in the name, but it would collide with a standard 628 procedure, and it's common to import the gdb module without a prefix. 629 There are ways around this, but they're more cumbersome. 630 631 This has % in the name because it's experimental, and we want the 632 user-visible version to come from module (gdb experimental). */ 633 634static SCM 635gdbscm_percent_with_gdb_output_to_port (SCM port, SCM thunk) 636{ 637 return ioscm_with_output_to_port_worker (port, thunk, GDB_STDOUT, FUNC_NAME); 638} 639 640/* (%with-gdb-error-to-port port thunk) -> object 641 This function is experimental. 642 IWBN to not include "gdb" in the name, but it would collide with a standard 643 procedure, and it's common to import the gdb module without a prefix. 644 There are ways around this, but they're more cumbersome. 645 646 This has % in the name because it's experimental, and we want the 647 user-visible version to come from module (gdb experimental). */ 648 649static SCM 650gdbscm_percent_with_gdb_error_to_port (SCM port, SCM thunk) 651{ 652 return ioscm_with_output_to_port_worker (port, thunk, GDB_STDERR, FUNC_NAME); 653} 654 655/* Support for r/w memory via ports. */ 656 657/* Perform an "lseek" to OFFSET,WHENCE on memory port IOMEM. 658 OFFSET must be in the range [0,size]. 659 The result is non-zero for success, zero for failure. */ 660 661static int 662ioscm_lseek_address (ioscm_memory_port *iomem, LONGEST offset, int whence) 663{ 664 CORE_ADDR new_current; 665 666 gdb_assert (iomem->current <= iomem->size); 667 668 switch (whence) 669 { 670 case SEEK_CUR: 671 /* Catch over/underflow. */ 672 if ((offset < 0 && iomem->current + offset > iomem->current) 673 || (offset > 0 && iomem->current + offset < iomem->current)) 674 return 0; 675 new_current = iomem->current + offset; 676 break; 677 case SEEK_SET: 678 new_current = offset; 679 break; 680 case SEEK_END: 681 if (offset == 0) 682 { 683 new_current = iomem->size; 684 break; 685 } 686 /* TODO: Not supported yet. */ 687 return 0; 688 default: 689 return 0; 690 } 691 692 if (new_current > iomem->size) 693 return 0; 694 iomem->current = new_current; 695 return 1; 696} 697 698#if USING_GUILE_BEFORE_2_2 699 700/* "fill_input" method for memory ports. */ 701 702static int 703gdbscm_memory_port_fill_input (SCM port) 704{ 705 scm_t_port *pt = SCM_PTAB_ENTRY (port); 706 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port); 707 size_t to_read; 708 709 /* "current" is the offset of the first byte we want to read. */ 710 gdb_assert (iomem->current <= iomem->size); 711 if (iomem->current == iomem->size) 712 return EOF; 713 714 /* Don't read outside the allowed memory range. */ 715 to_read = pt->read_buf_size; 716 if (to_read > iomem->size - iomem->current) 717 to_read = iomem->size - iomem->current; 718 719 if (target_read_memory (iomem->start + iomem->current, pt->read_buf, 720 to_read) != 0) 721 gdbscm_memory_error (FUNC_NAME, _("error reading memory"), SCM_EOL); 722 723 iomem->current += to_read; 724 pt->read_pos = pt->read_buf; 725 pt->read_end = pt->read_buf + to_read; 726 return *pt->read_buf; 727} 728 729/* "end_input" method for memory ports. 730 Clear the read buffer and adjust the file position for unread bytes. */ 731 732static void 733gdbscm_memory_port_end_input (SCM port, int offset) 734{ 735 scm_t_port *pt = SCM_PTAB_ENTRY (port); 736 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port); 737 size_t remaining = pt->read_end - pt->read_pos; 738 739 /* Note: Use of "int offset" is specified by Guile ports API. */ 740 if ((offset < 0 && remaining + offset > remaining) 741 || (offset > 0 && remaining + offset < remaining)) 742 { 743 gdbscm_out_of_range_error (FUNC_NAME, 0, scm_from_int (offset), 744 _("overflow in offset calculation")); 745 } 746 offset += remaining; 747 748 if (offset > 0) 749 { 750 pt->read_pos = pt->read_end; 751 /* Throw error if unread-char used at beginning of file 752 then attempting to write. Seems correct. */ 753 if (!ioscm_lseek_address (iomem, -offset, SEEK_CUR)) 754 { 755 gdbscm_out_of_range_error (FUNC_NAME, 0, scm_from_int (offset), 756 _("bad offset")); 757 } 758 } 759 760 pt->rw_active = SCM_PORT_NEITHER; 761} 762 763/* "flush" method for memory ports. */ 764 765static void 766gdbscm_memory_port_flush (SCM port) 767{ 768 scm_t_port *pt = SCM_PTAB_ENTRY (port); 769 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port); 770 size_t to_write = pt->write_pos - pt->write_buf; 771 772 if (to_write == 0) 773 return; 774 775 /* There's no way to indicate a short write, so if the request goes past 776 the end of the port's memory range, flag an error. */ 777 if (to_write > iomem->size - iomem->current) 778 { 779 gdbscm_out_of_range_error (FUNC_NAME, 0, 780 gdbscm_scm_from_ulongest (to_write), 781 _("writing beyond end of memory range")); 782 } 783 784 if (target_write_memory (iomem->start + iomem->current, pt->write_buf, 785 to_write) != 0) 786 gdbscm_memory_error (FUNC_NAME, _("error writing memory"), SCM_EOL); 787 788 iomem->current += to_write; 789 pt->write_pos = pt->write_buf; 790 pt->rw_active = SCM_PORT_NEITHER; 791} 792 793/* "seek" method for memory ports. */ 794 795static scm_t_off 796gdbscm_memory_port_seek (SCM port, scm_t_off offset, int whence) 797{ 798 scm_t_port *pt = SCM_PTAB_ENTRY (port); 799 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port); 800 CORE_ADDR result; 801 int rc; 802 803 if (pt->rw_active == SCM_PORT_WRITE) 804 { 805 if (offset != 0 || whence != SEEK_CUR) 806 { 807 gdbscm_memory_port_flush (port); 808 rc = ioscm_lseek_address (iomem, offset, whence); 809 result = iomem->current; 810 } 811 else 812 { 813 /* Read current position without disturbing the buffer, 814 but flag an error if what's in the buffer goes outside the 815 allowed range. */ 816 CORE_ADDR current = iomem->current; 817 size_t delta = pt->write_pos - pt->write_buf; 818 819 if (current + delta < current 820 || current + delta > iomem->size) 821 rc = 0; 822 else 823 { 824 result = current + delta; 825 rc = 1; 826 } 827 } 828 } 829 else if (pt->rw_active == SCM_PORT_READ) 830 { 831 if (offset != 0 || whence != SEEK_CUR) 832 { 833 scm_end_input (port); 834 rc = ioscm_lseek_address (iomem, offset, whence); 835 result = iomem->current; 836 } 837 else 838 { 839 /* Read current position without disturbing the buffer 840 (particularly the unread-char buffer). */ 841 CORE_ADDR current = iomem->current; 842 size_t remaining = pt->read_end - pt->read_pos; 843 844 if (current - remaining > current 845 || current - remaining < iomem->start) 846 rc = 0; 847 else 848 { 849 result = current - remaining; 850 rc = 1; 851 } 852 853 if (rc != 0 && pt->read_buf == pt->putback_buf) 854 { 855 size_t saved_remaining = pt->saved_read_end - pt->saved_read_pos; 856 857 if (result - saved_remaining > result 858 || result - saved_remaining < iomem->start) 859 rc = 0; 860 else 861 result -= saved_remaining; 862 } 863 } 864 } 865 else /* SCM_PORT_NEITHER */ 866 { 867 rc = ioscm_lseek_address (iomem, offset, whence); 868 result = iomem->current; 869 } 870 871 if (rc == 0) 872 { 873 gdbscm_out_of_range_error (FUNC_NAME, 0, 874 gdbscm_scm_from_longest (offset), 875 _("bad seek")); 876 } 877 878 /* TODO: The Guile API doesn't support 32x64. We can't fix that here, 879 and there's no need to throw an error if the new address can't be 880 represented in a scm_t_off. But we could return something less 881 clumsy. */ 882 return result; 883} 884 885/* "write" method for memory ports. */ 886 887static void 888gdbscm_memory_port_write (SCM port, const void *void_data, size_t size) 889{ 890 scm_t_port *pt = SCM_PTAB_ENTRY (port); 891 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port); 892 const gdb_byte *data = (const gdb_byte *) void_data; 893 894 /* There's no way to indicate a short write, so if the request goes past 895 the end of the port's memory range, flag an error. */ 896 if (size > iomem->size - iomem->current) 897 { 898 gdbscm_out_of_range_error (FUNC_NAME, 0, gdbscm_scm_from_ulongest (size), 899 _("writing beyond end of memory range")); 900 } 901 902 if (pt->write_buf == &pt->shortbuf) 903 { 904 /* Unbuffered port. */ 905 if (target_write_memory (iomem->start + iomem->current, data, size) != 0) 906 gdbscm_memory_error (FUNC_NAME, _("error writing memory"), SCM_EOL); 907 iomem->current += size; 908 return; 909 } 910 911 /* Note: The edge case of what to do when the buffer exactly fills is 912 debatable. Guile flushes when the buffer exactly fills up, so we 913 do too. It's counter-intuitive to my mind, but in case there's a 914 subtlety somewhere that depends on this, we do the same. */ 915 916 { 917 size_t space = pt->write_end - pt->write_pos; 918 919 if (size < space) 920 { 921 /* Data fits in buffer, and does not fill it. */ 922 memcpy (pt->write_pos, data, size); 923 pt->write_pos += size; 924 } 925 else 926 { 927 memcpy (pt->write_pos, data, space); 928 pt->write_pos = pt->write_end; 929 gdbscm_memory_port_flush (port); 930 { 931 const gdb_byte *ptr = data + space; 932 size_t remaining = size - space; 933 934 if (remaining >= pt->write_buf_size) 935 { 936 if (target_write_memory (iomem->start + iomem->current, ptr, 937 remaining) != 0) 938 gdbscm_memory_error (FUNC_NAME, _("error writing memory"), 939 SCM_EOL); 940 iomem->current += remaining; 941 } 942 else 943 { 944 memcpy (pt->write_pos, ptr, remaining); 945 pt->write_pos += remaining; 946 } 947 } 948 } 949 } 950} 951 952/* "close" method for memory ports. */ 953 954static int 955gdbscm_memory_port_close (SCM port) 956{ 957 scm_t_port *pt = SCM_PTAB_ENTRY (port); 958 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port); 959 960 gdbscm_memory_port_flush (port); 961 962 if (pt->read_buf == pt->putback_buf) 963 pt->read_buf = pt->saved_read_buf; 964 if (pt->read_buf != &pt->shortbuf) 965 xfree (pt->read_buf); 966 if (pt->write_buf != &pt->shortbuf) 967 xfree (pt->write_buf); 968 scm_gc_free (iomem, sizeof (*iomem), "memory port"); 969 970 return 0; 971} 972 973/* "free" method for memory ports. */ 974 975static size_t 976gdbscm_memory_port_free (SCM port) 977{ 978 gdbscm_memory_port_close (port); 979 980 return 0; 981} 982 983/* Re-initialize a memory port, updating its read/write buffer sizes. 984 An exception is thrown if the port is unbuffered. 985 TODO: Allow switching buffered/unbuffered. 986 An exception is also thrown if data is still buffered, except in the case 987 where the buffer size isn't changing (since that's just a nop). */ 988 989static void 990ioscm_reinit_memory_port (SCM port, size_t read_buf_size, 991 size_t write_buf_size, const char *func_name) 992{ 993 scm_t_port *pt = SCM_PTAB_ENTRY (port); 994 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port); 995 996 gdb_assert (read_buf_size >= min_memory_port_buf_size 997 && read_buf_size <= max_memory_port_buf_size); 998 gdb_assert (write_buf_size >= min_memory_port_buf_size 999 && write_buf_size <= max_memory_port_buf_size); 1000 1001 /* First check if the port is unbuffered. */ 1002 1003 if (pt->read_buf == &pt->shortbuf) 1004 { 1005 gdb_assert (pt->write_buf == &pt->shortbuf); 1006 scm_misc_error (func_name, _("port is unbuffered: ~a"), 1007 scm_list_1 (port)); 1008 } 1009 1010 /* Next check if anything is buffered. */ 1011 1012 if (read_buf_size != pt->read_buf_size 1013 && pt->read_end != pt->read_buf) 1014 { 1015 scm_misc_error (func_name, _("read buffer not empty: ~a"), 1016 scm_list_1 (port)); 1017 } 1018 1019 if (write_buf_size != pt->write_buf_size 1020 && pt->write_pos != pt->write_buf) 1021 { 1022 scm_misc_error (func_name, _("write buffer not empty: ~a"), 1023 scm_list_1 (port)); 1024 } 1025 1026 /* Now we can update the buffer sizes, but only if the size has changed. */ 1027 1028 if (read_buf_size != pt->read_buf_size) 1029 { 1030 iomem->read_buf_size = read_buf_size; 1031 pt->read_buf_size = read_buf_size; 1032 xfree (pt->read_buf); 1033 pt->read_buf = (unsigned char *) xmalloc (pt->read_buf_size); 1034 pt->read_pos = pt->read_end = pt->read_buf; 1035 } 1036 1037 if (write_buf_size != pt->write_buf_size) 1038 { 1039 iomem->write_buf_size = write_buf_size; 1040 pt->write_buf_size = write_buf_size; 1041 xfree (pt->write_buf); 1042 pt->write_buf = (unsigned char *) xmalloc (pt->write_buf_size); 1043 pt->write_pos = pt->write_buf; 1044 pt->write_end = pt->write_buf + pt->write_buf_size; 1045 } 1046} 1047 1048#else /* !USING_GUILE_BEFORE_2_2 */ 1049 1050/* The semantics get weird if the buffer size is larger than the port range, 1051 so provide a better default buffer size. */ 1052 1053static void 1054gdbscm_get_natural_buffer_sizes (SCM port, size_t *read_size, 1055 size_t *write_size) 1056{ 1057 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port); 1058 1059 size_t size = natural_buf_size; 1060 if (iomem != NULL && iomem->size < size) 1061 size = iomem->size; 1062 *read_size = *write_size = size; 1063} 1064 1065/* Read up to COUNT bytes into bytevector DST at offset START. Return the 1066 number of bytes read, zero for the end of file. */ 1067 1068static size_t 1069gdbscm_memory_port_read (SCM port, SCM dst, size_t start, size_t count) 1070{ 1071 gdb_byte *read_buf; 1072 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port); 1073 1074 /* "current" is the offset of the first byte we want to read. */ 1075 gdb_assert (iomem->current <= iomem->size); 1076 if (iomem->current == iomem->size) 1077 return 0; 1078 1079 /* Don't read outside the allowed memory range. */ 1080 if (count > iomem->size - iomem->current) 1081 count = iomem->size - iomem->current; 1082 1083 read_buf = (gdb_byte *) SCM_BYTEVECTOR_CONTENTS (dst) + start; 1084 if (target_read_memory (iomem->start + iomem->current, read_buf, 1085 count) != 0) 1086 gdbscm_memory_error (FUNC_NAME, _("error reading memory"), SCM_EOL); 1087 1088 iomem->current += count; 1089 return count; 1090} 1091 1092static size_t 1093gdbscm_memory_port_write (SCM port, SCM src, size_t start, size_t count) 1094{ 1095 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port); 1096 const gdb_byte *data = 1097 (const gdb_byte *) SCM_BYTEVECTOR_CONTENTS (src) + start; 1098 1099 /* If the request goes past the end of the port's memory range, flag an 1100 error. */ 1101 if (count > iomem->size - iomem->current) 1102 gdbscm_out_of_range_error (FUNC_NAME, 0, scm_from_size_t (count), 1103 _("writing beyond end of memory range")); 1104 1105 if (target_write_memory (iomem->start + iomem->current, data, 1106 count) != 0) 1107 gdbscm_memory_error (FUNC_NAME, _("error writing memory"), 1108 SCM_EOL); 1109 1110 iomem->current += count; 1111 1112 return count; 1113} 1114 1115static scm_t_off 1116gdbscm_memory_port_seek (SCM port, scm_t_off offset, int whence) 1117{ 1118 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port); 1119 int rc; 1120 1121 rc = ioscm_lseek_address (iomem, offset, whence); 1122 if (rc == 0) 1123 gdbscm_out_of_range_error (FUNC_NAME, 0, 1124 gdbscm_scm_from_longest (offset), 1125 _("bad seek")); 1126 1127 /* TODO: The Guile API doesn't support 32x64. We can't fix that here, 1128 and there's no need to throw an error if the new address can't be 1129 represented in a scm_t_off. But we could return something less 1130 clumsy. */ 1131 return iomem->current; 1132} 1133 1134static void 1135gdbscm_memory_port_close (SCM port) 1136{ 1137 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port); 1138 scm_gc_free (iomem, sizeof (*iomem), "memory port"); 1139 SCM_SETSTREAM (port, NULL); 1140} 1141 1142#endif /* !USING_GUILE_BEFORE_2_2 */ 1143 1144/* "print" method for memory ports. */ 1145 1146static int 1147gdbscm_memory_port_print (SCM exp, SCM port, scm_print_state *pstate) 1148{ 1149 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (exp); 1150 1151 scm_puts ("#<", port); 1152 scm_print_port_mode (exp, port); 1153 /* scm_print_port_mode includes a trailing space. */ 1154 gdbscm_printf (port, "%s %s-%s", memory_port_desc_name, 1155 hex_string (iomem->start), hex_string (iomem->end)); 1156 scm_putc ('>', port); 1157 return 1; 1158} 1159 1160/* Create the port type used for memory. */ 1161 1162static void 1163ioscm_init_memory_port_type (void) 1164{ 1165 memory_port_desc = scm_make_port_type (memory_port_desc_name, 1166#if USING_GUILE_BEFORE_2_2 1167 gdbscm_memory_port_fill_input, 1168#else 1169 gdbscm_memory_port_read, 1170#endif 1171 gdbscm_memory_port_write); 1172 1173#if USING_GUILE_BEFORE_2_2 1174 scm_set_port_end_input (memory_port_desc, gdbscm_memory_port_end_input); 1175 scm_set_port_flush (memory_port_desc, gdbscm_memory_port_flush); 1176 scm_set_port_free (memory_port_desc, gdbscm_memory_port_free); 1177#else 1178 scm_set_port_get_natural_buffer_sizes (memory_port_desc, 1179 gdbscm_get_natural_buffer_sizes); 1180#endif 1181 scm_set_port_seek (memory_port_desc, gdbscm_memory_port_seek); 1182 scm_set_port_close (memory_port_desc, gdbscm_memory_port_close); 1183 scm_set_port_print (memory_port_desc, gdbscm_memory_port_print); 1184} 1185 1186/* Helper for gdbscm_open_memory to parse the mode bits. 1187 An exception is thrown if MODE is invalid. */ 1188 1189static long 1190ioscm_parse_mode_bits (const char *func_name, const char *mode) 1191{ 1192 const char *p; 1193 long mode_bits; 1194 1195 if (*mode != 'r' && *mode != 'w') 1196 { 1197 gdbscm_out_of_range_error (func_name, 0, 1198 gdbscm_scm_from_c_string (mode), 1199 _("bad mode string")); 1200 } 1201 for (p = mode + 1; *p != '\0'; ++p) 1202 { 1203 switch (*p) 1204 { 1205 case '0': 1206 case 'b': 1207 case '+': 1208 break; 1209 default: 1210 gdbscm_out_of_range_error (func_name, 0, 1211 gdbscm_scm_from_c_string (mode), 1212 _("bad mode string")); 1213 } 1214 } 1215 1216 /* Kinda awkward to convert the mode from SCM -> string only to have Guile 1217 convert it back to SCM, but that's the API we have to work with. */ 1218 mode_bits = scm_mode_bits ((char *) mode); 1219 1220 return mode_bits; 1221} 1222 1223/* Return the memory object to be used as a "stream" associated with a memory 1224 port for the START--END range. */ 1225 1226static ioscm_memory_port * 1227ioscm_init_memory_port_stream (CORE_ADDR start, CORE_ADDR end) 1228{ 1229 ioscm_memory_port *iomem; 1230 1231 gdb_assert (start <= end); 1232 1233 iomem = (ioscm_memory_port *) scm_gc_malloc_pointerless (sizeof (*iomem), 1234 "memory port"); 1235 1236 iomem->start = start; 1237 iomem->end = end; 1238 iomem->size = end - start; 1239 iomem->current = 0; 1240 1241 return iomem; 1242} 1243 1244#if USING_GUILE_BEFORE_2_2 1245 1246/* Helper for gdbscm_open_memory to finish initializing the port. 1247 The port has address range [start,end). 1248 This means that address of 0xff..ff is not accessible. 1249 I can live with that. */ 1250 1251static void 1252ioscm_init_memory_port_buffers (SCM port) 1253{ 1254 ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port); 1255 1256 int buffered = (SCM_CELL_WORD_0 (port) & SCM_BUF0) == 0; 1257 if (buffered) 1258 { 1259 iomem->read_buf_size = default_read_buf_size; 1260 iomem->write_buf_size = default_write_buf_size; 1261 } 1262 else 1263 { 1264 iomem->read_buf_size = 1; 1265 iomem->write_buf_size = 1; 1266 } 1267 1268 scm_t_port *pt = SCM_PTAB_ENTRY (port); 1269 /* Match the expectation of `binary-port?'. */ 1270 pt->encoding = NULL; 1271 pt->rw_random = 1; 1272 pt->read_buf_size = iomem->read_buf_size; 1273 pt->write_buf_size = iomem->write_buf_size; 1274 if (buffered) 1275 { 1276 pt->read_buf = (unsigned char *) xmalloc (pt->read_buf_size); 1277 pt->write_buf = (unsigned char *) xmalloc (pt->write_buf_size); 1278 } 1279 else 1280 { 1281 pt->read_buf = &pt->shortbuf; 1282 pt->write_buf = &pt->shortbuf; 1283 } 1284 pt->read_pos = pt->read_end = pt->read_buf; 1285 pt->write_pos = pt->write_buf; 1286 pt->write_end = pt->write_buf + pt->write_buf_size; 1287} 1288 1289#endif 1290 1291/* (open-memory [#:mode string] [#:start address] [#:size integer]) -> port 1292 Return a port that can be used for reading and writing memory. 1293 MODE is a string, and must be one of "r", "w", or "r+". 1294 "0" may be appended to MODE to mark the port as unbuffered. 1295 For compatibility "b" (binary) may also be appended, but we ignore it: 1296 memory ports are binary only. 1297 1298 The chunk of memory that can be accessed can be bounded. 1299 If both START,SIZE are unspecified, all of memory can be accessed 1300 (except 0xff..ff). If only START is specified, all of memory from that 1301 point on can be accessed (except 0xff..ff). If only SIZE if specified, 1302 all memory in [0,SIZE) can be accessed. If both are specified, all memory 1303 in [START,START+SIZE) can be accessed. 1304 1305 Note: If it becomes useful enough we can later add #:end as an alternative 1306 to #:size. For now it is left out. 1307 1308 The result is a Scheme port, and its semantics are a bit odd for accessing 1309 memory (e.g., unget), but we don't try to hide this. It's a port. 1310 1311 N.B. Seeks on the port must be in the range [0,size]. 1312 This is for similarity with bytevector ports, and so that one can seek 1313 to the first byte. */ 1314 1315static SCM 1316gdbscm_open_memory (SCM rest) 1317{ 1318 const SCM keywords[] = { 1319 mode_keyword, start_keyword, size_keyword, SCM_BOOL_F 1320 }; 1321 char *mode = NULL; 1322 CORE_ADDR start = 0; 1323 CORE_ADDR end; 1324 int mode_arg_pos = -1, start_arg_pos = -1, size_arg_pos = -1; 1325 ULONGEST size; 1326 SCM port; 1327 long mode_bits; 1328 1329 gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "#sUU", rest, 1330 &mode_arg_pos, &mode, 1331 &start_arg_pos, &start, 1332 &size_arg_pos, &size); 1333 1334 scm_dynwind_begin ((scm_t_dynwind_flags) 0); 1335 1336 if (mode == NULL) 1337 mode = xstrdup ("r"); 1338 scm_dynwind_free (mode); 1339 1340 if (size_arg_pos > 0) 1341 { 1342 /* For now be strict about start+size overflowing. If it becomes 1343 a nuisance we can relax things later. */ 1344 if (start + size < start) 1345 { 1346 gdbscm_out_of_range_error (FUNC_NAME, 0, 1347 scm_list_2 (gdbscm_scm_from_ulongest (start), 1348 gdbscm_scm_from_ulongest (size)), 1349 _("start+size overflows")); 1350 } 1351 end = start + size; 1352 } 1353 else 1354 end = ~(CORE_ADDR) 0; 1355 1356 mode_bits = ioscm_parse_mode_bits (FUNC_NAME, mode); 1357 1358 /* Edge case: empty range -> unbuffered. 1359 There's no need to disallow empty ranges, but we need an unbuffered port 1360 to get the semantics right. */ 1361 if (size == 0) 1362 mode_bits |= SCM_BUF0; 1363 1364 auto stream = ioscm_init_memory_port_stream (start, end); 1365 port = ioscm_open_port (memory_port_desc, mode_bits, 1366 (scm_t_bits) stream); 1367 1368#if USING_GUILE_BEFORE_2_2 1369 ioscm_init_memory_port_buffers (port); 1370#endif 1371 1372 scm_dynwind_end (); 1373 1374 /* TODO: Set the file name as "memory-start-end"? */ 1375 return port; 1376} 1377 1378/* Return non-zero if OBJ is a memory port. */ 1379 1380static int 1381gdbscm_is_memory_port (SCM obj) 1382{ 1383#if USING_GUILE_BEFORE_2_2 1384 return !SCM_IMP (obj) && (SCM_TYP16 (obj) == memory_port_desc); 1385#else 1386 return SCM_PORTP (obj) && (SCM_PORT_TYPE (obj) == memory_port_desc); 1387#endif 1388} 1389 1390/* (memory-port? obj) -> boolean */ 1391 1392static SCM 1393gdbscm_memory_port_p (SCM obj) 1394{ 1395 return scm_from_bool (gdbscm_is_memory_port (obj)); 1396} 1397 1398/* (memory-port-range port) -> (start end) */ 1399 1400static SCM 1401gdbscm_memory_port_range (SCM port) 1402{ 1403 ioscm_memory_port *iomem; 1404 1405 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME, 1406 memory_port_desc_name); 1407 1408 iomem = (ioscm_memory_port *) SCM_STREAM (port); 1409 return scm_list_2 (gdbscm_scm_from_ulongest (iomem->start), 1410 gdbscm_scm_from_ulongest (iomem->end)); 1411} 1412 1413/* (memory-port-read-buffer-size port) -> integer */ 1414 1415static SCM 1416gdbscm_memory_port_read_buffer_size (SCM port) 1417{ 1418#if USING_GUILE_BEFORE_2_2 1419 ioscm_memory_port *iomem; 1420 1421 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME, 1422 memory_port_desc_name); 1423 1424 iomem = (ioscm_memory_port *) SCM_STREAM (port); 1425 return scm_from_uint (iomem->read_buf_size); 1426#else 1427 return scm_from_uint (0); 1428#endif 1429} 1430 1431/* (set-memory-port-read-buffer-size! port size) -> unspecified 1432 An exception is thrown if read data is still buffered or if the port 1433 is unbuffered. */ 1434 1435static SCM 1436gdbscm_set_memory_port_read_buffer_size_x (SCM port, SCM size) 1437{ 1438#if USING_GUILE_BEFORE_2_2 1439 ioscm_memory_port *iomem; 1440 1441 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME, 1442 memory_port_desc_name); 1443 SCM_ASSERT_TYPE (scm_is_integer (size), size, SCM_ARG2, FUNC_NAME, 1444 _("integer")); 1445 1446 if (!scm_is_unsigned_integer (size, min_memory_port_buf_size, 1447 max_memory_port_buf_size)) 1448 { 1449 gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, size, 1450 out_of_range_buf_size); 1451 } 1452 1453 iomem = (ioscm_memory_port *) SCM_STREAM (port); 1454 ioscm_reinit_memory_port (port, scm_to_uint (size), iomem->write_buf_size, 1455 FUNC_NAME); 1456 1457 return SCM_UNSPECIFIED; 1458#else 1459 return scm_setvbuf (port, scm_from_utf8_symbol ("block"), size); 1460#endif 1461} 1462 1463/* (memory-port-write-buffer-size port) -> integer */ 1464 1465static SCM 1466gdbscm_memory_port_write_buffer_size (SCM port) 1467{ 1468#if USING_GUILE_BEFORE_2_2 1469 ioscm_memory_port *iomem; 1470 1471 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME, 1472 memory_port_desc_name); 1473 1474 iomem = (ioscm_memory_port *) SCM_STREAM (port); 1475 return scm_from_uint (iomem->write_buf_size); 1476#else 1477 return scm_from_uint (0); 1478#endif 1479} 1480 1481/* (set-memory-port-write-buffer-size! port size) -> unspecified 1482 An exception is thrown if write data is still buffered or if the port 1483 is unbuffered. */ 1484 1485static SCM 1486gdbscm_set_memory_port_write_buffer_size_x (SCM port, SCM size) 1487{ 1488#if USING_GUILE_BEFORE_2_2 1489 ioscm_memory_port *iomem; 1490 1491 SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME, 1492 memory_port_desc_name); 1493 SCM_ASSERT_TYPE (scm_is_integer (size), size, SCM_ARG2, FUNC_NAME, 1494 _("integer")); 1495 1496 if (!scm_is_unsigned_integer (size, min_memory_port_buf_size, 1497 max_memory_port_buf_size)) 1498 { 1499 gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, size, 1500 out_of_range_buf_size); 1501 } 1502 1503 iomem = (ioscm_memory_port *) SCM_STREAM (port); 1504 ioscm_reinit_memory_port (port, iomem->read_buf_size, scm_to_uint (size), 1505 FUNC_NAME); 1506 1507 return SCM_UNSPECIFIED; 1508#else 1509 return scm_setvbuf (port, scm_from_utf8_symbol ("block"), size); 1510#endif 1511} 1512 1513/* Initialize gdb ports. */ 1514 1515static const scheme_function port_functions[] = 1516{ 1517 { "input-port", 0, 0, 0, as_a_scm_t_subr (gdbscm_input_port), 1518 "\ 1519Return gdb's input port." }, 1520 1521 { "output-port", 0, 0, 0, as_a_scm_t_subr (gdbscm_output_port), 1522 "\ 1523Return gdb's output port." }, 1524 1525 { "error-port", 0, 0, 0, as_a_scm_t_subr (gdbscm_error_port), 1526 "\ 1527Return gdb's error port." }, 1528 1529 { "stdio-port?", 1, 0, 0, as_a_scm_t_subr (gdbscm_stdio_port_p), 1530 "\ 1531Return #t if the object is a gdb:stdio-port." }, 1532 1533 { "open-memory", 0, 0, 1, as_a_scm_t_subr (gdbscm_open_memory), 1534 "\ 1535Return a port that can be used for reading/writing inferior memory.\n\ 1536\n\ 1537 Arguments: [#:mode string] [#:start address] [#:size integer]\n\ 1538 Returns: A port object." }, 1539 1540 { "memory-port?", 1, 0, 0, as_a_scm_t_subr (gdbscm_memory_port_p), 1541 "\ 1542Return #t if the object is a memory port." }, 1543 1544 { "memory-port-range", 1, 0, 0, as_a_scm_t_subr (gdbscm_memory_port_range), 1545 "\ 1546Return the memory range of the port as (start end)." }, 1547 1548 { "memory-port-read-buffer-size", 1, 0, 0, 1549 as_a_scm_t_subr (gdbscm_memory_port_read_buffer_size), 1550 "\ 1551Return the size of the read buffer for the memory port." }, 1552 1553 { "set-memory-port-read-buffer-size!", 2, 0, 0, 1554 as_a_scm_t_subr (gdbscm_set_memory_port_read_buffer_size_x), 1555 "\ 1556Set the size of the read buffer for the memory port.\n\ 1557\n\ 1558 Arguments: port integer\n\ 1559 Returns: unspecified." }, 1560 1561 { "memory-port-write-buffer-size", 1, 0, 0, 1562 as_a_scm_t_subr (gdbscm_memory_port_write_buffer_size), 1563 "\ 1564Return the size of the write buffer for the memory port." }, 1565 1566 { "set-memory-port-write-buffer-size!", 2, 0, 0, 1567 as_a_scm_t_subr (gdbscm_set_memory_port_write_buffer_size_x), 1568 "\ 1569Set the size of the write buffer for the memory port.\n\ 1570\n\ 1571 Arguments: port integer\n\ 1572 Returns: unspecified." }, 1573 1574 END_FUNCTIONS 1575}; 1576 1577static const scheme_function private_port_functions[] = 1578{ 1579#if 0 /* TODO */ 1580 { "%with-gdb-input-from-port", 2, 0, 0, 1581 as_a_scm_t_subr (gdbscm_percent_with_gdb_input_from_port), 1582 "\ 1583Temporarily set GDB's input port to PORT and then invoke THUNK.\n\ 1584\n\ 1585 Arguments: port thunk\n\ 1586 Returns: The result of calling THUNK.\n\ 1587\n\ 1588This procedure is experimental." }, 1589#endif 1590 1591 { "%with-gdb-output-to-port", 2, 0, 0, 1592 as_a_scm_t_subr (gdbscm_percent_with_gdb_output_to_port), 1593 "\ 1594Temporarily set GDB's output port to PORT and then invoke THUNK.\n\ 1595\n\ 1596 Arguments: port thunk\n\ 1597 Returns: The result of calling THUNK.\n\ 1598\n\ 1599This procedure is experimental." }, 1600 1601 { "%with-gdb-error-to-port", 2, 0, 0, 1602 as_a_scm_t_subr (gdbscm_percent_with_gdb_error_to_port), 1603 "\ 1604Temporarily set GDB's error port to PORT and then invoke THUNK.\n\ 1605\n\ 1606 Arguments: port thunk\n\ 1607 Returns: The result of calling THUNK.\n\ 1608\n\ 1609This procedure is experimental." }, 1610 1611 END_FUNCTIONS 1612}; 1613 1614void 1615gdbscm_initialize_ports (void) 1616{ 1617 /* Save the original stdio ports for debugging purposes. */ 1618 1619 orig_input_port_scm = scm_current_input_port (); 1620 orig_output_port_scm = scm_current_output_port (); 1621 orig_error_port_scm = scm_current_error_port (); 1622 1623 /* Set up the stdio ports. */ 1624 1625 ioscm_init_gdb_stdio_port (); 1626 input_port_scm = ioscm_make_gdb_stdio_port (0); 1627 output_port_scm = ioscm_make_gdb_stdio_port (1); 1628 error_port_scm = ioscm_make_gdb_stdio_port (2); 1629 1630 /* Set up memory ports. */ 1631 1632 ioscm_init_memory_port_type (); 1633 1634 /* Install the accessor functions. */ 1635 1636 gdbscm_define_functions (port_functions, 1); 1637 gdbscm_define_functions (private_port_functions, 0); 1638 1639 /* Keyword args for open-memory. */ 1640 1641 mode_keyword = scm_from_latin1_keyword ("mode"); 1642 start_keyword = scm_from_latin1_keyword ("start"); 1643 size_keyword = scm_from_latin1_keyword ("size"); 1644 1645#if USING_GUILE_BEFORE_2_2 1646 /* Error message text for "out of range" memory port buffer sizes. */ 1647 1648 out_of_range_buf_size = xstrprintf ("size not between %u - %u", 1649 min_memory_port_buf_size, 1650 max_memory_port_buf_size); 1651#endif 1652} 1653