/* GDB/Scheme pretty-printing.
- Copyright (C) 2008-2014 Free Software Foundation, Inc.
+ Copyright (C) 2008-2019 Free Software Foundation, Inc.
This file is part of GDB.
#include "defs.h"
#include "charset.h"
-#include "gdb_assert.h"
#include "symtab.h" /* Needed by language.h. */
#include "language.h"
#include "objfiles.h"
static SCM
ppscm_make_pp_type_error_exception (const char *message, SCM object)
{
- char *msg = xstrprintf ("%s: ~S", message);
- struct cleanup *cleanup = make_cleanup (xfree, msg);
- SCM exception
- = gdbscm_make_error (pp_type_error_symbol,
- NULL /* func */, msg,
- scm_list_1 (object), scm_list_1 (object));
-
- do_cleanups (cleanup);
-
- return exception;
+ std::string msg = string_printf ("%s: ~S", message);
+ return gdbscm_make_error (pp_type_error_symbol,
+ NULL /* func */, msg.c_str (),
+ scm_list_1 (object), scm_list_1 (object));
}
/* Print MESSAGE as an exception (meaning it is controlled by
SCM matcher = scm_car (list);
SCM worker;
pretty_printer_smob *pp_smob;
- int rc;
if (!ppscm_is_pretty_printer (matcher))
{
static SCM
ppscm_find_pretty_printer_from_objfiles (SCM value)
{
- struct objfile *objfile;
-
- ALL_OBJFILES (objfile)
- {
- objfile_smob *o_smob = ofscm_objfile_smob_from_objfile (objfile);
- SCM pp = ppscm_search_pp_list (ofscm_objfile_smob_pretty_printers (o_smob),
- value);
-
- /* Note: This will return if pp is a <gdb:exception> object,
- which is what we want. */
- if (gdbscm_is_true (pp))
- return pp;
- }
+ for (objfile *objfile : all_objfiles (current_program_space))
+ {
+ objfile_smob *o_smob = ofscm_objfile_smob_from_objfile (objfile);
+ SCM pp
+ = ppscm_search_pp_list (ofscm_objfile_smob_pretty_printers (o_smob),
+ value);
+
+ /* Note: This will return if pp is a <gdb:exception> object,
+ which is what we want. */
+ if (gdbscm_is_true (pp))
+ return pp;
+ }
return SCM_BOOL_F;
}
struct gdbarch *gdbarch,
const struct language_defn *language)
{
- volatile struct gdb_exception except;
SCM result = SCM_BOOL_F;
*out_value = NULL;
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
- int rc;
pretty_printer_worker_smob *w_smob
= (pretty_printer_worker_smob *) SCM_SMOB_DATA (printer);
(_("invalid result from pretty-printer to-string"), result);
}
}
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ }
+ END_CATCH
return result;
}
{
if (gdbscm_memory_error_p (gdbscm_exception_key (exception)))
{
- char *msg = gdbscm_exception_message_to_string (exception);
- struct cleanup *cleanup = make_cleanup (xfree, msg);
+ gdb::unique_xmalloc_ptr<char> msg
+ = gdbscm_exception_message_to_string (exception);
/* This "shouldn't happen", but play it safe. */
- if (msg == NULL || *msg == '\0')
+ if (msg == NULL || msg.get ()[0] == '\0')
fprintf_filtered (stream, _("<error reading variable>"));
else
{
/* Remove the trailing newline. We could instead call a special
routine for printing memory error messages, but this is easy
enough for now. */
- size_t len = strlen (msg);
+ char *msg_text = msg.get ();
+ size_t len = strlen (msg_text);
- if (msg[len - 1] == '\n')
- msg[len - 1] = '\0';
- fprintf_filtered (stream, _("<error reading variable: %s>"), msg);
+ if (msg_text[len - 1] == '\n')
+ msg_text[len - 1] = '\0';
+ fprintf_filtered (stream, _("<error reading variable: %s>"), msg_text);
}
-
- do_cleanups (cleanup);
}
else
gdbscm_print_gdb_exception (SCM_BOOL_F, exception);
}
else if (scm_is_string (str_scm))
{
- struct cleanup *cleanup;
size_t length;
- char *string
+ gdb::unique_xmalloc_ptr<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,
+ LA_PRINT_STRING (stream, type, (gdb_byte *) string.get (),
length, NULL, 0, options);
}
else
for (i = 0; i < length; ++i)
{
- if (string[i] == '\0')
+ if (string.get ()[i] == '\0')
fputs_filtered ("\\000", stream);
else
- fputc_filtered (string[i], stream);
+ fputc_filtered (string.get ()[i], stream);
}
}
result = STRING_REPR_OK;
- do_cleanups (cleanup);
}
else if (lsscm_is_lazy_string (str_scm))
{
= (pretty_printer_worker_smob *) SCM_SMOB_DATA (printer);
int is_map, is_array, done_flag, pretty;
unsigned int i;
- SCM children, status;
+ SCM children;
SCM iter = SCM_BOOL_F; /* -Wall */
- struct cleanup *cleanups;
if (gdbscm_is_false (w_smob->children))
return;
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;
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))
{
" a string"), item);
continue;
}
- name = gdbscm_scm_to_c_string (scm_name);
- make_cleanup (xfree, name);
+ gdb::unique_xmalloc_ptr<char> name
+ = gdbscm_scm_to_c_string (scm_name);
/* Print initial "{". For other elements, there are three cases:
1. Maps. Print a "," after each value element.
}
else if (! is_map)
{
- fputs_filtered (name, stream);
+ fputs_filtered (name.get (), stream);
fputs_filtered (" = ", stream);
}
}
else if (scm_is_string (v_scm))
{
- char *output = gdbscm_scm_to_c_string (v_scm);
-
- fputs_filtered (output, stream);
- xfree (output);
+ gdb::unique_xmalloc_ptr<char> output
+ = gdbscm_scm_to_c_string (v_scm);
+ fputs_filtered (output.get (), stream);
}
else
{
if (is_map && i % 2 == 0)
fputs_filtered ("] = ", stream);
-
- do_cleanups (inner_cleanup);
}
if (i)
}
done:
- do_cleanups (cleanups);
-
/* Play it safe, make sure ITER doesn't get GC'd. */
scm_remember_upto_here_1 (iter);
}
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 type *type,
+ LONGEST embedded_offset, CORE_ADDR address,
struct ui_file *stream, int recurse,
- const struct value *val,
+ struct value *val,
const struct value_print_options *options,
const struct language_defn *language)
{
SCM val_obj = SCM_BOOL_F;
struct value *value;
enum display_hint hint;
- struct cleanup *cleanups;
- int result = EXT_LANG_RC_NOP;
+ enum ext_lang_rc result = EXT_LANG_RC_NOP;
enum string_repr_result print_result;
+ if (value_lazy (val))
+ value_fetch_lazy (val);
+
/* 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);
+ value = value_from_component (val, type, embedded_offset);
val_obj = vlscm_scm_from_value (value);
if (gdbscm_is_exception (val_obj))
done:
if (gdbscm_is_exception (exception))
ppscm_print_exception_unless_memory_error (exception, stream);
- do_cleanups (cleanups);
return result;
}
\f
static const scheme_function pretty_printer_functions[] =
{
- { "make-pretty-printer", 2, 0, 0, gdbscm_make_pretty_printer,
+ { "make-pretty-printer", 2, 0, 0,
+ as_a_scm_t_subr (gdbscm_make_pretty_printer),
"\
Create a <gdb:pretty-printer> object.\n\
\n\
lookup: a procedure:\n\
(pretty-printer <gdb:value>) -> <gdb:pretty-printer-worker> | #f." },
- { "pretty-printer?", 1, 0, 0, gdbscm_pretty_printer_p,
+ { "pretty-printer?", 1, 0, 0, as_a_scm_t_subr (gdbscm_pretty_printer_p),
"\
Return #t if the object is a <gdb:pretty-printer> object." },
- { "pretty-printer-enabled?", 1, 0, 0, gdbscm_pretty_printer_enabled_p,
+ { "pretty-printer-enabled?", 1, 0, 0,
+ as_a_scm_t_subr (gdbscm_pretty_printer_enabled_p),
"\
Return #t if the pretty-printer is enabled." },
{ "set-pretty-printer-enabled!", 2, 0, 0,
- gdbscm_set_pretty_printer_enabled_x,
+ as_a_scm_t_subr (gdbscm_set_pretty_printer_enabled_x),
"\
Set the enabled flag of the pretty-printer.\n\
Returns \"unspecified\"." },
- { "make-pretty-printer-worker", 3, 0, 0, gdbscm_make_pretty_printer_worker,
+ { "make-pretty-printer-worker", 3, 0, 0,
+ as_a_scm_t_subr (gdbscm_make_pretty_printer_worker),
"\
Create a <gdb:pretty-printer-worker> object.\n\
\n\
children: either #f or a procedure:\n\
(pretty-printer) -> <gdb:iterator>" },
- { "pretty-printer-worker?", 1, 0, 0, gdbscm_pretty_printer_worker_p,
+ { "pretty-printer-worker?", 1, 0, 0,
+ as_a_scm_t_subr (gdbscm_pretty_printer_worker_p),
"\
Return #t if the object is a <gdb:pretty-printer-worker> object." },
- { "pretty-printers", 0, 0, 0, gdbscm_pretty_printers,
+ { "pretty-printers", 0, 0, 0, as_a_scm_t_subr (gdbscm_pretty_printers),
"\
Return the list of global pretty-printers." },
{ "set-pretty-printers!", 1, 0, 0,
- gdbscm_set_pretty_printers_x,
+ as_a_scm_t_subr (gdbscm_set_pretty_printers_x),
"\
Set the list of global pretty-printers." },
projects / deliverable / binutils-gdb.git / blobdiff