static void
gdbscm_memory_port_end_input (SCM port, int offset)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
size_t remaining = pt->read_end - pt->read_pos;
/* Note: Use of "int offset" is specified by Guile ports API. */
if ((offset < 0 && remaining + offset > remaining)
|| (offset > 0 && remaining + offset < remaining))
{
gdbscm_out_of_range_error (FUNC_NAME, 0, scm_from_int (offset),
_("overflow in offset calculation"));
}
offset += remaining;
if (offset > 0)
{
pt->read_pos = pt->read_end;
/* Throw error if unread-char used at beginning of file
then attempting to write. Seems correct. */
if (!ioscm_lseek_address (iomem, -offset, SEEK_CUR))
{
gdbscm_out_of_range_error (FUNC_NAME, 0, scm_from_int (offset),
_("bad offset"));
}
}
pt->rw_active = SCM_PORT_NEITHER;
}
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 void
gdbscm_memory_port_flush (SCM port)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
size_t to_write = pt->write_pos - pt->write_buf;
if (to_write == 0)
return;
/* There's no way to indicate a short write, so if the request goes past
the end of the port's memory range, flag an error. */
if (to_write > iomem->size - iomem->current)
{
gdbscm_out_of_range_error (FUNC_NAME, 0,
gdbscm_scm_from_ulongest (to_write),
_("writing beyond end of memory range"));
}
if (target_write_memory (iomem->start + iomem->current, pt->write_buf,
to_write) != 0)
gdbscm_memory_error (FUNC_NAME, _("error writing memory"), SCM_EOL);
iomem->current += to_write;
pt->write_pos = pt->write_buf;
pt->rw_active = SCM_PORT_NEITHER;
}
static SCM
gdbscm_open_memory (SCM rest)
{
const SCM keywords[] = {
mode_keyword, start_keyword, size_keyword, SCM_BOOL_F
};
char *mode = NULL;
CORE_ADDR start = 0;
CORE_ADDR end;
int mode_arg_pos = -1, start_arg_pos = -1, size_arg_pos = -1;
ULONGEST size;
SCM port;
long mode_bits;
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "#sUU", rest,
&mode_arg_pos, &mode,
&start_arg_pos, &start,
&size_arg_pos, &size);
scm_dynwind_begin ((scm_t_dynwind_flags) 0);
if (mode == NULL)
mode = xstrdup ("r");
scm_dynwind_free (mode);
if (size_arg_pos > 0)
{
/* For now be strict about start+size overflowing. If it becomes
a nuisance we can relax things later. */
if (start + size < start)
{
gdbscm_out_of_range_error (FUNC_NAME, 0,
scm_list_2 (gdbscm_scm_from_ulongest (start),
gdbscm_scm_from_ulongest (size)),
_("start+size overflows"));
}
end = start + size;
}
else
end = ~(CORE_ADDR) 0;
mode_bits = ioscm_parse_mode_bits (FUNC_NAME, mode);
port = ioscm_open_port (memory_port_desc, mode_bits);
ioscm_init_memory_port (port, start, end);
scm_dynwind_end ();
/* TODO: Set the file name as "memory-start-end"? */
return port;
}
static SCM
gdbscm_set_memory_port_write_buffer_size_x (SCM port, SCM size)
{
ioscm_memory_port *iomem;
SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME,
memory_port_desc_name);
SCM_ASSERT_TYPE (scm_is_integer (size), size, SCM_ARG2, FUNC_NAME,
_("integer"));
if (!scm_is_unsigned_integer (size, min_memory_port_buf_size,
max_memory_port_buf_size))
{
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, size,
out_of_range_buf_size);
}
iomem = (ioscm_memory_port *) SCM_STREAM (port);
ioscm_reinit_memory_port (port, iomem->read_buf_size, scm_to_uint (size),
FUNC_NAME);
return SCM_UNSPECIFIED;
}
static SCM
gdbscm_make_breakpoint (SCM location_scm, SCM rest)
{
const SCM keywords[] = {
type_keyword, wp_class_keyword, internal_keyword, SCM_BOOL_F
};
char *s;
char *location;
int type_arg_pos = -1, access_type_arg_pos = -1, internal_arg_pos = -1;
enum bptype type = bp_breakpoint;
enum target_hw_bp_type access_type = hw_write;
int internal = 0;
SCM result;
breakpoint_smob *bp_smob;
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#iit",
location_scm, &location, rest,
&type_arg_pos, &type,
&access_type_arg_pos, &access_type,
&internal_arg_pos, &internal);
result = bpscm_make_breakpoint_smob ();
bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (result);
s = location;
location = gdbscm_gc_xstrdup (s);
xfree (s);
switch (type)
{
case bp_breakpoint:
if (access_type_arg_pos > 0)
{
gdbscm_misc_error (FUNC_NAME, access_type_arg_pos,
scm_from_int (access_type),
_("access type with breakpoint is not allowed"));
}
break;
case bp_watchpoint:
switch (access_type)
{
case hw_write:
case hw_access:
case hw_read:
break;
default:
gdbscm_out_of_range_error (FUNC_NAME, access_type_arg_pos,
scm_from_int (access_type),
_("invalid watchpoint class"));
}
break;
default:
gdbscm_out_of_range_error (FUNC_NAME, access_type_arg_pos,
scm_from_int (type),
_("invalid breakpoint type"));
}
bp_smob->is_scheme_bkpt = 1;
bp_smob->spec.location = location;
bp_smob->spec.type = type;
bp_smob->spec.access_type = access_type;
bp_smob->spec.is_internal = internal;
return result;
}
static SCM
gdbscm_make_parameter (SCM name_scm, SCM rest)
{
const SCM keywords[] = {
command_class_keyword, parameter_type_keyword, enum_list_keyword,
set_func_keyword, show_func_keyword,
doc_keyword, set_doc_keyword, show_doc_keyword,
initial_value_keyword, SCM_BOOL_F
};
int cmd_class_arg_pos = -1, param_type_arg_pos = -1;
int enum_list_arg_pos = -1, set_func_arg_pos = -1, show_func_arg_pos = -1;
int doc_arg_pos = -1, set_doc_arg_pos = -1, show_doc_arg_pos = -1;
int initial_value_arg_pos = -1;
char *s;
char *name;
int cmd_class = no_class;
int param_type = var_boolean; /* ARI: var_boolean */
SCM enum_list_scm = SCM_BOOL_F;
SCM set_func = SCM_BOOL_F, show_func = SCM_BOOL_F;
char *doc = NULL, *set_doc = NULL, *show_doc = NULL;
SCM initial_value_scm = SCM_BOOL_F;
const char * const *enum_list = NULL;
SCM p_scm;
param_smob *p_smob;
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#iiOOOsssO",
name_scm, &name, rest,
&cmd_class_arg_pos, &cmd_class,
¶m_type_arg_pos, ¶m_type,
&enum_list_arg_pos, &enum_list_scm,
&set_func_arg_pos, &set_func,
&show_func_arg_pos, &show_func,
&doc_arg_pos, &doc,
&set_doc_arg_pos, &set_doc,
&show_doc_arg_pos, &show_doc,
&initial_value_arg_pos, &initial_value_scm);
/* If doc is NULL, leave it NULL. See add_setshow_cmd_full. */
if (set_doc == NULL)
set_doc = get_doc_string ();
if (show_doc == NULL)
show_doc = get_doc_string ();
s = name;
name = gdbscm_canonicalize_command_name (s, 0);
xfree (s);
if (doc != NULL)
{
s = doc;
doc = gdbscm_gc_xstrdup (s);
xfree (s);
}
s = set_doc;
set_doc = gdbscm_gc_xstrdup (s);
xfree (s);
s = show_doc;
show_doc = gdbscm_gc_xstrdup (s);
xfree (s);
if (!gdbscm_valid_command_class_p (cmd_class))
{
gdbscm_out_of_range_error (FUNC_NAME, cmd_class_arg_pos,
scm_from_int (cmd_class),
_("invalid command class argument"));
}
if (!pascm_valid_parameter_type_p (param_type))
{
gdbscm_out_of_range_error (FUNC_NAME, param_type_arg_pos,
scm_from_int (param_type),
_("invalid parameter type argument"));
}
if (enum_list_arg_pos > 0 && param_type != var_enum)
{
gdbscm_misc_error (FUNC_NAME, enum_list_arg_pos, enum_list_scm,
_("#:enum-values can only be provided with PARAM_ENUM"));
}
if (enum_list_arg_pos < 0 && param_type == var_enum)
{
gdbscm_misc_error (FUNC_NAME, GDBSCM_ARG_NONE, SCM_BOOL_F,
_("PARAM_ENUM requires an enum-values argument"));
}
if (set_func_arg_pos > 0)
{
SCM_ASSERT_TYPE (gdbscm_is_procedure (set_func), set_func,
set_func_arg_pos, FUNC_NAME, _("procedure"));
}
if (show_func_arg_pos > 0)
{
SCM_ASSERT_TYPE (gdbscm_is_procedure (show_func), show_func,
show_func_arg_pos, FUNC_NAME, _("procedure"));
}
if (param_type == var_enum)
{
/* Note: enum_list lives in GC space, so we don't have to worry about
freeing it if we later throw an exception. */
enum_list = compute_enum_list (enum_list_scm, enum_list_arg_pos,
FUNC_NAME);
}
/* If initial-value is a function, we need the parameter object constructed
to pass it to the function. A typical thing the function may want to do
is add an object-property to it to record the last known good value. */
p_scm = pascm_make_param_smob ();
p_smob = (param_smob *) SCM_SMOB_DATA (p_scm);
/* These are all stored in GC space so that we don't have to worry about
freeing them if we throw an exception. */
p_smob->name = name;
p_smob->cmd_class = (enum command_class) cmd_class;
p_smob->type = (enum var_types) param_type;
p_smob->doc = doc;
p_smob->set_doc = set_doc;
p_smob->show_doc = show_doc;
p_smob->enumeration = enum_list;
p_smob->set_func = set_func;
p_smob->show_func = show_func;
if (initial_value_arg_pos > 0)
{
if (gdbscm_is_procedure (initial_value_scm))
{
initial_value_scm = gdbscm_safe_call_1 (initial_value_scm,
p_smob->containing_scm, NULL);
if (gdbscm_is_exception (initial_value_scm))
gdbscm_throw (initial_value_scm);
}
pascm_set_param_value_x (p_smob->type, &p_smob->value, enum_list,
initial_value_scm,
initial_value_arg_pos, FUNC_NAME);
}
return p_scm;
}
static void
pascm_set_param_value_x (enum var_types type, union pascm_variable *var,
const char * const *enumeration,
SCM value, int arg_pos, const char *func_name)
{
switch (type)
{
case var_string:
case var_string_noescape:
case var_optional_filename:
case var_filename:
SCM_ASSERT_TYPE (scm_is_string (value)
|| (type != var_filename
&& gdbscm_is_false (value)),
value, arg_pos, func_name,
_("string or #f for non-PARAM_FILENAME parameters"));
if (gdbscm_is_false (value))
{
xfree (var->stringval);
if (type == var_optional_filename)
var->stringval = xstrdup ("");
else
var->stringval = NULL;
}
else
{
char *string;
SCM exception;
string = gdbscm_scm_to_host_string (value, NULL, &exception);
if (string == NULL)
gdbscm_throw (exception);
xfree (var->stringval);
var->stringval = string;
}
break;
case var_enum:
{
int i;
char *str;
SCM exception;
SCM_ASSERT_TYPE (scm_is_string (value), value, arg_pos, func_name,
_("string"));
str = gdbscm_scm_to_host_string (value, NULL, &exception);
if (str == NULL)
gdbscm_throw (exception);
for (i = 0; enumeration[i]; ++i)
{
if (strcmp (enumeration[i], str) == 0)
break;
}
xfree (str);
if (enumeration[i] == NULL)
{
gdbscm_out_of_range_error (func_name, arg_pos, value,
_("not member of enumeration"));
}
var->cstringval = enumeration[i];
break;
}
case var_boolean:
SCM_ASSERT_TYPE (gdbscm_is_bool (value), value, arg_pos, func_name,
_("boolean"));
var->intval = gdbscm_is_true (value);
break;
case var_auto_boolean:
SCM_ASSERT_TYPE (gdbscm_is_bool (value)
|| scm_is_eq (value, auto_keyword),
value, arg_pos, func_name,
_("boolean or #:auto"));
if (scm_is_eq (value, auto_keyword))
var->autoboolval = AUTO_BOOLEAN_AUTO;
else if (gdbscm_is_true (value))
var->autoboolval = AUTO_BOOLEAN_TRUE;
else
var->autoboolval = AUTO_BOOLEAN_FALSE;
break;
case var_zinteger:
case var_uinteger:
case var_zuinteger:
case var_zuinteger_unlimited:
if (type == var_uinteger
|| type == var_zuinteger_unlimited)
{
SCM_ASSERT_TYPE (gdbscm_is_bool (value)
|| scm_is_eq (value, unlimited_keyword),
value, arg_pos, func_name,
_("integer or #:unlimited"));
if (scm_is_eq (value, unlimited_keyword))
{
if (type == var_uinteger)
var->intval = UINT_MAX;
else
var->intval = -1;
break;
}
}
else
{
SCM_ASSERT_TYPE (scm_is_integer (value), value, arg_pos, func_name,
_("integer"));
}
if (type == var_uinteger
|| type == var_zuinteger)
{
unsigned int u = scm_to_uint (value);
if (type == var_uinteger && u == 0)
u = UINT_MAX;
var->uintval = u;
}
else
{
int i = scm_to_int (value);
if (type == var_zuinteger_unlimited && i < -1)
{
gdbscm_out_of_range_error (func_name, arg_pos, value,
_("must be >= -1"));
}
var->intval = i;
}
break;
default:
gdb_assert_not_reached ("bad parameter type");
}
}
static SCM
gdbscm_arch_disassemble (SCM self, SCM start_scm, SCM rest)
{
arch_smob *a_smob
= arscm_get_arch_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct gdbarch *gdbarch = arscm_get_gdbarch (a_smob);
const SCM keywords[] = {
port_keyword, offset_keyword, size_keyword, count_keyword, SCM_BOOL_F
};
int port_arg_pos = -1, offset_arg_pos = -1;
int size_arg_pos = -1, count_arg_pos = -1;
SCM port = SCM_BOOL_F;
ULONGEST offset = 0;
unsigned int count = 1;
unsigned int size;
ULONGEST start_arg;
CORE_ADDR start, end;
CORE_ADDR pc;
unsigned int i;
int using_port;
SCM result;
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "U#OUuu",
start_scm, &start_arg, rest,
&port_arg_pos, &port,
&offset_arg_pos, &offset,
&size_arg_pos, &size,
&count_arg_pos, &count);
/* START is first stored in a ULONGEST because we don't have a format char
for CORE_ADDR, and it's not really worth it to have one yet. */
start = start_arg;
if (port_arg_pos > 0)
{
SCM_ASSERT_TYPE (gdbscm_is_false (port)
|| gdbscm_is_true (scm_input_port_p (port)),
port, port_arg_pos, FUNC_NAME, _("input port"));
}
using_port = gdbscm_is_true (port);
if (offset_arg_pos > 0
&& (port_arg_pos < 0
|| gdbscm_is_false (port)))
{
gdbscm_out_of_range_error (FUNC_NAME, offset_arg_pos,
gdbscm_scm_from_ulongest (offset),
_("offset provided but port is missing"));
}
if (size_arg_pos > 0)
{
if (size == 0)
return SCM_EOL;
/* For now be strict about start+size overflowing. If it becomes
a nuisance we can relax things later. */
if (start + size < start)
{
gdbscm_out_of_range_error (FUNC_NAME, 0,
scm_list_2 (gdbscm_scm_from_ulongest (start),
gdbscm_scm_from_ulongest (size)),
_("start+size overflows"));
}
end = start + size - 1;
}
else
end = ~(CORE_ADDR) 0;
if (count == 0)
return SCM_EOL;
result = SCM_EOL;
for (pc = start, i = 0; pc <= end && i < count; )
{
int insn_len = 0;
struct ui_file *memfile = mem_fileopen ();
struct cleanup *cleanups = make_cleanup_ui_file_delete (memfile);
TRY
{
if (using_port)
{
insn_len = gdbscm_print_insn_from_port (gdbarch, port, offset,
pc, memfile, NULL);
}
else
insn_len = gdb_print_insn (gdbarch, pc, memfile, NULL);
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
}
END_CATCH
std::string as = ui_file_as_string (memfile);
result = scm_cons (dascm_make_insn (pc, as.c_str (), insn_len),
result);
pc += insn_len;
i++;
do_cleanups (cleanups);
}
static scm_t_off
gdbscm_memory_port_seek (SCM port, scm_t_off offset, int whence)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
CORE_ADDR result;
int rc;
if (pt->rw_active == SCM_PORT_WRITE)
{
if (offset != 0 || whence != SEEK_CUR)
{
gdbscm_memory_port_flush (port);
rc = ioscm_lseek_address (iomem, offset, whence);
result = iomem->current;
}
else
{
/* Read current position without disturbing the buffer,
but flag an error if what's in the buffer goes outside the
allowed range. */
CORE_ADDR current = iomem->current;
size_t delta = pt->write_pos - pt->write_buf;
if (current + delta < current
|| current + delta > iomem->size)
rc = 0;
else
{
result = current + delta;
rc = 1;
}
}
}
else if (pt->rw_active == SCM_PORT_READ)
{
if (offset != 0 || whence != SEEK_CUR)
{
scm_end_input (port);
rc = ioscm_lseek_address (iomem, offset, whence);
result = iomem->current;
}
else
{
/* Read current position without disturbing the buffer
(particularly the unread-char buffer). */
CORE_ADDR current = iomem->current;
size_t remaining = pt->read_end - pt->read_pos;
if (current - remaining > current
|| current - remaining < iomem->start)
rc = 0;
else
{
result = current - remaining;
rc = 1;
}
if (rc != 0 && pt->read_buf == pt->putback_buf)
{
size_t saved_remaining = pt->saved_read_end - pt->saved_read_pos;
if (result - saved_remaining > result
|| result - saved_remaining < iomem->start)
rc = 0;
else
result -= saved_remaining;
}
}
}
else /* SCM_PORT_NEITHER */
{
rc = ioscm_lseek_address (iomem, offset, whence);
result = iomem->current;
}
if (rc == 0)
{
gdbscm_out_of_range_error (FUNC_NAME, 0,
gdbscm_scm_from_longest (offset),
_("bad seek"));
}
/* TODO: The Guile API doesn't support 32x64. We can't fix that here,
and there's no need to throw an error if the new address can't be
represented in a scm_t_off. But we could return something less
clumsy. */
return result;
}
static void
gdbscm_memory_port_write (SCM port, const void *void_data, size_t size)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
const gdb_byte *data = (const gdb_byte *) void_data;
/* There's no way to indicate a short write, so if the request goes past
the end of the port's memory range, flag an error. */
if (size > iomem->size - iomem->current)
{
gdbscm_out_of_range_error (FUNC_NAME, 0, gdbscm_scm_from_ulongest (size),
_("writing beyond end of memory range"));
}
if (pt->write_buf == &pt->shortbuf)
{
/* Unbuffered port. */
if (target_write_memory (iomem->start + iomem->current, data, size) != 0)
gdbscm_memory_error (FUNC_NAME, _("error writing memory"), SCM_EOL);
iomem->current += size;
return;
}
/* Note: The edge case of what to do when the buffer exactly fills is
debatable. Guile flushes when the buffer exactly fills up, so we
do too. It's counter-intuitive to my mind, but in case there's a
subtlety somewhere that depends on this, we do the same. */
{
size_t space = pt->write_end - pt->write_pos;
if (size < space)
{
/* Data fits in buffer, and does not fill it. */
memcpy (pt->write_pos, data, size);
pt->write_pos += size;
}
else
{
memcpy (pt->write_pos, data, space);
pt->write_pos = pt->write_end;
gdbscm_memory_port_flush (port);
{
const gdb_byte *ptr = data + space;
size_t remaining = size - space;
if (remaining >= pt->write_buf_size)
{
if (target_write_memory (iomem->start + iomem->current, ptr,
remaining) != 0)
gdbscm_memory_error (FUNC_NAME, _("error writing memory"),
SCM_EOL);
iomem->current += remaining;
}
else
{
memcpy (pt->write_pos, ptr, remaining);
pt->write_pos += remaining;
}
}
}
}
}
