From patchwork Thu Mar 5 15:10:24 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andy Wingo X-Patchwork-Id: 5477 Received: (qmail 74647 invoked by alias); 5 Mar 2015 15:10:49 -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 73621 invoked by uid 89); 5 Mar 2015 15:10:49 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=0.4 required=5.0 tests=AWL, BAYES_40, KAM_STOCKGEN, RCVD_IN_DNSWL_LOW, SPF_NEUTRAL autolearn=no version=3.3.2 X-HELO: sasl.smtp.pobox.com Received: from pb-sasl1.int.icgroup.com (HELO sasl.smtp.pobox.com) (208.72.237.25) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 05 Mar 2015 15:10:35 +0000 Received: from sasl.smtp.pobox.com (unknown [127.0.0.1]) by pb-sasl1.pobox.com (Postfix) with ESMTP id 607B63A828 for ; Thu, 5 Mar 2015 10:10:33 -0500 (EST) Received: from pb-sasl1.int.icgroup.com (unknown [127.0.0.1]) by pb-sasl1.pobox.com (Postfix) with ESMTP id 5798F3A827 for ; Thu, 5 Mar 2015 10:10:33 -0500 (EST) Received: from rusty (unknown [88.160.190.192]) (using TLSv1 with cipher ECDHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by pb-sasl1.pobox.com (Postfix) with ESMTPSA id BF8EC3A826 for ; Thu, 5 Mar 2015 10:10:28 -0500 (EST) From: Andy Wingo To: gdb-patches@sourceware.org Subject: [PATCH v3] Add Guile frame-filter interface Date: Thu, 05 Mar 2015 16:10:24 +0100 Message-ID: <87sidjwkdb.fsf@igalia.com> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.4 (gnu/linux) MIME-Version: 1.0 X-Pobox-Relay-ID: C261E15C-C349-11E4-8464-B058D0B8C469-02397024!pb-sasl1.pobox.com X-IsSubscribed: yes Changes: * Frame annotator interface folded into frame filters -- they are now all filters * Annotators renamed decorators * Guile module renamed (gdb frame-filters) from (gdb frames) * (ice-9 streams) streams instead of (srfi srfi-41) for pre-2.0.9 compat * coding style foo Thanks in advance for review :) Andy From 7965abdaa51ea2e52cc145bc14fb2b77391f671c Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 15 Feb 2015 12:17:23 +0100 Subject: [PATCH] Add Guile frame filter interface. gdb/ChangeLog: * guile/scm-frame-filter.c: * guile/lib/gdb/frame-filters.scm: New files. * guile/guile.c (guile_extension_ops): Add the Guile frame filter. (initialize_gdb_module): Initialize the Guile frame filter module. * guile/guile-internal.h (frscm_scm_from_frame) (gdbscm_apply_frame_filter, gdbscm_initialize_frame_filters) (gdbscm_type_error, gdbscm_dynwind_restore_cleanups) (gdbscm_dynwind_do_cleanups): New declarations. (GDBSCM_BEGIN_TRY_CATCH_WITH_DYNWIND) (GDBSCM_END_TRY_CATCH_WITH_DYNWIND): New helper macros. * mi/mi-main.c (mi_cmd_list_features): Add the "guile" feature if appropriate. * Makefile.in: Add scm-frame-filter.c. * data-directory/Makefile.in: Add frame-filters.scm. * guile/scm-exception.c (gdbscm_type_error): New helper. * guile/scm-frame.c (frscm_scm_from_frame): Export. * guile/scm-utils.c (gdbscm_dynwind_restore_cleanups) (gdbscm_dynwind_do_cleanups): New helpers. gdb/doc/ChangeLog: * guile.texi (Guile Frame Filter API) (Writing a Frame Filter in Guile): New sections. gdb/testsuite/ChangeLog: * gdb.guile/amd64-scm-frame-filter-invalidarg.S: * gdb.guile/scm-frame-filter-gdb.scm.in: * gdb.guile/scm-frame-filter-invalidarg-gdb.scm.in: * gdb.guile/scm-frame-filter-invalidarg.exp: * gdb.guile/scm-frame-filter-invalidarg.scm: * gdb.guile/scm-frame-filter-mi.c: * gdb.guile/scm-frame-filter-mi.exp: * gdb.guile/scm-frame-filter.c: * gdb.guile/scm-frame-filter.exp: * gdb.guile/scm-frame-filter.scm: New files. --- gdb/ChangeLog | 23 + gdb/Makefile.in | 6 + gdb/data-directory/Makefile.in | 2 + gdb/doc/ChangeLog | 5 + gdb/doc/guile.texi | 436 +++++++++- gdb/guile/guile-internal.h | 72 ++ gdb/guile/guile.c | 3 +- gdb/guile/lib/gdb/frame-filters.scm | 445 ++++++++++ gdb/guile/scm-exception.c | 9 + gdb/guile/scm-frame-filter.c | 949 +++++++++++++++++++++ gdb/guile/scm-frame.c | 2 +- gdb/guile/scm-utils.c | 17 + gdb/mi/mi-main.c | 3 + gdb/testsuite/ChangeLog | 13 + .../gdb.guile/amd64-scm-frame-filter-invalidarg.S | 261 ++++++ .../gdb.guile/scm-frame-filter-gdb.scm.in | 39 + .../scm-frame-filter-invalidarg-gdb.scm.in | 39 + .../gdb.guile/scm-frame-filter-invalidarg.exp | 66 ++ .../gdb.guile/scm-frame-filter-invalidarg.scm | 36 + gdb/testsuite/gdb.guile/scm-frame-filter-mi.c | 140 +++ gdb/testsuite/gdb.guile/scm-frame-filter-mi.exp | 179 ++++ gdb/testsuite/gdb.guile/scm-frame-filter.c | 157 ++++ gdb/testsuite/gdb.guile/scm-frame-filter.exp | 239 ++++++ gdb/testsuite/gdb.guile/scm-frame-filter.scm | 89 ++ 24 files changed, 3226 insertions(+), 4 deletions(-) create mode 100644 gdb/guile/lib/gdb/frame-filters.scm create mode 100644 gdb/guile/scm-frame-filter.c create mode 100644 gdb/testsuite/gdb.guile/amd64-scm-frame-filter-invalidarg.S create mode 100644 gdb/testsuite/gdb.guile/scm-frame-filter-gdb.scm.in create mode 100644 gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg-gdb.scm.in create mode 100644 gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg.exp create mode 100644 gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg.scm create mode 100644 gdb/testsuite/gdb.guile/scm-frame-filter-mi.c create mode 100644 gdb/testsuite/gdb.guile/scm-frame-filter-mi.exp create mode 100644 gdb/testsuite/gdb.guile/scm-frame-filter.c create mode 100644 gdb/testsuite/gdb.guile/scm-frame-filter.exp create mode 100644 gdb/testsuite/gdb.guile/scm-frame-filter.scm diff --git a/gdb/ChangeLog b/gdb/ChangeLog index a5e98ed..3b2c66b 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,5 +1,28 @@ 2015-03-05 Andy Wingo + * guile/scm-frame-filter.c: + * guile/lib/gdb/frame-filters.scm: New files. + * guile/guile.c (guile_extension_ops): Add the Guile frame + filter. + (initialize_gdb_module): Initialize the Guile frame filter + module. + * guile/guile-internal.h (frscm_scm_from_frame) + (gdbscm_apply_frame_filter, gdbscm_initialize_frame_filters) + (gdbscm_type_error, gdbscm_dynwind_restore_cleanups) + (gdbscm_dynwind_do_cleanups): New declarations. + (GDBSCM_BEGIN_TRY_CATCH_WITH_DYNWIND) + (GDBSCM_END_TRY_CATCH_WITH_DYNWIND): New helper macros. + * mi/mi-main.c (mi_cmd_list_features): Add the "guile" feature if + appropriate. + * Makefile.in: Add scm-frame-filter.c. + * data-directory/Makefile.in: Add frame-filters.scm. + * guile/scm-exception.c (gdbscm_type_error): New helper. + * guile/scm-frame.c (frscm_scm_from_frame): Export. + * guile/scm-utils.c (gdbscm_dynwind_restore_cleanups) + (gdbscm_dynwind_do_cleanups): New helpers. + +2015-03-05 Andy Wingo + * guile/scm-objfile.c (gdbscm_objfile_progspace): New function. (objfile_functions): Bind gdbscm_objfile_progspace to objfile-progspace. diff --git a/gdb/Makefile.in b/gdb/Makefile.in index e837c6f..a343304 100644 --- a/gdb/Makefile.in +++ b/gdb/Makefile.in @@ -314,6 +314,7 @@ SUBDIR_GUILE_OBS = \ scm-disasm.o \ scm-exception.o \ scm-frame.o \ + scm-frame-filter.o \ scm-gsmob.o \ scm-iterator.o \ scm-lazy-string.o \ @@ -340,6 +341,7 @@ SUBDIR_GUILE_SRCS = \ guile/scm-disasm.c \ guile/scm-exception.c \ guile/scm-frame.c \ + guile/scm-frame-filter.c \ guile/scm-gsmob.c \ guile/scm-iterator.c \ guile/scm-lazy-string.c \ @@ -2410,6 +2412,10 @@ scm-frame.o: $(srcdir)/guile/scm-frame.c $(COMPILE) $(srcdir)/guile/scm-frame.c $(POSTCOMPILE) +scm-frame-filter.o: $(srcdir)/guile/scm-frame-filter.c + $(COMPILE) $(srcdir)/guile/scm-frame-filter.c + $(POSTCOMPILE) + scm-gsmob.o: $(srcdir)/guile/scm-gsmob.c $(COMPILE) $(srcdir)/guile/scm-gsmob.c $(POSTCOMPILE) diff --git a/gdb/data-directory/Makefile.in b/gdb/data-directory/Makefile.in index c01b86d..55f2417 100644 --- a/gdb/data-directory/Makefile.in +++ b/gdb/data-directory/Makefile.in @@ -87,6 +87,7 @@ GUILE_SOURCE_FILES = \ ./gdb.scm \ gdb/boot.scm \ gdb/experimental.scm \ + gdb/frame-filters.scm \ gdb/init.scm \ gdb/iterator.scm \ gdb/printing.scm \ @@ -96,6 +97,7 @@ GUILE_SOURCE_FILES = \ GUILE_COMPILED_FILES = \ ./gdb.go \ gdb/experimental.go \ + gdb/frame-filters.go \ gdb/iterator.go \ gdb/printing.go \ gdb/support.go \ diff --git a/gdb/doc/ChangeLog b/gdb/doc/ChangeLog index c7afd0f..1982ff1 100644 --- a/gdb/doc/ChangeLog +++ b/gdb/doc/ChangeLog @@ -1,3 +1,8 @@ +2015-02-15 Andy Wingo + + * guile.texi (Guile Frame Filter API) + (Writing a Frame Filter in Guile): New sections. + 2015-03-05 Andy Wingo * guile.texi (Objfiles In Guile): Document objfile-progspace. diff --git a/gdb/doc/guile.texi b/gdb/doc/guile.texi index 4a4365c..2f331fc 100644 --- a/gdb/doc/guile.texi +++ b/gdb/doc/guile.texi @@ -141,6 +141,8 @@ 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 +* Guile Frame Filter API:: Filtering frames. +* Writing a Frame Filter in Guile:: Writing a frame filter. * Commands In Guile:: Implementing new commands in Guile * Parameters In Guile:: Adding new @value{GDBN} parameters * Progspaces In Guile:: Program spaces @@ -170,8 +172,8 @@ output interrupted by the user (@pxref{Screen Size}). In this situation, a Guile @code{signal} exception is thrown with value @code{SIGINT}. Guile's history mechanism uses the same naming as @value{GDBN}'s, -namely the user of dollar-variables (e.g., $1, $2, etc.). -The results of evaluations in Guile and in GDB are counted separately, +namely the user of dollar-variables (e.g., $1, $2, etc.). The results +of evaluations in Guile and in @value{GDBN} are counted separately, @code{$1} in Guile is not the same value as @code{$1} in @value{GDBN}. @value{GDBN} is not thread-safe. If your Guile program uses multiple @@ -1693,6 +1695,436 @@ my_library.so: bar @end smallexample +@node Guile Frame Filter API +@subsubsection Filtering Frames in Guile +@cindex frame filters api, guile + +Frame filters allow the user to programmatically alter the way a +backtrace (@pxref{Backtrace}) prints. Frame filters can reorganize, +decorate, insert, and remove frames in a backtrace. + +Only commands that print a backtrace, or, in the case of @sc{gdb/mi} +commands (@pxref{GDB/MI}), those that return a collection of frames +are affected. The commands that work with frame filters are: + +@table @code +@item backtrace +@xref{backtrace-command,, The backtrace command}. +@item -stack-list-frames +@xref{-stack-list-frames,, The -stack-list-frames command}. +@item -stack-list-variables +@xref{-stack-list-variables,, The -stack-list-variables command}. +@item -stack-list-arguments +@xref{-stack-list-arguments,, The -stack-list-arguments command}. +@item -stack-list-locals +@xref{-stack-list-locals,, The -stack-list-locals command}. +@end table + +@cindex frame decorators api, guile +A frame filter is a function that takes a stream of decorated frame +objects as an argument, and returns a potentially modified stream of +decorated frame objects. @xref{Streams,,,guile,The Guile Reference +Manual}, for more on lazy streams in Guile. Operating over a stream +allows frame filters to inspect, reorganize, insert, and remove +frames. @value{GDBN} also provides a more simple @dfn{frame +decorator} API that works on individual frames, for the common case in +which the user does not need to reorganize the backtrace. A frame +decorator in Guile is just a kind of frame filter. The frame filter +API is described below. + +There can be multiple frame filters registered with @value{GDBN}, and +each one may be individually enabled or disabled at will. Multiple +frame filters can be enabled at the same time. Frame filters have an +associated priority which determines the order in which they are +applied over the decorated frame stream. For example, if there are +two filters registered and enabled, @var{f1} and @var{f2}, and the +priority of @var{f2} is greater than that of @var{f1}, then the result +of frame filtering will be @code{(@var{f1} (@var{f2} @var{stream}))}. +In this way, higher-priority frame filters get the first crack on the +stream of frames from GDB. On the other hand, lower-priority filters +do get the final word on the word on the backtrace that is ultimately +printed. + +An important consideration when designing frame filters, and well +worth reflecting upon, is that frame filters should avoid unwinding +the call stack if possible. Some stacks can run very deep, into the +tens of thousands in some cases. To search every frame when a frame +filter executes may be too expensive at that step. The frame filter +cannot know how many frames it has to iterate over, and it may have to +iterate through them all. This ends up duplicating effort as +@value{GDBN} performs this iteration when it prints the frames. +Therefore a frame filter should avoid peeking ahead in the frame +stream, if possible. @xref{Writing a Frame Filter}, for examples on +how to write a good frame filter. + +To use frame filters, first load the @code{(gdb frame-filters)} module +to have access to the procedures that manipulate frame filters: + +@example +(use-modules (gdb frame-filters)) +@end example + +@deffn {Scheme Procedure} make-frame-filter name procedure @ + @r{[}#:priority priority@r{]} @r{[}#:enabled? boolean@r{]} @ + @r{[}#:objfile objfile@r{]} @r{[}#:progspace progspace@r{]} +Make a new frame filter. @var{procedure} should be a function of one +argument, taking a stream of decorated frames and returning a +possibily modified stream of decorated frames. +@xref{Streams,,,guile,The Guile Reference Manual}, for more on Guile +streams. The filter is identified by @var{name}, which must be unique +within its registered scope. + +By default, the scope of the filter is global, meaning that it is +associated with all objfiles and progspaces. Pass one of +@code{#:objfile} or @code{#:progspace} to instead scope the filter +into a specific objfile or progspace, respectively. + +The filter will be initially enabled, unless the keyword argument +@code{#:enabled? #f} is given. Even if the filter is marked as +enabled, it will need to be added to @value{GDBN}'s set of active +filters via @code{add-frame-filter!} in order to take effect. When +added, the filter will be inserted into the chain of registered with +the given @var{priority}, which should be a number, and which defaults +to 20 if not given. Higher priority filters will run before +lower-priority filters. +@end deffn + +@deffn {Scheme Procedure} all-frame-filters +Return a list of all frame filters. +@end deffn + +@deffn {Scheme Procedure} add-frame-filter! filter +@deffnx {Scheme Procedure} remove-frame-filter! filter +Register or unregister the frame filter @var{filter} with +@value{GDBN}. Frame filters are also implicitly unregistered when +their objfile or progspace goes away. +@end deffn + +@deffn {Scheme Procedure} enable-frame-filter! filter +@deffnx {Scheme Procedure} disable-frame-filter! filter +Enable or disable a frame filter, respectively. @var{filter} can +either be a frame filter object, or it can be a string naming a filter +in the current scope. If no such filter is found, an error is +signalled. +@end deffn + +@deffn {Scheme Procedure} frame-filter-name filter +@deffnx {Scheme Procedure} frame-filter-enabled? filter +@deffnx {Scheme Procedure} frame-filter-registered? filter +@deffnx {Scheme Procedure} frame-filter-priority filter +@deffnx {Scheme Procedure} frame-filter-procedure filter +@deffnx {Scheme Procedure} frame-filter-scope filter +Accessors for a frame filter object's fields. The @code{registered?} +field indicates whether a filter has been added to @value{GDBN} or +not. @code{scope} is the objfile or progspace in which the filter was +registered, or @code{#f} otherwise. +@end deffn + +When a command is executed from @value{GDBN} that is compatible with +frame filters, @value{GDBN} selects all filters registered in the +current progspace, filters for all objfiles of the current progspace, +and filters with no associated objfile or progspace. That list is +then sorted by priority, as described above, and applied to the +decorated frame stream. + +An decorated frame is a Guile record type that holds information about +a frame: its function name, its arguments, its locals, and so on. An +decorated frame is always associated with a @value{GDBN} frame object. To +add, remove, or otherwise alter information associated with an +decorated frame, use the @code{redecorate-frame} procedure. + +@deffn {Scheme Procedure} redecorate-frame dec @ + @r{[}#:function-name function-name@r{]} @ + @r{[}#:address address@r{]} @ + @r{[}#:filename filename@r{]} @ + @r{[}#:line line@r{]} @ + @r{[}#:arguments arguments@r{]} @ + @r{[}#:locals locals@r{]} @ + @r{[}#:children children@r{]} +Take the decorated frame object @var{dec} and return a new decorated +frame object, replacing the fields specified by the keyword arguments +with their new values. For example, calling @code{(redecorate-frame +@var{x} #:function-name "foo")} will create a new decorated frame +object that inherits all fields from @var{x}, but whose function name +has been set to @samp{foo}. +@end deffn + +The @code{(gdb frame-filters)} module defines accessors for the various +fields of decorated frame objects. + +@deffn {Scheme Procedure} decorated-frame-frame dec +Return the @value{GDBN} frame object associated with the decorated frame +@var{dec}. @xref{Frames In Guile}. +@end deffn + +@deffn {Scheme Procedure} decorated-frame-function-name dec +Return the function name associated with the decorated frame +@var{dec}, as a string, or @code{#f} if not available. +@end deffn + +@deffn {Scheme Procedure} decorated-frame-address dec +Return the address associated with the decorated frame @var{dec}, as +an integer. +@end deffn + +@deffn {Scheme Procedure} decorated-frame-filename dec +Return the file name associated with the decorated frame @var{dec}, as +a string, or @code{#f} if not available. +@end deffn + +@deffn {Scheme Procedure} decorated-frame-line dec +Return the line number associated with the decorated frame @var{dec}, +as an integer, or @code{#f} if not available. +@end deffn + +@deffn {Scheme Procedure} decorated-frame-arguments dec +Return a list of the function arguments associated with the decorated +frame @var{dec}. Each item of the list should either be a +@value{GDBN} symbol (@pxref{Symbols In Guile}), a pair of a +@value{GDBN} symbol and a @value{GDBN} value (@pxref{Values From +Inferior In Guile}, or a pair of a string and a @value{GDBN} value. +In the first case, the value will be loaded from the frame if needed. +@end deffn + +@deffn {Scheme Procedure} decorated-frame-locals dec +Return a list of the function arguments associated with the decorated +frame @var{dec}, in the same format as for +@code{decorated-frame-arguments}. +@end deffn + +Decorated frames may also have child frames. By default, no frame has +a child frame, but filters may reorganize the frame stream into a +stream of frame trees, by populating the child list. Of course, such +a reorganization is ultimately cosmetic, as it doesn't alter the stack +of frames seen by @value{GDBN} and navigable by the user, for example +by using the @code{frame} command. Still, nesting frames may lead to +a more understandable presentation of a backtrace. + +@deffn {Scheme Procedure} decorated-frame-children dec +Return a list of the child frames associated with the decorated frame +@var{dec}. Each item of the list should be an decorated frame object. +@end deffn + +While frame filters can both reorganize and redecorate the frame +stream, it is often the case that one only wants to redecorate the +frames in a stream, without reorganizing then. In that case there is +a simpler API for frame decorators that simply maps decorated frames +to decorated frames. + +@deffn {Scheme Procedure} make-decorating-frame-filter name decorator @ + @r{[}#:priority priority@r{]} @r{[}#:enabled? boolean@r{]} @ + @r{[}#:objfile objfile@r{]} @r{[}#:progspace progspace@r{]} +Make a frame filter for the frame decorator procedure @var{decorator}. +@var{decorator} should be a function of one argument, taking decorated +frame object and returning a possibily modified decorated frame. + +The rest of the arguments are the same as for +@code{make-frame-filter}, and the result is a frame filter object. +A decorator is just a simple kind of frame filter. +@end deffn + +Internally, @code{make-decorating-frame-filter} just calls +@code{make-frame-filter} with all of its arguments, except that the +procedure has been wrapped by +@code{make-decorating-frame-filter-procedure}. + +@deffn {Scheme Procedure} make-decorating-frame-filter-procedure decorator +Take the given @var{decorator} procedure and return a frame filter +procedure that will call @var{decorator} on each frame in the stream. +@end deffn + +@node Writing a Frame Filter in Guile +@subsubsection Writing a Frame Filter in Guile +@cindex writing a frame filter in guile + +The simplest kind of frame filter just takes the incoming stream of +frames and produces an identical stream of values. For example: + +@example +(use-modules (gdb frame-filters) + (ice-9 streams)) + +(define (identity-frame-filter stream) + ;; Just map the identity function over the stream. + (stream-map identity stream)) +@end example + +Before going deep into the example, a note on the streams interface. +For compatibility with pre-2.0.9 Guile, frame filters operate on +streams from the older @code{(ice-9 streams)} module, rather than the +newer @code{(srfi srfi-41)}. In Guile 2.2, both modules will operate +over the same data type, so you can use the more convenient SRFI-41 +interface. However in Guile 2.0 that's not possible, so in this +example we will stick to the older interfaces. +@xref{Streams,,,guile,The Guile Reference Manual}, for more on +@code{(ice-9 streams)}. @xref{SRFI-41,,,guile,The Guile Reference +Manual}, for more on @code{(srfi srfi-41)}. + +If you are not familiar with streams, you might think calling +@code{stream-map} would eagerly traverse the whole stack of frames. +This would be bad because we don't want to produce an entire backtrace +at once when the user might cancel after only seeing one page. +However this is not the case, because unlike normal Scheme procedures, +@code{stream-map} produces a @emph{lazy} stream of values, which is to +say that its values are only produced when they are accessed via +@code{stream-car} and @code{stream-cdr}. In this way the stream looks +infinite, but in reality only produces as many values as needed. + +To use this frame filter function, we have to create a corresponding +filter object and register it with @value{GDBN}. + +@example +(define identity-filter-object + (make-frame-filter "identity" identity-frame-filter)) + +(add-frame-filter! identity-filter-object) +@end example + +Now our filter will run each time a backtrace is printed, or in +general for any @value{GDBN} command that uses the frame filter +interface. Note however that there is also a Python frame filter +interface; in practice if there are any Python frame filters enabled, +then they will run first, and Guile filters won't be given a chance to +run. The priority-based ordering of frame filters only works within +one extension language. To ensure that your Guile filters can run, +you might need to disable any Python frame filters loaded in your +session. + +By default, filters are enabled when they are added. You can control +the enabled or disabled state of a filter using the appropriate +procedures: + +@example +(disable-frame-filter! identity-filter-object) +(enable-frame-filter! identity-filter-object) +@end example + +These two procedures can also enable or disable filters by name, so +this is also valid: + +@example +(disable-frame-filter! "identity") +(enable-frame-filter! "identity") +@end example + +Finally, we can remove all filters with a simple application of +@code{for-each}: + +@example +(for-each remove-frame-filter! (all-frame-filters)) +@end example + +Let us define a more interesting example. For example, in Guile there +is a function @code{scm_call_n}, which may be invoked directly but is +often invoked via well-known wrappers like @code{scm_call_0}, +@code{scm_call_1}, and so on. For example here is part of a backtrace +of an optimized Guile build, when you first start a Guile REPL: + +@smallexample +#10 0x00007ffff7b6ed91 in vm_debug_engine ([...]) at vm-engine.c:815 +#11 0x00007ffff7b74380 in scm_call_n ([...]) at vm.c:1258 +#12 0x00007ffff7afb9d9 in scm_call_0 ([...]) at eval.c:475 +#13 0x00007ffff7b74a0e in sf_fill_input ([...]) at vports.c:94 +@end smallexample + +For the sake of the example, the arguments to each have been +abbreviated to @code{[...]}. Now, it might be nice if we could nest +@code{scm_call_n} inside @code{scm_call_0}, so let's do that: + +@smallexample +(use-modules (gdb) (gdb frame-filters) (ice-9 streams)) + +;; Unfold F across STREAM. The return value should be a pair whose +;; car is the first element in the resulting stream, and the CDR is +;; the stream on which to recurse. +(define (stream-map* f stream) + (make-stream + (lambda (stream) + (and (not (stream-null? stream)) + (f (stream-car stream) (stream-cdr stream)))) + stream)) + +(define (nest-scm-call-filter stream) + (stream-map* + (lambda (head tail) + (cond + ;; Is this a call to scm_call_n and is there a next frame? + ((and (equal? (decorated-frame-function-name head) + "scm_call_n") + (not (stream-null? tail))) + (let* ((next (stream-car tail)) + (next-name (decorated-frame-function-name next))) + (cond + ;; Does the next frame have a function name and + ;; does it start with "scm_call_"? + ((and next-name + (string-prefix? "scm_call_" next-name)) + ;; A match! Add `head' to the child list of `next'. + (let ((children (cons head + (decorated-frame-children next)))) + (cons (redecorate-frame next #:children children) + (stream-cdr tail)))) + (else (cons head tail))))) + (else (cons head tail)))) + stream)) + +(add-frame-filter! + (make-frame-filter "nest-scm-call" nest-scm-call-filter)) +@end smallexample + +With this filter in place, the resulting backtrace looks like: + +@smallexample +#10 0x00007ffff7b6ed91 in vm_debug_engine ([...]) at vm-engine.c:815 +#12 0x00007ffff7afb9d9 in scm_call_0 ([...]) at eval.c:475 + #11 0x00007ffff7b74380 in scm_call_n ([...]) at vm.c:1258 +#13 0x00007ffff7b74a0e in sf_fill_input ([...]) at vports.c:94 +@end smallexample + +As you can see, frame #11 has been nested below frame #12. + +Sometimes, though, all this stream processing and stream recursion can +be too complicated if your desire is just to decorate individual +frames. In that situation, the frame decorator API can be more +appropriate. For example, if we know that there are some C procedures +that have ``aliases'' in some other language, like Scheme, then we can +decorate them in the backtrace with their Scheme names. + +@smallexample +(use-modules (gdb frame-filters)) + +(define *function-name-aliases* + '(("scm_primitive_eval" . "primitive-eval"))) + +(define (alias-decorator dec) + (let* ((name (decorated-frame-function-name dec)) + (alias (assoc-ref *function-name-aliases* name))) + (if alias + (redecorate-frame dec #:function-name + (string-append "[" alias "] " name)) + dec))) + +(add-frame-filter! + (make-decorating-frame-filter "alias-decorator" alias-decorator)) +@end smallexample + +A backtrace with this decorator in place produces: + +@smallexample +#19 [...] in vm_debug_engine ([...]) at vm-engine.c:806 +#20 [...] in scm_call_n ([...]) at vm.c:1258 +#21 [...] in [primitive-eval] scm_primitive_eval ([...]) at eval.c:656 +#22 [...] in scm_eval ([...]) at eval.c:690 +#23 [...] in scm_shell ([...]) at script.c:454 +@end smallexample + +Again, parts have been elided with @code{[...]}. + +The decorator interface is just a simple layer over filters, so it is +also possible to do the job of an decorator with a filter. Still, +avoiding the stream interfaces can often be a good reason to use the +simpler decorator layer. + @node Commands In Guile @subsubsection Commands In Guile diff --git a/gdb/guile/guile-internal.h b/gdb/guile/guile-internal.h index 9e62a22..4ed8cbb 100644 --- a/gdb/guile/guile-internal.h +++ b/gdb/guile/guile-internal.h @@ -32,6 +32,7 @@ struct block; struct frame_info; struct objfile; struct symbol; +struct inferior; /* A function to pass to the safe-call routines to ignore things like memory errors. */ @@ -305,6 +306,10 @@ extern SCM gdbscm_make_error (SCM key, const char *subr, const char *message, extern SCM gdbscm_make_type_error (const char *subr, int arg_pos, SCM bad_value, const char *expected_type); +extern void gdbscm_type_error (const char *subr, int arg_pos, + SCM bad_value, const char *expected_type) + ATTRIBUTE_NORETURN; + extern SCM gdbscm_make_invalid_object_error (const char *subr, int arg_pos, SCM bad_value, const char *error); @@ -422,6 +427,9 @@ typedef struct _frame_smob frame_smob; extern int frscm_is_frame (SCM scm); +extern SCM frscm_scm_from_frame (struct frame_info *frame, + struct inferior *inferior); + extern frame_smob *frscm_get_frame_smob_arg_unsafe (SCM frame_scm, int arg_pos, const char *func_name); @@ -580,6 +588,11 @@ extern enum ext_lang_rc gdbscm_apply_val_pretty_printer const struct value_print_options *options, const struct language_defn *language); +extern enum ext_lang_bt_status gdbscm_apply_frame_filter + (const struct extension_language_defn *, + struct frame_info *frame, int flags, enum ext_lang_frame_args args_type, + struct ui_out *out, int frame_low, int frame_high); + extern int gdbscm_breakpoint_has_cond (const struct extension_language_defn *, struct breakpoint *b); @@ -596,6 +609,7 @@ extern void gdbscm_initialize_commands (void); extern void gdbscm_initialize_disasm (void); extern void gdbscm_initialize_exceptions (void); extern void gdbscm_initialize_frames (void); +extern void gdbscm_initialize_frame_filters (void); extern void gdbscm_initialize_iterators (void); extern void gdbscm_initialize_lazy_strings (void); extern void gdbscm_initialize_math (void); @@ -635,4 +649,62 @@ extern void gdbscm_initialize_values (void); } \ } while (0) +/* Internal helpers for GDBSCM_BEGIN_TRY_CATCH_WITH_DYNWIND. */ + +extern void gdbscm_dynwind_restore_cleanups (void *data); +extern void gdbscm_dynwind_do_cleanups (void *data); + +/* A simple form of integrating GDB and Scheme exceptions. + + GDBSCM_BEGIN_TRY_CATCH_WITH_DYNWIND and + GDBSCM_END_TRY_CATCH_WITH_DYNWIND delimit a Scheme dynwind and a GDB + TRY_CATCH. Any GDB exception raised within the block will be caught + and re-raised as a Scheme exception. Likewise, any Scheme exception + will cause GDB cleanups to run. + + Use these handlers when you know you are within gdbscm_safe_call or + some other Scheme error-catching context. As with any piece of GDB in + which Scheme exceptions may be thrown, local data must be longjmp-safe. + In practice this means that any cleanups need to be registered via + make_cleanup or via Scheme dynwinds, and particular RAII-style C++ + destructors are not supported. + + Leaving the block in any way -- whether normally, via a GDB exception, + or a Scheme exception -- will cause any cleanups that were registered + within the block to run, as well as any handlers installed via + scm_dynwind_unwind_handler. (Scheme unwind handlers installed without + SCM_F_WIND_EXPLICITLY will only be run on Scheme exceptions.) */ + +#define GDBSCM_BEGIN_TRY_CATCH_WITH_DYNWIND() \ + do { \ + volatile struct gdb_exception dynwind_except; \ + /* Any cleanup pushed within the TRY_CATCH will be run on GDB \ + exception. We will have to run them manually on normal exit or \ + Scheme exception. */ \ + scm_dynwind_begin (0); \ + /* Save the cleanup stack, and arrange to restore it after any exit \ + from the TRY_CATCH, local or non-local. */ \ + scm_dynwind_unwind_handler (gdbscm_dynwind_restore_cleanups, \ + save_cleanups (), \ + SCM_F_WIND_EXPLICITLY); \ + TRY_CATCH (dynwind_except, RETURN_MASK_ALL) \ + { \ + struct cleanup *dynwind_cleanups = make_cleanup (null_cleanup, NULL); \ + /* Ensure cleanups run on Scheme exception. */ \ + scm_dynwind_unwind_handler (gdbscm_dynwind_do_cleanups, \ + dynwind_cleanups, 0); \ + do + +#define GDBSCM_END_TRY_CATCH_WITH_DYNWIND() \ + while (0); \ + /* Ensure cleanups run on normal exit. */ \ + do_cleanups (dynwind_cleanups); \ + } \ + /* Pop the dynwind and restore the saved cleanup stack. */ \ + scm_dynwind_end (); \ + if (dynwind_except.reason < 0) \ + /* Rethrow GDB exception as Scheme exception. */ \ + gdbscm_throw_gdb_exception (dynwind_except); \ + } while (0) + #endif /* GDB_GUILE_INTERNAL_H */ diff --git a/gdb/guile/guile.c b/gdb/guile/guile.c index bb326fc..bbc4340 100644 --- a/gdb/guile/guile.c +++ b/gdb/guile/guile.c @@ -147,7 +147,7 @@ const struct extension_language_ops guile_extension_ops = gdbscm_apply_val_pretty_printer, - NULL, /* gdbscm_apply_frame_filter, */ + gdbscm_apply_frame_filter, gdbscm_preserve_values, @@ -663,6 +663,7 @@ initialize_gdb_module (void *data) gdbscm_initialize_commands (); gdbscm_initialize_disasm (); gdbscm_initialize_frames (); + gdbscm_initialize_frame_filters (); gdbscm_initialize_iterators (); gdbscm_initialize_lazy_strings (); gdbscm_initialize_math (); diff --git a/gdb/guile/lib/gdb/frame-filters.scm b/gdb/guile/lib/gdb/frame-filters.scm new file mode 100644 index 0000000..b09f3db --- /dev/null +++ b/gdb/guile/lib/gdb/frame-filters.scm @@ -0,0 +1,445 @@ +;; Frame filter support. +;; +;; Copyright (C) 2015 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 . + +(define-module (gdb frame-filters) + #:use-module ((gdb) #:hide (frame? symbol?)) + #:use-module ((gdb) #:select ((frame? . gdb:frame?) (symbol? . gdb:symbol?))) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-26) + #:use-module (ice-9 streams) + #:use-module (ice-9 match) + #:export (redecorate-frame + decorated-frame? + decorated-frame-frame + decorated-frame-function-name + decorated-frame-address + decorated-frame-filename + decorated-frame-line + decorated-frame-arguments + decorated-frame-locals + decorated-frame-children + + make-frame-filter + frame-filter? + frame-filter-name + frame-filter-enabled? + frame-filter-registered? + frame-filter-priority + frame-filter-procedure + frame-filter-scope + + find-frame-filter-by-name + + add-frame-filter! + remove-frame-filter! + enable-frame-filter! + disable-frame-filter! + + make-decorating-frame-filter-procedure + make-decorating-frame-filter + + all-frame-filters)) + +(define-record-type + (make-decorated-frame frame function-name address filename line + arguments locals children) + decorated-frame? + (frame decorated-frame-frame) ; frame + (function-name decorated-frame-function-name) ; string or #f + (address decorated-frame-address) ; non-negative int + (filename decorated-frame-filename) ; string or #f + (line decorated-frame-line) ; positive int or #f + ;; binding := symbol | (symbol . value) | (string . value) + (arguments decorated-frame-arguments) ; (binding ...) + (locals decorated-frame-locals) ; (binding ...) + (children decorated-frame-children) ; (decorated-frame ...) + ) + +(define (frame-function-name frame) + "Compute the function name for FRAME, as a string or #f if unavailable." + (let ((f (frame-function frame))) + (cond + ((not f) f) + ((gdb:symbol? f) (symbol-name f)) + (else (object->string f))))) + +(define (frame-filename frame) + "Compute the file name for FRAME, if available, or #f otherwise." + (or (and=> (frame-sal frame) + (lambda (sal) + (and=> (sal-symtab sal) symtab-filename))) + ;; FIXME: Fall back to (solib-name (frame-pc frame)) if present. + #f)) + +(define (frame-line frame) + "Compte the line number for FRAME, if available, or #f otherwise." + (and=> (frame-sal frame) sal-line)) + +(define symbol-has-value? + (let ((*interesting-addr-classes* (list SYMBOL_LOC_STATIC + SYMBOL_LOC_REGISTER + SYMBOL_LOC_ARG + SYMBOL_LOC_REF_ARG + SYMBOL_LOC_LOCAL + SYMBOL_LOC_REGPARM_ADDR + SYMBOL_LOC_COMPUTED))) + (lambda (sym) + "Return true if the SYM has a value, or #f otherwise." + (memq (symbol-addr-class sym) *interesting-addr-classes*)))) + +(define (frame-arguments frame) + "Return a list of GDB symbols for the arguments bound in FRAME." + (let lp ((block (false-if-exception (frame-block frame)))) + (cond + ((not block) '()) + ((not (block-function block)) (lp (block-superblock block))) + (else + (filter symbol-argument? (block-symbols block)))))) + +(define (frame-locals frame) + "Return a list of GDB symbols for the locals bound in FRAME." + (let lp ((block (false-if-exception (frame-block frame)))) + (if (or (not block) (block-global? block) (block-static? block)) + '() + (append (filter (lambda (sym) + (and (not (symbol-argument? sym)) + (symbol-has-value? sym))) + (block-symbols block)) + (lp (block-superblock block)))))) + +;; frame -> decorated-frame +(define (decorate-frame frame) + "Construct an decorated frame from a GDB frame." + (make-decorated-frame frame + (frame-function-name frame) + (frame-pc frame) + (frame-filename frame) + (frame-line frame) + (frame-arguments frame) + (frame-locals frame) + '())) + +(define* (redecorate-frame dec #:key + (function-name (decorated-frame-function-name dec)) + (address (decorated-frame-address dec)) + (filename (decorated-frame-filename dec)) + (line (decorated-frame-line dec)) + (arguments (decorated-frame-arguments dec)) + (locals (decorated-frame-locals dec)) + (children (decorated-frame-children dec))) + "Create a new decorated frame inheriting all of the fields from DEC, +except the fields given in keyword arguments. For example, + + (redecorate-frame dec #:filename \"foo.txt\") + +will return a new frame whose filename has been set to \"foo.txt\"." + (define (valid-local? x) + (or (gdb:symbol? x) + (and (pair? x) + (or (gdb:symbol? (car x)) (string? (car x))) + (value? (cdr x))))) + (define (list-of? pred x) + (and (list? x) (and-map pred x))) + (unless (or (not function-name) (string? function-name)) + (error "function-name should be a string or #f")) + (unless (and (exact-integer? address) (not (negative? address))) + (error "address should be an non-negative integer")) + (unless (or (not filename) (string? filename)) + (error "filename should be a string or #f")) + (unless (or (not line) (and (exact-integer? line) (positive? line))) + (error "line expected to a positive integer or #f")) + (unless (list-of? valid-local? arguments) + (error "arguments should be a list of symbol-value pairs, \ +string-value pairs, or symbols")) + (unless (list-of? valid-local? locals) + (error "locals should be a list of symbol-value pairs, \ +string-value pairs, or symbols")) + (unless (and-map decorated-frame? children) + (error "children should be decorated frames" children)) + (make-decorated-frame (decorated-frame-frame dec) + function-name address filename line arguments locals + children)) + +(define-record-type + (%make-frame-filter name priority enabled? registered? procedure scope) + frame-filter? + ;; string + (name frame-filter-name) + ;; real + (priority frame-filter-priority set-priority!) + ;; bool + (enabled? frame-filter-enabled? set-enabled?!) + ;; bool + (registered? frame-filter-registered? set-registered?!) + ;; Stream decorated-frame -> Stream decorated-frame + (procedure frame-filter-procedure) + ;; objfile | progspace | #f + (scope frame-filter-scope)) + +(define* (make-frame-filter name procedure #:key + objfile progspace (priority 20) (enabled? #t)) + "Make and return a new frame filter. NAME and PROCEDURE are required +arguments. Specify #:objfile or #:progspace to limit the frame filter +to a given scope, and #:priority or #:enabled? to set the priority and +enabled status of the filter. + +The filter must be added to the active set via `add-frame-filter!' +before it is active." + (define (compute-scope objfile progspace) + (cond + (objfile + (when progspace + (error "Only one of #:objfile or #:progspace may be given")) + (unless (objfile? objfile) + (error "Not an objfile" objfile)) + objfile) + (progspace + (unless (progspace? progspace) + (error "Not a progspace" progspace)) + progspace) + (else #f))) + (let ((registered? #f) + (scope (compute-scope objfile progspace))) + (%make-frame-filter name priority enabled? registered? procedure scope))) + +;; List of frame filters, sorted by priority from highest to lowest. +(define *frame-filters* '()) + +(define (same-scope? a b) + "Return #t if A and B represent the same scope, for the purposes of +frame filter selection." + (cond + ;; If either is the global scope, they share a scope. + ((or (not a) (not b)) #t) + ;; If either is an objfile, compare their progspaces. + ((objfile? a) (same-scope? (objfile-progspace a) b)) + ((objfile? b) (same-scope? a (objfile-progspace b))) + ;; Otherwise they are progspaces. If they eq?, it's the same scope. + (else (eq? a b)))) + +(define (is-valid? filter) + "Return #t if the scope of FILTER is still valid, or otherwise #f if +the objfile or progspace has been removed from GDB." + (let ((scope (frame-filter-scope filter))) + (cond + ((progspace? scope) (progspace-valid? scope)) + ((objfile? scope) (objfile-valid? scope)) + (else #t)))) + +(define (all-frame-filters) + "Return a list of all active frame filters, ordered from highest to +lowest priority." + ;; Copy the list to prevent callers from mutating our state. + (list-copy *frame-filters*)) + +(define* (has-active-frame-filters? #:optional (scope (current-progspace))) + "Return #t if there are active frame filters for the given scope, or +#f otherwise." + (let lp ((filters *frame-filters*)) + (match filters + (() #f) + ((filter . filters) + (or (and (frame-filter-enabled? filter) + (same-scope? (frame-filter-scope filter) scope)) + (lp filters)))))) + +(define (prune-frame-filters!) + "Prune frame filters whose objfile or progspace has gone away, +returning a fresh list of frame filters." + (set! *frame-filters* + (let lp ((filters *frame-filters*)) + (match filters + (() '()) + ((f . filters) + (cond + ((is-valid? f) + (cons f (lp filters))) + (else + (set-registered?! f #f) + (lp filters)))))))) + +(define (add-frame-filter! filter) + "Add a frame filter to the active set. Frame filters must be added +before they will be used to filter backtraces." + (define (duplicate-filter? other) + (and (equal? (frame-filter-name other) (frame-filter-name filter)) + (same-scope? (frame-filter-scope other) (frame-filter-scope filter)))) + (define (priority>=? a b) + (>= (frame-filter-priority a) (frame-filter-priority b))) + (define (insert-sorted elt xs <=?) + (let lp ((xs xs)) + (match xs + (() (list elt)) + ((x . xs*) + (if (<=? elt x) + (cons elt xs) + (cons x (lp xs*))))))) + + (prune-frame-filters!) + (when (or-map duplicate-filter? *frame-filters*) + (error "Frame filter with this name already present in scope" + (frame-filter-name filter))) + (set-registered?! filter #t) + (set! *frame-filters* (insert-sorted filter *frame-filters* priority>=?))) + +(define (remove-frame-filter! filter) + "Remove a frame filter from the active set." + (set-registered?! filter #f) + (set! *frame-filters* (delq filter *frame-filters*))) + +(define* (find-frame-filter-by-name name #:optional (scope (current-progspace))) + (prune-frame-filters!) + (or (find (lambda (filter) + (and (equal? name (frame-filter-name filter)) + (same-scope? (frame-filter-scope filter) scope))) + *frame-filters*) + (error "no frame filter found with name" name))) + +(define (enable-frame-filter! filter) + "Mark a frame filter as enabled." + (let ((filter (if (frame-filter? filter) + filter + (find-frame-filter-by-name filter)))) + (set-enabled?! filter #t) + *unspecified*)) + +(define (disable-frame-filter! filter) + "Mark a frame filter as disabled." + (let ((filter (if (frame-filter? filter) + filter + (find-frame-filter-by-name filter)))) + (set-enabled?! filter #f) + *unspecified*)) + +;; frame-decorator := decorated-frame -> decorated-frame +(define (make-decorating-frame-filter-procedure decorator) + "Make a frame filter procedure out of a frame decorator procedure." + (lambda (stream) + (stream-map decorator stream))) + +(define (make-decorating-frame-filter name decorator . args) + "Make a frame filter from the given DECORATOR." + (let ((proc (make-decorating-frame-filter-procedure decorator))) + (apply make-frame-filter name proc args))) + +(define (stream-unfold map pred gen base) + "A SRFI-41-style wrapper for the (ice-9 streams) make-stream +constructor." + (make-stream (lambda (base) + (and (pred base) + (cons (map base) (gen base)))) + base)) + +(define (stream-take count stream) + "Return a stream of the first COUNT elements of STREAM." + (make-stream (match-lambda + ((count . stream) + (and (positive? count) + (not (stream-null? stream)) + (cons (stream-car stream) + (cons (1- count) (stream-cdr stream)))))) + (cons count stream))) + +;; frame int int -> Stream decorated-frame +(define (frame-stream frame frame-low frame-high) + "Build an decorated frame stream starting from FRAME which is +considered to have level 0, and going from levels FRAME-LOW to +FRAME-HIGH. A negative FRAME-LOW means the outmost -FRAME-LOW frames. +Otherwise the innermost FRAME-LOW frames are skipped, and then the frame +stream will continue until it reaches the end of the stack, or +FRAME-HIGH if it is not #f, whichever comes first." + (define (make-stream frame count) + (let ((frames (stream-unfold decorate-frame gdb:frame? frame-older frame))) + (if count + (stream-take count frames) + frames))) + (if (negative? frame-low) + ;; Traverse the stack to find the outermost N frames. + (let ((count (- frame-low))) + (let lp ((older frame) (n 0)) + (cond + ((not older) + (make-stream frame #f)) + ((< n count) + (lp (frame-older older) (1+ n))) + (else + ;; "older" is now "count" frames older than "frame". Keep + ;; going until we hit the oldest frame. + (let lp ((frame frame) (older older)) + (if older + (lp (frame-older frame) (frame-older older)) + (make-stream frame #f))))))) + (let lp ((frame frame) (frame-low frame-low) (newer-index 0)) + ;; Cut the innermost N frames. + (cond + ((not frame) 'no-frames) + ((zero? frame-low) + (let ((count (if (eqv? frame-high -1) + #f + (1+ (max (- frame-high newer-index) 0))))) + (make-stream frame count))) + (else + (lp (frame-older frame) (1- frame-low) (1+ newer-index))))))) + +(define (stream->gdb-iterator stream lower) + "Convert a stream to a GDB iterator." + (make-iterator stream stream + (lambda (iter) + (let ((stream (iterator-progress iter))) + (cond + ((stream-null? stream) + (end-of-iteration)) + (else + (set-iterator-progress! iter (stream-cdr stream)) + (lower (stream-car stream)))))))) + +(define (decorated-frame->vector dec) + ;; C can't deal so nicely with record types, so lower to a more simple + ;; data structure. + (vector (decorated-frame-frame dec) + (decorated-frame-function-name dec) + (decorated-frame-address dec) + (decorated-frame-filename dec) + (decorated-frame-line dec) + (decorated-frame-arguments dec) + (decorated-frame-locals dec) + (map decorated-frame->vector (decorated-frame-children dec)))) + +(define* (apply-active-frame-filters stream #:optional + (scope (current-progspace))) + "Fold the active frame filter procedures over a stream." + (fold (lambda (filter stream) + (if (and (frame-filter-enabled? filter) + (same-scope? (frame-filter-scope filter) scope)) + ((frame-filter-procedure filter) stream) + stream)) + stream + *frame-filters*)) + +(define (apply-frame-filter frame frame-low frame-high) + "Apply active frame filters to a slice of frames. If any frame +filters are active, returns a of decorated frame vectors, +and otherwise returns #f." + (and (has-active-frame-filters?) + (let ((frames (frame-stream frame frame-low frame-high))) + (stream->gdb-iterator (apply-active-frame-filters frames) + decorated-frame->vector)))) + +(load-extension "gdb" "gdbscm_load_frame_filters") diff --git a/gdb/guile/scm-exception.c b/gdb/guile/scm-exception.c index 73dfb84..84675e8 100644 --- a/gdb/guile/scm-exception.c +++ b/gdb/guile/scm-exception.c @@ -268,6 +268,15 @@ gdbscm_make_type_error (const char *subr, int arg_pos, SCM bad_value, return result; } +/* Helper to throw type errors as Scheme exceptions. */ + +void +gdbscm_type_error (const char *subr, int arg_pos, SCM val, + const char *expected_type) +{ + gdbscm_throw (gdbscm_make_type_error (subr, arg_pos, val, expected_type)); +} + /* A variant of gdbscm_make_type_error for non-type argument errors. ERROR_PREFIX and ERROR are combined to build the error message. Care needs to be taken so that the i18n composed form is still diff --git a/gdb/guile/scm-frame-filter.c b/gdb/guile/scm-frame-filter.c new file mode 100644 index 0000000..8082649 --- /dev/null +++ b/gdb/guile/scm-frame-filter.c @@ -0,0 +1,949 @@ +/* Scheme interface to frame filter. + + Copyright (C) 2015 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 . */ + +/* See README file in this directory for implementation notes, coding + conventions, et.al. */ + +#include "defs.h" +#include "annotate.h" +#include "block.h" +#include "demangle.h" +#include "frame.h" +#include "inferior.h" +#include "language.h" +#include "objfiles.h" +#include "symfile.h" +#include "symtab.h" +#include "stack.h" +#include "valprint.h" +#include "value.h" +#include "guile-internal.h" + +/* Non-zero if the (gdb frame-filters) module has been loaded. */ +static int gdbscm_frame_filters_loaded = 0; + +/* The captured apply-frame-filter variable. */ +static SCM apply_frame_filter = SCM_BOOL_F; + +/* Called by lib/gdb/frame-filters.scm. */ + +static void +gdbscm_load_frame_filters (void *unused) +{ + if (gdbscm_frame_filters_loaded) + return; + + gdbscm_frame_filters_loaded = 1; + + apply_frame_filter = scm_c_lookup ("apply-frame-filter"); +} + +/* Helper function to extract a symbol, a name, a language definition, + and a value from ITEM, which is an element of a Scheme "arguments" or + "locals" list. + + ITEM will either be a pair of a string and a value, a pair of a + symbol and a value, or just a symbol. NAME is a pass-through + argument where the name of the symbol will be written. NAME is + allocated in this function, and a cleanup handler is registered if + needed. SYM is a pass-through argument where the symbol will be + written. If the name is a string and not a symbol, SYM will be set + to NULL. LANGUAGE is also a pass-through argument denoting the + language attributed to the symbol. In the case of SYM being NULL, + this will be set to the current language. Finally, VALUE will be set + to the unwrapped GDB value, if ITEM is a pair, and otherwise + NULL. */ + +static void +extract_sym_and_value (SCM item, const char **name, struct symbol **sym, + const struct language_defn **language, + struct value **value, struct gdbarch *gdbarch) +{ + if (scm_is_pair (item)) + { + SCM symbol_scm = scm_car (item), value_scm = scm_cdr (item); + SCM exception = SCM_BOOL_F; + + if (scm_is_string (symbol_scm)) + { + *name = gdbscm_scm_to_host_string (symbol_scm, NULL, + &exception); + if (!*name) + gdbscm_throw (exception); + make_cleanup (xfree, name); + + *sym = NULL; + *language = current_language; + } + else + { + *sym = syscm_get_valid_symbol_arg_unsafe (symbol_scm, + GDBSCM_ARG_NONE, + "print-frame"); + *name = SYMBOL_PRINT_NAME (*sym); + + if (language_mode == language_mode_auto) + *language = language_def (SYMBOL_LANGUAGE (*sym)); + else + *language = current_language; + } + + *value = vlscm_convert_value_from_scheme ("print-frame", + GDBSCM_ARG_NONE, + value_scm, + &exception, + gdbarch, + *language); + if (*value == NULL) + gdbscm_throw (exception); + } + else + { + *sym = syscm_get_valid_symbol_arg_unsafe (item, GDBSCM_ARG_NONE, + "print-frame"); + *name = SYMBOL_PRINT_NAME (*sym); + + if (language_mode == language_mode_auto) + *language = language_def (SYMBOL_LANGUAGE (*sym)); + else + *language = current_language; + + *value = NULL; + } +} + +enum mi_print_types +{ + MI_PRINT_ARGS, + MI_PRINT_LOCALS +}; + +/* MI prints only certain values according to the type of symbol and + also what the user has specified. SYM is the symbol to check, and + MI_PRINT_TYPES is an enum specifying what the user wants emitted + for the MI command in question. */ + +static int +mi_should_print (struct symbol *sym, enum mi_print_types type) +{ + switch (SYMBOL_CLASS (sym)) + { + case LOC_ARG: + case LOC_REF_ARG: + case LOC_REGPARM_ADDR: + case LOC_LOCAL: + case LOC_STATIC: + case LOC_REGISTER: + case LOC_COMPUTED: + return (type == MI_PRINT_ARGS) == SYMBOL_IS_ARGUMENT (sym); + + default: + return 0; + } +} + +/* Helper function which outputs a type name extracted from VAL to a + "type" field in the output stream OUT. OUT is the ui-out structure + the type name will be output too, and VAL is the value that the + type will be extracted from. */ + +static void +gdbscm_print_type (struct ui_out *out, struct value *val) +{ + struct type *type; + + GDBSCM_BEGIN_TRY_CATCH_WITH_DYNWIND () + { + struct ui_file *stb = mem_fileopen (); + + make_cleanup_ui_file_delete (stb); + type = check_typedef (value_type (val)); + type_print (value_type (val), "", stb, -1); + ui_out_field_stream (out, "type", stb); + } + GDBSCM_END_TRY_CATCH_WITH_DYNWIND (); +} + +/* Is this value "simple", for the purposes of MI_PRINT_SIMPLE_VALUES? */ + +static int +is_simple_value (struct value *val) +{ + struct type *type = check_typedef (value_type (val)); + + return (TYPE_CODE (type) != TYPE_CODE_ARRAY + && TYPE_CODE (type) != TYPE_CODE_STRUCT + && TYPE_CODE (type) != TYPE_CODE_UNION); +} + +/* Given the printing mode ARGS_TYPE, return non-zero if VAL should be + printed. */ + +static int +should_print_value (enum ext_lang_frame_args args_type, struct value *val) +{ + if (args_type == MI_PRINT_SIMPLE_VALUES) + return is_simple_value (val); + else + return args_type != NO_VALUES; +} + +/* Helper function which outputs a value to an output field in a + stream. OUT is the ui-out structure the value will be output to, + VAL is the value that will be printed, OPTS contains the value + printing options, ARGS_TYPE is an enumerator describing the + argument format, and LANGUAGE is the language_defn that the value + will be printed with. */ + +static void +gdbscm_print_value (struct ui_out *out, struct value *val, + const struct value_print_options *opts, + int indent, + enum ext_lang_frame_args args_type, + const struct language_defn *language) +{ + int local_indent = (4 * indent); + + /* Never set an indent level for common_val_print if MI. */ + if (ui_out_is_mi_like_p (out)) + local_indent = 0; + + if (should_print_value (args_type, val)) + { + GDBSCM_BEGIN_TRY_CATCH_WITH_DYNWIND () + { + struct ui_file *stb = mem_fileopen (); + make_cleanup_ui_file_delete (stb); + common_val_print (val, stb, indent, opts, language); + ui_out_field_stream (out, "value", stb); + } + GDBSCM_END_TRY_CATCH_WITH_DYNWIND (); + } +} + +enum print_args_field +{ + WITH_ARGS_FIELD, + WITHOUT_ARGS_FIELD +}; + +/* Helper function to output a single frame argument and value to an + output stream. This function will account for entry values if the FV + parameter is populated, the frame argument has entry values + associated with them, and the appropriate "set entry-value" options + are set. Will output in CLI or MI like format depending on the type + of output stream detected. OUT is the output stream, SYM_NAME is the + name of the symbol. If SYM_NAME is populated then it must have an + accompanying value in the parameter FV. FA is a frame argument + structure. If FA is populated, both SYM_NAME and FV are ignored. + OPTS contains the value printing options, ARGS_TYPE is an enumerator + describing the argument format, PRINT_ARGS_FIELD is a flag which + indicates if we output "ARGS=1" in MI output in commands where both + arguments and locals are printed. */ + +static void +gdbscm_print_single_arg (struct ui_out *out, + const char *sym_name, + struct frame_arg *fa, + struct value *fv, + const struct value_print_options *opts, + enum ext_lang_frame_args args_type, + enum print_args_field print_args_field, + const struct language_defn *language) +{ + struct value *val; + + if (fa != NULL) + { + if (fa->val == NULL && fa->error == NULL) + return; + language = language_def (SYMBOL_LANGUAGE (fa->sym)); + val = fa->val; + } + else + val = fv; + + GDBSCM_BEGIN_TRY_CATCH_WITH_DYNWIND () + { + /* MI has varying rules for tuples, but generally if there is only one + element in each item in the list, do not start a tuple. The exception + is -stack-list-variables which emits an ARGS="1" field if the value is + a frame argument. This is denoted in this function with + PRINT_ARGS_FIELD which is flag from the caller to emit the ARGS + field. */ + if (ui_out_is_mi_like_p (out)) + { + if (print_args_field == WITH_ARGS_FIELD + || args_type != NO_VALUES) + make_cleanup_ui_out_tuple_begin_end (out, NULL); + } + + annotate_arg_begin (); + + /* If frame argument is populated, check for entry-values and the + entry value options. */ + if (fa != NULL) + { + struct ui_file *stb; + + stb = mem_fileopen (); + make_cleanup_ui_file_delete (stb); + fprintf_symbol_filtered (stb, SYMBOL_PRINT_NAME (fa->sym), + SYMBOL_LANGUAGE (fa->sym), + DMGL_PARAMS | DMGL_ANSI); + if (fa->entry_kind == print_entry_values_compact) + { + fputs_filtered ("=", stb); + + fprintf_symbol_filtered (stb, SYMBOL_PRINT_NAME (fa->sym), + SYMBOL_LANGUAGE (fa->sym), + DMGL_PARAMS | DMGL_ANSI); + } + if (fa->entry_kind == print_entry_values_only + || fa->entry_kind == print_entry_values_compact) + { + fputs_filtered ("@entry", stb); + } + ui_out_field_stream (out, "name", stb); + } + else + /* Otherwise, just output the name. */ + ui_out_field_string (out, "name", sym_name); + + annotate_arg_name_end (); + + if (! ui_out_is_mi_like_p (out)) + ui_out_text (out, "="); + + if (print_args_field == WITH_ARGS_FIELD) + ui_out_field_int (out, "arg", 1); + + /* For MI print the type, but only for simple values. This seems + weird, but this is how MI choose to format the various output + types. */ + if (args_type == MI_PRINT_SIMPLE_VALUES && val != NULL) + gdbscm_print_type (out, val); + + if (val != NULL) + annotate_arg_value (value_type (val)); + + /* If the output is to the CLI, and the user option "set print + frame-arguments" is set to none, just output "...". */ + if (! ui_out_is_mi_like_p (out) && args_type == NO_VALUES) + ui_out_field_string (out, "value", "..."); + else + { + /* Otherwise, print the value for both MI and the CLI, except + for the case of MI_PRINT_NO_VALUES. */ + if (args_type != NO_VALUES) + { + if (val == NULL) + { + gdb_assert (fa != NULL && fa->error != NULL); + ui_out_field_fmt (out, "value", + _(""), + fa->error); + } + else + gdbscm_print_value (out, val, opts, 0, args_type, + language); + } + } + } + GDBSCM_END_TRY_CATCH_WITH_DYNWIND (); +} + +/* Helper function to print one local. LOCAL is the pair or symbol that + is compatible with extract_sym_and_value, OUT is the output stream, + INDENT is whether we should indent the output (for CLI), ARGS_TYPE is + an enumerator describing the argument format, PRINT_ARGS_FIELD is + flag which indicates whether to output the ARGS field in the case of + -stack-list-variables and FRAME is the backing frame. */ + +static void +gdbscm_print_local (SCM local, + struct ui_out *out, + int indent, + enum ext_lang_frame_args args_type, + struct frame_info *frame, + enum print_args_field print_args_field, + struct gdbarch *gdbarch) +{ + struct value_print_options opts; + const struct language_defn *language; + const char *sym_name; + struct value *val; + struct symbol *sym; + int local_indent = 8 + (8 * indent); + int out_is_mi = ui_out_is_mi_like_p (out); + + get_user_print_options (&opts); + opts.deref_ref = 1; + + extract_sym_and_value (local, &sym_name, &sym, &language, &val, + gdbarch); + + if (sym && out_is_mi && ! mi_should_print (sym, MI_PRINT_LOCALS)) + return; + + if (!val) + /* If the object did not provide a value, read it. */ + val = read_var_value (sym, frame); + + GDBSCM_BEGIN_TRY_CATCH_WITH_DYNWIND () + { + /* With PRINT_NO_VALUES, MI does not emit a tuple normally as each + output contains only one field. The exception is + -stack-list-variables, which always provides a tuple. */ + if (out_is_mi) + { + if (print_args_field == WITH_ARGS_FIELD + || args_type != NO_VALUES) + make_cleanup_ui_out_tuple_begin_end (out, NULL); + } + else + { + /* If the output is not MI we indent locals. */ + ui_out_spaces (out, local_indent); + } + + ui_out_field_string (out, "name", sym_name); + + if (! out_is_mi) + ui_out_text (out, " = "); + + if (args_type == MI_PRINT_SIMPLE_VALUES) + gdbscm_print_type (out, val); + + /* CLI always prints values for locals. MI uses the + simple/no/all system. */ + if (! out_is_mi) + { + int val_indent = (indent + 1) * 4; + + gdbscm_print_value (out, val, &opts, val_indent, args_type, + language); + } + else + { + if (args_type != NO_VALUES) + gdbscm_print_value (out, val, &opts, 0, args_type, language); + } + } + GDBSCM_END_TRY_CATCH_WITH_DYNWIND (); + + ui_out_text (out, "\n"); +} + +/* Helper function for printing locals. This function largely just + creates the wrapping tuple, and calls enumerate_locals. Returns + EXT_LANG_BT_ERROR on error, or EXT_LANG_BT_OK on success. */ +static void +gdbscm_print_locals (SCM locals, + struct ui_out *out, + enum ext_lang_frame_args args_type, + int indent, + struct frame_info *frame, + enum print_args_field print_args_field, + struct gdbarch *gdbarch) +{ + GDBSCM_BEGIN_TRY_CATCH_WITH_DYNWIND () + { + if (print_args_field == WITHOUT_ARGS_FIELD) + make_cleanup_ui_out_list_begin_end (out, "locals"); + + for (; scm_is_pair (locals); locals = scm_cdr (locals)) + { + SCM local = scm_car (locals); + + gdbscm_print_local (local, out, indent, args_type, frame, + print_args_field, gdbarch); + } + + if (!scm_is_null (locals)) + gdbscm_type_error ("print-locals", GDBSCM_ARG_NONE, + locals, "null-terminated locals list"); + } + GDBSCM_END_TRY_CATCH_WITH_DYNWIND (); +} + +/* Helper function to print an argument. ARG is a pair or a symbol, in + the format expected by extract_sym_and_value, OUT is the output + stream, ARGS_TYPE is an enumerator describing the argument format, + PRINT_ARGS_FIELD is a flag which indicates if we output "ARGS=1" in + MI output in commands where both arguments and locals are printed, + and FRAME is the backing frame. */ + +static void +gdbscm_print_arg (SCM arg, struct ui_out *out, + enum ext_lang_frame_args args_type, + struct frame_info *frame, + enum print_args_field print_args_field, + struct gdbarch *gdbarch) +{ + struct value_print_options opts; + const struct language_defn *language; + const char *sym_name; + struct symbol *sym; + struct value *val; + + get_user_print_options (&opts); + if (args_type == CLI_SCALAR_VALUES) + opts.summary = 1; + opts.deref_ref = 1; + + extract_sym_and_value (arg, &sym_name, &sym, &language, &val, gdbarch); + + if (sym && ui_out_is_mi_like_p (out) + && ! mi_should_print (sym, MI_PRINT_ARGS)) + return; + + annotate_arg_begin (); + + if (val) + { + /* If the decorated frame provides a value, just print that. */ + gdbscm_print_single_arg (out, sym_name, NULL, val, &opts, + args_type, print_args_field, + language); + } + else + { + struct frame_arg arg, entryarg; + + /* Otherwise, the decorated frame did not provide a value, so this + is a frame argument to be read by GDB. In this case we have to + account for entry-values. */ + read_frame_arg (sym, frame, &arg, &entryarg); + make_cleanup (xfree, arg.error); + make_cleanup (xfree, entryarg.error); + + if (arg.entry_kind != print_entry_values_only) + gdbscm_print_single_arg (out, NULL, &arg, NULL, &opts, + args_type, print_args_field, NULL); + + if (entryarg.entry_kind != print_entry_values_no) + { + if (arg.entry_kind != print_entry_values_only) + { + /* Delimit the two arguments that we are printing. */ + ui_out_text (out, ", "); + ui_out_wrap_hint (out, " "); + } + + gdbscm_print_single_arg (out, NULL, &entryarg, NULL, &opts, + args_type, print_args_field, NULL); + } + } + + annotate_arg_end (); +} + +/* Helper function for printing frame arguments. */ + +static void +gdbscm_print_args (SCM args, struct ui_out *out, + enum ext_lang_frame_args args_type, + struct frame_info *frame, + enum print_args_field print_args_field, + struct gdbarch *gdbarch) +{ + GDBSCM_BEGIN_TRY_CATCH_WITH_DYNWIND () + { + int arg_index = 0; + + if (print_args_field == WITHOUT_ARGS_FIELD) + make_cleanup_ui_out_list_begin_end (out, "args"); + + annotate_frame_args (); + if (! ui_out_is_mi_like_p (out)) + ui_out_text (out, " ("); + + for (; scm_is_pair (args); args = scm_cdr (args), arg_index++) + { + SCM arg = scm_car (args); + + if (arg_index > 0) + ui_out_text (out, ", "); + + gdbscm_print_arg (arg, out, args_type, frame, + print_args_field, gdbarch); + } + + if (!scm_is_null (args)) + gdbscm_type_error ("print-args", GDBSCM_ARG_NONE, + args, "null-terminated argument list"); + + if (! ui_out_is_mi_like_p (out)) + ui_out_text (out, ")"); + } + GDBSCM_END_TRY_CATCH_WITH_DYNWIND (); +} + +/* Print a single frame to the designated output stream, detecting + whether the output is MI or console, and formatting the output + according to the conventions of that protocol. ANN is the decorated + frame object, as a vector. FLAGS is an integer describing the + various print options. The FLAGS variables is described in + "apply_frame_filter" function. ARGS_TYPE is an enumerator + describing the argument format. OUT is the output stream to print, + INDENT is the level of indention for this frame, in the case of + child frames. */ + +static void +gdbscm_print_frame (SCM ann, int flags, enum ext_lang_frame_args args_type, + struct ui_out *out, int indent) +{ + struct gdbarch *gdbarch; + struct frame_info *frame; + struct value_print_options opts; + int print_level, print_frame_info, print_args, print_locals; + SCM frame_scm, function_name_scm, address_scm, filename_scm, line_scm; + SCM arguments_scm, locals_scm, children_scm; + + /* Extract print settings from FLAGS. */ + print_level = (flags & PRINT_LEVEL) ? 1 : 0; + print_frame_info = (flags & PRINT_FRAME_INFO) ? 1 : 0; + print_args = (flags & PRINT_ARGS) ? 1 : 0; + print_locals = (flags & PRINT_LOCALS) ? 1 : 0; + + get_user_print_options (&opts); + + frame_scm = scm_c_vector_ref (ann, 0); + function_name_scm = scm_c_vector_ref (ann, 1); + address_scm = scm_c_vector_ref (ann, 2); + filename_scm = scm_c_vector_ref (ann, 3); + line_scm = scm_c_vector_ref (ann, 4); + arguments_scm = scm_c_vector_ref (ann, 5); + locals_scm = scm_c_vector_ref (ann, 6); + children_scm = scm_c_vector_ref (ann, 7); + + { + frame_smob *smob = + frscm_get_frame_smob_arg_unsafe (frame_scm, 0, "print-frame"); + frame = frscm_frame_smob_to_frame (smob); + } + + /* stack-list-variables. */ + if (print_locals && print_args && ! print_frame_info) + { + GDBSCM_BEGIN_TRY_CATCH_WITH_DYNWIND () + { + /* Getting the frame arch needs to happen within a dynwind. */ + gdbarch = get_frame_arch (frame); + + make_cleanup_ui_out_list_begin_end (out, "variables"); + gdbscm_print_args (arguments_scm, out, args_type, frame, + WITH_ARGS_FIELD, gdbarch); + gdbscm_print_locals (locals_scm, out, args_type, indent, frame, + WITH_ARGS_FIELD, gdbarch); + } + GDBSCM_END_TRY_CATCH_WITH_DYNWIND (); + /* FIXME: Print variables for child frames? */ + return; + } + + GDBSCM_BEGIN_TRY_CATCH_WITH_DYNWIND () + { + /* Getting the frame arch needs to happen within a dynwind. */ + gdbarch = get_frame_arch (frame); + + /* -stack-list-locals does not require a wrapping frame + attribute. */ + if (print_frame_info || (print_args && ! print_locals)) + make_cleanup_ui_out_tuple_begin_end (out, "frame"); + + if (print_frame_info && indent > 0) + { + /* Child frames are also printed with this function + (recursively) and are printed with indention. */ + ui_out_spaces (out, indent * 4); + } + + /* Print frame level. MI does not require the level if + locals/variables only are being printed. */ + if ((print_frame_info || print_args) && print_level) + { + CORE_ADDR address = 0; + int level = frame_relative_level (frame); + + if (gdbscm_is_true (address_scm)) + address = gdbscm_scm_to_ulongest (address_scm); + + annotate_frame_begin (print_level ? level : 0, gdbarch, + address); + ui_out_text (out, "#"); + ui_out_field_fmt_int (out, 2, ui_left, "level", level); + } + + if (print_frame_info) + { + /* Print address to the address field. If an address is not + provided, print nothing. */ + if (opts.addressprint && gdbscm_is_true (address_scm)) + { + CORE_ADDR addr = gdbscm_scm_to_ulongest (address_scm); + annotate_frame_address (); + ui_out_field_core_addr (out, "addr", gdbarch, addr); + annotate_frame_address_end (); + ui_out_text (out, " in "); + } + + /* Print frame function name. */ + if (gdbscm_is_false (function_name_scm)) + { + const char *function_name = NULL; + + /* Grovel for a minimal symbol before giving up. */ + if (gdbscm_is_true (address_scm)) + { + CORE_ADDR addr = gdbscm_scm_to_ulongest (address_scm); + struct bound_minimal_symbol msymbol; + + msymbol = lookup_minimal_symbol_by_pc (addr); + if (msymbol.minsym != NULL) + function_name = MSYMBOL_PRINT_NAME (msymbol.minsym); + } + + if (function_name) + { + annotate_frame_function_name (); + ui_out_field_string (out, "func", function_name); + } + else + { + annotate_frame_function_name (); + ui_out_field_skip (out, "func"); + } + } + else if (scm_is_string (function_name_scm)) + { + SCM exception = SCM_BOOL_F; + char *function; + + function = gdbscm_scm_to_host_string (function_name_scm, + NULL, + &exception); + if (!function) + gdbscm_throw (exception); + make_cleanup (xfree, function); + + annotate_frame_function_name (); + ui_out_field_string (out, "func", function); + } + else + { + gdbscm_type_error ("print-frame", GDBSCM_ARG_NONE, + function_name_scm, "string or false"); + } + } + + /* Frame arguments. Check the result, and error if something went + wrong. */ + if (print_args) + gdbscm_print_args (arguments_scm, out, args_type, frame, + WITHOUT_ARGS_FIELD, gdbarch); + + /* File name/source/line number information. */ + if (print_frame_info) + { + char *filename = NULL; + + annotate_frame_source_begin (); + + if (gdbscm_is_true (filename_scm)) + { + SCM exception = SCM_BOOL_F; + + filename = gdbscm_scm_to_host_string (filename_scm, NULL, + &exception); + + if (!filename) + gdbscm_throw (exception); + + make_cleanup (xfree, filename); + + ui_out_wrap_hint (out, " "); + ui_out_text (out, " at "); + annotate_frame_source_file (); + ui_out_field_string (out, "file", filename); + annotate_frame_source_file_end (); + + if (gdbscm_is_true (line_scm)) + { + int line = scm_to_int (line_scm); + ui_out_text (out, ":"); + annotate_frame_source_line (); + ui_out_field_int (out, "line", line); + } + } + } + + /* For MI we need to deal with child frames, so if MI output + detected do not send newline. */ + if (! ui_out_is_mi_like_p (out)) + { + annotate_frame_end (); + ui_out_text (out, "\n"); + } + + if (print_locals) + gdbscm_print_locals (locals_scm, out, args_type, indent, frame, + WITHOUT_ARGS_FIELD, gdbarch); + + /* Finally recursively print child frames, if any. */ + if (! ui_out_is_mi_like_p (out)) + indent++; + + if (!scm_is_null (children_scm)) + { + /* No need for another dynwind; since we're at the end of the + function, the GDBSCM_END_TRY_CATCH_WITH_DYNWIND + below will close the "children" list just fine. */ + make_cleanup_ui_out_list_begin_end (out, "children"); + for (; + scm_is_pair (children_scm); + children_scm = scm_cdr (children_scm)) + { + SCM child = scm_car (children_scm); + + gdbscm_print_frame (child, flags, args_type, out, indent); + } + + if (!scm_is_null (children_scm)) + gdbscm_type_error ("print-frame", GDBSCM_ARG_NONE, + children_scm, "null-terminated child list"); + } + } + GDBSCM_END_TRY_CATCH_WITH_DYNWIND (); +} + +/* Iterate through the frame stream, printing each one. Throws Scheme + exceptions on error. */ + +static void +print_decorated_frame_stream (SCM iter, int flags, + enum ext_lang_frame_args args_type, + struct ui_out *out) +{ + while (1) + { + SCM ann = itscm_safe_call_next_x (iter, gdbscm_memory_error_p); + + if (itscm_is_end_of_iteration (ann)) + break; + + /* Since we handle all exceptions via gdbscm_safe_call, really + we'd like an itcm_call_next_x method that propagates the + exception, but lacking that we manually re-throw as needed. */ + if (gdbscm_is_exception (ann)) + gdbscm_throw (ann); + + gdbscm_print_frame (ann, flags, args_type, out, 0); + } +} + +struct print_args { + SCM iter; + int flags; + enum ext_lang_frame_args args_type; + struct ui_out *out; +}; + +/* Returns normally if successful, or otherwise throws an exception. */ + +static SCM +do_print_decorated_frame_stream (void *data) +{ + struct print_args *args = data; + + print_decorated_frame_stream (args->iter, args->flags, args->args_type, + args->out); + + return SCM_BOOL_T; +} + +/* This is the only publicly exported function in this file. FRAME is + the source frame to start frame-filter invocation. FLAGS is an + integer holding the flags for printing. The following elements of + the FRAME_FILTER_FLAGS enum denotes the make-up of FLAGS: + PRINT_LEVEL is a flag indicating whether to print the frame's + relative level in the output. PRINT_FRAME_INFO is a flag that + indicates whether this function should print the frame information, + PRINT_ARGS is a flag that indicates whether to print frame + arguments, and PRINT_LOCALS, likewise, with frame local variables. + ARGS_TYPE is an enumerator describing the argument format, OUT is + the output stream to print. FRAME_LOW is the beginning of the slice + of frames to print, and FRAME_HIGH is the upper limit of the frames + to count. Returns EXT_LANG_BT_ERROR on error, or + EXT_LANG_BT_COMPLETED on success. */ + +enum ext_lang_bt_status +gdbscm_apply_frame_filter (const struct extension_language_defn *extlang, + struct frame_info *frame, int flags, + enum ext_lang_frame_args args_type, + struct ui_out *out, int frame_low, + int frame_high) +{ + struct inferior *inferior; + SCM result; + + /* Note that it's possible to have loaded the Guile interface, but not yet + loaded (gdb frame-filters), so checking gdb_scheme_initialized is not + sufficient. */ + if (!gdbscm_frame_filters_loaded) + return EXT_LANG_BT_NO_FILTERS; + + inferior = current_inferior (); + result = gdbscm_safe_call_3 (scm_variable_ref (apply_frame_filter), + frscm_scm_from_frame (frame, inferior), + scm_from_int (frame_low), + scm_from_int (frame_high), + gdbscm_memory_error_p); + + if (gdbscm_is_false (result)) + return EXT_LANG_BT_NO_FILTERS; + + if (itscm_is_iterator (result)) + { + struct print_args args = { result, flags, args_type, out }; + + /* Recurse through gdbscm_call_guile so that we can just throw + exceptions on error. */ + result = gdbscm_call_guile (do_print_decorated_frame_stream, &args, + gdbscm_memory_error_p); + } + + if (gdbscm_is_exception (result)) + { + gdbscm_print_gdb_exception (SCM_BOOL_F, result); + return EXT_LANG_BT_ERROR; + } + + return EXT_LANG_BT_COMPLETED; +} + +/* Register gdbscm_load_frame_filters for calling by (gdb frame-filters). */ + +void +gdbscm_initialize_frame_filters (void) +{ + scm_c_register_extension ("gdb", "gdbscm_load_frame_filters", + gdbscm_load_frame_filters, NULL); +} diff --git a/gdb/guile/scm-frame.c b/gdb/guile/scm-frame.c index a30c093..3927714 100644 --- a/gdb/guile/scm-frame.c +++ b/gdb/guile/scm-frame.c @@ -213,7 +213,7 @@ gdbscm_frame_p (SCM scm) /* Create a new object that encapsulates FRAME. Returns a object if there is an error. */ -static SCM +SCM frscm_scm_from_frame (struct frame_info *frame, struct inferior *inferior) { frame_smob *f_smob, f_smob_for_lookup; diff --git a/gdb/guile/scm-utils.c b/gdb/guile/scm-utils.c index 59d8b52..b2ecda6 100644 --- a/gdb/guile/scm-utils.c +++ b/gdb/guile/scm-utils.c @@ -641,3 +641,20 @@ gdbscm_guile_version_is_at_least (int major, int minor, int micro) return 0; return 1; } + +/* Helpers for GDBSCM_BEGIN_TRY_CATCH_WITH_DYNWIND to match the prototype of + Guile unwind handlers. */ + +void +gdbscm_dynwind_restore_cleanups (void *data) +{ + struct cleanup *cleanups = data; + restore_cleanups (cleanups); +} + +void +gdbscm_dynwind_do_cleanups (void *data) +{ + struct cleanup *cleanups = data; + do_cleanups (cleanups); +} diff --git a/gdb/mi/mi-main.c b/gdb/mi/mi-main.c index 7412f7d..540dcbb 100644 --- a/gdb/mi/mi-main.c +++ b/gdb/mi/mi-main.c @@ -1865,6 +1865,9 @@ mi_cmd_list_features (char *command, char **argv, int argc) if (ext_lang_initialized_p (get_ext_lang_defn (EXT_LANG_PYTHON))) ui_out_field_string (uiout, NULL, "python"); + if (ext_lang_initialized_p (get_ext_lang_defn (EXT_LANG_GUILE))) + ui_out_field_string (uiout, NULL, "guile"); + do_cleanups (cleanup); return; } diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index 8f79e21..d63ed79 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,5 +1,18 @@ 2015-03-05 Andy Wingo + * gdb.guile/amd64-scm-frame-filter-invalidarg.S: + * gdb.guile/scm-frame-filter-gdb.scm.in: + * gdb.guile/scm-frame-filter-invalidarg-gdb.scm.in: + * gdb.guile/scm-frame-filter-invalidarg.exp: + * gdb.guile/scm-frame-filter-invalidarg.scm: + * gdb.guile/scm-frame-filter-mi.c: + * gdb.guile/scm-frame-filter-mi.exp: + * gdb.guile/scm-frame-filter.c: + * gdb.guile/scm-frame-filter.exp: + * gdb.guile/scm-frame-filter.scm: New files. + +2015-03-05 Andy Wingo + * gdb.guile/scm-objfile.exp: Add objfile-progspace test. 2015-03-02 Pedro Alves diff --git a/gdb/testsuite/gdb.guile/amd64-scm-frame-filter-invalidarg.S b/gdb/testsuite/gdb.guile/amd64-scm-frame-filter-invalidarg.S new file mode 100644 index 0000000..0901714 --- /dev/null +++ b/gdb/testsuite/gdb.guile/amd64-scm-frame-filter-invalidarg.S @@ -0,0 +1,261 @@ +/* This testcase is part of GDB, the GNU debugger. + + Copyright 2014-2015 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 compiled from a single line + int main (int argc, char **argv) { return 0; } + using -g -dA -S -O2 and patched as #if-ed below. */ + + .file "scm-frame-filter-invalidarg.c" + .text +.Ltext0: + .globl main + .type main, @function +main: +.LFB0: + .file 1 "scm-frame-filter-invalidarg.c" + # scm-frame-filter-invalidarg.c:1 + .loc 1 1 0 + .cfi_startproc +# BLOCK 2 seq:0 +# PRED: ENTRY (FALLTHRU) + pushq %rbp + .cfi_def_cfa_offset 16 + .cfi_offset 6, -16 + movq %rsp, %rbp + .cfi_def_cfa_register 6 + movl %edi, -4(%rbp) + movq %rsi, -16(%rbp) + # scm-frame-filter-invalidarg.c:2 + .loc 1 2 0 + movl $0, %eax + # scm-frame-filter-invalidarg.c:3 + .loc 1 3 0 + popq %rbp + .cfi_def_cfa 7, 8 +# SUCC: EXIT [100.0%] + ret + .cfi_endproc +.LFE0: + .size main, .-main +.Letext0: + .section .debug_info,"",@progbits +.Ldebug_info0: + .long .Le - .Ls # Length of Compilation Unit Info +.Ls: + .value 0x4 # DWARF version number + .long .Ldebug_abbrev0 # Offset Into Abbrev. Section + .byte 0x8 # Pointer Size (in bytes) + .uleb128 0x1 # (DIE (0xb) DW_TAG_compile_unit) + .long .LASF3 # DW_AT_producer: "GNU C 4.9.1 20140813 (Red Hat 4.9.1-7) -mtune=generic -march=x86-64 -g" + .byte 0x1 # DW_AT_language + .long .LASF4 # DW_AT_name: "scm-frame-filter-invalidarg.c" + .long .LASF5 # DW_AT_comp_dir: "" + .quad .Ltext0 # DW_AT_low_pc + .quad .Letext0-.Ltext0 # DW_AT_high_pc + .long .Ldebug_line0 # DW_AT_stmt_list +die2d: + .uleb128 0x2 # (DIE (0x2d) DW_TAG_subprogram) + # DW_AT_external + .long .LASF6 # DW_AT_name: "main" + .byte 0x1 # DW_AT_decl_file (scm-frame-filter-invalidarg.c) + .byte 0x1 # DW_AT_decl_line + # DW_AT_prototyped + .long die6b-.Ldebug_info0 # DW_AT_type + .quad .LFB0 # DW_AT_low_pc + .quad .LFE0-.LFB0 # DW_AT_high_pc + .uleb128 0x1 # DW_AT_frame_base + .byte 0x9c # DW_OP_call_frame_cfa + # DW_AT_GNU_all_call_sites +die4e: + .uleb128 0x3 # (DIE (0x4e) DW_TAG_formal_parameter) + .long .LASF0 # DW_AT_name: "argc" + .byte 0x1 # DW_AT_decl_file (scm-frame-filter-invalidarg.c) + .byte 0x1 # DW_AT_decl_line + .long die6b-.Ldebug_info0 # DW_AT_type +#if 0 + .uleb128 0x2 # DW_AT_location + .byte 0x91 # DW_OP_fbreg + .sleb128 -20 +#endif +#if 0 + .uleb128 1f - 2f # DW_AT_location +2: + .byte 0x03 # DW_OP_addr + .quad 0 +1: +#endif +#if 1 + .uleb128 1f - 2f # DW_AT_location +2: + .byte 0x13 # DW_OP_drop + .quad 0 +1: +#endif +die5c: + .uleb128 0x3 # (DIE (0x5c) DW_TAG_formal_parameter) + .long .LASF1 # DW_AT_name: "argv" + .byte 0x1 # DW_AT_decl_file (scm-frame-filter-invalidarg.c) + .byte 0x1 # DW_AT_decl_line + .long die72-.Ldebug_info0 # DW_AT_type + .uleb128 0x2 # DW_AT_location + .byte 0x91 # DW_OP_fbreg + .sleb128 -32 + .byte 0 # end of children of DIE 0x2d +die6b: + .uleb128 0x4 # (DIE (0x6b) DW_TAG_base_type) + .byte 0x4 # DW_AT_byte_size + .byte 0x5 # DW_AT_encoding + .ascii "int\0" # DW_AT_name +die72: + .uleb128 0x5 # (DIE (0x72) DW_TAG_pointer_type) + .byte 0x8 # DW_AT_byte_size + .long die78-.Ldebug_info0 # DW_AT_type +die78: + .uleb128 0x5 # (DIE (0x78) DW_TAG_pointer_type) + .byte 0x8 # DW_AT_byte_size + .long die7e-.Ldebug_info0 # DW_AT_type +die7e: + .uleb128 0x6 # (DIE (0x7e) DW_TAG_base_type) + .byte 0x1 # DW_AT_byte_size + .byte 0x6 # DW_AT_encoding + .long .LASF2 # DW_AT_name: "char" + .byte 0 # end of children of DIE 0xb +.Le: + .section .debug_abbrev,"",@progbits +.Ldebug_abbrev0: + .uleb128 0x1 # (abbrev code) + .uleb128 0x11 # (TAG: DW_TAG_compile_unit) + .byte 0x1 # DW_children_yes + .uleb128 0x25 # (DW_AT_producer) + .uleb128 0xe # (DW_FORM_strp) + .uleb128 0x13 # (DW_AT_language) + .uleb128 0xb # (DW_FORM_data1) + .uleb128 0x3 # (DW_AT_name) + .uleb128 0xe # (DW_FORM_strp) + .uleb128 0x1b # (DW_AT_comp_dir) + .uleb128 0xe # (DW_FORM_strp) + .uleb128 0x11 # (DW_AT_low_pc) + .uleb128 0x1 # (DW_FORM_addr) + .uleb128 0x12 # (DW_AT_high_pc) + .uleb128 0x7 # (DW_FORM_data8) + .uleb128 0x10 # (DW_AT_stmt_list) + .uleb128 0x17 # (DW_FORM_sec_offset) + .byte 0 + .byte 0 + .uleb128 0x2 # (abbrev code) + .uleb128 0x2e # (TAG: DW_TAG_subprogram) + .byte 0x1 # DW_children_yes + .uleb128 0x3f # (DW_AT_external) + .uleb128 0x19 # (DW_FORM_flag_present) + .uleb128 0x3 # (DW_AT_name) + .uleb128 0xe # (DW_FORM_strp) + .uleb128 0x3a # (DW_AT_decl_file) + .uleb128 0xb # (DW_FORM_data1) + .uleb128 0x3b # (DW_AT_decl_line) + .uleb128 0xb # (DW_FORM_data1) + .uleb128 0x27 # (DW_AT_prototyped) + .uleb128 0x19 # (DW_FORM_flag_present) + .uleb128 0x49 # (DW_AT_type) + .uleb128 0x13 # (DW_FORM_ref4) + .uleb128 0x11 # (DW_AT_low_pc) + .uleb128 0x1 # (DW_FORM_addr) + .uleb128 0x12 # (DW_AT_high_pc) + .uleb128 0x7 # (DW_FORM_data8) + .uleb128 0x40 # (DW_AT_frame_base) + .uleb128 0x18 # (DW_FORM_exprloc) + .uleb128 0x2117 # (DW_AT_GNU_all_call_sites) + .uleb128 0x19 # (DW_FORM_flag_present) + .byte 0 + .byte 0 + .uleb128 0x3 # (abbrev code) + .uleb128 0x5 # (TAG: DW_TAG_formal_parameter) + .byte 0 # DW_children_no + .uleb128 0x3 # (DW_AT_name) + .uleb128 0xe # (DW_FORM_strp) + .uleb128 0x3a # (DW_AT_decl_file) + .uleb128 0xb # (DW_FORM_data1) + .uleb128 0x3b # (DW_AT_decl_line) + .uleb128 0xb # (DW_FORM_data1) + .uleb128 0x49 # (DW_AT_type) + .uleb128 0x13 # (DW_FORM_ref4) + .uleb128 0x2 # (DW_AT_location) + .uleb128 0x18 # (DW_FORM_exprloc) + .byte 0 + .byte 0 + .uleb128 0x4 # (abbrev code) + .uleb128 0x24 # (TAG: DW_TAG_base_type) + .byte 0 # DW_children_no + .uleb128 0xb # (DW_AT_byte_size) + .uleb128 0xb # (DW_FORM_data1) + .uleb128 0x3e # (DW_AT_encoding) + .uleb128 0xb # (DW_FORM_data1) + .uleb128 0x3 # (DW_AT_name) + .uleb128 0x8 # (DW_FORM_string) + .byte 0 + .byte 0 + .uleb128 0x5 # (abbrev code) + .uleb128 0xf # (TAG: DW_TAG_pointer_type) + .byte 0 # DW_children_no + .uleb128 0xb # (DW_AT_byte_size) + .uleb128 0xb # (DW_FORM_data1) + .uleb128 0x49 # (DW_AT_type) + .uleb128 0x13 # (DW_FORM_ref4) + .byte 0 + .byte 0 + .uleb128 0x6 # (abbrev code) + .uleb128 0x24 # (TAG: DW_TAG_base_type) + .byte 0 # DW_children_no + .uleb128 0xb # (DW_AT_byte_size) + .uleb128 0xb # (DW_FORM_data1) + .uleb128 0x3e # (DW_AT_encoding) + .uleb128 0xb # (DW_FORM_data1) + .uleb128 0x3 # (DW_AT_name) + .uleb128 0xe # (DW_FORM_strp) + .byte 0 + .byte 0 + .byte 0 + .section .debug_aranges,"",@progbits + .long 0x2c # Length of Address Ranges Info + .value 0x2 # DWARF Version + .long .Ldebug_info0 # Offset of Compilation Unit Info + .byte 0x8 # Size of Address + .byte 0 # Size of Segment Descriptor + .value 0 # Pad to 16 byte boundary + .value 0 + .quad .Ltext0 # Address + .quad .Letext0-.Ltext0 # Length + .quad 0 + .quad 0 + .section .debug_line,"",@progbits +.Ldebug_line0: + .section .debug_str,"MS",@progbits,1 +.LASF1: + .string "argv" +.LASF4: + .string "scm-frame-filter-invalidarg.c" +.LASF5: + .string "" +.LASF0: + .string "argc" +.LASF3: + .string "GNU C 4.9.1 20140813 (Red Hat 4.9.1-7) -mtune=generic -march=x86-64 -g" +.LASF6: + .string "main" +.LASF2: + .string "char" + .ident "GCC: (GNU) 4.9.1 20140813 (Red Hat 4.9.1-7)" + .section .note.GNU-stack,"",@progbits diff --git a/gdb/testsuite/gdb.guile/scm-frame-filter-gdb.scm.in b/gdb/testsuite/gdb.guile/scm-frame-filter-gdb.scm.in new file mode 100644 index 0000000..e114fb8 --- /dev/null +++ b/gdb/testsuite/gdb.guile/scm-frame-filter-gdb.scm.in @@ -0,0 +1,39 @@ +;; Copyright (C) 2015 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 test-suite. It tests Guile-based frame +;; filters. + +(use-modules (gdb) (gdb frame-filters)) + +(define (filter-one stream) + stream) + +(define (filter-two stream) + stream) + +(add-frame-filter! + (make-frame-filter "filter-one-progspace" filter-one #:priority 10 + #:progspace (current-progspace))) +(add-frame-filter! + (make-frame-filter "filter-one-objfile" filter-one #:priority 13 + #:objfile (current-objfile))) + +(add-frame-filter! + (make-frame-filter "filter-two-progspace" filter-two #:priority 11 + #:progspace (current-progspace))) +(add-frame-filter! + (make-frame-filter "filter-two-objfile" filter-two #:priority 12 + #:objfile (current-objfile))) diff --git a/gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg-gdb.scm.in b/gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg-gdb.scm.in new file mode 100644 index 0000000..171df84 --- /dev/null +++ b/gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg-gdb.scm.in @@ -0,0 +1,39 @@ +;; Copyright (C) 2015 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 test-suite. It tests Guile-based frame +;; filters. + +(use-modules (gdb) (gdb frame-filters)) + +(define (filter-one stream) + stream) + +(define (filter-two stream) + stream) + +(add-frame-filter! + (make-frame-filter "filter-one-progspace" filter-one #:priority 1 + #:progspace (current-progspace))) +(add-frame-filter! + (make-frame-filter "filter-one-objfile" filter-one #:priority 1 + #:objfile (current-objfile))) + +(add-frame-filter! + (make-frame-filter "filter-two-progspace" filter-two #:priority 100 + #:progspace (current-progspace))) +(add-frame-filter! + (make-frame-filter "filter-two-objfile" filter-two #:priority 100 + #:objfile (current-objfile))) diff --git a/gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg.exp b/gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg.exp new file mode 100644 index 0000000..6eaf2ae --- /dev/null +++ b/gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg.exp @@ -0,0 +1,66 @@ +# Copyright (C) 2014-2015 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 . + +load_lib gdb-guile.exp + +standard_testfile amd64-scm-frame-filter-invalidarg.S + +if { ![istarget x86_64-*-* ] || ![is_lp64_target] } { + verbose "Skipping scm-frame-filter-invalidarg." + return +} + +# We cannot use prepare_for_testing as we have to set the safe-patch +# to check objfile and progspace printers. +if {[build_executable $testfile.exp $testfile $srcfile {}] == -1} { + return -1 +} + +# Start with a fresh gdb. +gdb_exit +gdb_start + +# Skip all tests if Guile scripting is not enabled. +if { [skip_guile_tests] } { continue } + +# Make the -gdb.scm script available to gdb, it is automagically loaded +# by gdb. Care is taken to put it in the same directory as the binary +# so that gdb will find it. +set remote_obj_guile_file \ + [remote_download \ + host ${srcdir}/${subdir}/${testfile}-gdb.scm.in \ + [standard_output_file ${testfile}-gdb.scm]] + +gdb_reinitialize_dir $srcdir/$subdir +gdb_test_no_output "set auto-load safe-path ${remote_obj_guile_file}" \ + "set auto-load safe-path" +gdb_load ${binfile} +# Verify gdb loaded the script. +gdb_test "info auto-load guile-scripts" "Yes.*/${testfile}-gdb.scm.*" \ + "Test auto-load had loaded guile scripts" + +if ![runto_main] then { + perror "couldn't run to breakpoint" + return +} +gdb_test_no_output "set guile print-stack full" \ + "Set guile print-stack to full" + +# Load global frame-filters +set remote_guile_file [gdb_remote_download host \ + ${srcdir}/${subdir}/${testfile}.scm] +gdb_scm_load_file ${remote_guile_file} + +gdb_test "bt" " in niam \\(argc=, argv=0x\[0-9a-f\]+\\) at scm-frame-filter-invalidarg.c:\[0-9\]+" "bt full with filters" diff --git a/gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg.scm b/gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg.scm new file mode 100644 index 0000000..cf241b7 --- /dev/null +++ b/gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg.scm @@ -0,0 +1,36 @@ +;; Copyright (C) 2015 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 test-suite. It tests Guile-based frame +;; filters. + +(use-modules (gdb) (gdb frame-filters)) + +(define (reverse-decorator dec) + (let ((name (decorated-frame-function-name dec))) + (redecorate-frame + dec + #:function-name + (cond + ((not name) #f) + ((equal? name "end_func") + (string-append (string-reverse name) + (let ((frame (decorated-frame-frame dec))) + (value->string (frame-read-var frame "str"))))) + (else + (string-reverse name)))))) + +(add-frame-filter! + (make-decorating-frame-filter "Reverse" reverse-decorator #:priority 100)) diff --git a/gdb/testsuite/gdb.guile/scm-frame-filter-mi.c b/gdb/testsuite/gdb.guile/scm-frame-filter-mi.c new file mode 100644 index 0000000..308a56a --- /dev/null +++ b/gdb/testsuite/gdb.guile/scm-frame-filter-mi.c @@ -0,0 +1,140 @@ +/* This testcase is part of GDB, the GNU debugger. + + Copyright 2013-2015 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 . */ + +#include + +void funca(void); +int count = 0; + +typedef struct +{ + char *nothing; + int f; + short s; +} foobar; + +void end_func (int foo, char *bar, foobar *fb, foobar bf) +{ + const char *str = "The End"; + const char *st2 = "Is Near"; + int b = 12; + short c = 5; + { + int d = 15; + int e = 14; + const char *foo = "Inside block"; + { + int f = 42; + int g = 19; + const char *bar = "Inside block x2"; + { + short h = 9; + h = h +1; /* Inner test breakpoint */ + } + } + } + + return; /* Backtrace end breakpoint */ +} + +void funcb(int j) +{ + struct foo + { + int a; + int b; + }; + + struct foo bar; + + bar.a = 42; + bar.b = 84; + + funca(); + return; +} + +void funca(void) +{ + foobar fb; + foobar *bf; + + if (count < 10) + { + count++; + funcb(count); + } + + fb.nothing = "Foo Bar"; + fb.f = 42; + fb.s = 19; + + bf = malloc (sizeof (foobar)); + bf->nothing = malloc (128); + bf->nothing = "Bar Foo"; + bf->f = 24; + bf->s = 91; + + end_func(21, "Param", bf, fb); + free (bf->nothing); + free (bf); + return; +} + + +void func1(void) +{ + funca(); + return; +} + +int func2(void) +{ + func1(); + return 1; +} + +void func3(int i) +{ + func2(); + + return; +} + +int func4(int j) +{ + func3(j); + + return 2; +} + +int func5(int f, int d) +{ + int i = 0; + char *random = "random"; + i=i+f; + + func4(i); + return i; +} + +int +main() +{ + func5(3,5); + return 0; +} diff --git a/gdb/testsuite/gdb.guile/scm-frame-filter-mi.exp b/gdb/testsuite/gdb.guile/scm-frame-filter-mi.exp new file mode 100644 index 0000000..5032025 --- /dev/null +++ b/gdb/testsuite/gdb.guile/scm-frame-filter-mi.exp @@ -0,0 +1,179 @@ +# Copyright (C) 2013-2015 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 Guile-based +# frame-filters. +load_lib mi-support.exp +load_lib gdb-guile.exp + +set MIFLAGS "-i=mi2" + +gdb_exit +if [mi_gdb_start] { + continue +} + +standard_testfile scm-frame-filter-mi.c +set scmfile scm-frame-filter.scm + +if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug additional_flags=-DMI}] != "" } { + untested ${testfile}.exp + return -1 +} + +mi_delete_breakpoints +mi_gdb_reinitialize_dir $srcdir/$subdir +mi_gdb_load ${binfile} + +if {[lsearch -exact [mi_get_features] guile] < 0} { + unsupported "guile support is disabled" + return -1 +} + +mi_runto main + +set remote_guile_file [gdb_remote_download host ${srcdir}/${subdir}/${scmfile}] + +mi_gdb_test "guile (load \"${remote_guile_file}\")" ".*\\^done." \ + "Load guile file" + +# Multiple blocks test +mi_continue_to_line [gdb_get_line_number {Inner test breakpoint} ${srcfile}] \ + "step to breakpoint" + +mi_gdb_test "-stack-list-locals --all-values" \ + "\\^done,locals=\\\[{name=\"h\",value=\"9\"},{name=\"f\",value=\"42\"},{name=\"g\",value=\"19\"},{name=\"bar\",value=\"$hex \\\\\"Inside block x2\\\\\"\"},{name=\"d\",value=\"15\"},{name=\"e\",value=\"14\"},{name=\"foo\",value=\"$hex \\\\\"Inside block\\\\\"\"},{name=\"str\",value=\"$hex \\\\\"The End\\\\\"\"},{name=\"st2\",value=\"$hex \\\\\"Is Near\\\\\"\"},{name=\"b\",value=\"12\"},{name=\"c\",value=\"5\"}\\\]" \ + "stack-list-locals --all-values" + +mi_gdb_test "-enable-frame-filters" ".*\\^done." "enable frame filters" +mi_gdb_test "-stack-list-locals --all-values" \ + "\\^done,locals=\\\[{name=\"h\",value=\"9\"},{name=\"f\",value=\"42\"},{name=\"g\",value=\"19\"},{name=\"bar\",value=\"$hex \\\\\"Inside block x2\\\\\"\"},{name=\"d\",value=\"15\"},{name=\"e\",value=\"14\"},{name=\"foo\",value=\"$hex \\\\\"Inside block\\\\\"\"},{name=\"str\",value=\"$hex \\\\\"The End\\\\\"\"},{name=\"st2\",value=\"$hex \\\\\"Is Near\\\\\"\"},{name=\"b\",value=\"12\"},{name=\"c\",value=\"5\"}\\\]" \ + "stack-list-locals --all-values frame filters enabled" + +mi_continue_to_line [gdb_get_line_number {Backtrace end breakpoint} ${srcfile}] \ + "step to breakpoint" + +mi_gdb_test "-stack-list-frames" \ + "\\^done,stack=\\\[frame={level=\"0\",addr=\"$hex\",func=\"cnuf_dne.*\".*},frame={level=\"1\",addr=\"$hex\",func=\"acnuf\".*},frame={level=\"2\",addr=\"$hex\",func=\"bcnuf\".*},frame={level=\"3\",addr=\"$hex\",func=\"acnuf\".*},frame={level=\"22\",addr=\"$hex\",func=\"1cnuf\".*,children=\\\[frame={level=\"23\",addr=\"$hex\",func=\"func2\".*}\\\]},frame={level=\"24\",addr=\"$hex\",func=\"3cnuf\".*},frame={level=\"27\",addr=\"$hex\",func=\"niam\".*}\\\].*" \ + "filtered stack listing" +mi_gdb_test "-stack-list-frames 0 3" \ + "\\^done,stack=\\\[frame={level=\"0\",addr=\"$hex\",func=\"cnuf_dne.*\".*},frame={level=\"1\",addr=\"$hex\",func=\"acnuf\".*},frame={level=\"2\",addr=\"$hex\",func=\"bcnuf\".*},frame={level=\"3\",addr=\"$hex\",func=\"acnuf\".*}\\\]" \ + "filtered stack list 0 3" +mi_gdb_test "-stack-list-frames 22 24" \ + "\\^done,stack=\\\[frame={level=\"22\",addr=\"$hex\",func=\"1cnuf\".*,children=\\\[frame={level=\"23\",addr=\"$hex\",func=\"func2\".*}\\\]},frame={level=\"24\",addr=\"$hex\",func=\"3cnuf\".*}\\\]" \ + "filtered stack list 22 24" + +#stack list arguments + + +mi_gdb_test "-stack-list-arguments 0" \ + "\\^done,stack-args=\\\[frame={level=\"0\",args=\\\[name=\"foo\",name=\"bar\",name=\"fb\",name=\"bf\"\\\]},frame={level=\"1\",args=\\\[\\\]},frame={level=\"2\",args=\\\[name=\"j\"\\\]},.*frame={level=\"22\",args=\\\[\\\],children=\\\[frame={level=\"23\",args=\\\[\\\]}\\\]},.*frame={level=\"26\",args=\\\[name=\"f\",name=\"d\"\\\]},frame={level=\"27\",args=\\\[\\\]}\\\]" \ + "stack-list-arguments 0" + +mi_gdb_test "-stack-list-arguments --no-frame-filters 0" \ + "\\^done,stack-args=\\\[frame={level=\"0\",args=\\\[name=\"foo\",name=\"bar\",name=\"fb\",name=\"bf\"\\\]},frame={level=\"1\",args=\\\[\\\]},frame={level=\"2\",args=\\\[name=\"j\"\\\]},.*frame={level=\"22\",args=\\\[\\\]},frame={level=\"23\",args=\\\[\\\]},.*frame={level=\"26\",args=\\\[name=\"f\",name=\"d\"\\\]},frame={level=\"27\",args=\\\[\\\]}\\\]" \ + "stack-list-arguments --no-frame-filters 0" + +mi_gdb_test "-stack-list-arguments 0 0 3" \ + "\\^done,stack-args=\\\[frame={level=\"0\",args=\\\[name=\"foo\",name=\"bar\",name=\"fb\",name=\"bf\"\\\]},frame={level=\"1\",args=\\\[\\\]},frame={level=\"2\",args=\\\[name=\"j\"\\\]},frame={level=\"3\",args=\\\[\\\]}\\\]" \ + "stack-list-arguments 0 0 3" + +mi_gdb_test "-stack-list-arguments 0 22 27" \ + "\\^done,stack-args=\\\[frame={level=\"22\",args=\\\[\\\],children=\\\[frame={level=\"23\",args=\\\[\\\]}\\\]},.*frame={level=\"26\",args=\\\[name=\"f\",name=\"d\"\\\]},frame={level=\"27\",args=\\\[\\\]}\\\]" \ + "stack-list-arguments 0 22 27" + +mi_gdb_test "-stack-list-arguments 1" \ + "\\^done,stack-args=\\\[frame={level=\"0\",args=\\\[{name=\"foo\",value=\"21\"},{name=\"bar\",value=\"$hex \\\\\"Param\\\\\"\"},{name=\"fb\",value=\"$hex\"},{name=\"bf\",value=\"{nothing = $hex \\\\\"Foo Bar\\\\\", f = 42, s = 19}\"}\\\]},frame={level=\"1\",args=\\\[\\\]},frame={level=\"2\",args=\\\[{name=\"j\",value=\"10\"}\\\]},.*frame={level=\"22\",args=\\\[\\\],children=\\\[frame={level=\"23\",args=\\\[\\\]}\\\]},.*frame={level=\"26\",args=\\\[{name=\"f\",value=\"3\"},{name=\"d\",value=\"5\"}\\\]},frame={level=\"27\",args=\\\[\\\]}\\\]" \ + "stack-list-arguments 1" + +mi_gdb_test "-stack-list-arguments --no-frame-filters 1" \ + "\\^done,stack-args=\\\[frame={level=\"0\",args=\\\[{name=\"foo\",value=\"21\"},{name=\"bar\",value=\"$hex \\\\\"Param\\\\\"\"},{name=\"fb\",value=\"$hex\"},{name=\"bf\",value=\"{nothing = $hex \\\\\"Foo Bar\\\\\", f = 42, s = 19}\"}\\\]},frame={level=\"1\",args=\\\[\\\]},frame={level=\"2\",args=\\\[{name=\"j\",value=\"10\"}\\\]},.*frame={level=\"22\",args=\\\[\\\]},frame={level=\"23\",args=\\\[\\\]},.*frame={level=\"26\",args=\\\[{name=\"f\",value=\"3\"},{name=\"d\",value=\"5\"}\\\]},frame={level=\"27\",args=\\\[\\\]}\\\]" \ + "stack-list-arguments --no-frame-filters 1" + + +mi_gdb_test "-stack-list-arguments 1 0 3" \ + "\\^done,stack-args=\\\[frame={level=\"0\",args=\\\[{name=\"foo\",value=\"21\"},{name=\"bar\",value=\"$hex \\\\\"Param\\\\\"\"},{name=\"fb\",value=\"$hex\"},{name=\"bf\",value=\"{nothing = $hex \\\\\"Foo Bar\\\\\", f = 42, s = 19}\"}\\\]},frame={level=\"1\",args=\\\[\\\]},frame={level=\"2\",args=\\\[{name=\"j\",value=\"10\"}\\\]},frame={level=\"3\",args=\\\[\\\]}\\\]" \ + "stack-list-arguments 1 0 3" + +mi_gdb_test "-stack-list-arguments 1 22 27" \ + "\\^done,stack-args=\\\[frame={level=\"22\",args=\\\[\\\],children=\\\[frame={level=\"23\",args=\\\[\\\]}\\\]},.*frame={level=\"26\",args=\\\[{name=\"f\",value=\"3\"},{name=\"d\",value=\"5\"}\\\]},frame={level=\"27\",args=\\\[\\\]}\\\]" \ + "stack-list-arguments 1 22 27" + +mi_gdb_test "-stack-list-arguments 2" \ + "\\^done,stack-args=\\\[frame={level=\"0\",args=\\\[{name=\"foo\",type=\"int\",value=\"21\"},{name=\"bar\",type=\"char \\\*\",value=\"$hex \\\\\"Param\\\\\"\"},{name=\"fb\",type=\"foobar \\\*\",value=\"$hex\"},{name=\"bf\",type=\"foobar\"\}\\\]},frame={level=\"1\",args=\\\[\\\]},frame={level=\"2\",args=\\\[{name=\"j\",type=\"int\",value=\"10\"}\\\]},.*frame={level=\"22\",args=\\\[\\\],children=\\\[frame={level=\"23\",args=\\\[\\\]}\\\]},.*frame={level=\"26\",args=\\\[{name=\"f\",type=\"int\",value=\"3\"},{name=\"d\",type=\"int\",value=\"5\"}\\\]},frame={level=\"27\",args=\\\[\\\]}\\\]" \ + "stack-list-arguments 2" + +mi_gdb_test "-stack-list-arguments --no-frame-filters 2" \ + "\\^done,stack-args=\\\[frame={level=\"0\",args=\\\[{name=\"foo\",type=\"int\",value=\"21\"},{name=\"bar\",type=\"char \\\*\",value=\"$hex \\\\\"Param\\\\\"\"},{name=\"fb\",type=\"foobar \\\*\",value=\"$hex\"},{name=\"bf\",type=\"foobar\"}\\\]},frame={level=\"1\",args=\\\[\\\]},frame={level=\"2\",args=\\\[{name=\"j\",type=\"int\",value=\"10\"}\\\]},.*frame={level=\"22\",args=\\\[\\\]},.*frame={level=\"26\",args=\\\[{name=\"f\",type=\"int\",value=\"3\"},{name=\"d\",type=\"int\",value=\"5\"}\\\]},frame={level=\"27\",args=\\\[\\\]}\\\]" \ + "stack-list-arguments --no-frame-filters 2" + + +mi_gdb_test "-stack-list-arguments 2 0 3" \ + "\\^done,stack-args=\\\[frame={level=\"0\",args=\\\[{name=\"foo\",type=\"int\",value=\"21\"},{name=\"bar\",type=\"char \\\*\",value=\"$hex \\\\\"Param\\\\\"\"},{name=\"fb\",type=\"foobar \\\*\",value=\"$hex\"},{name=\"bf\",type=\"foobar\"}\\\]},frame={level=\"1\",args=\\\[\\\]},frame={level=\"2\",args=\\\[{name=\"j\",type=\"int\",value=\"10\"}\\\]},frame={level=\"3\",args=\\\[\\\]}\\\]" \ + "stack-list-arguments 2 0 3" + +mi_gdb_test "-stack-list-arguments 2 22 27" \ + "\\^done,stack-args=\\\[frame={level=\"22\",args=\\\[\\\],children=\\\[frame={level=\"23\",args=\\\[\\\]}\\\]},.*frame={level=\"26\",args=\\\[{name=\"f\",type=\"int\",value=\"3\"},{name=\"d\",type=\"int\",value=\"5\"}\\\]},frame={level=\"27\",args=\\\[\\\]}\\\]" \ + "stack-list-arguments 2 22 27" + +mi_gdb_test "-stack-list-arguments --no-frame-filters 2 22 27" \ + "\\^done,stack-args=\\\[frame={level=\"22\",args=\\\[\\\]},frame={level=\"23\",args=\\\[\\\]},.*frame={level=\"26\",args=\\\[{name=\"f\",type=\"int\",value=\"3\"},{name=\"d\",type=\"int\",value=\"5\"}\\\]},frame={level=\"27\",args=\\\[\\\]}\\\]" \ + "stack-list-arguments --no-frame-filters 2 22 27" + +#stack-list-locals +mi_gdb_test "-stack-list-locals --no-frame-filters 0" \ + "\\^done,locals=\\\[name=\"str\",name=\"st2\",name=\"b\",name=\"c\"\\\]" \ + "stack-list-locals --no-frame-filters 0" + +mi_gdb_test "-stack-list-locals --no-frame-filters 1" \ + "\\^done,locals=\\\[{name=\"str\",value=\"$hex \\\\\"The End\\\\\"\"},{name=\"st2\",value=\"$hex \\\\\"Is Near\\\\\"\"},{name=\"b\",value=\"12\"},{name=\"c\",value=\"5\"}\\\]" \ + "stack-list-locals --no-frame-filters 1" + +mi_gdb_test "-stack-list-locals --no-frame-filters 2" \ + "\\^done,locals=\\\[{name=\"str\",type=\"const char \\\*\",value=\"$hex \\\\\"The End\\\\\"\"},{name=\"st2\",type=\"const char \\\*\",value=\"$hex \\\\\"Is Near\\\\\"\"},{name=\"b\",type=\"int\",value=\"12\"},{name=\"c\",type=\"short\",value=\"5\"}\\\]" \ + "stack-list-locals --no-frame-filters 2" + +mi_gdb_test "-stack-list-locals --no-frame-filters --no-values" \ + "\\^done,locals=\\\[name=\"str\",name=\"st2\",name=\"b\",name=\"c\"\\\]" \ + "stack-list-locals --no-frame-filters --no-values" + +mi_gdb_test "-stack-list-locals --no-frame-filters --all-values" \ + "\\^done,locals=\\\[{name=\"str\",value=\"$hex \\\\\"The End\\\\\"\"},{name=\"st2\",value=\"$hex \\\\\"Is Near\\\\\"\"},{name=\"b\",value=\"12\"},{name=\"c\",value=\"5\"}\\\]" \ + "stack-list-locals --no-frame-filters --all-values" + +mi_gdb_test "-stack-list-locals --no-frame-filters --simple-values" \ + "\\^done,locals=\\\[{name=\"str\",type=\"const char \\\*\",value=\"$hex \\\\\"The End\\\\\"\"},{name=\"st2\",type=\"const char \\\*\",value=\"$hex \\\\\"Is Near\\\\\"\"},{name=\"b\",type=\"int\",value=\"12\"},{name=\"c\",type=\"short\",value=\"5\"}\\\]" \ + "stack-list-locals --no-frame-filters --simple-values" + +mi_gdb_test "-stack-list-locals 0" \ + "\\^done,locals=\\\[name=\"str\",name=\"st2\",name=\"b\",name=\"c\"\\\]" \ + "stack-list-locals 0" + +mi_gdb_test "-stack-list-locals 1" \ + "\\^done,locals=\\\[{name=\"str\",value=\"$hex \\\\\"The End\\\\\"\"},{name=\"st2\",value=\"$hex \\\\\"Is Near\\\\\"\"},{name=\"b\",value=\"12\"},{name=\"c\",value=\"5\"}\\\]" \ + "stack-list-locals 1" + +mi_gdb_test "-stack-list-locals 2" \ + "\\^done,locals=\\\[{name=\"str\",type=\"const char \\\*\",value=\"$hex \\\\\"The End\\\\\"\"},{name=\"st2\",type=\"const char \\\*\",value=\"$hex \\\\\"Is Near\\\\\"\"},{name=\"b\",type=\"int\",value=\"12\"},{name=\"c\",type=\"short\",value=\"5\"}\\\]" \ + "stack-list-locals 2" + +# stack-list-variables +mi_gdb_test "-stack-list-variables --no-frame-filters 0" \ + "\\^done,variables=\\\[{name=\"foo\",arg=\"1\"},{name=\"bar\",arg=\"1\"},{name=\"fb\",arg=\"1\"},{name=\"bf\",arg=\"1\"},{name=\"str\"},{name=\"st2\"},{name=\"b\"},{name=\"c\"}\\\]" \ + "stack-list-variables --no-frame-filters 0" + +mi_gdb_test "-stack-list-variables 0" \ + "\\^done,variables=\\\[{name=\"foo\",arg=\"1\"},{name=\"bar\",arg=\"1\"},{name=\"fb\",arg=\"1\"},{name=\"bf\",arg=\"1\"},{name=\"str\"},{name=\"st2\"},{name=\"b\"},{name=\"c\"}\\\]" \ + "stack-list-variables 0" diff --git a/gdb/testsuite/gdb.guile/scm-frame-filter.c b/gdb/testsuite/gdb.guile/scm-frame-filter.c new file mode 100644 index 0000000..db3b360 --- /dev/null +++ b/gdb/testsuite/gdb.guile/scm-frame-filter.c @@ -0,0 +1,157 @@ +/* This testcase is part of GDB, the GNU debugger. + + Copyright 2013-2015 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 . */ + +#include + +void funca(void); +int count = 0; + +typedef struct +{ + char *nothing; + int f; + short s; +} foobar; + +void end_func (int foo, char *bar, foobar *fb, foobar bf) +{ + const char *str = "The End"; + const char *st2 = "Is Near"; + int b = 12; + short c = 5; + + { + int d = 15; + int e = 14; + const char *foo = "Inside block"; + { + int f = 42; + int g = 19; + const char *bar = "Inside block x2"; + { + short h = 9; + h = h +1; /* Inner test breakpoint */ + } + } + } + + return; /* Backtrace end breakpoint */ +} + +void funcb(int j) +{ + struct foo + { + int a; + int b; + }; + + struct foo bar; + + bar.a = 42; + bar.b = 84; + + funca(); + return; +} + +void funca(void) +{ + foobar fb; + foobar *bf = NULL; + + if (count < 10) + { + count++; + funcb(count); + } + + fb.nothing = "Foo Bar"; + fb.f = 42; + fb.s = 19; + + bf = alloca (sizeof (foobar)); + bf->nothing = alloca (128); + bf->nothing = "Bar Foo"; + bf->f = 24; + bf->s = 91; + + end_func(21, "Param", bf, fb); + return; +} + + +void func1(void) +{ + funca(); + return; +} + +int func2(int f) +{ + int c; + const char *elided = "Elided frame"; + foobar fb; + foobar *bf = NULL; + + fb.nothing = "Elided Foo Bar"; + fb.f = 84; + fb.s = 38; + + bf = alloca (sizeof (foobar)); + bf->nothing = alloca (128); + bf->nothing = "Elided Bar Foo"; + bf->f = 48; + bf->s = 182; + + func1(); + return 1; +} + +void func3(int i) +{ + func2(i); + + return; +} + +int func4(int j) +{ + func3(j); + + return 2; +} + +int func5(int f, int d) +{ + int i = 0; + char *random = "random"; + i=i+f; + + func4(i); + return i; +} + +int +main() +{ + int z = 32; + int y = 44; + const char *foo1 = "Test"; + func5(3,5); + return 0; +} diff --git a/gdb/testsuite/gdb.guile/scm-frame-filter.exp b/gdb/testsuite/gdb.guile/scm-frame-filter.exp new file mode 100644 index 0000000..b5d8cf7 --- /dev/null +++ b/gdb/testsuite/gdb.guile/scm-frame-filter.exp @@ -0,0 +1,239 @@ +# Copyright (C) 2013-2015 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 Guile-based +# frame-filters. + +load_lib gdb-guile.exp + +standard_testfile + +# We cannot use prepare_for_testing as we have to set the safe-patch +# to check objfile and progspace printers. +if {[build_executable $testfile.exp $testfile $srcfile debug] == -1} { + return -1 +} + +# Start with a fresh gdb. +gdb_exit +gdb_start + +# Skip all tests if Guile scripting is not enabled. +if { [skip_guile_tests] } { continue } + +# Make the -gdb.scm script available to gdb, it is automagically loaded by gdb. +# Care is taken to put it in the same directory as the binary so that +# gdb will find it. +set remote_obj_guile_file \ + [remote_download \ + host ${srcdir}/${subdir}/${testfile}-gdb.scm.in \ + [standard_output_file ${testfile}-gdb.scm]] + +gdb_reinitialize_dir $srcdir/$subdir +gdb_test_no_output "set auto-load safe-path ${remote_obj_guile_file}" \ + "set auto-load safe-path" +gdb_load ${binfile} +# Verify gdb loaded the script. +gdb_test "info auto-load guile-scripts" "Yes.*/${testfile}-gdb.scm.*" \ + "Test auto-load had loaded guile scripts" + +if ![runto_main] then { + perror "couldn't run to breakpoint" + return +} +gdb_test_no_output "set guile print-stack full" \ + "Set guile print-stack to full" + +# Load global frame-filters +set remote_guile_file [gdb_remote_download host \ + ${srcdir}/${subdir}/${testfile}.scm] +gdb_scm_load_file ${remote_guile_file} + +gdb_breakpoint [gdb_get_line_number "Backtrace end breakpoint"] +gdb_breakpoint [gdb_get_line_number "Inner test breakpoint"] +gdb_continue_to_breakpoint "Inner test breakpoint" + +# Test multiple local blocks. +gdb_test "bt full no-filters" \ + ".*#0.*end_func.*h = 9.*f = 42.*g = 19.*bar = $hex \"Inside block x2\".*d = 15.*e = 14.*foo = $hex \"Inside block\".*str = $hex \"The End\".*st2 = $hex \"Is Near\".*b = 12.*c = 5.*" \ + "bt full no-filters" +gdb_test "bt full" \ + ".*#0.*cnuf_dne.*h = 9.*f = 42.*g = 19.*bar = $hex \"Inside block x2\".*d = 15.*e = 14.*foo = $hex \"Inside block\".*str = $hex \"The End\".*st2 = $hex \"Is Near\".*b = 12.*c = 5.*" \ + "bt full with filters" + +gdb_continue_to_breakpoint "Backtrace end breakpoint" + +# Test query +gdb_test "guile (all-frame-filters)" \ + ".*Elider.*Reverse.*Dummy.*Error.*" \ + "all frame filters" +gdb_test "guile (map frame-filter-priority (all-frame-filters))" \ + ".*900 100 30 20.*" \ + "all frame filter priorities" +gdb_test "guile (map frame-filter-enabled? (all-frame-filters))" \ + ".*#t #t #t #t.*" \ + "all frame filter enabled?" + +gdb_test_no_output "guile (disable-frame-filter! \"Elider\")" \ + "disable elider" +gdb_test "guile (frame-filter-enabled? (find-frame-filter-by-name \"Elider\"))"\ + ".*#f.*" \ + "elider not enabled" +gdb_test_no_output "guile (enable-frame-filter! \"Elider\")" \ + "re-enable elider" +gdb_test "guile (frame-filter-enabled? (find-frame-filter-by-name \"Elider\"))"\ + ".*#t.*" \ + "elider re-enabled" + +# Test no-filters +gdb_test "bt no-filters" \ + ".*#0.*end_func.*#22.*in func1.*#27.*in main \\(\\).*" \ + "bt no-filters" + +# Test reverse +gdb_test "bt" \ + ".*#0.*cnuf_dne.*#22.*in 1cnuf.*#27.*in niam \\(\\).*" \ + "bt with frame filters" + +# Disable Reverse +gdb_test_no_output "guile (disable-frame-filter! \"Reverse\")" \ + "disable frame-filter global Reverse" +gdb_test "bt" \ + ".*#0.*end_func.*#22.*in func1.*#27.*in main \\(\\).*" \ + "bt with frame-filter Reverse disabled" +gdb_test "bt -2" \ + ".*#26.*func5.*#27.*in main \\(\\).*" \ + "bt -2 with frame-filter Reverse disabled" +gdb_test "bt 3" \ + ".*#0.*end_func.*#1.*in funca \\(\\).*#2.*in funcb \\(j=10\\).*" \ + "bt 3 with frame-filter Reverse disabled" +gdb_test "bt no-filter full" \ + ".*#0.*end_func.*str = $hex \"The End\".*st2 = $hex \"Is Near\".*b = 12.*c = 5.*#1.*in funca \\(\\).*#2.*in funcb \\(j=10\\).*bar = \{a = 42, b = 84\}.*" \ + "bt no-filters full with Reverse disabled" +gdb_test "bt full" \ + ".*#0.*end_func.*str = $hex \"The End\".*st2 = $hex \"Is Near\".*b = 12.*c = 5.*#1.*in funca \\(\\).*#2.*in funcb \\(j=10\\).*bar = \{a = 42, b = 84\}.*#22.*in func1 \\(\\).*#23.*in func2 \\(f=3\\).*elided = $hex \"Elided frame\".*fb = \{nothing = $hex \"Elided Foo Bar\", f = 84, s = 38\}.*bf = $hex.*" \ + "bt full with Reverse disabled" + +# Test set print frame-arguments +# none +gdb_test_no_output "set print frame-arguments none" \ + "turn off frame arguments" +gdb_test "bt no-filter 1" \ + "#0.*end_func \\(foo=\.\.\., bar=\.\.\., fb=\.\.\., bf=\.\.\.\\) at .*scm-frame-filter.c.*" \ + "bt no-filter 1 no args" +gdb_test "bt 1" \ + "#0.*end_func \\(foo=\.\.\., bar=\.\.\., fb=\.\.\., bf=\.\.\.\\) at .*scm-frame-filter.c.*" \ + "bt 1 no args" + +# scalars +gdb_test_no_output "set print frame-arguments scalars" \ + "turn frame arguments to scalars only" +gdb_test "bt no-filter 1" \ + "#0.*end_func \\(foo=21, bar=$hex \"Param\", fb=$hex, bf=\.\.\.\\) at .*scm-frame-filter.c.*" \ + "bt no-filter 1 scalars" +gdb_test "bt 1" \ + "#0.*end_func \\(foo=21, bar=$hex \"Param\", fb=$hex, bf=\.\.\.\\) at .*scm-frame-filter.c.*" \ + "bt 1 scalars" + +# all +gdb_test_no_output "set print frame-arguments all" \ + "turn on frame arguments" +gdb_test "bt no-filter 1" \ + "#0.*end_func \\(foo=21, bar=$hex \"Param\", fb=$hex, bf=\{nothing = $hex \"Foo Bar\", f = 42, s = 19\}\\) at .*scm-frame-filter.c.*" \ + "bt no-filter 1 all args" +gdb_test "bt 1" \ + "#0.*end_func \\(foo=21, bar=$hex \"Param\", fb=$hex, bf=\{nothing = $hex \"Foo Bar\", f = 42, s = 19\}\\) at .*scm-frame-filter.c.*" \ + "bt 1 all args" + +# set print address off +gdb_test_no_output "set print address off" \ + "Turn off address printing" +gdb_test "bt no-filter 1" \ + "#0 end_func \\(foo=21, bar=\"Param\", fb=, bf=\{nothing = \"Foo Bar\", f = 42, s = 19\}\\) at .*scm-frame-filter.c.*" \ + "bt no-filter 1 no address" +gdb_test "bt 1" \ + "#0 end_func \\(foo=21, bar=\"Param\", fb=, bf=\{nothing = \"Foo Bar\", f = 42, s = 19\}\\) at .*scm-frame-filter.c.*" \ + "bt 1 no addresss" + +gdb_test_no_output "set guile print-stack message" \ + "Set guile print-stack to message for Error decorator" +gdb_test_no_output "guile (enable-frame-filter! \"Error\")" \ + "enable Error decorator" +set test "bt 1 with Error filter" +gdb_test_multiple "bt 1" $test { + -re "ERROR: whoops.*$gdb_prompt $" { + pass $test + } +} + +# # Test with no debuginfo + +# We cannot use prepare_for_testing as we have to set the safe-patch +# to check objfile and progspace printers. +if {[build_executable $testfile.exp $testfile $srcfile {nodebug}] == -1} { + return -1 +} + +# Start with a fresh gdb. +gdb_exit +gdb_start + +# Skip all tests if Guile scripting is not enabled. +if { [skip_guile_tests] } { continue } + +# Make the -gdb.scm script available to gdb, it is automagically loaded by gdb. +# Care is taken to put it in the same directory as the binary so that +# gdb will find it. +set remote_obj_guile_file \ + [remote_download \ + host ${srcdir}/${subdir}/${testfile}-gdb.scm.in \ + [standard_output_file ${testfile}-gdb.scm]] + +gdb_reinitialize_dir $srcdir/$subdir +gdb_test_no_output "set auto-load safe-path ${remote_obj_guile_file}" \ + "set auto-load safe-path for no debug info" +gdb_load ${binfile} + +# Verify gdb loaded the script. +gdb_test "info auto-load guile-scripts" "Yes.*/${testfile}-gdb.scm.*" \ + "Set autoload path for no debug info tests" +if ![runto_main] then { + perror "couldn't run to breakpoint" + return +} + +gdb_test_no_output "set guile print-stack full" \ + "set guile print-stack full for no debuginfo tests" + +# Load global frame-filters +set remote_guile_file [gdb_remote_download host \ + ${srcdir}/${subdir}/${testfile}.scm] +gdb_scm_load_file ${remote_guile_file} + +# Disable Reverse +gdb_test_no_output "guile (disable-frame-filter! \"Reverse\")" \ + "disable frame-filter global Reverse for no debuginfo" +gdb_test "bt" \ + ".*#0..*in main \\(\\).*" \ + "bt for no debuginfo" +gdb_test "bt full" \ + ".*#0..*in main \\(\\).*" \ + "bt full for no debuginfo" +gdb_test "bt no-filters" \ + ".*#0..*in main \\(\\).*" \ + "bt no filters for no debuginfo" +gdb_test "bt no-filters full" \ + ".*#0..*in main \\(\\).*" \ + "bt no-filters full no debuginfo" diff --git a/gdb/testsuite/gdb.guile/scm-frame-filter.scm b/gdb/testsuite/gdb.guile/scm-frame-filter.scm new file mode 100644 index 0000000..2d0b71a --- /dev/null +++ b/gdb/testsuite/gdb.guile/scm-frame-filter.scm @@ -0,0 +1,89 @@ +;; Copyright (C) 2015 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 test-suite. It tests Guile-based frame +;; filters. + +(use-modules (gdb) + ((gdb) #:select ((symbol? . gdb:symbol?))) + (gdb frame-filters) + (ice-9 streams)) + +(define (reverse-decorator dec) + (let ((name (decorated-frame-function-name dec))) + (redecorate-frame + dec + #:function-name + (cond + ((not name) #f) + ((equal? name "end_func") + (string-append (string-reverse name) + (let ((frame (decorated-frame-frame dec))) + (value->string (frame-read-var frame "str"))))) + (else + (string-reverse name)))))) + +(define (dummy-decorator dec) + (redecorate-frame dec + #:function-name "Dummy function" + #:address #x123 + #:filename "Dummy filename" + #:line 1 + #:arguments (list (cons "Foo" (make-value 12)) + (cons "Bar" (make-value "Stuff")) + (cons "FooBar" (make-value 42))) + #:locals '() + #:children '())) + +(define (frame-function-name frame) + (let ((f (frame-function frame))) + (cond + ((not f) f) + ((gdb:symbol? f) (symbol-print-name f)) + (else (object->string f))))) + +(define (stream-map* f stream) + (make-stream + (lambda (stream) + (and (not (stream-null? stream)) + (f (stream-car stream) (stream-cdr stream)))) + stream)) + +(define (eliding-filter stream) + (stream-map* + (lambda (head tail) + (if (and (equal? (decorated-frame-function-name head) "func1") + (not (stream-null? tail))) + ;; Suppose we want to return the 'func1' frame but elide the + ;; next frame. E.g., if call in our interpreter language + ;; takes two C frames to implement, and the first one we see + ;; is the "sentinel". + (cons (redecorate-frame head #:children (list (stream-car tail))) + (stream-cdr tail)) + (cons head tail))) + stream)) + +;; A simple decorator that gives an error when computing the function. +(define (error-decorator frame) + (redecorate-frame frame #:function-name (error "whoops"))) + +(add-frame-filter! (make-decorating-frame-filter + "Reverse" reverse-decorator #:priority 100)) +(add-frame-filter! (make-decorating-frame-filter + "Dummy" dummy-decorator #:enabled? #f #:priority 30)) +(add-frame-filter! (make-frame-filter + "Elider" eliding-filter #:priority 900)) +(add-frame-filter! (make-decorating-frame-filter + "Error" error-decorator #:enabled? #f))