static SCM
ppscm_search_pp_list (SCM list, SCM value)
{
SCM orig_list = list;
if (scm_is_null (list))
return SCM_BOOL_F;
if (gdbscm_is_false (scm_list_p (list))) /* scm_is_pair? */
{
return ppscm_make_pp_type_error_exception
(_("pretty-printer list is not a list"), list);
}
for ( ; scm_is_pair (list); list = scm_cdr (list))
{
SCM matcher = scm_car (list);
SCM worker;
pretty_printer_smob *pp_smob;
if (!ppscm_is_pretty_printer (matcher))
{
return ppscm_make_pp_type_error_exception
(_("pretty-printer list contains non-pretty-printer object"),
matcher);
}
pp_smob = (pretty_printer_smob *) SCM_SMOB_DATA (matcher);
/* Skip if disabled. */
if (gdbscm_is_false (pp_smob->enabled))
continue;
if (!gdbscm_is_procedure (pp_smob->lookup))
{
return ppscm_make_pp_type_error_exception
(_("invalid lookup object in pretty-printer matcher"),
pp_smob->lookup);
}
worker = gdbscm_safe_call_2 (pp_smob->lookup, matcher,
value, gdbscm_memory_error_p);
if (!gdbscm_is_false (worker))
{
if (gdbscm_is_exception (worker))
return worker;
if (ppscm_is_pretty_printer_worker (worker))
return worker;
return ppscm_make_pp_type_error_exception
(_("invalid result from pretty-printer lookup"), worker);
}
}
if (!scm_is_null (list))
{
return ppscm_make_pp_type_error_exception
(_("pretty-printer list is not a list"), orig_list);
}
return SCM_BOOL_F;
}
SCM
gdbscm_scm_from_string (const char *string, size_t len,
const char *charset, int strict)
{
struct scm_from_stringn_data data;
SCM scm_result;
data.string = string;
data.len = len;
data.charset = charset;
/* The use of SCM_FAILED_CONVERSION_QUESTION_MARK is specified by Guile. */
data.conversion_kind = (strict
? SCM_FAILED_CONVERSION_ERROR
: SCM_FAILED_CONVERSION_QUESTION_MARK);
data.result = SCM_UNDEFINED;
scm_result = gdbscm_call_guile (gdbscm_call_scm_from_stringn, &data, NULL);
if (gdbscm_is_false (scm_result))
{
gdb_assert (!SCM_UNBNDP (data.result));
return data.result;
}
gdb_assert (gdbscm_is_exception (scm_result));
return scm_result;
}
char *
gdbscm_scm_to_string (SCM string, size_t *lenp,
const char *charset, int strict, SCM *except_scmp)
{
struct scm_to_stringn_data data;
SCM scm_result;
data.string = string;
data.lenp = lenp;
data.charset = charset;
data.conversion_kind = (strict
? SCM_FAILED_CONVERSION_ERROR
: SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE);
data.result = NULL;
scm_result = gdbscm_call_guile (gdbscm_call_scm_to_stringn, &data, NULL);
if (gdbscm_is_false (scm_result))
{
gdb_assert (data.result != NULL);
return data.result;
}
gdb_assert (gdbscm_is_exception (scm_result));
*except_scmp = scm_result;
return NULL;
}
static void
gdbscm_print_exception_message (SCM port, SCM frame, SCM key, SCM args)
{
SCM printer, status;
if (gdbscm_is_false (port))
port = scm_current_error_port ();
gdb_assert (!scm_is_eq (key, with_stack_error_symbol));
/* This does not use scm_print_exception because we tweak the output a bit.
Compare Guile's print-exception with our %print-exception-message for
details. */
if (gdbscm_is_false (percent_print_exception_message_var))
{
percent_print_exception_message_var
= scm_c_private_variable (gdbscm_init_module_name,
percent_print_exception_message_name);
/* If we can't find %print-exception-message, there's a problem on the
Scheme side. Don't kill GDB, just flag an error and leave it at
that. */
if (gdbscm_is_false (percent_print_exception_message_var))
{
gdbscm_printf (port, _("Error in Scheme exception printing,"
" can't find %s.\n"),
percent_print_exception_message_name);
return;
}
}
printer = scm_variable_ref (percent_print_exception_message_var);
status = gdbscm_safe_call_4 (printer, port, frame, key, args, NULL);
/* If that failed still tell the user something.
But don't use the exception printing machinery! */
if (gdbscm_is_exception (status))
{
gdbscm_printf (port, _("Error in Scheme exception printing:\n"));
scm_display (status, port);
scm_newline (port);
}
}
static int
stscm_sal_is_valid (sal_smob *s_smob)
{
symtab_smob *st_smob;
/* If there's no symtab that's ok, the sal is still valid. */
if (gdbscm_is_false (s_smob->symtab_scm))
return 1;
st_smob = (symtab_smob *) SCM_SMOB_DATA (s_smob->symtab_scm);
return st_smob->symtab != NULL;
}
void
gdbscm_parse_function_args (const char *func_name,
int beginning_arg_pos,
const SCM *keywords,
const char *format, ...)
{
va_list args;
const char *p;
int i, have_rest, num_keywords, length, position;
int have_optional = 0;
SCM status;
SCM rest = SCM_EOL;
/* Keep track of malloc'd strings. We need to free them upon error. */
VEC (char_ptr) *allocated_strings = NULL;
char *ptr;
have_rest = validate_arg_format (format);
num_keywords = count_keywords (keywords);
va_start (args, format);
p = format;
position = beginning_arg_pos;
/* Process required, optional arguments. */
while (*p && *p != '#' && *p != '.')
{
SCM arg;
void *arg_ptr;
if (*p == '|')
{
have_optional = 1;
++p;
continue;
}
arg = va_arg (args, SCM);
if (!have_optional || !SCM_UNBNDP (arg))
{
arg_ptr = va_arg (args, void *);
status = extract_arg (*p, arg, arg_ptr, func_name, position);
if (!gdbscm_is_false (status))
goto fail;
if (*p == 's')
VEC_safe_push (char_ptr, allocated_strings, *(char **) arg_ptr);
}
++p;
++position;
}
static SCM
ppscm_pretty_print_one_value (SCM printer, struct value **out_value,
struct gdbarch *gdbarch,
const struct language_defn *language)
{
SCM result = SCM_BOOL_F;
*out_value = NULL;
TRY
{
int rc;
pretty_printer_worker_smob *w_smob
= (pretty_printer_worker_smob *) SCM_SMOB_DATA (printer);
result = gdbscm_safe_call_1 (w_smob->to_string, printer,
gdbscm_memory_error_p);
if (gdbscm_is_false (result))
; /* Done. */
else if (scm_is_string (result)
|| lsscm_is_lazy_string (result))
; /* Done. */
else if (vlscm_is_value (result))
{
SCM except_scm;
*out_value
= vlscm_convert_value_from_scheme (FUNC_NAME, GDBSCM_ARG_NONE,
result, &except_scm,
gdbarch, language);
if (*out_value != NULL)
result = SCM_BOOL_T;
else
result = except_scm;
}
else if (gdbscm_is_exception (result))
; /* Done. */
else
{
/* Invalid result from to-string. */
result = ppscm_make_pp_type_error_exception
(_("invalid result from pretty-printer to-string"), result);
}
}
CATCH (except, RETURN_MASK_ALL)
{
}
END_CATCH
return result;
}
void
gdbscm_print_exception_with_stack (SCM port, SCM stack, SCM key, SCM args)
{
SCM printer, status;
if (gdbscm_is_false (port))
port = scm_current_error_port ();
if (gdbscm_is_false (percent_print_exception_with_stack_var))
{
percent_print_exception_with_stack_var
= scm_c_private_variable (gdbscm_init_module_name,
percent_print_exception_with_stack_name);
/* If we can't find %print-exception-with-stack, there's a problem on the
Scheme side. Don't kill GDB, just flag an error and leave it at
that. */
if (gdbscm_is_false (percent_print_exception_with_stack_var))
{
gdbscm_printf (port, _("Error in Scheme exception printing,"
" can't find %s.\n"),
percent_print_exception_with_stack_name);
return;
}
}
printer = scm_variable_ref (percent_print_exception_with_stack_var);
status = gdbscm_safe_call_4 (printer, port, stack, key, args, NULL);
/* If that failed still tell the user something.
But don't use the exception printing machinery! */
if (gdbscm_is_exception (status))
{
gdbscm_printf (port, _("Error in Scheme exception printing:\n"));
scm_display (status, port);
scm_newline (port);
}
}
static enum display_hint
ppscm_get_display_hint_enum (SCM printer)
{
SCM hint = ppscm_get_display_hint_scm (printer);
if (gdbscm_is_false (hint))
return HINT_NONE;
if (scm_is_string (hint))
{
if (gdbscm_is_true (scm_string_equal_p (hint, ppscm_array_string)))
return HINT_STRING;
if (gdbscm_is_true (scm_string_equal_p (hint, ppscm_map_string)))
return HINT_STRING;
if (gdbscm_is_true (scm_string_equal_p (hint, ppscm_string_string)))
return HINT_STRING;
return HINT_ERROR;
}
return HINT_ERROR;
}
enum ext_lang_rc
gdbscm_apply_val_pretty_printer (const struct extension_language_defn *extlang,
struct type *type, const gdb_byte *valaddr,
int embedded_offset, CORE_ADDR address,
struct ui_file *stream, int recurse,
const struct value *val,
const struct value_print_options *options,
const struct language_defn *language)
{
struct gdbarch *gdbarch = get_type_arch (type);
SCM exception = SCM_BOOL_F;
SCM printer = SCM_BOOL_F;
SCM val_obj = SCM_BOOL_F;
struct value *value;
enum display_hint hint;
struct cleanup *cleanups;
enum ext_lang_rc result = EXT_LANG_RC_NOP;
enum string_repr_result print_result;
/* No pretty-printer support for unavailable values. */
if (!value_bytes_available (val, embedded_offset, TYPE_LENGTH (type)))
return EXT_LANG_RC_NOP;
if (!gdb_scheme_initialized)
return EXT_LANG_RC_NOP;
cleanups = make_cleanup (null_cleanup, NULL);
/* Instantiate the printer. */
if (valaddr)
valaddr += embedded_offset;
value = value_from_contents_and_address (type, valaddr,
address + embedded_offset);
set_value_component_location (value, val);
/* set_value_component_location resets the address, so we may
need to set it again. */
if (VALUE_LVAL (value) != lval_internalvar
&& VALUE_LVAL (value) != lval_internalvar_component
&& VALUE_LVAL (value) != lval_computed)
set_value_address (value, address + embedded_offset);
val_obj = vlscm_scm_from_value (value);
if (gdbscm_is_exception (val_obj))
{
exception = val_obj;
result = EXT_LANG_RC_ERROR;
goto done;
}
printer = ppscm_find_pretty_printer (val_obj);
if (gdbscm_is_exception (printer))
{
exception = printer;
result = EXT_LANG_RC_ERROR;
goto done;
}
if (gdbscm_is_false (printer))
{
result = EXT_LANG_RC_NOP;
goto done;
}
gdb_assert (ppscm_is_pretty_printer_worker (printer));
/* If we are printing a map, we want some special formatting. */
hint = ppscm_get_display_hint_enum (printer);
if (hint == HINT_ERROR)
{
/* Print the error as an exception for consistency. */
SCM hint_scm = ppscm_get_display_hint_scm (printer);
ppscm_print_pp_type_error ("Invalid display hint", hint_scm);
/* Fall through. A bad hint doesn't stop pretty-printing. */
hint = HINT_NONE;
}
/* Print the section. */
print_result = ppscm_print_string_repr (printer, hint, stream, recurse,
options, gdbarch, language);
if (print_result != STRING_REPR_ERROR)
{
ppscm_print_children (printer, hint, stream, recurse, options,
gdbarch, language,
print_result == STRING_REPR_NONE);
}
result = EXT_LANG_RC_OK;
done:
if (gdbscm_is_exception (exception))
ppscm_print_exception_unless_memory_error (exception, stream);
do_cleanups (cleanups);
return result;
}
static void
ppscm_print_children (SCM printer, enum display_hint hint,
struct ui_file *stream, int recurse,
const struct value_print_options *options,
struct gdbarch *gdbarch,
const struct language_defn *language,
int printed_nothing)
{
pretty_printer_worker_smob *w_smob
= (pretty_printer_worker_smob *) SCM_SMOB_DATA (printer);
int is_map, is_array, done_flag, pretty;
unsigned int i;
SCM children, status;
SCM iter = SCM_BOOL_F; /* -Wall */
struct cleanup *cleanups;
if (gdbscm_is_false (w_smob->children))
return;
if (!gdbscm_is_procedure (w_smob->children))
{
ppscm_print_pp_type_error
(_("pretty-printer \"children\" object is not a procedure or #f"),
w_smob->children);
return;
}
cleanups = make_cleanup (null_cleanup, NULL);
/* If we are printing a map or an array, we want special formatting. */
is_map = hint == HINT_MAP;
is_array = hint == HINT_ARRAY;
children = gdbscm_safe_call_1 (w_smob->children, printer,
gdbscm_memory_error_p);
if (gdbscm_is_exception (children))
{
ppscm_print_exception_unless_memory_error (children, stream);
goto done;
}
/* We combine two steps here: get children, make an iterator out of them.
This simplifies things because there's no language means of creating
iterators, and it's the printer object that knows how it will want its
children iterated over. */
if (!itscm_is_iterator (children))
{
ppscm_print_pp_type_error
(_("result of pretty-printer \"children\" procedure is not"
" a <gdb:iterator> object"), children);
goto done;
}
iter = children;
/* Use the prettyformat_arrays option if we are printing an array,
and the pretty option otherwise. */
if (is_array)
pretty = options->prettyformat_arrays;
else
{
if (options->prettyformat == Val_prettyformat)
pretty = 1;
else
pretty = options->prettyformat_structs;
}
done_flag = 0;
for (i = 0; i < options->print_max; ++i)
{
int rc;
SCM scm_name, v_scm;
char *name;
SCM item = itscm_safe_call_next_x (iter, gdbscm_memory_error_p);
struct cleanup *inner_cleanup = make_cleanup (null_cleanup, NULL);
if (gdbscm_is_exception (item))
{
ppscm_print_exception_unless_memory_error (item, stream);
break;
}
if (itscm_is_end_of_iteration (item))
{
/* Set a flag so we can know whether we printed all the
available elements. */
done_flag = 1;
break;
}
if (! scm_is_pair (item))
{
ppscm_print_pp_type_error
(_("result of pretty-printer children iterator is not a pair"
" or (end-of-iteration)"),
item);
continue;
}
scm_name = scm_car (item);
v_scm = scm_cdr (item);
if (!scm_is_string (scm_name))
{
ppscm_print_pp_type_error
(_("first element of pretty-printer children iterator is not"
" a string"), item);
continue;
}
name = gdbscm_scm_to_c_string (scm_name);
make_cleanup (xfree, name);
/* Print initial "{". For other elements, there are three cases:
1. Maps. Print a "," after each value element.
2. Arrays. Always print a ",".
3. Other. Always print a ",". */
if (i == 0)
{
if (printed_nothing)
fputs_filtered ("{", stream);
else
fputs_filtered (" = {", stream);
}
else if (! is_map || i % 2 == 0)
fputs_filtered (pretty ? "," : ", ", stream);
/* In summary mode, we just want to print "= {...}" if there is
a value. */
if (options->summary)
{
/* This increment tricks the post-loop logic to print what
we want. */
++i;
/* Likewise. */
pretty = 0;
break;
}
if (! is_map || i % 2 == 0)
{
if (pretty)
{
fputs_filtered ("\n", stream);
print_spaces_filtered (2 + 2 * recurse, stream);
}
else
wrap_here (n_spaces (2 + 2 *recurse));
}
if (is_map && i % 2 == 0)
fputs_filtered ("[", stream);
else if (is_array)
{
/* We print the index, not whatever the child method
returned as the name. */
if (options->print_array_indexes)
fprintf_filtered (stream, "[%d] = ", i);
}
else if (! is_map)
{
fputs_filtered (name, stream);
fputs_filtered (" = ", stream);
}
if (lsscm_is_lazy_string (v_scm))
{
struct value_print_options local_opts = *options;
local_opts.addressprint = 0;
lsscm_val_print_lazy_string (v_scm, stream, &local_opts);
}
else if (scm_is_string (v_scm))
{
char *output = gdbscm_scm_to_c_string (v_scm);
fputs_filtered (output, stream);
xfree (output);
}
else
{
SCM except_scm;
struct value *value
= vlscm_convert_value_from_scheme (FUNC_NAME, GDBSCM_ARG_NONE,
v_scm, &except_scm,
gdbarch, language);
if (value == NULL)
{
ppscm_print_exception_unless_memory_error (except_scm, stream);
break;
}
common_val_print (value, stream, recurse + 1, options, language);
}
if (is_map && i % 2 == 0)
fputs_filtered ("] = ", stream);
do_cleanups (inner_cleanup);
}
if (i)
{
if (!done_flag)
{
if (pretty)
{
fputs_filtered ("\n", stream);
print_spaces_filtered (2 + 2 * recurse, stream);
}
fputs_filtered ("...", stream);
}
if (pretty)
{
fputs_filtered ("\n", stream);
print_spaces_filtered (2 * recurse, stream);
}
fputs_filtered ("}", stream);
}
done:
do_cleanups (cleanups);
/* Play it safe, make sure ITER doesn't get GC'd. */
scm_remember_upto_here_1 (iter);
}
static enum string_repr_result
ppscm_print_string_repr (SCM printer, enum display_hint hint,
struct ui_file *stream, int recurse,
const struct value_print_options *options,
struct gdbarch *gdbarch,
const struct language_defn *language)
{
struct value *replacement = NULL;
SCM str_scm;
enum string_repr_result result = STRING_REPR_ERROR;
str_scm = ppscm_pretty_print_one_value (printer, &replacement,
gdbarch, language);
if (gdbscm_is_false (str_scm))
{
result = STRING_REPR_NONE;
}
else if (scm_is_eq (str_scm, SCM_BOOL_T))
{
struct value_print_options opts = *options;
gdb_assert (replacement != NULL);
opts.addressprint = 0;
common_val_print (replacement, stream, recurse, &opts, language);
result = STRING_REPR_OK;
}
else if (scm_is_string (str_scm))
{
struct cleanup *cleanup;
size_t length;
char *string
= gdbscm_scm_to_string (str_scm, &length,
target_charset (gdbarch), 0 /*!strict*/, NULL);
cleanup = make_cleanup (xfree, string);
if (hint == HINT_STRING)
{
struct type *type = builtin_type (gdbarch)->builtin_char;
LA_PRINT_STRING (stream, type, (gdb_byte *) string,
length, NULL, 0, options);
}
else
{
/* Alas scm_to_stringn doesn't nul-terminate the string if we
ask for the length. */
size_t i;
for (i = 0; i < length; ++i)
{
if (string[i] == '\0')
fputs_filtered ("\\000", stream);
else
fputc_filtered (string[i], stream);
}
}
result = STRING_REPR_OK;
do_cleanups (cleanup);
}
else if (lsscm_is_lazy_string (str_scm))
{
struct value_print_options local_opts = *options;
local_opts.addressprint = 0;
lsscm_val_print_lazy_string (str_scm, stream, &local_opts);
result = STRING_REPR_OK;
}
else
{
gdb_assert (gdbscm_is_exception (str_scm));
ppscm_print_exception_unless_memory_error (str_scm, stream);
result = STRING_REPR_ERROR;
}
return result;
}
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);
}