* [PATCH v5] Add Guile frame filter interface
@ 2015-04-09 15:57 Andy Wingo
2015-04-09 16:28 ` Andy Wingo
0 siblings, 1 reply; 8+ messages in thread
From: Andy Wingo @ 2015-04-09 15:57 UTC (permalink / raw)
To: gdb-patches; +Cc: dje
Changes from v4 are mostly related to feedback on the unwinder
interface (which is a different patch).
* Remove enable-frame-filter! / disable-frame-filter!, and just have
set-frame-filter-enabled!, which always takes a filter object and
never a string.
* Rename #:scope to #:locus. Names must be unique only within a
locus, not among all filters. Add #:replace? to
register-frame-filter!.
* Limit priorities to the signed int32 range.
* Rename unregister-frame-filter! to remove-frame-filter!.
* Update docs.
* Compile most .scm files with -Wunbound-variable, and not
-Wunbound-toplevel.
WDYT?
Andy
^ permalink raw reply [flat|nested] 8+ messages in thread* Re: [PATCH v5] Add Guile frame filter interface 2015-04-09 15:57 [PATCH v5] Add Guile frame filter interface Andy Wingo @ 2015-04-09 16:28 ` Andy Wingo 2015-04-09 16:49 ` Eli Zaretskii 2015-04-20 5:29 ` Doug Evans 0 siblings, 2 replies; 8+ messages in thread From: Andy Wingo @ 2015-04-09 16:28 UTC (permalink / raw) To: gdb-patches; +Cc: dje [-- Attachment #1: Type: text/plain, Size: 777 bytes --] On Thu 09 Apr 2015 17:56, Andy Wingo <wingo@igalia.com> writes: > Changes from v4 are mostly related to feedback on the unwinder > interface (which is a different patch). > > * Remove enable-frame-filter! / disable-frame-filter!, and just have > set-frame-filter-enabled!, which always takes a filter object and > never a string. > > * Rename #:scope to #:locus. Names must be unique only within a > locus, not among all filters. Add #:replace? to > register-frame-filter!. > > * Limit priorities to the signed int32 range. > > * Rename unregister-frame-filter! to remove-frame-filter!. > > * Update docs. > > * Compile most .scm files with -Wunbound-variable, and not > -Wunbound-toplevel. > > WDYT? Voici le patch, mesdames et messieurs: [-- Attachment #2: 0001-Add-Guile-frame-filter-interface.patch --] [-- Type: text/plain, Size: 134613 bytes --] From 0011d7668c219aca0fc535a51771d12525c7550c 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: New file. * guile/lib/gdb/frame-filters.scm: New file. * 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. Rework to not use -Wunused-toplevel, as it doesn't account for uses via macro expansion, but do add -Wunbound-variable for files other than gdb.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 | 26 + gdb/Makefile.in | 6 + gdb/data-directory/Makefile.in | 27 +- gdb/doc/ChangeLog | 5 + gdb/doc/guile.texi | 430 +++++++++- gdb/guile/guile-internal.h | 76 ++ gdb/guile/guile.c | 3 +- gdb/guile/lib/gdb/frame-filters.scm | 461 ++++++++++ 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 | 35 + .../scm-frame-filter-invalidarg-gdb.scm.in | 35 + .../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, 3253 insertions(+), 11 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 8519fea..1f15ae6 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,5 +1,31 @@ 2015-04-09 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. Rework to + not use -Wunused-toplevel, as it doesn't account for uses via + macro expansion, but do add -Wunbound-variable for files other + than gdb.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-04-09 Andy Wingo <wingo@igalia.com> + * guile/scm-frame.c (gdbscm_frame_read_register): New function. (frame_functions): Bind gdbscm_frame_read_register to frame-read-register. diff --git a/gdb/Makefile.in b/gdb/Makefile.in index 87645cd..4c664ae 100644 --- a/gdb/Makefile.in +++ b/gdb/Makefile.in @@ -321,6 +321,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 \ @@ -347,6 +348,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 \ @@ -2434,6 +2436,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 30cfd17..21e44b9 100644 --- a/gdb/data-directory/Makefile.in +++ b/gdb/data-directory/Makefile.in @@ -89,21 +89,26 @@ GUILE_SOURCE_FILES = \ ./gdb.scm \ gdb/boot.scm \ gdb/experimental.scm \ + gdb/frame-filters.scm \ gdb/init.scm \ gdb/iterator.scm \ gdb/printing.scm \ gdb/support.scm \ gdb/types.scm +GUILE_NO_UNBOUND_WARNING_COMPILED_FILES = \ + ./gdb.go + GUILE_COMPILED_FILES = \ - ./gdb.go \ gdb/experimental.go \ + gdb/frame-filters.go \ gdb/iterator.go \ gdb/printing.go \ gdb/support.go \ gdb/types.go -@HAVE_GUILE_TRUE@GUILE_FILES = $(GUILE_SOURCE_FILES) $(GUILE_COMPILED_FILES) +@HAVE_GUILE_TRUE@GUILE_FILES = $(GUILE_SOURCE_FILES) \ + $(GUILE_COMPILED_FILES) $(GUILE_NO_UNBOUND_WARNING_COMPILED_FILES) @HAVE_GUILE_FALSE@GUILE_FILES = GUILD = @GUILD@ @@ -115,10 +120,10 @@ GUILD_TARGET_FLAG = @GUILD_TARGET_FLAG@ # Note: To work around a guile 2.0.5 issue (it can't find gdb/init.scm even if # we pass -L <dir>) we have to compile in the directory containing gdb.scm. # We still need to pass "-L ." so that other modules are found. -GUILD_COMPILE_FLAGS = \ - $(GUILD_TARGET_FLAG) \ - -Warity-mismatch -Wformat -Wunused-toplevel \ - -L . +GUILD_NO_UNBOUND_WARNING_COMPILE_FLAGS = \ + $(GUILD_TARGET_FLAG) -Warity-mismatch -Wformat -L . +GUILD_COMPILE_FLAGS = $(GUILD_NO_UNBOUND_WARNING_COMPILE_FLAGS) \ + -Wunbound-variable SYSTEM_GDBINIT_DIR = system-gdbinit SYSTEM_GDBINIT_INSTALL_DIR = $(DESTDIR)$(GDB_DATADIR)/$(SYSTEM_GDBINIT_DIR) @@ -258,8 +263,16 @@ stamp-guile: Makefile $(GUILE_SOURCE_FILES) $(INSTALL_DIR) ./$(GUILE_DIR)/$$dir ; \ $(INSTALL_DATA) $(GUILE_SRCDIR)/$$file ./$(GUILE_DIR)/$$dir ; \ done ; \ - files='$(GUILE_COMPILED_FILES)' ; \ cd ./$(GUILE_DIR) ; \ + files='$(GUILE_NO_UNBOUND_WARNING_COMPILED_FILES)' ; \ + for go in $$files ; do \ + source="`echo $$go | sed 's/\.go$$/.scm/'`" ; \ + echo $(GUILD) compile $(GUILD_NO_UNBOUND_WARNING_COMPILE_FLAGS) \ + -o "$$go" "$$source" ; \ + $(GUILD) compile $(GUILD_NO_UNBOUND_WARNING_COMPILE_FLAGS) \ + -o "$$go" "$$source" || exit 1 ; \ + done ; \ + files='$(GUILE_COMPILED_FILES)' ; \ for go in $$files ; do \ source="`echo $$go | sed 's/\.go$$/.scm/'`" ; \ echo $(GUILD) compile $(GUILD_COMPILE_FLAGS) -o "$$go" "$$source" ; \ diff --git a/gdb/doc/ChangeLog b/gdb/doc/ChangeLog index 5ad5e3a..bcff616 100644 --- a/gdb/doc/ChangeLog +++ b/gdb/doc/ChangeLog @@ -1,5 +1,10 @@ 2015-04-09 Andy Wingo <wingo@igalia.com> + * guile.texi (Guile Frame Filter API) + (Writing a Frame Filter in Guile): New sections. + +2015-04-09 Andy Wingo <wingo@igalia.com> + * guile.texi (Frames In Guile): Describe frame-read-register. 2015-04-02 Gary Benson <gbenson@redhat.com> diff --git a/gdb/doc/guile.texi b/gdb/doc/guile.texi index 04572fd..e2826f0 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,430 @@ 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 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{]} +Make a new frame filter. + +The filter will be identified by the string @var{name}. +@var{procedure} must 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 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 registered with @value{GDBN} via +@code{register-frame-filter!} in order to take effect. When +registered, the filter will be inserted into the chain of registered +with the given @var{priority}, which must be a number in the signed +32-bit integer range, and which defaults to 0 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} register-frame-filter! filter @ + @r{[}#:locus locus@r{]} @r{[}#:replace? replace?@r{]} +Register the frame filter @var{filter} with @value{GDBN}. + +By default, the locus of the filter is global, meaning that it is +associated with all objfiles and progspaces. Pass an objfile or a +progspace as the @code{#:locus} keyword argument to instead associate +the filter with a specific objfile or progspace, respectively. + +The filter's name must be unique within its locus. @value{GDBN} will +raise an exception if the locus already has a filter registered with +the given name, unless a true value is passed as the @code{#:replace?} +keyword argument, in which case any existing filter will be removed. +@end deffn + +@deffn {Scheme Procedure} remove-frame-filter! filter +Remove the frame filter @var{filter}. Frame filters are also +implicitly removed when their locus (objfile or progspace) goes away. +@end deffn + +@deffn {Scheme Procedure} set-frame-filter-enabled! filter enabled? +Mark a frame filter as enabled, if @var{enabled?} is true, or +as disabled otherwise. +@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{]} +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)) + +(register-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 +(set-frame-filter-enabled! identity-filter-object #f) +@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)) + +(register-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))) + +(register-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 509120b..d7c166c 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. */ @@ -293,6 +294,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); @@ -410,6 +415,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); @@ -568,6 +576,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); @@ -584,6 +597,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); @@ -623,4 +637,66 @@ 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 { \ + /* 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 \ + { \ + 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); \ + } \ + CATCH (dynwind_except, RETURN_MASK_ALL) \ + { \ + /* Pop the dynwind and restore the saved cleanup stack. */ \ + scm_dynwind_end (); \ + /* Rethrow GDB exception as Scheme exception. */ \ + gdbscm_throw_gdb_exception (dynwind_except); \ + } \ + END_CATCH \ + /* Pop the dynwind and restore the saved cleanup stack. */ \ + scm_dynwind_end (); \ + } while (0) + #endif /* GDB_GUILE_INTERNAL_H */ diff --git a/gdb/guile/guile.c b/gdb/guile/guile.c index 4abf5c5..176e97e 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, @@ -669,6 +669,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..637ddf1 --- /dev/null +++ b/gdb/guile/lib/gdb/frame-filters.scm @@ -0,0 +1,461 @@ +;; 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-locus + + find-frame-filter-by-name + + register-frame-filter! + remove-frame-filter! + set-frame-filter-enabled! + + 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 locus) + 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 + (locus frame-filter-locus set-locus!)) + +(define *int32-min* (- (ash 1 31))) +(define *int32-max* (- (ash 1 31) 1)) + +(define (valid-priority? priority) + (and (number? priority) (integer? priority) (exact? priority) + (<= *int32-min* priority *int32-max*))) + +(define* (make-frame-filter name procedure #:key (priority 0) (enabled? #t)) + "Make and return a new frame filter. NAME and PROCEDURE are required +arguments. Specify #:priority or #:enabled? to set the priority and +enabled status of the filter. + +The filter must be registered with GDB via `register-frame-filter!' +before it is active." + (unless (valid-priority? priority) + (error "Priority must be within signed int32 range" priority)) + (let ((registered? #f) (locus #f)) + (%make-frame-filter name priority enabled? registered? procedure locus))) + +;; List of frame filters, sorted by priority from highest to lowest. +(define *frame-filters* '()) + +(define (same-scope? a b) + "Return #t if loci A and B represent the same scope, for the purposes +of frame filter selection." + (cond + ;; If either locus is global, they share a scope. + ((or (not a) (not b)) #t) + ;; If either locus is an objfile, compare their progspaces, unless + ;; the objfile is invalid. + ((objfile? a) (and (objfile-valid? a) + (same-scope? (objfile-progspace a) b))) + ((objfile? b) (and (objfile-valid? 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 locus of FILTER is still valid, or otherwise #f if +the objfile or progspace has been removed from GDB." + (let ((locus (frame-filter-locus filter))) + (cond + ((progspace? locus) (progspace-valid? locus)) + ((objfile? locus) (objfile-valid? locus)) + (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 (locus (current-progspace))) + "Return #t if there are active frame filters for the given locus, or +#f otherwise." + (let lp ((filters *frame-filters*)) + (match filters + (() #f) + ((filter . filters) + (or (and (frame-filter-enabled? filter) + (same-scope? (frame-filter-locus filter) locus)) + (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) + (set-locus! f #f) + (lp filters)))))))) + +(define* (register-frame-filter! filter #:key locus replace?) + "Register a frame filter with GDB. Frame filters must be registered +before they will be used to filter backtraces. + +By default, the filter will be registered globally. Specify an objfile +or a progspace as the #:locus keyword argument to instead register the +filter as belonging to a specific objfile or progspace. + +The filter's name must be unique within its locus. GDB will raise an +exception if the locus already has a filter registered with the given +name, unless a true value is passed as the #:replace? keyword argument, +in which case any existing filter will be removed from its locus." + (define (check-locus!) + (cond + ((objfile? locus) + (unless (objfile-valid? locus) + (error "Objfile is not valid" locus))) + ((progspace? locus) + (unless (progspace-valid? locus) + (error "Progspace is not valid" locus))) + (locus + (error "Invalid locus" locus)))) + (define (duplicate-filter? other) + (and (equal? (frame-filter-name other) (frame-filter-name filter)) + (eq? (frame-filter-locus other) locus))) + (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*))))))) + + (when (frame-filter-registered? filter) + (error "Frame filter is already registered with GDB" filter)) + (check-locus!) + (prune-frame-filters!) + (let ((found (find duplicate-filter? *frame-filters*))) + (when found + (if replace? + (remove-frame-filter! found) + (error "Frame filter with this name already present in locus" + (frame-filter-name filter))))) + (set-registered?! filter #t) + (set-locus! filter locus) + (set! *frame-filters* (insert-sorted filter *frame-filters* priority>=?))) + +(define (remove-frame-filter! filter) + "Remove a frame filter." + (set-registered?! filter #f) + (set-locus! filter #f) + (set! *frame-filters* (delq filter *frame-filters*))) + +(define* (find-frame-filter-by-name name #:optional (locus (current-progspace))) + (prune-frame-filters!) + (or (find (lambda (filter) + (and (equal? name (frame-filter-name filter)) + (eq? (frame-filter-locus filter) locus))) + *frame-filters*) + (find (lambda (filter) + (and (equal? name (frame-filter-name filter)) + (same-scope? (frame-filter-locus filter) locus))) + *frame-filters*) + (error "no frame filter found with name" name))) + +(define (set-frame-filter-enabled! filter enabled?) + "Enable or disable a frame filter." + (set-enabled?! filter enabled?) + *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 + (locus (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-locus filter) locus)) + ((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 787b788..6ec8058 100644 --- a/gdb/guile/scm-frame.c +++ b/gdb/guile/scm-frame.c @@ -214,7 +214,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 2733e80..42d204f 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 edc6b2e..e156f57 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,5 +1,18 @@ 2015-04-09 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-04-09 Andy Wingo <wingo@igalia.com> + * gdb.guile/scm-parameter.exp: Escape the path that we are matching against, as it might contain characters that are special to regular expressions. 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..a5a7f17 --- /dev/null +++ b/gdb/testsuite/gdb.guile/scm-frame-filter-gdb.scm.in @@ -0,0 +1,35 @@ +;; 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) + +(define (register! name procedure priority locus) + (let ((filter (make-frame-filter name procedure #:priority priority))) + (register-frame-filter! filter #:locus locus))) + +(register! "filter-one-progspace" filter-one 10 (current-progspace)) +(register! "filter-one-objfile" filter-one 13 (current-objfile)) + +(register! "filter-two-progspace" filter-two 11 (current-progspace)) +(register! "filter-two-objfile" filter-two 12 (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..041f016 --- /dev/null +++ b/gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg-gdb.scm.in @@ -0,0 +1,35 @@ +;; 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) + +(define (register! name procedure priority locus) + (let ((filter (make-frame-filter name procedure #:priority priority))) + (register-frame-filter! filter #:locus locus))) + +(register! "filter-one-progspace" filter-one 1 (current-progspace)) +(register! "filter-one-objfile" filter-one 1 (current-objfile)) + +(register! "filter-two-progspace" filter-two 100 (current-progspace)) +(register! "filter-two-objfile" filter-two 100 (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..5ea2681 --- /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)))))) + +(register-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..f0ca7d0 --- /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 13 12 11 10 0\\)" \ + "all frame filter priorities" +gdb_test "guile (map frame-filter-enabled? (all-frame-filters))" \ + "\\(#t #t #f #t #t #t #t #f\\)" \ + "all frame filter enabled?" + +gdb_test_no_output "guile (set-frame-filter-enabled! (find-frame-filter-by-name \"Elider\") #f)" \ + "disable elider" +gdb_test "guile (frame-filter-enabled? (find-frame-filter-by-name \"Elider\"))"\ + ".*#f.*" \ + "elider not enabled" +gdb_test_no_output "guile (set-frame-filter-enabled! (find-frame-filter-by-name \"Elider\") #t)" \ + "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 (set-frame-filter-enabled! (find-frame-filter-by-name \"Reverse\") #f)" \ + "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 (set-frame-filter-enabled! (find-frame-filter-by-name \"Error\") #t)" \ + "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 (set-frame-filter-enabled! (find-frame-filter-by-name \"Reverse\") #f)" \ + "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..a529f8f --- /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"))) + +(register-frame-filter! (make-decorating-frame-filter + "Reverse" reverse-decorator #:priority 100)) +(register-frame-filter! (make-decorating-frame-filter + "Dummy" dummy-decorator #:enabled? #f #:priority 30)) +(register-frame-filter! (make-frame-filter + "Elider" eliding-filter #:priority 900)) +(register-frame-filter! (make-decorating-frame-filter + "Error" error-decorator #:enabled? #f)) -- 2.1.4 ^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [PATCH v5] Add Guile frame filter interface 2015-04-09 16:28 ` Andy Wingo @ 2015-04-09 16:49 ` Eli Zaretskii 2015-04-28 10:46 ` Andy Wingo 2015-04-20 5:29 ` Doug Evans 1 sibling, 1 reply; 8+ messages in thread From: Eli Zaretskii @ 2015-04-09 16:49 UTC (permalink / raw) To: Andy Wingo; +Cc: gdb-patches, dje > From: Andy Wingo <wingo@igalia.com> > Cc: dje@google.com > Date: Thu, 09 Apr 2015 18:27:42 +0200 > > > Changes from v4 are mostly related to feedback on the unwinder > > interface (which is a different patch). > > > > * Remove enable-frame-filter! / disable-frame-filter!, and just have > > set-frame-filter-enabled!, which always takes a filter object and > > never a string. > > > > * Rename #:scope to #:locus. Names must be unique only within a > > locus, not among all filters. Add #:replace? to > > register-frame-filter!. > > > > * Limit priorities to the signed int32 range. > > > > * Rename unregister-frame-filter! to remove-frame-filter!. > > > > * Update docs. > > > > * Compile most .scm files with -Wunbound-variable, and not > > -Wunbound-toplevel. > > > > WDYT? > > Voici le patch, mesdames et messieurs: Thanks. > +not. @code{scope} is the objfile or progspace in which the filter was This sentence will begin with a lower-case letter. Suggest to use "The @code{scope} field" instead. > +An decorated frame is a Guile record type that holds information about ^^ "A" > +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. I'm confused: the first case is when the item is a symbol, so what value is being alluded to here? > +@example Please use @smallexample everywhere. > + To ensure that your Guile filters can run, > +you might need to disable any Python frame filters loaded in your > +session. It would be useful here to tell how, or to add a cross-reference to a node which holds such a description. Thanks. ^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [PATCH v5] Add Guile frame filter interface 2015-04-09 16:49 ` Eli Zaretskii @ 2015-04-28 10:46 ` Andy Wingo 2015-04-28 15:33 ` Eli Zaretskii 0 siblings, 1 reply; 8+ messages in thread From: Andy Wingo @ 2015-04-28 10:46 UTC (permalink / raw) To: Eli Zaretskii; +Cc: gdb-patches, dje Thanks for the feedback, Eli. Updated patch to come will fix nits. One comment: On Thu 09 Apr 2015 18:49, Eli Zaretskii <eliz@gnu.org> writes: >> From: Andy Wingo <wingo@igalia.com> >> Cc: dje@google.com >> Date: Thu, 09 Apr 2015 18:27:42 +0200 >> >> +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. > > I'm confused: the first case is when the item is a symbol, so what > value is being alluded to here? I replaced the last sentence with: In the first case, the @value{GDBN} symbol will be used to load the corresponding value from the frame if needed. Andy ^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [PATCH v5] Add Guile frame filter interface 2015-04-28 10:46 ` Andy Wingo @ 2015-04-28 15:33 ` Eli Zaretskii 0 siblings, 0 replies; 8+ messages in thread From: Eli Zaretskii @ 2015-04-28 15:33 UTC (permalink / raw) To: Andy Wingo; +Cc: gdb-patches, dje > From: Andy Wingo <wingo@igalia.com> > Cc: gdb-patches@sourceware.org, dje@google.com > Date: Tue, 28 Apr 2015 12:04:17 +0200 > > I replaced the last sentence with: > > In the first case, the @value{GDBN} symbol will be used to load the > corresponding value from the frame if needed. Thanks, I'm happy now. ^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [PATCH v5] Add Guile frame filter interface 2015-04-09 16:28 ` Andy Wingo 2015-04-09 16:49 ` Eli Zaretskii @ 2015-04-20 5:29 ` Doug Evans 2015-04-28 16:12 ` [PATCH v6] " Andy Wingo 1 sibling, 1 reply; 8+ messages in thread From: Doug Evans @ 2015-04-20 5:29 UTC (permalink / raw) To: Andy Wingo; +Cc: gdb-patches Andy Wingo <wingo@igalia.com> writes: Hi. Almost there. A few more comments inline (grep for ====). > On Thu 09 Apr 2015 17:56, Andy Wingo <wingo@igalia.com> writes: > >> Changes from v4 are mostly related to feedback on the unwinder >> interface (which is a different patch). >> >> * Remove enable-frame-filter! / disable-frame-filter!, and just have >> set-frame-filter-enabled!, which always takes a filter object and >> never a string. >> >> * Rename #:scope to #:locus. Names must be unique only within a >> locus, not among all filters. Add #:replace? to >> register-frame-filter!. >> >> * Limit priorities to the signed int32 range. >> >> * Rename unregister-frame-filter! to remove-frame-filter!. >> >> * Update docs. >> >> * Compile most .scm files with -Wunbound-variable, and not >> -Wunbound-toplevel. >> >> WDYT? > > Voici le patch, mesdames et messieurs: > > From 0011d7668c219aca0fc535a51771d12525c7550c 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: New file. > * guile/lib/gdb/frame-filters.scm: New file. > * 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. Rework to > not use -Wunused-toplevel, as it doesn't account for uses via > macro expansion, but do add -Wunbound-variable for files other > than gdb.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. >... > diff --git a/gdb/Makefile.in b/gdb/Makefile.in > index 87645cd..4c664ae 100644 > --- a/gdb/Makefile.in > +++ b/gdb/Makefile.in > @@ -321,6 +321,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 \ > @@ -347,6 +348,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 \ > @@ -2434,6 +2436,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 30cfd17..21e44b9 100644 > --- a/gdb/data-directory/Makefile.in > +++ b/gdb/data-directory/Makefile.in > @@ -89,21 +89,26 @@ GUILE_SOURCE_FILES = \ > ./gdb.scm \ > gdb/boot.scm \ > gdb/experimental.scm \ > + gdb/frame-filters.scm \ > gdb/init.scm \ > gdb/iterator.scm \ > gdb/printing.scm \ > gdb/support.scm \ > gdb/types.scm > > +GUILE_NO_UNBOUND_WARNING_COMPILED_FILES = \ > + ./gdb.go > + > GUILE_COMPILED_FILES = \ > - ./gdb.go \ > gdb/experimental.go \ > + gdb/frame-filters.go \ > gdb/iterator.go \ > gdb/printing.go \ > gdb/support.go \ > gdb/types.go > > -@HAVE_GUILE_TRUE@GUILE_FILES = $(GUILE_SOURCE_FILES) $(GUILE_COMPILED_FILES) > +@HAVE_GUILE_TRUE@GUILE_FILES = $(GUILE_SOURCE_FILES) \ > + $(GUILE_COMPILED_FILES) $(GUILE_NO_UNBOUND_WARNING_COMPILED_FILES) > @HAVE_GUILE_FALSE@GUILE_FILES = > > GUILD = @GUILD@ > @@ -115,10 +120,10 @@ GUILD_TARGET_FLAG = @GUILD_TARGET_FLAG@ > # Note: To work around a guile 2.0.5 issue (it can't find gdb/init.scm even if > # we pass -L <dir>) we have to compile in the directory containing gdb.scm. > # We still need to pass "-L ." so that other modules are found. > -GUILD_COMPILE_FLAGS = \ > - $(GUILD_TARGET_FLAG) \ > - -Warity-mismatch -Wformat -Wunused-toplevel \ > - -L . > +GUILD_NO_UNBOUND_WARNING_COMPILE_FLAGS = \ > + $(GUILD_TARGET_FLAG) -Warity-mismatch -Wformat -L . > +GUILD_COMPILE_FLAGS = $(GUILD_NO_UNBOUND_WARNING_COMPILE_FLAGS) \ > + -Wunbound-variable > > SYSTEM_GDBINIT_DIR = system-gdbinit > SYSTEM_GDBINIT_INSTALL_DIR = $(DESTDIR)$(GDB_DATADIR)/$(SYSTEM_GDBINIT_DIR) > @@ -258,8 +263,16 @@ stamp-guile: Makefile $(GUILE_SOURCE_FILES) > $(INSTALL_DIR) ./$(GUILE_DIR)/$$dir ; \ > $(INSTALL_DATA) $(GUILE_SRCDIR)/$$file ./$(GUILE_DIR)/$$dir ; \ > done ; \ > - files='$(GUILE_COMPILED_FILES)' ; \ > cd ./$(GUILE_DIR) ; \ > + files='$(GUILE_NO_UNBOUND_WARNING_COMPILED_FILES)' ; \ > + for go in $$files ; do \ > + source="`echo $$go | sed 's/\.go$$/.scm/'`" ; \ > + echo $(GUILD) compile $(GUILD_NO_UNBOUND_WARNING_COMPILE_FLAGS) \ > + -o "$$go" "$$source" ; \ > + $(GUILD) compile $(GUILD_NO_UNBOUND_WARNING_COMPILE_FLAGS) \ > + -o "$$go" "$$source" || exit 1 ; \ > + done ; \ > + files='$(GUILE_COMPILED_FILES)' ; \ > for go in $$files ; do \ > source="`echo $$go | sed 's/\.go$$/.scm/'`" ; \ > echo $(GUILD) compile $(GUILD_COMPILE_FLAGS) -o "$$go" "$$source" ; \ > diff --git a/gdb/doc/ChangeLog b/gdb/doc/ChangeLog > index 5ad5e3a..bcff616 100644 > --- a/gdb/doc/ChangeLog > +++ b/gdb/doc/ChangeLog > @@ -1,5 +1,10 @@ > 2015-04-09 Andy Wingo <wingo@igalia.com> > > + * guile.texi (Guile Frame Filter API) > + (Writing a Frame Filter in Guile): New sections. > + > +2015-04-09 Andy Wingo <wingo@igalia.com> > + > * guile.texi (Frames In Guile): Describe frame-read-register. > > 2015-04-02 Gary Benson <gbenson@redhat.com> > diff --git a/gdb/doc/guile.texi b/gdb/doc/guile.texi > index 04572fd..e2826f0 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,430 @@ 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 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{]} > +Make a new frame filter. > + > +The filter will be identified by the string @var{name}. > +@var{procedure} must 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 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 registered with @value{GDBN} via > +@code{register-frame-filter!} in order to take effect. When > +registered, the filter will be inserted into the chain of registered > +with the given @var{priority}, which must be a number in the signed > +32-bit integer range, and which defaults to 0 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} register-frame-filter! filter @ > + @r{[}#:locus locus@r{]} @r{[}#:replace? replace?@r{]} > +Register the frame filter @var{filter} with @value{GDBN}. > + > +By default, the locus of the filter is global, meaning that it is > +associated with all objfiles and progspaces. Pass an objfile or a > +progspace as the @code{#:locus} keyword argument to instead associate > +the filter with a specific objfile or progspace, respectively. > + > +The filter's name must be unique within its locus. @value{GDBN} will > +raise an exception if the locus already has a filter registered with > +the given name, unless a true value is passed as the @code{#:replace?} > +keyword argument, in which case any existing filter will be removed. > +@end deffn > + > +@deffn {Scheme Procedure} remove-frame-filter! filter > +Remove the frame filter @var{filter}. Frame filters are also > +implicitly removed when their locus (objfile or progspace) goes away. > +@end deffn > + > +@deffn {Scheme Procedure} set-frame-filter-enabled! filter enabled? > +Mark a frame filter as enabled, if @var{enabled?} is true, or > +as disabled otherwise. > +@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{]} > +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)) > + > +(register-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 > +(set-frame-filter-enabled! identity-filter-object #f) > +@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)) > + > +(register-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))) > + > +(register-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 509120b..d7c166c 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. */ > @@ -293,6 +294,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); > > @@ -410,6 +415,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); > > @@ -568,6 +576,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); > > @@ -584,6 +597,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); > @@ -623,4 +637,66 @@ 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 { \ > + /* 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 \ > + { \ > + 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); \ > + } \ > + CATCH (dynwind_except, RETURN_MASK_ALL) \ > + { \ > + /* Pop the dynwind and restore the saved cleanup stack. */ \ > + scm_dynwind_end (); \ > + /* Rethrow GDB exception as Scheme exception. */ \ > + gdbscm_throw_gdb_exception (dynwind_except); \ > + } \ > + END_CATCH \ > + /* Pop the dynwind and restore the saved cleanup stack. */ \ > + scm_dynwind_end (); \ > + } while (0) > + > #endif /* GDB_GUILE_INTERNAL_H */ > diff --git a/gdb/guile/guile.c b/gdb/guile/guile.c > index 4abf5c5..176e97e 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, > > @@ -669,6 +669,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..637ddf1 > --- /dev/null > +++ b/gdb/guile/lib/gdb/frame-filters.scm > @@ -0,0 +1,461 @@ > +;; 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-locus > + > + find-frame-filter-by-name > + > + register-frame-filter! > + remove-frame-filter! > + set-frame-filter-enabled! > + > + 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." ==== Typo: Compute > + (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." ==== s/an/a/ > + (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 locus) > + 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 > + (locus frame-filter-locus set-locus!)) > + > +(define *int32-min* (- (ash 1 31))) > +(define *int32-max* (- (ash 1 31) 1)) > + > +(define (valid-priority? priority) > + (and (number? priority) (integer? priority) (exact? priority) > + (<= *int32-min* priority *int32-max*))) > + > +(define* (make-frame-filter name procedure #:key (priority 0) (enabled? #t)) > + "Make and return a new frame filter. NAME and PROCEDURE are required > +arguments. Specify #:priority or #:enabled? to set the priority and > +enabled status of the filter. > + > +The filter must be registered with GDB via `register-frame-filter!' > +before it is active." > + (unless (valid-priority? priority) > + (error "Priority must be within signed int32 range" priority)) > + (let ((registered? #f) (locus #f)) > + (%make-frame-filter name priority enabled? registered? procedure locus))) > + > +;; List of frame filters, sorted by priority from highest to lowest. > +(define *frame-filters* '()) > + > +(define (same-scope? a b) > + "Return #t if loci A and B represent the same scope, for the purposes > +of frame filter selection." > + (cond > + ;; If either locus is global, they share a scope. > + ((or (not a) (not b)) #t) > + ;; If either locus is an objfile, compare their progspaces, unless > + ;; the objfile is invalid. > + ((objfile? a) (and (objfile-valid? a) > + (same-scope? (objfile-progspace a) b))) > + ((objfile? b) (and (objfile-valid? 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 locus of FILTER is still valid, or otherwise #f if > +the objfile or progspace has been removed from GDB." > + (let ((locus (frame-filter-locus filter))) > + (cond > + ((progspace? locus) (progspace-valid? locus)) > + ((objfile? locus) (objfile-valid? locus)) > + (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 (locus (current-progspace))) ==== Is current-progspace the best default here? Dunno. Since this function is only called without arguments how about removing "locus" for now. > + "Return #t if there are active frame filters for the given locus, or > +#f otherwise." > + (let lp ((filters *frame-filters*)) > + (match filters > + (() #f) > + ((filter . filters) > + (or (and (frame-filter-enabled? filter) > + (same-scope? (frame-filter-locus filter) locus)) > + (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) > + (set-locus! f #f) > + (lp filters)))))))) > + > +(define* (register-frame-filter! filter #:key locus replace?) > + "Register a frame filter with GDB. Frame filters must be registered > +before they will be used to filter backtraces. > + > +By default, the filter will be registered globally. Specify an objfile > +or a progspace as the #:locus keyword argument to instead register the > +filter as belonging to a specific objfile or progspace. > + > +The filter's name must be unique within its locus. GDB will raise an > +exception if the locus already has a filter registered with the given > +name, unless a true value is passed as the #:replace? keyword argument, > +in which case any existing filter will be removed from its locus." > + (define (check-locus!) > + (cond > + ((objfile? locus) > + (unless (objfile-valid? locus) > + (error "Objfile is not valid" locus))) > + ((progspace? locus) > + (unless (progspace-valid? locus) > + (error "Progspace is not valid" locus))) > + (locus > + (error "Invalid locus" locus)))) > + (define (duplicate-filter? other) > + (and (equal? (frame-filter-name other) (frame-filter-name filter)) > + (eq? (frame-filter-locus other) locus))) > + (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*))))))) > + > + (when (frame-filter-registered? filter) > + (error "Frame filter is already registered with GDB" filter)) > + (check-locus!) > + (prune-frame-filters!) > + (let ((found (find duplicate-filter? *frame-filters*))) > + (when found > + (if replace? > + (remove-frame-filter! found) > + (error "Frame filter with this name already present in locus" > + (frame-filter-name filter))))) > + (set-registered?! filter #t) > + (set-locus! filter locus) > + (set! *frame-filters* (insert-sorted filter *frame-filters* priority>=?))) > + > +(define (remove-frame-filter! filter) > + "Remove a frame filter." > + (set-registered?! filter #f) > + (set-locus! filter #f) > + (set! *frame-filters* (delq filter *frame-filters*))) > + > +(define* (find-frame-filter-by-name name #:optional (locus (current-progspace))) ==== Is current-progspace the best default? Dunno. How about removing a default for locus until there's a compelling choice. > + (prune-frame-filters!) > + (or (find (lambda (filter) > + (and (equal? name (frame-filter-name filter)) > + (eq? (frame-filter-locus filter) locus))) > + *frame-filters*) > + (find (lambda (filter) > + (and (equal? name (frame-filter-name filter)) > + (same-scope? (frame-filter-locus filter) locus))) > + *frame-filters*) > + (error "no frame filter found with name" name))) > + > +(define (set-frame-filter-enabled! filter enabled?) > + "Enable or disable a frame filter." > + (set-enabled?! filter enabled?) > + *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 > + (locus (current-progspace))) ==== Similarly, it's not clear to me what the best default for locus is. Also, it appears locus is currently unused (the only caller doesn't pass a locus). > + "Fold the active frame filter procedures over a stream." > + (fold (lambda (filter stream) > + (if (and (frame-filter-enabled? filter) > + (same-scope? (frame-filter-locus filter) locus)) > + ((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) ==== *name == NULL > + gdbscm_throw (exception); > + make_cleanup (xfree, name); ==== *name? [but given the const char *, one may need to store the result of gdbscm_scm_to_host_string in a char * first] > + > + *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); ==== My understanding is that the community generally frowns on trying to be too clever for the sake of brevity. Far more important is making things readable with minimal effort. py-framefilter.c:mi_should_print writes it this way because (and again, this is my understanding) it's the way the community prefers. if (type == MI_PRINT_LOCALS) print_me = ! SYMBOL_IS_ARGUMENT (sym); else print_me = 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) ==== ffscm_print_type > +{ > + 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); ==== pass type here instead of value_type (val)? [I suspect py-framefilter.c has the same bug.] Whether we *want* to strip typedefs here is a good question. It's not immediately obvious that we do. OTOH, check_typedef serves two purposes, the other being to resolve opaque types and I'm guessing we do want to resolve opaque types here, *and* we have no other function which does just this (we need to fix this). Thoughts? > + 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, ==== ffscm_print_value > + 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 (); ==== blank line > + 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 ==== s/.<tab>If/. If/ > + 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, ==== ffscm_print_single_arg > + 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 ==== s/.<tab>LOCAL/. LOCAL/ > + 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, ==== ffscm_print_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) ==== val == NULL > + /* 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. */ ==== blank line > +static void > +gdbscm_print_locals (SCM locals, ==== ffscm_print_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, ==== ffscm_print_arg > + 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, ==== ffscm_print_args > + 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 ==== s/.<tab>FLAGS/. FLAGS/ > + 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, ==== ffscm_print_frame > + 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"); ==== blank line > + 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); ==== blank line > + 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) ==== function_name != NULL > + { > + 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) ==== function == NULL > + 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) ==== filename == NULL > + 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 ==== s/.<tab>Throws/. Throws/ > + 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 ==== extra space after /* [I can imagine py-framefilter.c has the same issue, no need to fix it there.] > + the source frame to start frame-filter invocation. FLAGS is an ==== s/.<tab>FLAGS/. FLAGS/ > + 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 787b788..6ec8058 100644 > --- a/gdb/guile/scm-frame.c > +++ b/gdb/guile/scm-frame.c > @@ -214,7 +214,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; ==== blank line > + restore_cleanups (cleanups); > +} > + > +void > +gdbscm_dynwind_do_cleanups (void *data) > +{ > + struct cleanup *cleanups = data; ==== blank line > + do_cleanups (cleanups); > +} > diff --git a/gdb/mi/mi-main.c b/gdb/mi/mi-main.c > index 2733e80..42d204f 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 edc6b2e..e156f57 100644 > --- a/gdb/testsuite/ChangeLog > +++ b/gdb/testsuite/ChangeLog > @@ -1,5 +1,18 @@ > 2015-04-09 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-04-09 Andy Wingo <wingo@igalia.com> > + > * gdb.guile/scm-parameter.exp: Escape the path that we are > matching against, as it might contain characters that are special > to regular expressions. > 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 ==== There's no real need for "amd64-" in the file name. It's long enough already so shortening it some is welcome. [I realize the file is just copied from testsuite/gdb.python.] > @@ -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..a5a7f17 > --- /dev/null > +++ b/gdb/testsuite/gdb.guile/scm-frame-filter-gdb.scm.in > @@ -0,0 +1,35 @@ > +;; 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) > + > +(define (register! name procedure priority locus) > + (let ((filter (make-frame-filter name procedure #:priority priority))) > + (register-frame-filter! filter #:locus locus))) > + > +(register! "filter-one-progspace" filter-one 10 (current-progspace)) > +(register! "filter-one-objfile" filter-one 13 (current-objfile)) > + > +(register! "filter-two-progspace" filter-two 11 (current-progspace)) > +(register! "filter-two-objfile" filter-two 12 (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..041f016 > --- /dev/null > +++ b/gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg-gdb.scm.in > @@ -0,0 +1,35 @@ > +;; 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) > + > +(define (register! name procedure priority locus) > + (let ((filter (make-frame-filter name procedure #:priority priority))) > + (register-frame-filter! filter #:locus locus))) > + > +(register! "filter-one-progspace" filter-one 1 (current-progspace)) > +(register! "filter-one-objfile" filter-one 1 (current-objfile)) > + > +(register! "filter-two-progspace" filter-two 100 (current-progspace)) > +(register! "filter-two-objfile" filter-two 100 (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..5ea2681 > --- /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)))))) > + > +(register-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); ==== Lots of gdb coding convention violations, but since this is just copied from testsuite/gdb.python I think it's ok to leave as is. > +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}] != "" } { ==== extra space after "if" > + 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..f0ca7d0 > --- /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 13 12 11 10 0\\)" \ > + "all frame filter priorities" > +gdb_test "guile (map frame-filter-enabled? (all-frame-filters))" \ > + "\\(#t #t #f #t #t #t #t #f\\)" \ > + "all frame filter enabled?" > + > +gdb_test_no_output "guile (set-frame-filter-enabled! (find-frame-filter-by-name \"Elider\") #f)" \ > + "disable elider" > +gdb_test "guile (frame-filter-enabled? (find-frame-filter-by-name \"Elider\"))"\ > + ".*#f.*" \ > + "elider not enabled" > +gdb_test_no_output "guile (set-frame-filter-enabled! (find-frame-filter-by-name \"Elider\") #t)" \ > + "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 (set-frame-filter-enabled! (find-frame-filter-by-name \"Reverse\") #f)" \ > + "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 (set-frame-filter-enabled! (find-frame-filter-by-name \"Error\") #t)" \ > + "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 (set-frame-filter-enabled! (find-frame-filter-by-name \"Reverse\") #f)" \ > + "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..a529f8f > --- /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"))) > + > +(register-frame-filter! (make-decorating-frame-filter > + "Reverse" reverse-decorator #:priority 100)) > +(register-frame-filter! (make-decorating-frame-filter > + "Dummy" dummy-decorator #:enabled? #f #:priority 30)) > +(register-frame-filter! (make-frame-filter > + "Elider" eliding-filter #:priority 900)) > +(register-frame-filter! (make-decorating-frame-filter > + "Error" error-decorator #:enabled? #f)) ^ permalink raw reply [flat|nested] 8+ messages in thread
* [PATCH v6] Add Guile frame filter interface 2015-04-20 5:29 ` Doug Evans @ 2015-04-28 16:12 ` Andy Wingo 2015-05-04 0:38 ` Doug Evans 0 siblings, 1 reply; 8+ messages in thread From: Andy Wingo @ 2015-04-28 16:12 UTC (permalink / raw) To: Doug Evans; +Cc: gdb-patches [-- Attachment #1: Type: text/plain, Size: 7411 bytes --] Hi, thanks for the review. Fixed nits, a couple comments and responses. On Mon 20 Apr 2015 07:27, Doug Evans <xdje42@gmail.com> writes: > Andy Wingo <wingo@igalia.com> writes: > >> +(define* (has-active-frame-filters? #:optional (locus (current-progspace))) > > Is current-progspace the best default here? Dunno. > Since this function is only called without arguments > how about removing "locus" for now. This is an internal helper. It should probably be called with an argument but it is not, as you note below, and we haven't seen a problem because the default value is the same as the one it would be called with. However it is the correct default, I think; below you ask what the correct default is for apply-frame-filters, and I think it is indeed the current progspace. Note that this isn't really a locus but more of a scope. Which frame filters can apply to a backtrace? The ones registered on objfiles that are in the current progspace, the ones registered on the current progspace, and the ones registered globally. See the same-scope? procedure, which I reproduce here: (define (same-scope? a b) "Return #t if loci A and B represent the same scope, for the purposes of frame filter selection." (cond ;; If either locus is global, they share a scope. ((or (not a) (not b)) #t) ;; If either locus is an objfile, compare their progspaces, unless ;; the objfile is invalid. ((objfile? a) (and (objfile-valid? a) (same-scope? (objfile-progspace a) b))) ((objfile? b) (and (objfile-valid? b) (same-scope? a (objfile-progspace b)))) ;; Otherwise they are progspaces. If they eq?, it's the same scope. (else (eq? a b)))) I don't know if this should be different, but it is effectively what Python does (see frames.py:return_list). I guess Python also includes filters for objfiles in other progspaces, but that sounds like the wrong thing to me... >> +(define* (find-frame-filter-by-name name #:optional (locus (current-progspace))) > > Is current-progspace the best default? Dunno. > How about removing a default for locus until there's a compelling choice. > >> + (prune-frame-filters!) >> + (or (find (lambda (filter) >> + (and (equal? name (frame-filter-name filter)) >> + (eq? (frame-filter-locus filter) locus))) >> + *frame-filters*) >> + (find (lambda (filter) >> + (and (equal? name (frame-filter-name filter)) >> + (same-scope? (frame-filter-locus filter) locus))) >> + *frame-filters*) >> + (error "no frame filter found with name" name))) You sure? The code above will also find filters that have "same-scope?" with the given locus, which for the current progspace includes its objfiles and the global scope. To me this is a fine default and in no way limits what the function can do. Just want to double-check here. >> +(define* (apply-active-frame-filters stream #:optional >> + (locus (current-progspace))) > > Similarly, it's not clear to me what the best default for locus is. > Also, it appears locus is currently unused (the only caller doesn't > pass a locus). > >> + "Fold the active frame filter procedures over a stream." >> + (fold (lambda (filter stream) >> + (if (and (frame-filter-enabled? filter) >> + (same-scope? (frame-filter-locus filter) locus)) >> + ((frame-filter-procedure filter) stream) >> + stream)) >> + stream >> + *frame-filters*)) Not sure if I understand this comment. "locus" is certainly used in the body of the function, with its default value of (current-progspace) when called from apply-frame-filter. Are you suggesting that instead we bind (let ((scope (current-progspace))) ...) in the function? To me the optional argument with its default initializer does this nicely. >> +{ >> + 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); > > pass type here instead of value_type (val)? > [I suspect py-framefilter.c has the same bug.] This causes scm-frame-filter-mi.exp to fail: Expecting: ^(-stack-list-arguments 2[ ]+)?(\^done,stack-args=\[frame={level="0",args=\[{name="foo",type="int",value="21"},{name="bar",type="char \*",value="0x[0-9A-Fa-f]+ \\"Param\\""},{name="fb",type="foobar \*",value="0x[0-9A-Fa-f]+"},{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=\[\]}\][ ]+[(]gdb[)] [ ]*) -stack-list-arguments 2 ^done,stack-args=[frame={level="0",args=[{name="foo",type="int",value="21"},{name="bar",type="char *",value="0x4008b1 \"Param\""},{name="fb",type="foobar *",value="0x601010"},{name="bf",type="struct {...}"}]},frame={level="1",args=[]},frame={level="2",args=[{name="j",type="int",value="10"}]},frame={level="3",args=[]},frame={level="4",args=[{name="j",type="int",value="9"}]},frame={level="5",args=[]},frame={level="6",args=[{name="j",type="int",value="8"}]},frame={level="7",args=[]},frame={level="8",args=[{name="j",type="int",value="7"}]},frame={level="9",args=[]},frame={level="10",args=[{name="j",type="int",value="6"}]},frame={level="11",args=[]},frame={level="12",args=[{name="j",type="int",value="5"}]},frame={level="13",args=[]},frame={level="14",args=[{name="j",type="int",value="4"}]},frame={level="15",args=[]},frame={level="16",args=[{name="j",type="int",value="3"}]},frame={level="17",args=[]},frame={level="18",args=[{name="j",type="int",value="2"}]},frame={level="19",args=[]},frame={level="20",args=[{name="j",type="int",value="1"}]},frame={level="21",args=[]},frame={level="22",args=[],children=[frame={level="23",args=[]}]},frame={level="24",args=[{name="i",type="int",value="3"}]},frame={level="25",args=[{name="j",type="int",value="3"}]},frame={level="26",args=[{name="f",type="int",value="3"},{name="d",type="int",value="5"}]},frame={level="27",args=[]}] (gdb) FAIL: gdb.guile/scm-frame-filter-mi.exp: stack-list-arguments 2 One piece of it expects: {name="bf",type="foobar"} but gets: {name="bf",type="struct {...}"} Dunno. I didn't make this change in the patch because I don't understand what it's trying to do. What's the right thing? There's another failure also, for "stack-list-arguments 2 0 3" > Whether we *want* to strip typedefs here is a good question. > It's not immediately obvious that we do. > OTOH, check_typedef serves two purposes, the other being to resolve > opaque types and I'm guessing we do want to resolve opaque types here, > *and* we have no other function which does just this (we need to fix this). > > Thoughts? I am not sure and I don't really understand this code :) I'm happy to improve it over time though. I think I've covered the rest of the nits. Attached patch is v6. Regards, Andy [-- Attachment #2: 0001-Add-Guile-frame-filter-interface.patch --] [-- Type: text/plain, Size: 134752 bytes --] From 346a7697bdf2d242f6f5d7d05024746dca7db2a8 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: New file. * guile/lib/gdb/frame-filters.scm: New file. * 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. Rework to not use -Wunused-toplevel, as it doesn't account for uses via macro expansion, but do add -Wunbound-variable for files other than gdb.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/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 | 26 + gdb/Makefile.in | 6 + gdb/data-directory/Makefile.in | 27 +- gdb/doc/ChangeLog | 5 + gdb/doc/guile.texi | 431 ++++++++- gdb/guile/guile-internal.h | 76 ++ gdb/guile/guile.c | 3 +- gdb/guile/lib/gdb/frame-filters.scm | 462 ++++++++++ gdb/guile/scm-exception.c | 9 + gdb/guile/scm-frame-filter.c | 959 +++++++++++++++++++++ gdb/guile/scm-frame.c | 2 +- gdb/guile/scm-utils.c | 19 + gdb/mi/mi-main.c | 3 + gdb/testsuite/ChangeLog | 13 + .../gdb.guile/scm-frame-filter-gdb.scm.in | 35 + .../scm-frame-filter-invalidarg-gdb.scm.in | 35 + .../gdb.guile/scm-frame-filter-invalidarg.S | 261 ++++++ .../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, 3267 insertions(+), 11 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/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.S 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 d833876..babdff4 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,29 @@ +2015-04-28 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. Rework to + not use -Wunused-toplevel, as it doesn't account for uses via + macro expansion, but do add -Wunbound-variable for files other + than gdb.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-04-28 Patrick Palka <patrick@parcs.ath.cx> * tui/tui-source.c (tui_set_source_content): Avoid calling diff --git a/gdb/Makefile.in b/gdb/Makefile.in index 95104ef..64cb805 100644 --- a/gdb/Makefile.in +++ b/gdb/Makefile.in @@ -321,6 +321,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 \ @@ -347,6 +348,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 \ @@ -2434,6 +2436,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 30cfd17..21e44b9 100644 --- a/gdb/data-directory/Makefile.in +++ b/gdb/data-directory/Makefile.in @@ -89,21 +89,26 @@ GUILE_SOURCE_FILES = \ ./gdb.scm \ gdb/boot.scm \ gdb/experimental.scm \ + gdb/frame-filters.scm \ gdb/init.scm \ gdb/iterator.scm \ gdb/printing.scm \ gdb/support.scm \ gdb/types.scm +GUILE_NO_UNBOUND_WARNING_COMPILED_FILES = \ + ./gdb.go + GUILE_COMPILED_FILES = \ - ./gdb.go \ gdb/experimental.go \ + gdb/frame-filters.go \ gdb/iterator.go \ gdb/printing.go \ gdb/support.go \ gdb/types.go -@HAVE_GUILE_TRUE@GUILE_FILES = $(GUILE_SOURCE_FILES) $(GUILE_COMPILED_FILES) +@HAVE_GUILE_TRUE@GUILE_FILES = $(GUILE_SOURCE_FILES) \ + $(GUILE_COMPILED_FILES) $(GUILE_NO_UNBOUND_WARNING_COMPILED_FILES) @HAVE_GUILE_FALSE@GUILE_FILES = GUILD = @GUILD@ @@ -115,10 +120,10 @@ GUILD_TARGET_FLAG = @GUILD_TARGET_FLAG@ # Note: To work around a guile 2.0.5 issue (it can't find gdb/init.scm even if # we pass -L <dir>) we have to compile in the directory containing gdb.scm. # We still need to pass "-L ." so that other modules are found. -GUILD_COMPILE_FLAGS = \ - $(GUILD_TARGET_FLAG) \ - -Warity-mismatch -Wformat -Wunused-toplevel \ - -L . +GUILD_NO_UNBOUND_WARNING_COMPILE_FLAGS = \ + $(GUILD_TARGET_FLAG) -Warity-mismatch -Wformat -L . +GUILD_COMPILE_FLAGS = $(GUILD_NO_UNBOUND_WARNING_COMPILE_FLAGS) \ + -Wunbound-variable SYSTEM_GDBINIT_DIR = system-gdbinit SYSTEM_GDBINIT_INSTALL_DIR = $(DESTDIR)$(GDB_DATADIR)/$(SYSTEM_GDBINIT_DIR) @@ -258,8 +263,16 @@ stamp-guile: Makefile $(GUILE_SOURCE_FILES) $(INSTALL_DIR) ./$(GUILE_DIR)/$$dir ; \ $(INSTALL_DATA) $(GUILE_SRCDIR)/$$file ./$(GUILE_DIR)/$$dir ; \ done ; \ - files='$(GUILE_COMPILED_FILES)' ; \ cd ./$(GUILE_DIR) ; \ + files='$(GUILE_NO_UNBOUND_WARNING_COMPILED_FILES)' ; \ + for go in $$files ; do \ + source="`echo $$go | sed 's/\.go$$/.scm/'`" ; \ + echo $(GUILD) compile $(GUILD_NO_UNBOUND_WARNING_COMPILE_FLAGS) \ + -o "$$go" "$$source" ; \ + $(GUILD) compile $(GUILD_NO_UNBOUND_WARNING_COMPILE_FLAGS) \ + -o "$$go" "$$source" || exit 1 ; \ + done ; \ + files='$(GUILE_COMPILED_FILES)' ; \ for go in $$files ; do \ source="`echo $$go | sed 's/\.go$$/.scm/'`" ; \ echo $(GUILD) compile $(GUILD_COMPILE_FLAGS) -o "$$go" "$$source" ; \ diff --git a/gdb/doc/ChangeLog b/gdb/doc/ChangeLog index 5da9943..7899910 100644 --- a/gdb/doc/ChangeLog +++ b/gdb/doc/ChangeLog @@ -1,3 +1,8 @@ +2015-04-28 Andy Wingo <wingo@igalia.com> + + * guile.texi (Guile Frame Filter API) + (Writing a Frame Filter in Guile): New sections. + 2015-04-24 Andrew Burgess <andrew.burgess@embecosm.com> * gdb.texinfo (Dump/Restore Files): Add detail about verilog dump diff --git a/gdb/doc/guile.texi b/gdb/doc/guile.texi index 04572fd..225879c 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,431 @@ 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 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: + +@smallexample +(use-modules (gdb frame-filters)) +@end smallexample + +@deffn {Scheme Procedure} make-frame-filter name procedure @ + @r{[}#:priority priority@r{]} @r{[}#:enabled? boolean@r{]} +Make a new frame filter. + +The filter will be identified by the string @var{name}. +@var{procedure} must 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 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 registered with @value{GDBN} via +@code{register-frame-filter!} in order to take effect. When +registered, the filter will be inserted into the chain of registered +with the given @var{priority}, which must be a number in the signed +32-bit integer range, and which defaults to 0 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} register-frame-filter! filter @ + @r{[}#:locus locus@r{]} @r{[}#:replace? replace?@r{]} +Register the frame filter @var{filter} with @value{GDBN}. + +By default, the locus of the filter is global, meaning that it is +associated with all objfiles and progspaces. Pass an objfile or a +progspace as the @code{#:locus} keyword argument to instead associate +the filter with a specific objfile or progspace, respectively. + +The filter's name must be unique within its locus. @value{GDBN} will +raise an exception if the locus already has a filter registered with +the given name, unless a true value is passed as the @code{#:replace?} +keyword argument, in which case any existing filter will be removed. +@end deffn + +@deffn {Scheme Procedure} remove-frame-filter! filter +Remove the frame filter @var{filter}. Frame filters are also +implicitly removed when their locus (objfile or progspace) goes away. +@end deffn + +@deffn {Scheme Procedure} set-frame-filter-enabled! filter enabled? +Mark a frame filter as enabled, if @var{enabled?} is true, or +as disabled otherwise. +@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-locus 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. The @code{locus} 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. + +A 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{GDBN} symbol will be used to load the +corresponding value 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{]} +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: + +@smallexample +(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 smallexample + +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}. + +@smallexample +(define identity-filter-object + (make-frame-filter "identity" identity-frame-filter)) + +(register-frame-filter! identity-filter-object) +@end smallexample + +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. @xref{Frame Filter Management}. + +By default, filters are enabled when they are added. You can control +the enabled or disabled state of a filter using the appropriate +procedures: + +@smallexample +(set-frame-filter-enabled! identity-filter-object #f) +@end smallexample + +Finally, we can remove all filters with a simple application of +@code{for-each}: + +@smallexample +(for-each remove-frame-filter! (all-frame-filters)) +@end smallexample + +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)) + +(register-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))) + +(register-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 509120b..d7c166c 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. */ @@ -293,6 +294,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); @@ -410,6 +415,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); @@ -568,6 +576,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); @@ -584,6 +597,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); @@ -623,4 +637,66 @@ 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 { \ + /* 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 \ + { \ + 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); \ + } \ + CATCH (dynwind_except, RETURN_MASK_ALL) \ + { \ + /* Pop the dynwind and restore the saved cleanup stack. */ \ + scm_dynwind_end (); \ + /* Rethrow GDB exception as Scheme exception. */ \ + gdbscm_throw_gdb_exception (dynwind_except); \ + } \ + END_CATCH \ + /* Pop the dynwind and restore the saved cleanup stack. */ \ + scm_dynwind_end (); \ + } while (0) + #endif /* GDB_GUILE_INTERNAL_H */ diff --git a/gdb/guile/guile.c b/gdb/guile/guile.c index 4abf5c5..176e97e 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, @@ -669,6 +669,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..eae5264 --- /dev/null +++ b/gdb/guile/lib/gdb/frame-filters.scm @@ -0,0 +1,462 @@ +;; 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-locus + + find-frame-filter-by-name + + register-frame-filter! + remove-frame-filter! + set-frame-filter-enabled! + + 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) + "Compute 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 a 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 locus) + 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 + (locus frame-filter-locus set-locus!)) + +(define *int32-min* (- (ash 1 31))) +(define *int32-max* (- (ash 1 31) 1)) + +(define (valid-priority? priority) + (and (number? priority) (integer? priority) (exact? priority) + (<= *int32-min* priority *int32-max*))) + +(define* (make-frame-filter name procedure #:key (priority 0) (enabled? #t)) + "Make and return a new frame filter. NAME and PROCEDURE are required +arguments. Specify #:priority or #:enabled? to set the priority and +enabled status of the filter. + +The filter must be registered with GDB via `register-frame-filter!' +before it is active." + (unless (valid-priority? priority) + (error "Priority must be within signed int32 range" priority)) + (let ((registered? #f) (locus #f)) + (%make-frame-filter name priority enabled? registered? procedure locus))) + +;; List of frame filters, sorted by priority from highest to lowest. +(define *frame-filters* '()) + +(define (same-scope? a b) + "Return #t if loci A and B represent the same scope, for the purposes +of frame filter selection." + (cond + ;; If either locus is global, they share a scope. + ((or (not a) (not b)) #t) + ;; If either locus is an objfile, compare their progspaces, unless + ;; the objfile is invalid. + ((objfile? a) (and (objfile-valid? a) + (same-scope? (objfile-progspace a) b))) + ((objfile? b) (and (objfile-valid? 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 locus of FILTER is still valid, or otherwise #f if +the objfile or progspace has been removed from GDB." + (let ((locus (frame-filter-locus filter))) + (cond + ((progspace? locus) (progspace-valid? locus)) + ((objfile? locus) (objfile-valid? locus)) + (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? locus) + "Return #t if there are active frame filters that share a scope for +the given locus, or #f otherwise." + (let lp ((filters *frame-filters*)) + (match filters + (() #f) + ((filter . filters) + (or (and (frame-filter-enabled? filter) + (same-scope? (frame-filter-locus filter) locus)) + (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) + (set-locus! f #f) + (lp filters)))))))) + +(define* (register-frame-filter! filter #:key locus replace?) + "Register a frame filter with GDB. Frame filters must be registered +before they will be used to filter backtraces. + +By default, the filter will be registered globally. Specify an objfile +or a progspace as the #:locus keyword argument to instead register the +filter as belonging to a specific objfile or progspace. + +The filter's name must be unique within its locus. GDB will raise an +exception if the locus already has a filter registered with the given +name, unless a true value is passed as the #:replace? keyword argument, +in which case any existing filter will be removed from its locus." + (define (check-locus!) + (cond + ((objfile? locus) + (unless (objfile-valid? locus) + (error "Objfile is not valid" locus))) + ((progspace? locus) + (unless (progspace-valid? locus) + (error "Progspace is not valid" locus))) + (locus + (error "Invalid locus" locus)))) + (define (duplicate-filter? other) + (and (equal? (frame-filter-name other) (frame-filter-name filter)) + (eq? (frame-filter-locus other) locus))) + (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*))))))) + + (when (frame-filter-registered? filter) + (error "Frame filter is already registered with GDB" filter)) + (check-locus!) + (prune-frame-filters!) + (let ((found (find duplicate-filter? *frame-filters*))) + (when found + (if replace? + (remove-frame-filter! found) + (error "Frame filter with this name already present in locus" + (frame-filter-name filter))))) + (set-registered?! filter #t) + (set-locus! filter locus) + (set! *frame-filters* (insert-sorted filter *frame-filters* priority>=?))) + +(define (remove-frame-filter! filter) + "Remove a frame filter." + (set-registered?! filter #f) + (set-locus! filter #f) + (set! *frame-filters* (delq filter *frame-filters*))) + +(define* (find-frame-filter-by-name name #:optional (locus (current-progspace))) + (prune-frame-filters!) + (or (find (lambda (filter) + (and (equal? name (frame-filter-name filter)) + (eq? (frame-filter-locus filter) locus))) + *frame-filters*) + (find (lambda (filter) + (and (equal? name (frame-filter-name filter)) + (same-scope? (frame-filter-locus filter) locus))) + *frame-filters*) + (error "no frame filter found with name" name))) + +(define (set-frame-filter-enabled! filter enabled?) + "Enable or disable a frame filter." + (set-enabled?! filter enabled?) + *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 a 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 + (locus (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-locus filter) locus)) + ((frame-filter-procedure filter) stream) + stream)) + stream + *frame-filters*)) + +(define* (apply-frame-filter frame frame-low frame-high #:optional + (locus (current-progspace))) + "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? locus) + (let ((frames (frame-stream frame frame-low frame-high))) + (stream->gdb-iterator (apply-active-frame-filters frames locus) + 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..0727333 --- /dev/null +++ b/gdb/guile/scm-frame-filter.c @@ -0,0 +1,959 @@ +/* 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)) + { + char *fresh_name; + + fresh_name = gdbscm_scm_to_host_string (symbol_scm, NULL, + &exception); + if (fresh_name == NULL) + gdbscm_throw (exception); + make_cleanup (xfree, fresh_name); + + *name = fresh_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: + if (type == MI_PRINT_ARGS) + return SYMBOL_IS_ARGUMENT (sym); + else + return !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 +ffscm_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 +ffscm_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 +ffscm_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) + ffscm_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 + ffscm_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 +ffscm_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 == NULL) + /* 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) + ffscm_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; + + ffscm_print_value (out, val, &opts, val_indent, args_type, + language); + } + else + { + if (args_type != NO_VALUES) + ffscm_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 +ffscm_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); + + ffscm_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 +ffscm_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. */ + ffscm_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) + ffscm_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, " "); + } + + ffscm_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 +ffscm_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, ", "); + + ffscm_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 +ffscm_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"); + ffscm_print_args (arguments_scm, out, args_type, frame, + WITH_ARGS_FIELD, gdbarch); + ffscm_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 != NULL) + { + 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 == NULL) + 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) + ffscm_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 == NULL) + 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) + ffscm_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); + + ffscm_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); + + ffscm_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 787b788..6ec8058 100644 --- a/gdb/guile/scm-frame.c +++ b/gdb/guile/scm-frame.c @@ -214,7 +214,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..4482b31 100644 --- a/gdb/guile/scm-utils.c +++ b/gdb/guile/scm-utils.c @@ -641,3 +641,22 @@ 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 2733e80..42d204f 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 1967aca..b2b567d 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,5 +1,18 @@ 2015-04-28 Andy Wingo <wingo@igalia.com> + * gdb.guile/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-04-28 Andy Wingo <wingo@igalia.com> + * gdb.python/py-parameter.exp: * gdb.guile/scm-parameter.exp: Escape the path that we are matching against, as it might contain characters that are special 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..a5a7f17 --- /dev/null +++ b/gdb/testsuite/gdb.guile/scm-frame-filter-gdb.scm.in @@ -0,0 +1,35 @@ +;; 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) + +(define (register! name procedure priority locus) + (let ((filter (make-frame-filter name procedure #:priority priority))) + (register-frame-filter! filter #:locus locus))) + +(register! "filter-one-progspace" filter-one 10 (current-progspace)) +(register! "filter-one-objfile" filter-one 13 (current-objfile)) + +(register! "filter-two-progspace" filter-two 11 (current-progspace)) +(register! "filter-two-objfile" filter-two 12 (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..041f016 --- /dev/null +++ b/gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg-gdb.scm.in @@ -0,0 +1,35 @@ +;; 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) + +(define (register! name procedure priority locus) + (let ((filter (make-frame-filter name procedure #:priority priority))) + (register-frame-filter! filter #:locus locus))) + +(register! "filter-one-progspace" filter-one 1 (current-progspace)) +(register! "filter-one-objfile" filter-one 1 (current-objfile)) + +(register! "filter-two-progspace" filter-two 100 (current-progspace)) +(register! "filter-two-objfile" filter-two 100 (current-objfile)) diff --git a/gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg.S b/gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg.S new file mode 100644 index 0000000..0901714 --- /dev/null +++ b/gdb/testsuite/gdb.guile/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-invalidarg.exp b/gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg.exp new file mode 100644 index 0000000..599881e --- /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 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..5ea2681 --- /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)))))) + +(register-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..1d80e36 --- /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..f0ca7d0 --- /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 13 12 11 10 0\\)" \ + "all frame filter priorities" +gdb_test "guile (map frame-filter-enabled? (all-frame-filters))" \ + "\\(#t #t #f #t #t #t #t #f\\)" \ + "all frame filter enabled?" + +gdb_test_no_output "guile (set-frame-filter-enabled! (find-frame-filter-by-name \"Elider\") #f)" \ + "disable elider" +gdb_test "guile (frame-filter-enabled? (find-frame-filter-by-name \"Elider\"))"\ + ".*#f.*" \ + "elider not enabled" +gdb_test_no_output "guile (set-frame-filter-enabled! (find-frame-filter-by-name \"Elider\") #t)" \ + "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 (set-frame-filter-enabled! (find-frame-filter-by-name \"Reverse\") #f)" \ + "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 (set-frame-filter-enabled! (find-frame-filter-by-name \"Error\") #t)" \ + "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 (set-frame-filter-enabled! (find-frame-filter-by-name \"Reverse\") #f)" \ + "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..a529f8f --- /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"))) + +(register-frame-filter! (make-decorating-frame-filter + "Reverse" reverse-decorator #:priority 100)) +(register-frame-filter! (make-decorating-frame-filter + "Dummy" dummy-decorator #:enabled? #f #:priority 30)) +(register-frame-filter! (make-frame-filter + "Elider" eliding-filter #:priority 900)) +(register-frame-filter! (make-decorating-frame-filter + "Error" error-decorator #:enabled? #f)) -- 2.1.4 ^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [PATCH v6] Add Guile frame filter interface 2015-04-28 16:12 ` [PATCH v6] " Andy Wingo @ 2015-05-04 0:38 ` Doug Evans 0 siblings, 0 replies; 8+ messages in thread From: Doug Evans @ 2015-05-04 0:38 UTC (permalink / raw) To: Andy Wingo; +Cc: gdb-patches Andy Wingo <wingo@igalia.com> writes: > Hi, thanks for the review. Fixed nits, a couple comments and > responses. Thanks. > On Mon 20 Apr 2015 07:27, Doug Evans <xdje42@gmail.com> writes: > >> Andy Wingo <wingo@igalia.com> writes: >> >>> +(define* (has-active-frame-filters? #:optional (locus (current-progspace))) >> >> Is current-progspace the best default here? Dunno. >> Since this function is only called without arguments >> how about removing "locus" for now. > > This is an internal helper. It should probably be called with an > argument but it is not, as you note below, and we haven't seen a problem > because the default value is the same as the one it would be called > with. However it is the correct default, I think; below you ask what > the correct default is for apply-frame-filters, and I think it is indeed > the current progspace. Optional arguments impose extra complexity on the human reader. If there's no need for them let's keep the code simple and clear. > Note that this isn't really a locus but more of > a scope. Which frame filters can apply to a backtrace? The ones > registered on objfiles that are in the current progspace, the ones > registered on the current progspace, and the ones registered globally. > See the same-scope? procedure, which I reproduce here: > > (define (same-scope? a b) > "Return #t if loci A and B represent the same scope, for the purposes > of frame filter selection." > (cond > ;; If either locus is global, they share a scope. > ((or (not a) (not b)) #t) > ;; If either locus is an objfile, compare their progspaces, unless > ;; the objfile is invalid. > ((objfile? a) (and (objfile-valid? a) > (same-scope? (objfile-progspace a) b))) > ((objfile? b) (and (objfile-valid? b) > (same-scope? a (objfile-progspace b)))) > ;; Otherwise they are progspaces. If they eq?, it's the same scope. > (else (eq? a b)))) > > I don't know if this should be different, but it is effectively what > Python does (see frames.py:return_list). I guess Python also includes > filters for objfiles in other progspaces, but that sounds like the wrong > thing to me... I can imagine this doesn't happen in python because the objfile list is derived from the current progspace. That's what objfiles.h:ALL_OBJFILES does, and thus what Python's gdb.objfiles() function does. The name is a bit of a misnomer but intuitively it's generally wrong to ever consider all objfiles of all progspaces (there can be a few exceptions, but in general ...), and I think the name relies on this. Is it the case that this problem is introduced by the Guile version's choice of having one list for everything? (instead of, e.g., recording framefilters with the object like the Python version does; ref: gdb/py-objfiles.c:objfile_object) If Guile did the same as Python here would we need same-scope? ? >>> +(define* (find-frame-filter-by-name name #:optional (locus (current-progspace))) >> >> Is current-progspace the best default? Dunno. >> How about removing a default for locus until there's a compelling choice. >> >>> + (prune-frame-filters!) >>> + (or (find (lambda (filter) >>> + (and (equal? name (frame-filter-name filter)) >>> + (eq? (frame-filter-locus filter) locus))) >>> + *frame-filters*) >>> + (find (lambda (filter) >>> + (and (equal? name (frame-filter-name filter)) >>> + (same-scope? (frame-filter-locus filter) locus))) >>> + *frame-filters*) >>> + (error "no frame filter found with name" name))) > > You sure? The code above will also find filters that have "same-scope?" > with the given locus, which for the current progspace includes its > objfiles and the global scope. To me this is a fine default and in no > way limits what the function can do. Just want to double-check here. Ok. >>> +(define* (apply-active-frame-filters stream #:optional >>> + (locus (current-progspace))) >> >> Similarly, it's not clear to me what the best default for locus is. >> Also, it appears locus is currently unused (the only caller doesn't >> pass a locus). >> >>> + "Fold the active frame filter procedures over a stream." >>> + (fold (lambda (filter stream) >>> + (if (and (frame-filter-enabled? filter) >>> + (same-scope? (frame-filter-locus filter) locus)) >>> + ((frame-filter-procedure filter) stream) >>> + stream)) >>> + stream >>> + *frame-filters*)) > > Not sure if I understand this comment. "locus" is certainly used in the > body of the function, with its default value of (current-progspace) when > called from apply-frame-filter. Are you suggesting that instead we bind > (let ((scope (current-progspace))) ...) in the function? To me the > optional argument with its default initializer does this nicely. Sorry, I meant that it's never passed with different values. Since this is an internal implementation detail there's no real need for optional arguments here (at least not today), IOW always pass the locus in as an argument. >>> +{ >>> + 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); >> >> pass type here instead of value_type (val)? >> [I suspect py-framefilter.c has the same bug.] > > This causes scm-frame-filter-mi.exp to fail: Ah. Then I wonder what the call to check_typedef is here for. > > Expecting: ^(-stack-list-arguments 2[ > ]+)?(\^done,stack-args=\[frame={level="0",args=\[{name="foo",type="int",value="21"},{name="bar",type="char > ] \*",value="0x[0-9A-Fa-f]+ \\"Param\\""},{name="fb",type="foobar > ] \*",value="0x[0-9A-Fa-f]+"},{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=\[\]}\][ > ]+[(]gdb[)] > [ ]*) > -stack-list-arguments 2 > ^done,stack-args=[frame={level="0",args=[{name="foo",type="int",value="21"},{name="bar",type="char > *",value="0x4008b1 \"Param\""},{name="fb",type="foobar > *",value="0x601010"},{name="bf",type="struct > {...}"}]},frame={level="1",args=[]},frame={level="2",args=[{name="j",type="int",value="10"}]},frame={level="3",args=[]},frame={level="4",args=[{name="j",type="int",value="9"}]},frame={level="5",args=[]},frame={level="6",args=[{name="j",type="int",value="8"}]},frame={level="7",args=[]},frame={level="8",args=[{name="j",type="int",value="7"}]},frame={level="9",args=[]},frame={level="10",args=[{name="j",type="int",value="6"}]},frame={level="11",args=[]},frame={level="12",args=[{name="j",type="int",value="5"}]},frame={level="13",args=[]},frame={level="14",args=[{name="j",type="int",value="4"}]},frame={level="15",args=[]},frame={level="16",args=[{name="j",type="int",value="3"}]},frame={level="17",args=[]},frame={level="18",args=[{name="j",type="int",value="2"}]},frame={level="19",args=[]},frame={level="20",args=[{name="j",type="int",value="1"}]},frame={level="21",args=[]},frame={level="22",args=[],children=[frame={level="23",args=[]}]},frame={level="24",args=[{name="i",type="int",value="3"}]},frame={level="25",args=[{name="j",type="int",value="3"}]},frame={level="26",args=[{name="f",type="int",value="3"},{name="d",type="int",value="5"}]},frame={level="27",args=[]}] > (gdb) > FAIL: gdb.guile/scm-frame-filter-mi.exp: stack-list-arguments 2 > > One piece of it expects: > > {name="bf",type="foobar"} > > but gets: > > {name="bf",type="struct {...}"} > > Dunno. I didn't make this change in the patch because I don't > understand what it's trying to do. What's the right thing? There's > another failure also, for "stack-list-arguments 2 0 3" It looks like the line with the check_typedef can just be deleted. >> Whether we *want* to strip typedefs here is a good question. >> It's not immediately obvious that we do. >> OTOH, check_typedef serves two purposes, the other being to resolve >> opaque types and I'm guessing we do want to resolve opaque types here, >> *and* we have no other function which does just this (we need to fix this). >> >> Thoughts? > > I am not sure and I don't really understand this code :) I'm happy to > improve it over time though. > > I think I've covered the rest of the nits. Attached patch is v6. > > Regards, > > Andy > > From 346a7697bdf2d242f6f5d7d05024746dca7db2a8 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: New file. > * guile/lib/gdb/frame-filters.scm: New file. > * 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. Rework to > not use -Wunused-toplevel, as it doesn't account for uses via > macro expansion, but do add -Wunbound-variable for files other > than gdb.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/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. >... > > diff --git a/gdb/ChangeLog b/gdb/ChangeLog > index d833876..babdff4 100644 > --- a/gdb/ChangeLog > +++ b/gdb/ChangeLog > @@ -1,3 +1,29 @@ > +2015-04-28 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. Rework to > + not use -Wunused-toplevel, as it doesn't account for uses via > + macro expansion, but do add -Wunbound-variable for files other > + than gdb.scm. Explanatory comments like these are best put in the file itself. > + * 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-04-28 Patrick Palka <patrick@parcs.ath.cx> > > * tui/tui-source.c (tui_set_source_content): Avoid calling > diff --git a/gdb/Makefile.in b/gdb/Makefile.in > index 95104ef..64cb805 100644 > --- a/gdb/Makefile.in > +++ b/gdb/Makefile.in > @@ -321,6 +321,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 \ > @@ -347,6 +348,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 \ > @@ -2434,6 +2436,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 30cfd17..21e44b9 100644 > --- a/gdb/data-directory/Makefile.in > +++ b/gdb/data-directory/Makefile.in > @@ -89,21 +89,26 @@ GUILE_SOURCE_FILES = \ > ./gdb.scm \ > gdb/boot.scm \ > gdb/experimental.scm \ > + gdb/frame-filters.scm \ > gdb/init.scm \ > gdb/iterator.scm \ > gdb/printing.scm \ > gdb/support.scm \ > gdb/types.scm > > +GUILE_NO_UNBOUND_WARNING_COMPILED_FILES = \ > + ./gdb.go > + > GUILE_COMPILED_FILES = \ > - ./gdb.go \ > gdb/experimental.go \ > + gdb/frame-filters.go \ > gdb/iterator.go \ > gdb/printing.go \ > gdb/support.go \ > gdb/types.go > > -@HAVE_GUILE_TRUE@GUILE_FILES = $(GUILE_SOURCE_FILES) $(GUILE_COMPILED_FILES) > +@HAVE_GUILE_TRUE@GUILE_FILES = $(GUILE_SOURCE_FILES) \ > + $(GUILE_COMPILED_FILES) $(GUILE_NO_UNBOUND_WARNING_COMPILED_FILES) > @HAVE_GUILE_FALSE@GUILE_FILES = > > GUILD = @GUILD@ > @@ -115,10 +120,10 @@ GUILD_TARGET_FLAG = @GUILD_TARGET_FLAG@ > # Note: To work around a guile 2.0.5 issue (it can't find gdb/init.scm even if > # we pass -L <dir>) we have to compile in the directory containing gdb.scm. > # We still need to pass "-L ." so that other modules are found. > -GUILD_COMPILE_FLAGS = \ > - $(GUILD_TARGET_FLAG) \ > - -Warity-mismatch -Wformat -Wunused-toplevel \ > - -L . > +GUILD_NO_UNBOUND_WARNING_COMPILE_FLAGS = \ > + $(GUILD_TARGET_FLAG) -Warity-mismatch -Wformat -L . > +GUILD_COMPILE_FLAGS = $(GUILD_NO_UNBOUND_WARNING_COMPILE_FLAGS) \ > + -Wunbound-variable > > SYSTEM_GDBINIT_DIR = system-gdbinit > SYSTEM_GDBINIT_INSTALL_DIR = $(DESTDIR)$(GDB_DATADIR)/$(SYSTEM_GDBINIT_DIR) > @@ -258,8 +263,16 @@ stamp-guile: Makefile $(GUILE_SOURCE_FILES) > $(INSTALL_DIR) ./$(GUILE_DIR)/$$dir ; \ > $(INSTALL_DATA) $(GUILE_SRCDIR)/$$file ./$(GUILE_DIR)/$$dir ; \ > done ; \ > - files='$(GUILE_COMPILED_FILES)' ; \ > cd ./$(GUILE_DIR) ; \ > + files='$(GUILE_NO_UNBOUND_WARNING_COMPILED_FILES)' ; \ > + for go in $$files ; do \ > + source="`echo $$go | sed 's/\.go$$/.scm/'`" ; \ > + echo $(GUILD) compile $(GUILD_NO_UNBOUND_WARNING_COMPILE_FLAGS) \ > + -o "$$go" "$$source" ; \ > + $(GUILD) compile $(GUILD_NO_UNBOUND_WARNING_COMPILE_FLAGS) \ > + -o "$$go" "$$source" || exit 1 ; \ > + done ; \ > + files='$(GUILE_COMPILED_FILES)' ; \ > for go in $$files ; do \ > source="`echo $$go | sed 's/\.go$$/.scm/'`" ; \ > echo $(GUILD) compile $(GUILD_COMPILE_FLAGS) -o "$$go" "$$source" ; \ > diff --git a/gdb/doc/ChangeLog b/gdb/doc/ChangeLog > index 5da9943..7899910 100644 > --- a/gdb/doc/ChangeLog > +++ b/gdb/doc/ChangeLog > @@ -1,3 +1,8 @@ > +2015-04-28 Andy Wingo <wingo@igalia.com> > + > + * guile.texi (Guile Frame Filter API) > + (Writing a Frame Filter in Guile): New sections. > + > 2015-04-24 Andrew Burgess <andrew.burgess@embecosm.com> > > * gdb.texinfo (Dump/Restore Files): Add detail about verilog dump > diff --git a/gdb/doc/guile.texi b/gdb/doc/guile.texi > index 04572fd..225879c 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,431 @@ 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 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: > + > +@smallexample > +(use-modules (gdb frame-filters)) > +@end smallexample > + > +@deffn {Scheme Procedure} make-frame-filter name procedure @ > + @r{[}#:priority priority@r{]} @r{[}#:enabled? boolean@r{]} > +Make a new frame filter. > + > +The filter will be identified by the string @var{name}. > +@var{procedure} must 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 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 registered with @value{GDBN} via > +@code{register-frame-filter!} in order to take effect. When > +registered, the filter will be inserted into the chain of registered > +with the given @var{priority}, which must be a number in the signed > +32-bit integer range, and which defaults to 0 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} register-frame-filter! filter @ > + @r{[}#:locus locus@r{]} @r{[}#:replace? replace?@r{]} > +Register the frame filter @var{filter} with @value{GDBN}. > + > +By default, the locus of the filter is global, meaning that it is > +associated with all objfiles and progspaces. Pass an objfile or a > +progspace as the @code{#:locus} keyword argument to instead associate > +the filter with a specific objfile or progspace, respectively. > + > +The filter's name must be unique within its locus. @value{GDBN} will > +raise an exception if the locus already has a filter registered with > +the given name, unless a true value is passed as the @code{#:replace?} > +keyword argument, in which case any existing filter will be removed. > +@end deffn > + > +@deffn {Scheme Procedure} remove-frame-filter! filter > +Remove the frame filter @var{filter}. Frame filters are also > +implicitly removed when their locus (objfile or progspace) goes away. > +@end deffn > + > +@deffn {Scheme Procedure} set-frame-filter-enabled! filter enabled? > +Mark a frame filter as enabled, if @var{enabled?} is true, or > +as disabled otherwise. > +@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-locus 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. The @code{locus} 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. > + > +A 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{GDBN} symbol will be used to load the > +corresponding value 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{]} > +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: > + > +@smallexample > +(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 smallexample > + > +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}. > + > +@smallexample > +(define identity-filter-object > + (make-frame-filter "identity" identity-frame-filter)) > + > +(register-frame-filter! identity-filter-object) > +@end smallexample > + > +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. @xref{Frame Filter Management}. > + > +By default, filters are enabled when they are added. You can control > +the enabled or disabled state of a filter using the appropriate > +procedures: > + > +@smallexample > +(set-frame-filter-enabled! identity-filter-object #f) > +@end smallexample > + > +Finally, we can remove all filters with a simple application of > +@code{for-each}: > + > +@smallexample > +(for-each remove-frame-filter! (all-frame-filters)) > +@end smallexample > + > +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)) > + > +(register-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))) > + > +(register-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 509120b..d7c166c 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. */ > @@ -293,6 +294,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); > > @@ -410,6 +415,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); > > @@ -568,6 +576,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); > > @@ -584,6 +597,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); > @@ -623,4 +637,66 @@ 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 { \ > + /* 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 \ > + { \ > + 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); \ > + } \ > + CATCH (dynwind_except, RETURN_MASK_ALL) \ > + { \ > + /* Pop the dynwind and restore the saved cleanup stack. */ \ > + scm_dynwind_end (); \ > + /* Rethrow GDB exception as Scheme exception. */ \ > + gdbscm_throw_gdb_exception (dynwind_except); \ > + } \ > + END_CATCH \ > + /* Pop the dynwind and restore the saved cleanup stack. */ \ > + scm_dynwind_end (); \ > + } while (0) > + > #endif /* GDB_GUILE_INTERNAL_H */ > diff --git a/gdb/guile/guile.c b/gdb/guile/guile.c > index 4abf5c5..176e97e 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, > > @@ -669,6 +669,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..eae5264 > --- /dev/null > +++ b/gdb/guile/lib/gdb/frame-filters.scm > @@ -0,0 +1,462 @@ > +;; 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-locus > + > + find-frame-filter-by-name > + > + register-frame-filter! > + remove-frame-filter! > + set-frame-filter-enabled! > + > + 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) > + "Compute 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 a 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 locus) > + 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 > + (locus frame-filter-locus set-locus!)) > + > +(define *int32-min* (- (ash 1 31))) > +(define *int32-max* (- (ash 1 31) 1)) > + > +(define (valid-priority? priority) > + (and (number? priority) (integer? priority) (exact? priority) > + (<= *int32-min* priority *int32-max*))) > + > +(define* (make-frame-filter name procedure #:key (priority 0) (enabled? #t)) > + "Make and return a new frame filter. NAME and PROCEDURE are required > +arguments. Specify #:priority or #:enabled? to set the priority and > +enabled status of the filter. > + > +The filter must be registered with GDB via `register-frame-filter!' > +before it is active." > + (unless (valid-priority? priority) > + (error "Priority must be within signed int32 range" priority)) > + (let ((registered? #f) (locus #f)) > + (%make-frame-filter name priority enabled? registered? procedure locus))) > + > +;; List of frame filters, sorted by priority from highest to lowest. > +(define *frame-filters* '()) > + > +(define (same-scope? a b) > + "Return #t if loci A and B represent the same scope, for the purposes > +of frame filter selection." > + (cond > + ;; If either locus is global, they share a scope. > + ((or (not a) (not b)) #t) > + ;; If either locus is an objfile, compare their progspaces, unless > + ;; the objfile is invalid. > + ((objfile? a) (and (objfile-valid? a) > + (same-scope? (objfile-progspace a) b))) > + ((objfile? b) (and (objfile-valid? 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 locus of FILTER is still valid, or otherwise #f if > +the objfile or progspace has been removed from GDB." > + (let ((locus (frame-filter-locus filter))) > + (cond > + ((progspace? locus) (progspace-valid? locus)) > + ((objfile? locus) (objfile-valid? locus)) > + (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? locus) > + "Return #t if there are active frame filters that share a scope for > +the given locus, or #f otherwise." > + (let lp ((filters *frame-filters*)) > + (match filters > + (() #f) > + ((filter . filters) > + (or (and (frame-filter-enabled? filter) > + (same-scope? (frame-filter-locus filter) locus)) > + (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) > + (set-locus! f #f) > + (lp filters)))))))) > + > +(define* (register-frame-filter! filter #:key locus replace?) > + "Register a frame filter with GDB. Frame filters must be registered > +before they will be used to filter backtraces. > + > +By default, the filter will be registered globally. Specify an objfile > +or a progspace as the #:locus keyword argument to instead register the > +filter as belonging to a specific objfile or progspace. > + > +The filter's name must be unique within its locus. GDB will raise an > +exception if the locus already has a filter registered with the given > +name, unless a true value is passed as the #:replace? keyword argument, > +in which case any existing filter will be removed from its locus." > + (define (check-locus!) > + (cond > + ((objfile? locus) > + (unless (objfile-valid? locus) > + (error "Objfile is not valid" locus))) > + ((progspace? locus) > + (unless (progspace-valid? locus) > + (error "Progspace is not valid" locus))) > + (locus > + (error "Invalid locus" locus)))) > + (define (duplicate-filter? other) > + (and (equal? (frame-filter-name other) (frame-filter-name filter)) > + (eq? (frame-filter-locus other) locus))) > + (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*))))))) > + > + (when (frame-filter-registered? filter) > + (error "Frame filter is already registered with GDB" filter)) > + (check-locus!) > + (prune-frame-filters!) > + (let ((found (find duplicate-filter? *frame-filters*))) > + (when found > + (if replace? > + (remove-frame-filter! found) > + (error "Frame filter with this name already present in locus" > + (frame-filter-name filter))))) > + (set-registered?! filter #t) > + (set-locus! filter locus) > + (set! *frame-filters* (insert-sorted filter *frame-filters* priority>=?))) > + > +(define (remove-frame-filter! filter) > + "Remove a frame filter." > + (set-registered?! filter #f) > + (set-locus! filter #f) > + (set! *frame-filters* (delq filter *frame-filters*))) > + > +(define* (find-frame-filter-by-name name #:optional (locus (current-progspace))) > + (prune-frame-filters!) > + (or (find (lambda (filter) > + (and (equal? name (frame-filter-name filter)) > + (eq? (frame-filter-locus filter) locus))) > + *frame-filters*) > + (find (lambda (filter) > + (and (equal? name (frame-filter-name filter)) > + (same-scope? (frame-filter-locus filter) locus))) > + *frame-filters*) > + (error "no frame filter found with name" name))) > + > +(define (set-frame-filter-enabled! filter enabled?) > + "Enable or disable a frame filter." > + (set-enabled?! filter enabled?) > + *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 a 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 > + (locus (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-locus filter) locus)) > + ((frame-filter-procedure filter) stream) > + stream)) > + stream > + *frame-filters*)) > + > +(define* (apply-frame-filter frame frame-low frame-high #:optional > + (locus (current-progspace))) > + "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? locus) > + (let ((frames (frame-stream frame frame-low frame-high))) > + (stream->gdb-iterator (apply-active-frame-filters frames locus) > + 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..0727333 > --- /dev/null > +++ b/gdb/guile/scm-frame-filter.c > @@ -0,0 +1,959 @@ > +/* 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)) > + { > + char *fresh_name; > + > + fresh_name = gdbscm_scm_to_host_string (symbol_scm, NULL, > + &exception); > + if (fresh_name == NULL) > + gdbscm_throw (exception); > + make_cleanup (xfree, fresh_name); > + > + *name = fresh_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: > + if (type == MI_PRINT_ARGS) > + return SYMBOL_IS_ARGUMENT (sym); > + else > + return !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 > +ffscm_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 > +ffscm_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 > +ffscm_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) > + ffscm_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 > + ffscm_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 > +ffscm_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 == NULL) > + /* 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) > + ffscm_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; > + > + ffscm_print_value (out, val, &opts, val_indent, args_type, > + language); > + } > + else > + { > + if (args_type != NO_VALUES) > + ffscm_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 > +ffscm_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); > + > + ffscm_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 > +ffscm_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. */ > + ffscm_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) > + ffscm_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, " "); > + } > + > + ffscm_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 > +ffscm_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, ", "); > + > + ffscm_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 > +ffscm_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"); > + ffscm_print_args (arguments_scm, out, args_type, frame, > + WITH_ARGS_FIELD, gdbarch); > + ffscm_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 != NULL) > + { > + 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 == NULL) > + 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) > + ffscm_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 == NULL) > + 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) > + ffscm_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); > + > + ffscm_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); > + > + ffscm_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 787b788..6ec8058 100644 > --- a/gdb/guile/scm-frame.c > +++ b/gdb/guile/scm-frame.c > @@ -214,7 +214,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..4482b31 100644 > --- a/gdb/guile/scm-utils.c > +++ b/gdb/guile/scm-utils.c > @@ -641,3 +641,22 @@ 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 2733e80..42d204f 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 1967aca..b2b567d 100644 > --- a/gdb/testsuite/ChangeLog > +++ b/gdb/testsuite/ChangeLog > @@ -1,5 +1,18 @@ > 2015-04-28 Andy Wingo <wingo@igalia.com> > > + * gdb.guile/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-04-28 Andy Wingo <wingo@igalia.com> > + > * gdb.python/py-parameter.exp: > * gdb.guile/scm-parameter.exp: Escape the path that we are > matching against, as it might contain characters that are special > 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..a5a7f17 > --- /dev/null > +++ b/gdb/testsuite/gdb.guile/scm-frame-filter-gdb.scm.in > @@ -0,0 +1,35 @@ > +;; 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) > + > +(define (register! name procedure priority locus) > + (let ((filter (make-frame-filter name procedure #:priority priority))) > + (register-frame-filter! filter #:locus locus))) > + > +(register! "filter-one-progspace" filter-one 10 (current-progspace)) > +(register! "filter-one-objfile" filter-one 13 (current-objfile)) > + > +(register! "filter-two-progspace" filter-two 11 (current-progspace)) > +(register! "filter-two-objfile" filter-two 12 (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..041f016 > --- /dev/null > +++ b/gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg-gdb.scm.in > @@ -0,0 +1,35 @@ > +;; 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) > + > +(define (register! name procedure priority locus) > + (let ((filter (make-frame-filter name procedure #:priority priority))) > + (register-frame-filter! filter #:locus locus))) > + > +(register! "filter-one-progspace" filter-one 1 (current-progspace)) > +(register! "filter-one-objfile" filter-one 1 (current-objfile)) > + > +(register! "filter-two-progspace" filter-two 100 (current-progspace)) > +(register! "filter-two-objfile" filter-two 100 (current-objfile)) > diff --git a/gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg.S b/gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg.S > new file mode 100644 > index 0000000..0901714 > --- /dev/null > +++ b/gdb/testsuite/gdb.guile/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-invalidarg.exp b/gdb/testsuite/gdb.guile/scm-frame-filter-invalidarg.exp > new file mode 100644 > index 0000000..599881e > --- /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 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..5ea2681 > --- /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)))))) > + > +(register-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..1d80e36 > --- /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..f0ca7d0 > --- /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 13 12 11 10 0\\)" \ > + "all frame filter priorities" > +gdb_test "guile (map frame-filter-enabled? (all-frame-filters))" \ > + "\\(#t #t #f #t #t #t #t #f\\)" \ > + "all frame filter enabled?" > + > +gdb_test_no_output "guile (set-frame-filter-enabled! (find-frame-filter-by-name \"Elider\") #f)" \ > + "disable elider" > +gdb_test "guile (frame-filter-enabled? (find-frame-filter-by-name \"Elider\"))"\ > + ".*#f.*" \ > + "elider not enabled" > +gdb_test_no_output "guile (set-frame-filter-enabled! (find-frame-filter-by-name \"Elider\") #t)" \ > + "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 (set-frame-filter-enabled! (find-frame-filter-by-name \"Reverse\") #f)" \ > + "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 (set-frame-filter-enabled! (find-frame-filter-by-name \"Error\") #t)" \ > + "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 (set-frame-filter-enabled! (find-frame-filter-by-name \"Reverse\") #f)" \ > + "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..a529f8f > --- /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"))) > + > +(register-frame-filter! (make-decorating-frame-filter > + "Reverse" reverse-decorator #:priority 100)) > +(register-frame-filter! (make-decorating-frame-filter > + "Dummy" dummy-decorator #:enabled? #f #:priority 30)) > +(register-frame-filter! (make-frame-filter > + "Elider" eliding-filter #:priority 900)) > +(register-frame-filter! (make-decorating-frame-filter > + "Error" error-decorator #:enabled? #f)) ^ permalink raw reply [flat|nested] 8+ messages in thread
end of thread, other threads:[~2015-05-04 0:38 UTC | newest] Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed) -- links below jump to the message on this page -- 2015-04-09 15:57 [PATCH v5] Add Guile frame filter interface Andy Wingo 2015-04-09 16:28 ` Andy Wingo 2015-04-09 16:49 ` Eli Zaretskii 2015-04-28 10:46 ` Andy Wingo 2015-04-28 15:33 ` Eli Zaretskii 2015-04-20 5:29 ` Doug Evans 2015-04-28 16:12 ` [PATCH v6] " Andy Wingo 2015-05-04 0:38 ` Doug Evans
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).