* [PATCH v3] Add Guile frame-filter interface
@ 2015-03-05 15:10 Andy Wingo
2015-03-11 15:32 ` [PATCH v4] " Andy Wingo
0 siblings, 1 reply; 2+ messages in thread
From: Andy Wingo @ 2015-03-05 15:10 UTC (permalink / raw)
To: gdb-patches
[-- Attachment #1: Type: text/plain, Size: 339 bytes --]
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
[-- Attachment #2: 0001-Add-Guile-frame-filter-interface.patch --]
[-- Type: text/plain, Size: 131563 bytes --]
From 7965abdaa51ea2e52cc145bc14fb2b77391f671c Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@igalia.com>
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 <wingo@igalia.com>
+ * 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 <wingo@igalia.com>
+
* 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 <wingo@igalia.com>
+
+ * guile.texi (Guile Frame Filter API)
+ (Writing a Frame Filter in Guile): New sections.
+
2015-03-05 Andy Wingo <wingo@igalia.com>
* 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 <http://www.gnu.org/licenses/>.
+
+(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 <decorated-frame>
+ (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 <frame-filter>
+ (%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 <gdb:iterator> 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 <http://www.gnu.org/licenses/>. */
+
+/* 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",
+ _("<error reading variable: %s>"),
+ 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 <gdb:frame> object that encapsulates FRAME.
Returns a <gdb:exception> 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 <wingo@igalia.com>
+ * 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 <wingo@igalia.com>
+
* gdb.guile/scm-objfile.exp: Add objfile-progspace test.
2015-03-02 Pedro Alves <palves@redhat.com>
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 <http://www.gnu.org/licenses/>. */
+
+/* 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 <http://www.gnu.org/licenses/>.
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+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=<error reading variable: dwarf expression stack underflow>, 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 <http://www.gnu.org/licenses/>.
+
+;; 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 <http://www.gnu.org/licenses/>. */
+
+#include <stdlib.h>
+
+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 <http://www.gnu.org/licenses/>.
+
+# 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 <http://www.gnu.org/licenses/>. */
+
+#include <stdlib.h>
+
+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 <http://www.gnu.org/licenses/>.
+
+# 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 <http://www.gnu.org/licenses/>.
+
+;; 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))
--
2.1.4
^ permalink raw reply [flat|nested] 2+ messages in thread
* [PATCH v4] Add Guile frame-filter interface
2015-03-05 15:10 [PATCH v3] Add Guile frame-filter interface Andy Wingo
@ 2015-03-11 15:32 ` Andy Wingo
0 siblings, 0 replies; 2+ messages in thread
From: Andy Wingo @ 2015-03-11 15:32 UTC (permalink / raw)
To: gdb-patches; +Cc: xdje42
[-- Attachment #1: Type: text/plain, Size: 331 bytes --]
Changes:
* Specify #:scope when registering, not when creating filters
* s/add-frame-filter!/register-frame-filter!/
* s/remove-frame-filter!/unregister-frame-filter!/
* Add s/set-frame-filter-enabled!/
* Adapt for new TRY/CATCH/END_CATCH
* Build with -Wunbound-toplevel, except for gdb.scm
Cheers,
Andy
[-- Attachment #2: 0001-Add-Guile-frame-filter-interface.patch --]
[-- Type: text/plain, Size: 131563 bytes --]
From 7965abdaa51ea2e52cc145bc14fb2b77391f671c Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@igalia.com>
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 <wingo@igalia.com>
+ * 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 <wingo@igalia.com>
+
* 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 <wingo@igalia.com>
+
+ * guile.texi (Guile Frame Filter API)
+ (Writing a Frame Filter in Guile): New sections.
+
2015-03-05 Andy Wingo <wingo@igalia.com>
* 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 <http://www.gnu.org/licenses/>.
+
+(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 <decorated-frame>
+ (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 <frame-filter>
+ (%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 <gdb:iterator> 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 <http://www.gnu.org/licenses/>. */
+
+/* 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",
+ _("<error reading variable: %s>"),
+ 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 <gdb:frame> object that encapsulates FRAME.
Returns a <gdb:exception> 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 <wingo@igalia.com>
+ * 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 <wingo@igalia.com>
+
* gdb.guile/scm-objfile.exp: Add objfile-progspace test.
2015-03-02 Pedro Alves <palves@redhat.com>
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 <http://www.gnu.org/licenses/>. */
+
+/* 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 <http://www.gnu.org/licenses/>.
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+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=<error reading variable: dwarf expression stack underflow>, 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 <http://www.gnu.org/licenses/>.
+
+;; 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 <http://www.gnu.org/licenses/>. */
+
+#include <stdlib.h>
+
+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 <http://www.gnu.org/licenses/>.
+
+# 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 <http://www.gnu.org/licenses/>. */
+
+#include <stdlib.h>
+
+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 <http://www.gnu.org/licenses/>.
+
+# 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 <http://www.gnu.org/licenses/>.
+
+;; 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))
--
2.1.4
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2015-03-11 15:32 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2015-03-05 15:10 [PATCH v3] Add Guile frame-filter interface Andy Wingo
2015-03-11 15:32 ` [PATCH v4] " Andy Wingo
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).