From patchwork Wed May 21 19:22:20 2014 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Doug Evans X-Patchwork-Id: 1063 Return-Path: X-Original-To: siddhesh@wilcox.dreamhost.com Delivered-To: siddhesh@wilcox.dreamhost.com Received: from homiemail-mx23.g.dreamhost.com (mx2.sub5.homie.mail.dreamhost.com [208.113.200.128]) by wilcox.dreamhost.com (Postfix) with ESMTP id CB239360079 for ; Wed, 21 May 2014 12:22:51 -0700 (PDT) Received: by homiemail-mx23.g.dreamhost.com (Postfix, from userid 14314964) id 7738763EB93CA; Wed, 21 May 2014 12:22:51 -0700 (PDT) X-Original-To: gdb@patchwork.siddhesh.in Delivered-To: x14314964@homiemail-mx23.g.dreamhost.com Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by homiemail-mx23.g.dreamhost.com (Postfix) with ESMTPS id 3CB7C63EB93BD for ; Wed, 21 May 2014 12:22:51 -0700 (PDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=sourceware.org; h=list-id :list-unsubscribe:list-subscribe:list-archive:list-post :list-help:sender:from:to:subject:date:message-id:mime-version :content-type; q=dns; s=default; b=ANuHXbKEA6N99v5ROjdMYP/9KSsXr 7p2iojyXHT/ZrKijDlaCPQ9V1mmQfBwQ19st5IxSXEJSC3V4/Qm42pZs78xQPMzv 5KMN2uNxzW08iPMVBTunJ5IKSXyL7xPDIa5xUyRuaoqNT3Ah8mjHJffIuCwTUtFl wJmLyh50GeDsPc= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=sourceware.org; h=list-id :list-unsubscribe:list-subscribe:list-archive:list-post :list-help:sender:from:to:subject:date:message-id:mime-version :content-type; s=default; bh=9myZl0Bs93evFoyl7Ckvz/gi8kA=; b=Gq8 A4YxTztZCMHwUP97yOcNQ8zYPdr7sV4H4QQFCa/B9M47YSOlK54A6Q1CowbtW7Ts xsBHuaNcG2hII00dcPC7MhVF09tAfOpWtKdfxOKpThzh/+ERevh3oc8etRqfNW0Y 5y2C0VgRwSmcPSzVCBlcvFkAdSjB6XYqkekM/iHg= Received: (qmail 30980 invoked by alias); 21 May 2014 19:22:48 -0000 Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org Delivered-To: mailing list gdb-patches@sourceware.org Received: (qmail 30955 invoked by uid 89); 21 May 2014 19:22:44 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.5 required=5.0 tests=AWL, BAYES_00, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=no version=3.3.2 X-HELO: mail-pd0-f179.google.com Received: from mail-pd0-f179.google.com (HELO mail-pd0-f179.google.com) (209.85.192.179) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES128-SHA encrypted) ESMTPS; Wed, 21 May 2014 19:22:41 +0000 Received: by mail-pd0-f179.google.com with SMTP id x10so1688153pdj.10 for ; Wed, 21 May 2014 12:22:39 -0700 (PDT) X-Received: by 10.68.174.33 with SMTP id bp1mr22253705pbc.74.1400700159358; Wed, 21 May 2014 12:22:39 -0700 (PDT) Received: from seba.sebabeach.org.gmail.com (173-13-178-50-sfba.hfc.comcastbusiness.net. [173.13.178.50]) by mx.google.com with ESMTPSA id vg1sm9366796pbc.44.2014.05.21.12.22.38 for (version=TLSv1.2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Wed, 21 May 2014 12:22:38 -0700 (PDT) From: Doug Evans To: gdb-patches@sourceware.org, eliz@gnu.org Subject: [PATCH, doc RFA]: Add guile progspace support Date: Wed, 21 May 2014 12:22:20 -0700 Message-ID: MIME-Version: 1.0 X-IsSubscribed: yes X-DH-Original-To: gdb@patchwork.siddhesh.in Hi. This patch adds guile progspace support. 2014-05-21 Doug Evans 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 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. diff --git a/gdb/Makefile.in b/gdb/Makefile.in index f2c16ec..51aeeb3 100644 --- a/gdb/Makefile.in +++ b/gdb/Makefile.in @@ -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) diff --git a/gdb/doc/guile.texi b/gdb/doc/guile.texi index 56d817e..799e27c 100644 --- a/gdb/doc/guile.texi +++ b/gdb/doc/guile.texi @@ -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 @@ -406,6 +407,9 @@ Return an unsorted list of names of properties. @item @xref{Guile Pretty Printing API}. +@item +@xref{Progspaces In Guile}. + @item @xref{Symbols In Guile}. @@ -434,6 +438,7 @@ The following gsmobs are managed internally so that the Scheme function @item @item @item +@item @item @item @item @@ -1688,6 +1693,78 @@ my_library.so: bar @end smallexample +@node Progspaces In Guile +@subsubsection Program Spaces In Guile + +@cindex progspaces in guile +@tindex +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{} +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{} 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{} 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 file name of @var{progspace} as a string. +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{}. +@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{}. +@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{} objects for +@var{progspace} to @var{printer-list}. +@var{printer-list} must be a list of @code{} objects. +@xref{Guile Pretty Printing API}, for more information. +@end deffn + @node Objfiles In Guile @subsubsection Objfiles In Guile diff --git a/gdb/guile/guile-internal.h b/gdb/guile/guile-internal.h index f95f092..8b9d0be 100644 --- a/gdb/guile/guile-internal.h +++ b/gdb/guile/guile-internal.h @@ -426,6 +426,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); @@ -533,6 +543,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); diff --git a/gdb/guile/guile.c b/gdb/guile/guile.c index f2fd8d8..51919de 100644 --- a/gdb/guile/guile.c +++ b/gdb/guile/guile.c @@ -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 (); diff --git a/gdb/guile/lib/gdb.scm b/gdb/guile/lib/gdb.scm index f12769e..1aeb9d9 100644 --- a/gdb/guile/lib/gdb.scm +++ b/gdb/guile/lib/gdb.scm @@ -270,6 +270,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-smob.c gsmob-kind diff --git a/gdb/guile/lib/gdb/printing.scm b/gdb/guile/lib/gdb/printing.scm index 2944702..eac9417 100644 --- a/gdb/guile/lib/gdb/printing.scm +++ b/gdb/guile/lib/gdb/printing.scm @@ -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!)))) diff --git a/gdb/guile/scm-pretty-print.c b/gdb/guile/scm-pretty-print.c index 1b9902f4..fb62d9f 100644 --- a/gdb/guile/scm-pretty-print.c +++ b/gdb/guile/scm-pretty-print.c @@ -470,7 +470,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. diff --git a/gdb/guile/scm-progspace.c b/gdb/guile/scm-progspace.c new file mode 100644 index 0000000..e329b3a --- /dev/null +++ b/gdb/guile/scm-progspace.c @@ -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 . */ + +#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 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 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 . */ + +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 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 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 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 object in SELF. + Throws an exception if SELF is not a 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 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 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, + _("")); + } + + return p_smob; +} + +/* Program space methods. */ + +/* (progspace-valid? ) -> 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 ) -> 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 ) -> 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 ) -> 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! 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) -> + 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 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); +} diff --git a/gdb/testsuite/gdb.guile/scm-pretty-print.exp b/gdb/testsuite/gdb.guile/scm-pretty-print.exp index cd3ae95..555d751 100644 --- a/gdb/testsuite/gdb.guile/scm-pretty-print.exp +++ b/gdb/testsuite/gdb.guile/scm-pretty-print.exp @@ -138,11 +138,19 @@ gdb_test "print ss" " = a= b=<$hex>> b= 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= b=<$hex>> b= b=<$hex>>" \ "print ss enabled #2" + +gdb_test_no_output "guile (install-progspace-pretty-printers! (current-progspace))" +gdb_test "print ss" \ + " = a= b=<$hex>> b= 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= b=<$hex>> b= b=<$hex>>" \ + "print ss via objfile" diff --git a/gdb/testsuite/gdb.guile/scm-pretty-print.scm b/gdb/testsuite/gdb.guile/scm-pretty-print.scm index a42527c..26c0093 100644 --- a/gdb/testsuite/gdb.guile/scm-pretty-print.scm +++ b/gdb/testsuite/gdb.guile/scm-pretty-print.scm @@ -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)))) diff --git a/gdb/testsuite/gdb.guile/scm-progspace.c b/gdb/testsuite/gdb.guile/scm-progspace.c new file mode 100644 index 0000000..0034449 --- /dev/null +++ b/gdb/testsuite/gdb.guile/scm-progspace.c @@ -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 . */ + +int +main () +{ + return 0; +} diff --git a/gdb/testsuite/gdb.guile/scm-progspace.exp b/gdb/testsuite/gdb.guile/scm-progspace.exp new file mode 100644 index 0000000..5ec2afe --- /dev/null +++ b/gdb/testsuite/gdb.guile/scm-progspace.exp @@ -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 . + +# 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_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)" "= #"