static long
ioscm_parse_mode_bits (const char *func_name, const char *mode)
{
const char *p;
long mode_bits;
if (*mode != 'r' && *mode != 'w')
{
gdbscm_out_of_range_error (func_name, 0,
gdbscm_scm_from_c_string (mode),
_("bad mode string"));
}
for (p = mode + 1; *p != '\0'; ++p)
{
switch (*p)
{
case '0':
case 'b':
case '+':
break;
default:
gdbscm_out_of_range_error (func_name, 0,
gdbscm_scm_from_c_string (mode),
_("bad mode string"));
}
}
/* Kinda awkward to convert the mode from SCM -> string only to have Guile
convert it back to SCM, but that's the API we have to work with. */
mode_bits = scm_mode_bits ((char *) mode);
return mode_bits;
}
static SCM
gdbscm_string_to_argv (SCM string_scm)
{
char *string;
char **c_argv;
int i;
SCM result = SCM_EOL;
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "s",
string_scm, &string);
if (string == NULL || *string == '\0')
{
xfree (string);
return SCM_EOL;
}
c_argv = gdb_buildargv (string);
for (i = 0; c_argv[i] != NULL; ++i)
result = scm_cons (gdbscm_scm_from_c_string (c_argv[i]), result);
freeargv (c_argv);
xfree (string);
return scm_reverse_x (result, SCM_EOL);
}
static SCM
gdbscm_symtab_fullname (SCM self)
{
symtab_smob *st_smob
= stscm_get_valid_symtab_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct symtab *symtab = st_smob->symtab;
return gdbscm_scm_from_c_string (symtab_to_fullname (symtab));
}
static SCM
gdbscm_symbol_print_name (SCM self)
{
symbol_smob *s_smob
= syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
const struct symbol *symbol = s_smob->symbol;
return gdbscm_scm_from_c_string (SYMBOL_PRINT_NAME (symbol));
}
static SCM
gdbscm_arch_wide_charset (SCM self)
{
arch_smob *a_smob
= arscm_get_arch_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct gdbarch *gdbarch = a_smob->gdbarch;
return gdbscm_scm_from_c_string (target_wide_charset (gdbarch));
}
static SCM
dascm_make_insn (CORE_ADDR pc, const char *assembly, int insn_len)
{
return scm_list_3 (scm_cons (address_symbol,
gdbscm_scm_from_ulongest (pc)),
scm_cons (asm_symbol,
gdbscm_scm_from_c_string (assembly)),
scm_cons (length_symbol,
scm_from_int (insn_len)));
}
static SCM
gdbscm_lazy_string_encoding (SCM self)
{
SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm);
/* An encoding can be set to NULL by the user, so check first.
If NULL return #f. */
if (ls_smob != NULL)
return gdbscm_scm_from_c_string (ls_smob->encoding);
return SCM_BOOL_F;
}
static SCM
gdbscm_arch_name (SCM self)
{
arch_smob *a_smob
= arscm_get_arch_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct gdbarch *gdbarch = a_smob->gdbarch;
const char *name;
name = (gdbarch_bfd_arch_info (gdbarch))->printable_name;
return gdbscm_scm_from_c_string (name);
}
static SCM
gdbscm_execute_gdb_command (SCM command_scm, SCM rest)
{
int from_tty_arg_pos = -1, to_string_arg_pos = -1;
int from_tty = 0, to_string = 0;
volatile struct gdb_exception except;
const SCM keywords[] = { from_tty_keyword, to_string_keyword, SCM_BOOL_F };
char *command;
char *result = NULL;
struct cleanup *cleanups;
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#tt",
command_scm, &command, rest,
&from_tty_arg_pos, &from_tty,
&to_string_arg_pos, &to_string);
/* Note: The contents of "command" may get modified while it is
executed. */
cleanups = make_cleanup (xfree, command);
TRY_CATCH (except, RETURN_MASK_ALL)
{
struct cleanup *inner_cleanups;
inner_cleanups = make_cleanup_restore_integer (&interpreter_async);
interpreter_async = 0;
prevent_dont_repeat ();
if (to_string)
result = execute_command_to_string (command, from_tty);
else
{
execute_command (command, from_tty);
result = NULL;
}
/* Do any commands attached to breakpoint we stopped at. */
bpstat_do_actions ();
do_cleanups (inner_cleanups);
}
do_cleanups (cleanups);
GDBSCM_HANDLE_GDB_EXCEPTION (except);
if (result)
{
SCM r = gdbscm_scm_from_c_string (result);
xfree (result);
return r;
}
return SCM_UNSPECIFIED;
}
void
gdbscm_define_functions (const scheme_function *functions, int is_public)
{
const scheme_function *sf;
for (sf = functions; sf->name != NULL; ++sf)
{
SCM proc = scm_c_define_gsubr (sf->name, sf->required, sf->optional,
sf->rest, sf->func);
scm_set_procedure_property_x (proc, gdbscm_documentation_symbol,
gdbscm_scm_from_c_string (sf->doc_string));
if (is_public)
scm_c_export (sf->name, NULL);
}
}
SCM
gdbscm_scm_from_gdb_exception (struct gdb_exception exception)
{
SCM key;
if (exception.reason == RETURN_QUIT)
{
/* Handle this specially to be consistent with top-repl.scm. */
return gdbscm_make_error (signal_symbol, NULL, _("User interrupt"),
SCM_EOL, scm_list_1 (scm_from_int (SIGINT)));
}
if (exception.error == MEMORY_ERROR)
key = memory_error_symbol;
else
key = error_symbol;
return gdbscm_make_error (key, NULL, "~A",
scm_list_1 (gdbscm_scm_from_c_string
(exception.message)),
SCM_BOOL_F);
}
static SCM
gdbscm_string_to_argv (SCM string_scm)
{
char *string;
SCM result = SCM_EOL;
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "s",
string_scm, &string);
if (string == NULL || *string == '\0')
{
xfree (string);
return SCM_EOL;
}
gdb_argv c_argv (string);
for (char *arg : c_argv)
result = scm_cons (gdbscm_scm_from_c_string (arg), result);
xfree (string);
return scm_reverse_x (result, SCM_EOL);
}
static SCM
ioscm_make_gdb_stdio_port (int fd)
{
int is_a_tty = isatty (fd);
const char *name;
const char *mode_str;
long mode_bits;
SCM port;
switch (fd)
{
case 0:
name = input_port_name;
mode_str = is_a_tty ? "r0" : "r";
break;
case 1:
name = output_port_name;
mode_str = is_a_tty ? "w0" : "w";
break;
case 2:
name = error_port_name;
mode_str = is_a_tty ? "w0" : "w";
break;
default:
gdb_assert_not_reached ("bad stdio file descriptor");
}
mode_bits = scm_mode_bits ((char *) mode_str);
port = ioscm_open_port (stdio_port_desc, mode_bits);
scm_set_port_filename_x (port, gdbscm_scm_from_c_string (name));
ioscm_init_stdio_buffers (port, mode_bits);
return port;
}
static SCM
gdbscm_host_config (void)
{
return gdbscm_scm_from_c_string (host_name);
}
static SCM
gdbscm_guile_data_directory (void)
{
return gdbscm_scm_from_c_string (guile_datadir);
}
static SCM
gdbscm_target_config (void)
{
return gdbscm_scm_from_c_string (target_name);
}
static SCM
gdbscm_gdb_version (void)
{
return gdbscm_scm_from_c_string (version);
}