mirror of
https://sourceware.org/git/binutils-gdb.git
synced 2024-11-25 19:14:52 +08:00
Add progspace support for Guile.
* Makefile.in (SUBDIR_GUILE_OBS): Add scm-progspace.o. (SUBDIR_GUILE_SRCS): Add scm-progspace.c. (scm-progspace.o): New rule. * guile/guile-internal.h (pspace_smob): New typedef. (psscm_pspace_smob_pretty_printers): Declare. (psscm_pspace_smob_from_pspace): Declare. (psscm_scm_from_pspace): Declare. * guile/guile.c (initialize_gdb_module): Call gdbscm_initialize_pspaces. * guile/lib/gdb.scm: Export progspace symbols. * guile/lib/gdb/printing.scm (prepend-pretty-printer!): Add progspace support. (append-pretty-printer!): Ditto. * guile/scm-pretty-print.c (ppscm_find_pretty_printer_from_progspace): Implement. * guile/scm-progspace.c: New file. doc/ * guile.texi (Guile API): Add entry for Progspaces In Guile. (GDB Scheme Data Types): Mention <gdb:progspace> object. (Progspaces In Guile): New node. testsuite/ * gdb.guile/scm-pretty-print.exp: Add tests for objfile and progspace pretty-printer lookup. * gdb.guile/scm-pretty-print.scm (pp_s-printer): New function. (make-pp_s-printer): Call it. (make-pretty-printer-from-dict): New function. (lookup-pretty-printer-maker-from-dict): New function. (*pretty-printer*): Simplify. (make-objfile-pp_s-printer): New function. (install-objfile-pretty-printers!): New function. (make-progspace-pp_s-printer): New function. (install-progspace-pretty-printers!): New function. * gdb.guile/scm-progspace.c: New file. * gdb.guile/scm-progspace.exp: New file.
This commit is contained in:
Doug Evans
parent
397998fc32
commit
ded0378278
@ -1,3 +1,23 @@
|
||||
2014-06-02 Doug Evans <xdje42@gmail.com>
|
||||
|
||||
Add progspace support for Guile.
|
||||
* Makefile.in (SUBDIR_GUILE_OBS): Add scm-progspace.o.
|
||||
(SUBDIR_GUILE_SRCS): Add scm-progspace.c.
|
||||
(scm-progspace.o): New rule.
|
||||
* guile/guile-internal.h (pspace_smob): New typedef.
|
||||
(psscm_pspace_smob_pretty_printers): Declare.
|
||||
(psscm_pspace_smob_from_pspace): Declare.
|
||||
(psscm_scm_from_pspace): Declare.
|
||||
* guile/guile.c (initialize_gdb_module): Call
|
||||
gdbscm_initialize_pspaces.
|
||||
* guile/lib/gdb.scm: Export progspace symbols.
|
||||
* guile/lib/gdb/printing.scm (prepend-pretty-printer!): Add progspace
|
||||
support.
|
||||
(append-pretty-printer!): Ditto.
|
||||
* guile/scm-pretty-print.c (ppscm_find_pretty_printer_from_progspace):
|
||||
Implement.
|
||||
* guile/scm-progspace.c: New file.
|
||||
|
||||
2014-06-03 Alan Modra <amodra@gmail.com>
|
||||
|
||||
* ppc64-tdep.c (ppc64_standard_linkage8): New.
|
||||
|
||||
@ -298,6 +298,7 @@ SUBDIR_GUILE_OBS = \
|
||||
scm-math.o \
|
||||
scm-ports.o \
|
||||
scm-pretty-print.o \
|
||||
scm-progspace.o \
|
||||
scm-safe-call.o \
|
||||
scm-string.o \
|
||||
scm-symbol.o \
|
||||
@ -321,6 +322,7 @@ SUBDIR_GUILE_SRCS = \
|
||||
guile/scm-math.c \
|
||||
guile/scm-ports.c \
|
||||
guile/scm-pretty-print.c \
|
||||
guile/scm-progspace.c \
|
||||
guile/scm-safe-call.c \
|
||||
guile/scm-string.c \
|
||||
guile/scm-symbol.c \
|
||||
@ -2310,6 +2312,10 @@ scm-pretty-print.o: $(srcdir)/guile/scm-pretty-print.c
|
||||
$(COMPILE) $(srcdir)/guile/scm-pretty-print.c
|
||||
$(POSTCOMPILE)
|
||||
|
||||
scm-progspace.o: $(srcdir)/guile/scm-progspace.c
|
||||
$(COMPILE) $(srcdir)/guile/scm-progspace.c
|
||||
$(POSTCOMPILE)
|
||||
|
||||
scm-safe-call.o: $(srcdir)/guile/scm-safe-call.c
|
||||
$(COMPILE) $(srcdir)/guile/scm-safe-call.c
|
||||
$(POSTCOMPILE)
|
||||
|
||||
@ -1,3 +1,9 @@
|
||||
2014-06-02 Doug Evans <xdje42@gmail.com>
|
||||
|
||||
* guile.texi (Guile API): Add entry for Progspaces In Guile.
|
||||
(GDB Scheme Data Types): Mention <gdb:progspace> object.
|
||||
(Progspaces In Guile): New node.
|
||||
|
||||
2014-05-30 Andrew Burgess <aburgess@broadcom.com>
|
||||
|
||||
* guile.texi (Frames In Guile): Mention FRAME_UNWIND_MEMORY_ERROR.
|
||||
|
||||
@ -141,6 +141,7 @@ from the Guile interactive prompt.
|
||||
* Guile Pretty Printing API:: Pretty-printing values with Guile
|
||||
* Selecting Guile Pretty-Printers:: How GDB chooses a pretty-printer
|
||||
* Writing a Guile Pretty-Printer:: Writing a pretty-printer
|
||||
* Progspaces In Guile:: Program spaces
|
||||
* Objfiles In Guile:: Object files in Guile
|
||||
* Frames In Guile:: Accessing inferior stack frames from Guile
|
||||
* Blocks In Guile:: Accessing blocks from Guile
|
||||
@ -378,6 +379,9 @@ as a symbol.
|
||||
@item <gdb:pretty-printer-worker>
|
||||
@xref{Guile Pretty Printing API}.
|
||||
|
||||
@item <gdb:progspace>
|
||||
@xref{Progspaces In Guile}.
|
||||
|
||||
@item <gdb:symbol>
|
||||
@xref{Symbols In Guile}.
|
||||
|
||||
@ -406,6 +410,7 @@ Scheme function @code{eq?} may be applied to them.
|
||||
@item <gdb:breakpoint>
|
||||
@item <gdb:frame>
|
||||
@item <gdb:objfile>
|
||||
@item <gdb:progspace>
|
||||
@item <gdb:symbol>
|
||||
@item <gdb:symtab>
|
||||
@item <gdb:type>
|
||||
@ -1660,6 +1665,79 @@ my_library.so:
|
||||
bar
|
||||
@end smallexample
|
||||
|
||||
@node Progspaces In Guile
|
||||
@subsubsection Program Spaces In Guile
|
||||
|
||||
@cindex progspaces in guile
|
||||
@tindex <gdb:progspace>
|
||||
A program space, or @dfn{progspace}, represents a symbolic view
|
||||
of an address space.
|
||||
It consists of all of the objfiles of the program.
|
||||
@xref{Objfiles In Guile}.
|
||||
@xref{Inferiors and Programs, program spaces}, for more details
|
||||
about program spaces.
|
||||
|
||||
Each progspace is represented by an instance of the @code{<gdb:progspace>}
|
||||
smob. @xref{GDB Scheme Data Types}.
|
||||
|
||||
The following progspace-related functions are available in the
|
||||
@code{(gdb)} module:
|
||||
|
||||
@deffn {Scheme Procedure} progspace? object
|
||||
Return @code{#t} if @var{object} is a @code{<gdb:progspace>} object.
|
||||
Otherwise return @code{#f}.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} progspace-valid? progspace
|
||||
Return @code{#t} if @var{progspace} is valid, @code{#f} if not.
|
||||
A @code{<gdb:progspace>} object can become invalid
|
||||
if the program it refers to is not loaded in @value{GDBN} any longer.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} current-progspace
|
||||
This function returns the program space of the currently selected inferior.
|
||||
There is always a current progspace, this never returns @code{#f}.
|
||||
@xref{Inferiors and Programs}.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} progspaces
|
||||
Return a list of all the progspaces currently known to @value{GDBN}.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} progspace-filename progspace
|
||||
Return the absolute file name of @var{progspace} as a string.
|
||||
This is the name of the file passed as the argument to the @code{file}
|
||||
or @code{symbol-file} commands.
|
||||
If the program space does not have an associated file name,
|
||||
then @code{#f} is returned. This occurs, for example, when @value{GDBN}
|
||||
is started without a program to debug.
|
||||
|
||||
A @code{gdb:invalid-object-error} exception is thrown if @var{progspace}
|
||||
is invalid.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} progspace-objfiles progspace
|
||||
Return the list of objfiles of @var{progspace}.
|
||||
The order of objfiles in the result is arbitrary.
|
||||
Each element is an object of type @code{<gdb:objfile>}.
|
||||
@xref{Objfiles In Guile}.
|
||||
|
||||
A @code{gdb:invalid-object-error} exception is thrown if @var{progspace}
|
||||
is invalid.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} progspace-pretty-printers progspace
|
||||
Return the list of pretty-printers of @var{progspace}.
|
||||
Each element is an object of type @code{<gdb:pretty-printer>}.
|
||||
@xref{Guile Pretty Printing API}, for more information.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} set-progspace-pretty-printers! progspace printer-list
|
||||
Set the list of registered @code{<gdb:pretty-printer>} objects for
|
||||
@var{progspace} to @var{printer-list}.
|
||||
@xref{Guile Pretty Printing API}, for more information.
|
||||
@end deffn
|
||||
|
||||
@node Objfiles In Guile
|
||||
@subsubsection Objfiles In Guile
|
||||
|
||||
|
||||
@ -438,6 +438,16 @@ extern objfile_smob *ofscm_objfile_smob_from_objfile (struct objfile *objfile);
|
||||
|
||||
extern SCM ofscm_scm_from_objfile (struct objfile *objfile);
|
||||
|
||||
/* scm-progspace.c */
|
||||
|
||||
typedef struct _pspace_smob pspace_smob;
|
||||
|
||||
extern SCM psscm_pspace_smob_pretty_printers (const pspace_smob *);
|
||||
|
||||
extern pspace_smob *psscm_pspace_smob_from_pspace (struct program_space *);
|
||||
|
||||
extern SCM psscm_scm_from_pspace (struct program_space *);
|
||||
|
||||
/* scm-string.c */
|
||||
|
||||
extern char *gdbscm_scm_to_c_string (SCM string);
|
||||
@ -542,6 +552,7 @@ extern void gdbscm_initialize_math (void);
|
||||
extern void gdbscm_initialize_objfiles (void);
|
||||
extern void gdbscm_initialize_pretty_printers (void);
|
||||
extern void gdbscm_initialize_ports (void);
|
||||
extern void gdbscm_initialize_pspaces (void);
|
||||
extern void gdbscm_initialize_smobs (void);
|
||||
extern void gdbscm_initialize_strings (void);
|
||||
extern void gdbscm_initialize_symbols (void);
|
||||
|
||||
@ -545,6 +545,7 @@ initialize_gdb_module (void *data)
|
||||
gdbscm_initialize_objfiles ();
|
||||
gdbscm_initialize_ports ();
|
||||
gdbscm_initialize_pretty_printers ();
|
||||
gdbscm_initialize_pspaces ();
|
||||
gdbscm_initialize_strings ();
|
||||
gdbscm_initialize_symbols ();
|
||||
gdbscm_initialize_symtabs ();
|
||||
|
||||
@ -271,6 +271,17 @@
|
||||
make-pretty-printer-worker
|
||||
pretty-printer-worker?
|
||||
|
||||
;; scm-progspace.c
|
||||
|
||||
progspace?
|
||||
progspace-valid?
|
||||
progspace-filename
|
||||
progspace-objfiles
|
||||
progspace-pretty-printers
|
||||
set-progspace-pretty-printers!
|
||||
current-progspace
|
||||
progspaces
|
||||
|
||||
;; scm-gsmob.c
|
||||
|
||||
gdb-object-kind
|
||||
|
||||
@ -19,8 +19,9 @@
|
||||
|
||||
(define-module (gdb printing)
|
||||
#:use-module ((gdb) #:select
|
||||
(*pretty-printers* pretty-printer? objfile?
|
||||
objfile-pretty-printers set-objfile-pretty-printers!))
|
||||
(*pretty-printers* pretty-printer? objfile? progspace?
|
||||
objfile-pretty-printers set-objfile-pretty-printers!
|
||||
progspace-pretty-printers set-progspace-pretty-printers!))
|
||||
#:use-module (gdb init))
|
||||
|
||||
(define-public (prepend-pretty-printer! obj matcher)
|
||||
@ -31,9 +32,11 @@ If OBJ is #f, add MATCHER to the global list."
|
||||
(cond ((eq? obj #f)
|
||||
(set! *pretty-printers* (cons matcher *pretty-printers*)))
|
||||
((objfile? obj)
|
||||
(set-objfile-pretty-printers! obj
|
||||
(cons matcher
|
||||
(objfile-pretty-printers obj))))
|
||||
(set-objfile-pretty-printers!
|
||||
obj (cons matcher (objfile-pretty-printers obj))))
|
||||
((progspace? obj)
|
||||
(set-progspace-pretty-printers!
|
||||
obj (cons matcher (progspace-pretty-printers obj))))
|
||||
(else
|
||||
(%assert-type #f obj SCM_ARG1 'prepend-pretty-printer!))))
|
||||
|
||||
@ -45,8 +48,10 @@ If OBJ is #f, add MATCHER to the global list."
|
||||
(cond ((eq? obj #f)
|
||||
(set! *pretty-printers* (append! *pretty-printers* (list matcher))))
|
||||
((objfile? obj)
|
||||
(set-objfile-pretty-printers! obj
|
||||
(append! (objfile-pretty-printers obj)
|
||||
(list matcher))))
|
||||
(set-objfile-pretty-printers!
|
||||
obj (append! (objfile-pretty-printers obj) (list matcher))))
|
||||
((progspace? obj)
|
||||
(set-progspace-pretty-printers!
|
||||
obj (append! (progspace-pretty-printers obj) (list matcher))))
|
||||
(else
|
||||
(%assert-type #f obj SCM_ARG1 'append-pretty-printer!))))
|
||||
|
||||
@ -441,7 +441,11 @@ ppscm_find_pretty_printer_from_objfiles (SCM 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.
|
||||
|
||||
426
gdb/guile/scm-progspace.c
Normal file
426
gdb/guile/scm-progspace.c
Normal file
@ -0,0 +1,426 @@
|
||||
/* Guile interface to program spaces.
|
||||
|
||||
Copyright (C) 2010-2014 Free Software Foundation, Inc.
|
||||
|
||||
This file is part of GDB.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <http://www.gnu.org/licenses/>. */
|
||||
|
||||
#include "defs.h"
|
||||
#include "charset.h"
|
||||
#include "progspace.h"
|
||||
#include "objfiles.h"
|
||||
#include "language.h"
|
||||
#include "arch-utils.h"
|
||||
#include "guile-internal.h"
|
||||
|
||||
/* NOTE: Python exports the name "Progspace", so we export "progspace".
|
||||
Internally we shorten that to "pspace". */
|
||||
|
||||
/* The <gdb:progspace> smob.
|
||||
The typedef for this struct is in guile-internal.h. */
|
||||
|
||||
struct _pspace_smob
|
||||
{
|
||||
/* This always appears first. */
|
||||
gdb_smob base;
|
||||
|
||||
/* The corresponding pspace. */
|
||||
struct program_space *pspace;
|
||||
|
||||
/* The pretty-printer list of functions. */
|
||||
SCM pretty_printers;
|
||||
|
||||
/* The <gdb:progspace> object we are contained in, needed to
|
||||
protect/unprotect the object since a reference to it comes from
|
||||
non-gc-managed space (the progspace). */
|
||||
SCM containing_scm;
|
||||
};
|
||||
|
||||
static const char pspace_smob_name[] = "gdb:progspace";
|
||||
|
||||
/* The tag Guile knows the pspace smob by. */
|
||||
static scm_t_bits pspace_smob_tag;
|
||||
|
||||
static const struct program_space_data *psscm_pspace_data_key;
|
||||
|
||||
/* Return the list of pretty-printers registered with P_SMOB. */
|
||||
|
||||
SCM
|
||||
psscm_pspace_smob_pretty_printers (const pspace_smob *p_smob)
|
||||
{
|
||||
return p_smob->pretty_printers;
|
||||
}
|
||||
|
||||
/* Administrivia for progspace smobs. */
|
||||
|
||||
/* The smob "print" function for <gdb:progspace>. */
|
||||
|
||||
static int
|
||||
psscm_print_pspace_smob (SCM self, SCM port, scm_print_state *pstate)
|
||||
{
|
||||
pspace_smob *p_smob = (pspace_smob *) SCM_SMOB_DATA (self);
|
||||
|
||||
gdbscm_printf (port, "#<%s ", pspace_smob_name);
|
||||
if (p_smob->pspace != NULL)
|
||||
{
|
||||
struct objfile *objfile = p_smob->pspace->symfile_object_file;
|
||||
|
||||
gdbscm_printf (port, "%s",
|
||||
objfile != NULL
|
||||
? objfile_name (objfile)
|
||||
: "{no symfile}");
|
||||
}
|
||||
else
|
||||
scm_puts ("{invalid}", port);
|
||||
scm_puts (">", port);
|
||||
|
||||
scm_remember_upto_here_1 (self);
|
||||
|
||||
/* Non-zero means success. */
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Low level routine to create a <gdb:progspace> object.
|
||||
It's empty in the sense that a progspace still needs to be associated
|
||||
with it. */
|
||||
|
||||
static SCM
|
||||
psscm_make_pspace_smob (void)
|
||||
{
|
||||
pspace_smob *p_smob = (pspace_smob *)
|
||||
scm_gc_malloc (sizeof (pspace_smob), pspace_smob_name);
|
||||
SCM p_scm;
|
||||
|
||||
p_smob->pspace = NULL;
|
||||
p_smob->pretty_printers = SCM_EOL;
|
||||
p_scm = scm_new_smob (pspace_smob_tag, (scm_t_bits) p_smob);
|
||||
p_smob->containing_scm = p_scm;
|
||||
gdbscm_init_gsmob (&p_smob->base);
|
||||
|
||||
return p_scm;
|
||||
}
|
||||
|
||||
/* Clear the progspace pointer in P_SMOB and unprotect the object from GC. */
|
||||
|
||||
static void
|
||||
psscm_release_pspace (pspace_smob *p_smob)
|
||||
{
|
||||
p_smob->pspace = NULL;
|
||||
scm_gc_unprotect_object (p_smob->containing_scm);
|
||||
}
|
||||
|
||||
/* Progspace registry cleanup handler for when a progspace is deleted. */
|
||||
|
||||
static void
|
||||
psscm_handle_pspace_deleted (struct program_space *pspace, void *datum)
|
||||
{
|
||||
pspace_smob *p_smob = datum;
|
||||
|
||||
gdb_assert (p_smob->pspace == pspace);
|
||||
|
||||
psscm_release_pspace (p_smob);
|
||||
}
|
||||
|
||||
/* Return non-zero if SCM is a <gdb:progspace> object. */
|
||||
|
||||
static int
|
||||
psscm_is_pspace (SCM scm)
|
||||
{
|
||||
return SCM_SMOB_PREDICATE (pspace_smob_tag, scm);
|
||||
}
|
||||
|
||||
/* (progspace? object) -> boolean */
|
||||
|
||||
static SCM
|
||||
gdbscm_progspace_p (SCM scm)
|
||||
{
|
||||
return scm_from_bool (psscm_is_pspace (scm));
|
||||
}
|
||||
|
||||
/* Return a pointer to the progspace_smob that encapsulates PSPACE,
|
||||
creating one if necessary.
|
||||
The result is cached so that we have only one copy per objfile. */
|
||||
|
||||
pspace_smob *
|
||||
psscm_pspace_smob_from_pspace (struct program_space *pspace)
|
||||
{
|
||||
pspace_smob *p_smob;
|
||||
|
||||
p_smob = program_space_data (pspace, psscm_pspace_data_key);
|
||||
if (p_smob == NULL)
|
||||
{
|
||||
SCM p_scm = psscm_make_pspace_smob ();
|
||||
|
||||
p_smob = (pspace_smob *) SCM_SMOB_DATA (p_scm);
|
||||
p_smob->pspace = pspace;
|
||||
|
||||
set_program_space_data (pspace, psscm_pspace_data_key, p_smob);
|
||||
scm_gc_protect_object (p_smob->containing_scm);
|
||||
}
|
||||
|
||||
return p_smob;
|
||||
}
|
||||
|
||||
/* Return the <gdb:progspace> object that encapsulates PSPACE. */
|
||||
|
||||
SCM
|
||||
psscm_scm_from_pspace (struct program_space *pspace)
|
||||
{
|
||||
pspace_smob *p_smob = psscm_pspace_smob_from_pspace (pspace);
|
||||
|
||||
return p_smob->containing_scm;
|
||||
}
|
||||
|
||||
/* Returns the <gdb:progspace> object in SELF.
|
||||
Throws an exception if SELF is not a <gdb:progspace> object. */
|
||||
|
||||
static SCM
|
||||
psscm_get_pspace_arg_unsafe (SCM self, int arg_pos, const char *func_name)
|
||||
{
|
||||
SCM_ASSERT_TYPE (psscm_is_pspace (self), self, arg_pos, func_name,
|
||||
pspace_smob_name);
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
/* Returns a pointer to the pspace smob of SELF.
|
||||
Throws an exception if SELF is not a <gdb:progspace> object. */
|
||||
|
||||
static pspace_smob *
|
||||
psscm_get_pspace_smob_arg_unsafe (SCM self, int arg_pos,
|
||||
const char *func_name)
|
||||
{
|
||||
SCM p_scm = psscm_get_pspace_arg_unsafe (self, arg_pos, func_name);
|
||||
pspace_smob *p_smob = (pspace_smob *) SCM_SMOB_DATA (p_scm);
|
||||
|
||||
return p_smob;
|
||||
}
|
||||
|
||||
/* Return non-zero if pspace P_SMOB is valid. */
|
||||
|
||||
static int
|
||||
psscm_is_valid (pspace_smob *p_smob)
|
||||
{
|
||||
return p_smob->pspace != NULL;
|
||||
}
|
||||
|
||||
/* Return the pspace smob in SELF, verifying it's valid.
|
||||
Throws an exception if SELF is not a <gdb:progspace> object or is
|
||||
invalid. */
|
||||
|
||||
static pspace_smob *
|
||||
psscm_get_valid_pspace_smob_arg_unsafe (SCM self, int arg_pos,
|
||||
const char *func_name)
|
||||
{
|
||||
pspace_smob *p_smob
|
||||
= psscm_get_pspace_smob_arg_unsafe (self, arg_pos, func_name);
|
||||
|
||||
if (!psscm_is_valid (p_smob))
|
||||
{
|
||||
gdbscm_invalid_object_error (func_name, arg_pos, self,
|
||||
_("<gdb:progspace>"));
|
||||
}
|
||||
|
||||
return p_smob;
|
||||
}
|
||||
|
||||
/* Program space methods. */
|
||||
|
||||
/* (progspace-valid? <gdb:progspace>) -> boolean
|
||||
Returns #t if this program space still exists in GDB. */
|
||||
|
||||
static SCM
|
||||
gdbscm_progspace_valid_p (SCM self)
|
||||
{
|
||||
pspace_smob *p_smob
|
||||
= psscm_get_pspace_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||||
|
||||
return scm_from_bool (p_smob->pspace != NULL);
|
||||
}
|
||||
|
||||
/* (progspace-filename <gdb:progspace>) -> string
|
||||
Returns the name of the main symfile associated with the progspace,
|
||||
or #f if there isn't one.
|
||||
Throw's an exception if the underlying pspace is invalid. */
|
||||
|
||||
static SCM
|
||||
gdbscm_progspace_filename (SCM self)
|
||||
{
|
||||
pspace_smob *p_smob
|
||||
= psscm_get_valid_pspace_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||||
struct objfile *objfile = p_smob->pspace->symfile_object_file;
|
||||
|
||||
if (objfile != NULL)
|
||||
return gdbscm_scm_from_c_string (objfile_name (objfile));
|
||||
return SCM_BOOL_F;
|
||||
}
|
||||
|
||||
/* (progspace-objfiles <gdb:progspace>) -> list
|
||||
Return the list of objfiles in the progspace.
|
||||
Objfiles that are separate debug objfiles are *not* included in the result,
|
||||
only the "original/real" one appears in the result.
|
||||
The order of appearance of objfiles in the result is arbitrary.
|
||||
Throw's an exception if the underlying pspace is invalid.
|
||||
|
||||
Some apps can have 1000s of shared libraries. Seriously.
|
||||
A future extension here could be to provide, e.g., a regexp to select
|
||||
just the ones the caller is interested in (rather than building the list
|
||||
and then selecting the desired ones). Another alternative is passing a
|
||||
predicate, then the filter criteria can be more general. */
|
||||
|
||||
static SCM
|
||||
gdbscm_progspace_objfiles (SCM self)
|
||||
{
|
||||
pspace_smob *p_smob
|
||||
= psscm_get_valid_pspace_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||||
struct objfile *objfile;
|
||||
SCM result;
|
||||
|
||||
result = SCM_EOL;
|
||||
|
||||
ALL_PSPACE_OBJFILES (p_smob->pspace, objfile)
|
||||
{
|
||||
if (objfile->separate_debug_objfile_backlink == NULL)
|
||||
{
|
||||
SCM item = ofscm_scm_from_objfile (objfile);
|
||||
|
||||
result = scm_cons (item, result);
|
||||
}
|
||||
}
|
||||
|
||||
/* We don't really have to return the list in the same order as recorded
|
||||
internally, but for consistency we do. We still advertise that one
|
||||
cannot assume anything about the order. */
|
||||
return scm_reverse_x (result, SCM_EOL);
|
||||
}
|
||||
|
||||
/* (progspace-pretty-printers <gdb:progspace>) -> list
|
||||
Returns the list of pretty-printers for this program space. */
|
||||
|
||||
static SCM
|
||||
gdbscm_progspace_pretty_printers (SCM self)
|
||||
{
|
||||
pspace_smob *p_smob
|
||||
= psscm_get_pspace_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||||
|
||||
return p_smob->pretty_printers;
|
||||
}
|
||||
|
||||
/* (set-progspace-pretty-printers! <gdb:progspace> list) -> unspecified
|
||||
Set the pretty-printers for this program space. */
|
||||
|
||||
static SCM
|
||||
gdbscm_set_progspace_pretty_printers_x (SCM self, SCM printers)
|
||||
{
|
||||
pspace_smob *p_smob
|
||||
= psscm_get_pspace_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||||
|
||||
SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (printers)), printers,
|
||||
SCM_ARG2, FUNC_NAME, _("list"));
|
||||
|
||||
p_smob->pretty_printers = printers;
|
||||
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
||||
/* (current-progspace) -> <gdb:progspace>
|
||||
Return the current program space. There always is one. */
|
||||
|
||||
static SCM
|
||||
gdbscm_current_progspace (void)
|
||||
{
|
||||
SCM result;
|
||||
|
||||
result = psscm_scm_from_pspace (current_program_space);
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/* (progspaces) -> list
|
||||
Return a list of all progspaces. */
|
||||
|
||||
static SCM
|
||||
gdbscm_progspaces (void)
|
||||
{
|
||||
struct program_space *ps;
|
||||
SCM result;
|
||||
|
||||
result = SCM_EOL;
|
||||
|
||||
ALL_PSPACES (ps)
|
||||
{
|
||||
SCM item = psscm_scm_from_pspace (ps);
|
||||
|
||||
result = scm_cons (item, result);
|
||||
}
|
||||
|
||||
return scm_reverse_x (result, SCM_EOL);
|
||||
}
|
||||
|
||||
/* Initialize the Scheme program space support. */
|
||||
|
||||
static const scheme_function pspace_functions[] =
|
||||
{
|
||||
{ "progspace?", 1, 0, 0, gdbscm_progspace_p,
|
||||
"\
|
||||
Return #t if the object is a <gdb:objfile> object." },
|
||||
|
||||
{ "progspace-valid?", 1, 0, 0, gdbscm_progspace_valid_p,
|
||||
"\
|
||||
Return #t if the progspace is valid (hasn't been deleted from gdb)." },
|
||||
|
||||
{ "progspace-filename", 1, 0, 0, gdbscm_progspace_filename,
|
||||
"\
|
||||
Return the name of the main symbol file of the progspace." },
|
||||
|
||||
{ "progspace-objfiles", 1, 0, 0, gdbscm_progspace_objfiles,
|
||||
"\
|
||||
Return the list of objfiles associated with the progspace.\n\
|
||||
Objfiles that are separate debug objfiles are not included in the result.\n\
|
||||
The order of appearance of objfiles in the result is arbitrary." },
|
||||
|
||||
{ "progspace-pretty-printers", 1, 0, 0, gdbscm_progspace_pretty_printers,
|
||||
"\
|
||||
Return a list of pretty-printers of the progspace." },
|
||||
|
||||
{ "set-progspace-pretty-printers!", 2, 0, 0,
|
||||
gdbscm_set_progspace_pretty_printers_x,
|
||||
"\
|
||||
Set the list of pretty-printers of the progspace." },
|
||||
|
||||
{ "current-progspace", 0, 0, 0, gdbscm_current_progspace,
|
||||
"\
|
||||
Return the current program space if there is one or #f if there isn't one." },
|
||||
|
||||
{ "progspaces", 0, 0, 0, gdbscm_progspaces,
|
||||
"\
|
||||
Return a list of all program spaces." },
|
||||
|
||||
END_FUNCTIONS
|
||||
};
|
||||
|
||||
void
|
||||
gdbscm_initialize_pspaces (void)
|
||||
{
|
||||
pspace_smob_tag
|
||||
= gdbscm_make_smob_type (pspace_smob_name, sizeof (pspace_smob));
|
||||
scm_set_smob_print (pspace_smob_tag, psscm_print_pspace_smob);
|
||||
|
||||
gdbscm_define_functions (pspace_functions, 1);
|
||||
|
||||
psscm_pspace_data_key
|
||||
= register_program_space_data_with_cleanup (NULL,
|
||||
psscm_handle_pspace_deleted);
|
||||
}
|
||||
@ -1,3 +1,19 @@
|
||||
2014-06-02 Doug Evans <xdje42@gmail.com>
|
||||
|
||||
* gdb.guile/scm-pretty-print.exp: Add tests for objfile and progspace
|
||||
pretty-printer lookup.
|
||||
* gdb.guile/scm-pretty-print.scm (pp_s-printer): New function.
|
||||
(make-pp_s-printer): Call it.
|
||||
(make-pretty-printer-from-dict): New function.
|
||||
(lookup-pretty-printer-maker-from-dict): New function.
|
||||
(*pretty-printer*): Simplify.
|
||||
(make-objfile-pp_s-printer): New function.
|
||||
(install-objfile-pretty-printers!): New function.
|
||||
(make-progspace-pp_s-printer): New function.
|
||||
(install-progspace-pretty-printers!): New function.
|
||||
* gdb.guile/scm-progspace.c: New file.
|
||||
* gdb.guile/scm-progspace.exp: New file.
|
||||
|
||||
2014-06-02 Pedro Alves <palves@redhat.com>
|
||||
|
||||
* gdb.base/dprintf-bp-same-addr.c: New file.
|
||||
|
||||
@ -138,11 +138,19 @@ gdb_test "print ss" " = a=<a=<1> b=<$hex>> b=<a=<2> b=<$hex>>" \
|
||||
"print ss enabled #1"
|
||||
|
||||
gdb_test_no_output "guile (disable-matcher!)"
|
||||
|
||||
gdb_test "print ss" " = {a = {a = 1, b = $hex}, b = {a = 2, b = $hex}}" \
|
||||
"print ss disabled"
|
||||
|
||||
gdb_test_no_output "guile (enable-matcher!)"
|
||||
|
||||
gdb_test "print ss" " = a=<a=<1> b=<$hex>> b=<a=<2> b=<$hex>>" \
|
||||
"print ss enabled #2"
|
||||
|
||||
gdb_test_no_output "guile (install-progspace-pretty-printers! (current-progspace))"
|
||||
gdb_test "print ss" \
|
||||
" = a=<progspace a=<1> b=<$hex>> b=<progspace a=<2> b=<$hex>>" \
|
||||
"print ss via progspace"
|
||||
|
||||
gdb_test_no_output "guile (install-objfile-pretty-printers! (current-progspace) \"scm-pretty-print\")"
|
||||
gdb_test "print ss" \
|
||||
" = a=<objfile a=<1> b=<$hex>> b=<objfile a=<2> b=<$hex>>" \
|
||||
"print ss via objfile"
|
||||
|
||||
@ -104,16 +104,22 @@
|
||||
(lambda (printer)
|
||||
(make-pointer-iterator-except elements (value->integer len))))))
|
||||
|
||||
;; The actual pretty-printer for pp_s is split out so that we can pass
|
||||
;; in a prefix to distinguish objfile/progspace/global.
|
||||
|
||||
(define (pp_s-printer prefix val)
|
||||
(let ((a (value-field val "a"))
|
||||
(b (value-field val "b")))
|
||||
(if (not (value=? (value-address a) b))
|
||||
(error (format #f "&a(~A) != b(~A)"
|
||||
(value-address a) b)))
|
||||
(format #f "~aa=<~A> b=<~A>" prefix a b)))
|
||||
|
||||
(define (make-pp_s-printer val)
|
||||
(make-pretty-printer-worker
|
||||
#f
|
||||
(lambda (printer)
|
||||
(let ((a (value-field val "a"))
|
||||
(b (value-field val "b")))
|
||||
(if (not (value=? (value-address a) b))
|
||||
(error (format #f "&a(~A) != b(~A)"
|
||||
(value-address a) b)))
|
||||
(format #f "a=<~A> b=<~A>" a b)))
|
||||
(pp_s-printer "" val))
|
||||
#f))
|
||||
|
||||
(define (make-pp_ss-printer val)
|
||||
@ -285,17 +291,60 @@
|
||||
;; This is one way to register a printer that is composed of several
|
||||
;; subprinters, but there's no way to disable or list individual subprinters.
|
||||
|
||||
(define (make-pretty-printer-from-dict name dict lookup-maker)
|
||||
(make-pretty-printer
|
||||
name
|
||||
(lambda (matcher val)
|
||||
(let ((printer-maker (lookup-maker dict val)))
|
||||
(and printer-maker (printer-maker val))))))
|
||||
|
||||
(define (lookup-pretty-printer-maker-from-dict dict val)
|
||||
(let ((type-name (type-tag (get-type-for-printing val))))
|
||||
(and type-name
|
||||
(hash-ref dict type-name))))
|
||||
|
||||
(define *pretty-printer*
|
||||
(make-pretty-printer
|
||||
"pretty-printer-test"
|
||||
(let ((pretty-printers-dict (make-pretty-printer-dict)))
|
||||
(lambda (matcher val)
|
||||
"Look-up and return a pretty-printer that can print val."
|
||||
(let ((type (get-type-for-printing val)))
|
||||
(let ((typename (type-tag type)))
|
||||
(if typename
|
||||
(let ((printer-maker (hash-ref pretty-printers-dict typename)))
|
||||
(and printer-maker (printer-maker val)))
|
||||
#f)))))))
|
||||
(make-pretty-printer-from-dict "pretty-printer-test"
|
||||
(make-pretty-printer-dict)
|
||||
lookup-pretty-printer-maker-from-dict))
|
||||
|
||||
(append-pretty-printer! #f *pretty-printer*)
|
||||
|
||||
;; Different versions of a simple pretty-printer for use in testing
|
||||
;; objfile/progspace lookup.
|
||||
|
||||
(define (make-objfile-pp_s-printer val)
|
||||
(make-pretty-printer-worker
|
||||
#f
|
||||
(lambda (printer)
|
||||
(pp_s-printer "objfile " val))
|
||||
#f))
|
||||
|
||||
(define (install-objfile-pretty-printers! pspace objfile-name)
|
||||
(let ((objfiles (filter (lambda (objfile)
|
||||
(string-contains (objfile-filename objfile)
|
||||
objfile-name))
|
||||
(progspace-objfiles pspace)))
|
||||
(dict (make-hash-table)))
|
||||
(if (not (= (length objfiles) 1))
|
||||
(error "objfile not found or ambiguous: " objfile-name))
|
||||
(hash-set! dict "s" make-objfile-pp_s-printer)
|
||||
(let ((pp (make-pretty-printer-from-dict
|
||||
"objfile-pretty-printer-test"
|
||||
dict lookup-pretty-printer-maker-from-dict)))
|
||||
(append-pretty-printer! (car objfiles) pp))))
|
||||
|
||||
(define (make-progspace-pp_s-printer val)
|
||||
(make-pretty-printer-worker
|
||||
#f
|
||||
(lambda (printer)
|
||||
(pp_s-printer "progspace " val))
|
||||
#f))
|
||||
|
||||
(define (install-progspace-pretty-printers! pspace)
|
||||
(let ((dict (make-hash-table)))
|
||||
(hash-set! dict "s" make-progspace-pp_s-printer)
|
||||
(let ((pp (make-pretty-printer-from-dict
|
||||
"progspace-pretty-printer-test"
|
||||
dict lookup-pretty-printer-maker-from-dict)))
|
||||
(append-pretty-printer! pspace pp))))
|
||||
|
||||
22
gdb/testsuite/gdb.guile/scm-progspace.c
Normal file
22
gdb/testsuite/gdb.guile/scm-progspace.c
Normal file
@ -0,0 +1,22 @@
|
||||
/* This testcase is part of GDB, the GNU debugger.
|
||||
|
||||
Copyright 2010-2014 Free Software Foundation, Inc.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <http://www.gnu.org/licenses/>. */
|
||||
|
||||
int
|
||||
main ()
|
||||
{
|
||||
return 0;
|
||||
}
|
||||
92
gdb/testsuite/gdb.guile/scm-progspace.exp
Normal file
92
gdb/testsuite/gdb.guile/scm-progspace.exp
Normal file
@ -0,0 +1,92 @@
|
||||
# Copyright (C) 2010-2014 Free Software Foundation, Inc.
|
||||
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
# This file is part of the GDB testsuite.
|
||||
# It tests the program space support in Guile.
|
||||
|
||||
load_lib gdb-guile.exp
|
||||
|
||||
standard_testfile
|
||||
|
||||
if {[build_executable $testfile.exp $testfile $srcfile debug] == -1} {
|
||||
return -1
|
||||
}
|
||||
|
||||
# Start with a fresh gdb.
|
||||
|
||||
gdb_exit
|
||||
gdb_start
|
||||
gdb_reinitialize_dir $srcdir/$subdir
|
||||
|
||||
# Skip all tests if Guile scripting is not enabled.
|
||||
if { [skip_guile_tests] } { continue }
|
||||
|
||||
gdb_install_guile_utils
|
||||
gdb_install_guile_module
|
||||
|
||||
proc print_current_progspace { filename_regexp smob_filename_regexp } {
|
||||
gdb_test "gu (print (progspace-filename (current-progspace)))" \
|
||||
"= $filename_regexp" "current progspace filename"
|
||||
gdb_test "gu (print (progspaces))" \
|
||||
"= \\(#<gdb:progspace $smob_filename_regexp>\\)"
|
||||
}
|
||||
|
||||
gdb_test "gu (print (progspace? 42))" "= #f"
|
||||
gdb_test "gu (print (progspace? (current-progspace)))" "= #t"
|
||||
|
||||
with_test_prefix "at start" {
|
||||
print_current_progspace "#f" "{no symfile}"
|
||||
}
|
||||
|
||||
gdb_load ${binfile}
|
||||
|
||||
with_test_prefix "program loaded" {
|
||||
print_current_progspace ".*$testfile" ".*$testfile"
|
||||
gdb_test_no_output "gu (define progspace (current-progspace))"
|
||||
gdb_test "gu (print (progspace-valid? progspace))" "= #t"
|
||||
gdb_test "gu (print (progspace-filename progspace))" "= .*$testfile"
|
||||
gdb_test "gu (print (list? (progspace-objfiles progspace)))" "= #t"
|
||||
}
|
||||
|
||||
# Verify we keep the same progspace when the program is unloaded.
|
||||
|
||||
gdb_unload
|
||||
with_test_prefix "program unloaded" {
|
||||
print_current_progspace "#f" "{no symfile}"
|
||||
gdb_test "gu (print (eq? progspace (current-progspace)))" "= #t"
|
||||
}
|
||||
|
||||
# Verify the progspace is garbage collected ok.
|
||||
# Note that when a program is unloaded, the associated progspace doesn't get
|
||||
# deleted. We need to, for example, delete an inferior to get the progspace
|
||||
# to go away.
|
||||
|
||||
gdb_test "add-inferior" "Added inferior 2" "Create new inferior"
|
||||
gdb_test "inferior 2" ".*" "Switch to new inferior"
|
||||
gdb_test_no_output "remove-inferiors 1" "Remove first inferior"
|
||||
|
||||
with_test_prefix "inferior removed" {
|
||||
gdb_test "gu (print (progspace-valid? progspace))" "= #f"
|
||||
gdb_test "gu (print (progspace-filename progspace))" \
|
||||
"ERROR:.*Invalid object.*"
|
||||
gdb_test "gu (print (progspace-objfiles progspace))" \
|
||||
"ERROR:.*Invalid object.*"
|
||||
print_current_progspace "#f" "{no symfile}"
|
||||
}
|
||||
|
||||
# garbage-collects can trigger segvs if we've messed up somewhere.
|
||||
|
||||
gdb_test_no_output "gu (gc)"
|
||||
gdb_test "gu (print progspace)" "= #<gdb:progspace {invalid}>"
|
||||
Loading…
Reference in New Issue
Block a user