/* GDB/Scheme pretty-printing.
- Copyright (C) 2008-2014 Free Software Foundation, Inc.
+ Copyright (C) 2008-2016 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_t_bits pretty_printer_smob_tag;
static scm_t_bits pretty_printer_worker_smob_tag;
-/* Global list of pretty-printers. */
-static const char pretty_printer_list_name[] = "*pretty-printers*";
-
-/* The *pretty-printer* variable. */
-static SCM pretty_printer_list_var;
+/* The global pretty-printer list. */
+static SCM pretty_printer_list;
/* gdb:pp-type-error. */
static SCM pp_type_error_symbol;
return SCM_UNSPECIFIED;
}
+
+/* (pretty-printers) -> list
+ Returns the list of global pretty-printers. */
+
+static SCM
+gdbscm_pretty_printers (void)
+{
+ return pretty_printer_list;
+}
+
+/* (set-pretty-printers! list) -> unspecified
+ Set the global pretty-printers list. */
+
+static SCM
+gdbscm_set_pretty_printers_x (SCM printers)
+{
+ SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (printers)), printers,
+ SCM_ARG1, FUNC_NAME, _("list"));
+
+ pretty_printer_list = printers;
+
+ return SCM_UNSPECIFIED;
+}
\f
/* Administrivia for pretty-printer-worker smobs.
These are created when a matcher recognizes a value. */
static SCM
ppscm_find_pretty_printer_from_progspace (SCM value)
{
- return SCM_BOOL_F; /*TODO*/
+ pspace_smob *p_smob = psscm_pspace_smob_from_pspace (current_program_space);
+ SCM pp
+ = ppscm_search_pp_list (psscm_pspace_smob_pretty_printers (p_smob), value);
+
+ return pp;
}
/* Subroutine of find_pretty_printer to simplify it.
static SCM
ppscm_find_pretty_printer_from_gdb (SCM value)
{
- SCM pp_list, pp;
+ SCM pp = ppscm_search_pp_list (pretty_printer_list, value);
- /* Fetch the global pretty printer list. */
- pp_list = scm_variable_ref (pretty_printer_list_var);
- pp = ppscm_search_pp_list (pp_list, value);
return pp;
}
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
(_("invalid result from pretty-printer to-string"), result);
}
}
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ }
+ END_CATCH
return result;
}
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)
{
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;
+ const gdb_byte *valaddr = value_contents_for_printing (val);
/* No pretty-printer support for unavailable values. */
if (!value_bytes_available (val, embedded_offset, TYPE_LENGTH (type)))
cleanups = make_cleanup (null_cleanup, NULL);
/* Instantiate the printer. */
- if (valaddr)
- valaddr += embedded_offset;
- value = value_from_contents_and_address (type, valaddr,
+ value = value_from_contents_and_address (type, valaddr + embedded_offset,
address + embedded_offset);
set_value_component_location (value, val);
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, as_a_scm_t_subr (gdbscm_pretty_printers),
+ "\
+Return the list of global pretty-printers." },
+
+ { "set-pretty-printers!", 1, 0, 0,
+ as_a_scm_t_subr (gdbscm_set_pretty_printers_x),
+ "\
+Set the list of global pretty-printers." },
+
END_FUNCTIONS
};
gdbscm_define_functions (pretty_printer_functions, 1);
- scm_c_define (pretty_printer_list_name, SCM_EOL);
-
- pretty_printer_list_var
- = scm_c_private_variable (gdbscm_module_name,
- pretty_printer_list_name);
- gdb_assert (!gdbscm_is_false (pretty_printer_list_var));
+ pretty_printer_list = SCM_EOL;
pp_type_error_symbol = scm_from_latin1_symbol ("gdb:pp-type-error");