diff options
author | Doug Evans <xdje42@gmail.com> | 2014-02-09 19:40:01 -0800 |
---|---|---|
committer | Doug Evans <xdje42@gmail.com> | 2014-02-09 19:40:01 -0800 |
commit | ed3ef33944c39d9a3cea72b9a7cef3c20f0e3461 (patch) | |
tree | 4e67d95b8ea65bb36a9cade5e37df2ad6289052e /gdb/guile/scm-safe-call.c | |
parent | 7026a7c16ee82d39e84823f8cc3097a9a940ddb2 (diff) | |
download | gdb-ed3ef33944c39d9a3cea72b9a7cef3c20f0e3461.zip gdb-ed3ef33944c39d9a3cea72b9a7cef3c20f0e3461.tar.gz gdb-ed3ef33944c39d9a3cea72b9a7cef3c20f0e3461.tar.bz2 |
Add Guile as an extension language.
* NEWS: Mention Guile scripting.
* Makefile.in (SUBDIR_GUILE_OBS): New variable.
(SUBDIR_GUILE_SRCS, SUBDIR_GUILE_DEPS): New variables
(SUBDIR_GUILE_LDFLAGS, SUBDIR_GUILE_CFLAGS): New variables.
(INTERNAL_CPPFLAGS): Add GUILE_CPPFLAGS.
(CLIBS): Add GUILE_LIBS.
(install-guile): New rule.
(guile.o): New rule.
(scm-arch.o, scm-auto-load.o, scm-block.o): New rules.
(scm-breakpoint.o, scm-disasm.o, scm-exception.o): New rules.
(scm-frame.o, scm-iterator.o, scm-lazy-string.o): New rules.
(scm-math.o, scm-objfile.o, scm-ports.o): New rules.
(scm-pretty-print.o, scm-safe-call.o, scm-gsmob.o): New rules.
(scm-string.o, scm-symbol.o, scm-symtab.o): New rules.
(scm-type.o, scm-utils.o, scm-value.o): New rules.
* configure.ac: New option --with-guile.
* configure: Regenerate.
* config.in: Regenerate.
* auto-load.c: Remove #include "python/python.h". Add #include
"gdb/section-scripts.h".
(source_section_scripts): Handle Guile scripts.
(_initialize_auto_load): Add name of Guile objfile script to
scripts-directory help text.
* breakpoint.c (condition_command): Tweak comment to include Scheme.
* breakpoint.h (gdbscm_breakpoint_object): Add forward decl.
(struct breakpoint): New member scm_bp_object.
* defs.h (enum command_control_type): New value guile_control.
* cli/cli-cmds.c: Remove #include "python/python.h". Add #include
"extension.h".
(show_user): Update comment.
(_initialize_cli_cmds): Update help text for "show user". Update help
text for max-user-call-depth.
* cli/cli-script.c: Remove #include "python/python.h". Add #include
"extension.h".
(multi_line_command_p): Add guile_control.
(print_command_lines): Handle guile_control.
(execute_control_command, recurse_read_control_structure): Ditto.
(process_next_line): Recognize "guile" commands.
* disasm.c (gdb_disassemble_info): Make non-static.
* disasm.h: #include "dis-asm.h".
(struct gdbarch): Add forward decl.
(gdb_disassemble_info): Declare.
* extension.c: #include "guile/guile.h".
(extension_languages): Add guile.
(get_ext_lang_defn): Handle EXT_LANG_GDB.
* extension.h (enum extension_language): New value EXT_LANG_GUILE.
* gdbtypes.c (get_unsigned_type_max): New function.
(get_signed_type_minmax): New function.
* gdbtypes.h (get_unsigned_type_max): Declare.
(get_signed_type_minmax): Declare.
* guile/README: New file.
* guile/guile-internal.h: New file.
* guile/guile.c: New file.
* guile/guile.h: New file.
* guile/scm-arch.c: New file.
* guile/scm-auto-load.c: New file.
* guile/scm-block.c: New file.
* guile/scm-breakpoint.c: New file.
* guile/scm-disasm.c: New file.
* guile/scm-exception.c: New file.
* guile/scm-frame.c: New file.
* guile/scm-gsmob.c: New file.
* guile/scm-iterator.c: New file.
* guile/scm-lazy-string.c: New file.
* guile/scm-math.c: New file.
* guile/scm-objfile.c: New file.
* guile/scm-ports.c: New file.
* guile/scm-pretty-print.c: New file.
* guile/scm-safe-call.c: New file.
* guile/scm-string.c: New file.
* guile/scm-symbol.c: New file.
* guile/scm-symtab.c: New file.
* guile/scm-type.c: New file.
* guile/scm-utils.c: New file.
* guile/scm-value.c: New file.
* guile/lib/gdb.scm: New file.
* guile/lib/gdb/boot.scm: New file.
* guile/lib/gdb/experimental.scm: New file.
* guile/lib/gdb/init.scm: New file.
* guile/lib/gdb/iterator.scm: New file.
* guile/lib/gdb/printing.scm: New file.
* guile/lib/gdb/types.scm: New file.
* data-directory/Makefile.in (GUILE_SRCDIR): New variable.
(VPATH): Add $(GUILE_SRCDIR).
(GUILE_DIR): New variable.
(GUILE_INSTALL_DIR, GUILE_FILES): New variables.
(all): Add stamp-guile dependency.
(stamp-guile): New rule.
(clean-guile, install-guile, uninstall-guile): New rules.
(install-only): Add install-guile dependency.
(uninstall): Add uninstall-guile dependency.
(clean): Add clean-guile dependency.
doc/
* Makefile.in (GDB_DOC_FILES): Add guile.texi.
* gdb.texinfo (Auto-loading): Add set/show auto-load guile-scripts.
(Extending GDB): New menu entries Guile, Multiple Extension Languages.
(Guile docs): Include guile.texi.
(objfile-gdbdotext file): Add objfile-gdb.scm.
(dotdebug_gdb_scripts section): Mention Guile scripts.
(Multiple Extension Languages): New node.
* guile.texi: New file.
testsuite/
* configure.ac (AC_OUTPUT): Add gdb.guile.
* configure: Regenerate.
* lib/gdb-guile.exp: New file.
* lib/gdb.exp (get_target_charset): New function.
* gdb.base/help.exp: Update expected output from "apropos apropos".
* gdb.guile/Makefile.in: New file.
* gdb.guile/guile.exp: New file.
* gdb.guile/scm-arch.c: New file.
* gdb.guile/scm-arch.exp: New file.
* gdb.guile/scm-block.c: New file.
* gdb.guile/scm-block.exp: New file.
* gdb.guile/scm-breakpoint.c: New file.
* gdb.guile/scm-breakpoint.exp: New file.
* gdb.guile/scm-disasm.c: New file.
* gdb.guile/scm-disasm.exp: New file.
* gdb.guile/scm-equal.c: New file.
* gdb.guile/scm-equal.exp: New file.
* gdb.guile/scm-error.exp: New file.
* gdb.guile/scm-error.scm: New file.
* gdb.guile/scm-frame-args.c: New file.
* gdb.guile/scm-frame-args.exp: New file.
* gdb.guile/scm-frame-args.scm: New file.
* gdb.guile/scm-frame-inline.c: New file.
* gdb.guile/scm-frame-inline.exp: New file.
* gdb.guile/scm-frame.c: New file.
* gdb.guile/scm-frame.exp: New file.
* gdb.guile/scm-generics.exp: New file.
* gdb.guile/scm-gsmob.exp: New file.
* gdb.guile/scm-iterator.c: New file.
* gdb.guile/scm-iterator.exp: New file.
* gdb.guile/scm-math.c: New file.
* gdb.guile/scm-math.exp: New file.
* gdb.guile/scm-objfile-script-gdb.in: New file.
* gdb.guile/scm-objfile-script.c: New file.
* gdb.guile/scm-objfile-script.exp: New file.
* gdb.guile/scm-objfile.c: New file.
* gdb.guile/scm-objfile.exp: New file.
* gdb.guile/scm-ports.exp: New file.
* gdb.guile/scm-pretty-print.c: New file.
* gdb.guile/scm-pretty-print.exp: New file.
* gdb.guile/scm-pretty-print.scm: New file.
* gdb.guile/scm-section-script.c: New file.
* gdb.guile/scm-section-script.exp: New file.
* gdb.guile/scm-section-script.scm: New file.
* gdb.guile/scm-symbol.c: New file.
* gdb.guile/scm-symbol.exp: New file.
* gdb.guile/scm-symtab-2.c: New file.
* gdb.guile/scm-symtab.c: New file.
* gdb.guile/scm-symtab.exp: New file.
* gdb.guile/scm-type.c: New file.
* gdb.guile/scm-type.exp: New file.
* gdb.guile/scm-value-cc.cc: New file.
* gdb.guile/scm-value-cc.exp: New file.
* gdb.guile/scm-value.c: New file.
* gdb.guile/scm-value.exp: New file.
* gdb.guile/source2.scm: New file.
* gdb.guile/types-module.cc: New file.
* gdb.guile/types-module.exp: New file.
Diffstat (limited to 'gdb/guile/scm-safe-call.c')
-rw-r--r-- | gdb/guile/scm-safe-call.c | 464 |
1 files changed, 464 insertions, 0 deletions
diff --git a/gdb/guile/scm-safe-call.c b/gdb/guile/scm-safe-call.c new file mode 100644 index 0000000..147d7f5 --- /dev/null +++ b/gdb/guile/scm-safe-call.c @@ -0,0 +1,464 @@ +/* GDB/Scheme support for safe calls into the Guile interpreter. + + Copyright (C) 2014 Free Software Foundation, Inc. + + This file is part of GDB. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see <http://www.gnu.org/licenses/>. */ + +/* See README file in this directory for implementation notes, coding + conventions, et.al. */ + +#include "defs.h" +#include "filenames.h" +#include "gdb_assert.h" +#include "guile-internal.h" + +/* Struct to marshall args to scscm_safe_call_body. */ + +struct c_data +{ + void *(*func) (void *); + void *data; + /* An error message or NULL for success. */ + void *result; +}; + +/* Struct to marshall args through gdbscm_with_catch. */ + +struct with_catch_data +{ + scm_t_catch_body func; + void *data; + scm_t_catch_handler unwind_handler; + scm_t_catch_handler pre_unwind_handler; + + /* If EXCP_MATCHER is non-NULL, it is an excp_matcher_func function. + If the exception is recognized by it, the exception is recorded as is, + without wrapping it in gdb:with-stack. */ + excp_matcher_func *excp_matcher; + + SCM stack; + SCM catch_result; +}; + +/* The "body" argument to scm_i_with_continuation_barrier. + Invoke the user-supplied function. */ + +static SCM +scscm_safe_call_body (void *d) +{ + struct c_data *data = (struct c_data *) d; + + data->result = data->func (data->data); + + return SCM_UNSPECIFIED; +} + +/* A "pre-unwind handler" to scm_c_catch that prints the exception + according to "set guile print-stack". */ + +static SCM +scscm_printing_pre_unwind_handler (void *data, SCM key, SCM args) +{ + SCM stack = scm_make_stack (SCM_BOOL_T, scm_list_1 (scm_from_int (2))); + + gdbscm_print_exception_with_stack (SCM_BOOL_F, stack, key, args); + + return SCM_UNSPECIFIED; +} + +/* A no-op unwind handler. */ + +static SCM +scscm_nop_unwind_handler (void *data, SCM key, SCM args) +{ + return SCM_UNSPECIFIED; +} + +/* The "pre-unwind handler" to scm_c_catch that records the exception + for possible later printing. We do this in the pre-unwind handler because + we want the stack to include point where the exception occurred. + + If DATA is non-NULL, it is an excp_matcher_func function. + If the exception is recognized by it, the exception is recorded as is, + without wrapping it in gdb:with-stack. */ + +static SCM +scscm_recording_pre_unwind_handler (void *datap, SCM key, SCM args) +{ + struct with_catch_data *data = datap; + excp_matcher_func *matcher = data->excp_matcher; + + if (matcher != NULL && matcher (key)) + return SCM_UNSPECIFIED; + + /* There's no need to record the whole stack if we're not going to print it. + However, convention is to still print the stack frame in which the + exception occurred, even if we're not going to print a full backtrace. + For now, keep it simple. */ + + data->stack = scm_make_stack (SCM_BOOL_T, scm_list_1 (scm_from_int (2))); + + /* IWBN if we could return the <gdb:exception> here and skip the unwind + handler, but it doesn't work that way. If we want to return a + <gdb:exception> object from the catch it needs to come from the unwind + handler. So what we do is save the stack for later use by the unwind + handler. */ + + return SCM_UNSPECIFIED; +} + +/* Part two of the recording unwind handler. + Here we take the stack saved from the pre-unwind handler and create + the <gdb:exception> object. */ + +static SCM +scscm_recording_unwind_handler (void *datap, SCM key, SCM args) +{ + struct with_catch_data *data = datap; + + /* We need to record the stack in the exception since we're about to + throw and lose the location that got the exception. We do this by + wrapping the exception + stack in a new exception. */ + + if (gdbscm_is_true (data->stack)) + return gdbscm_make_exception_with_stack (key, args, data->stack); + + return gdbscm_make_exception (key, args); +} + +/* Ugh. :-( + Guile doesn't export scm_i_with_continuation_barrier which is exactly + what we need. To cope, have our own wrapper around scm_c_catch and + pass this as the "body" argument to scm_c_with_continuation_barrier. + Darn darn darn. */ + +static void * +gdbscm_with_catch (void *data) +{ + struct with_catch_data *d = data; + + d->catch_result + = scm_c_catch (SCM_BOOL_T, + d->func, d->data, + d->unwind_handler, d, + d->pre_unwind_handler, d); + + return NULL; +} + +/* A wrapper around scm_with_guile that prints backtraces and exceptions + according to "set guile print-stack". + The result if NULL if no exception occurred, otherwise it is a statically + allocated error message (caller must *not* free). */ + +void * +gdbscm_with_guile (void *(*func) (void *), void *data) +{ + struct c_data c_data; + struct with_catch_data catch_data; + + c_data.func = func; + c_data.data = data; + /* Set this now in case an exception is thrown. */ + c_data.result = _("Error while executing Scheme code."); + + catch_data.func = scscm_safe_call_body; + catch_data.data = &c_data; + catch_data.unwind_handler = scscm_nop_unwind_handler; + catch_data.pre_unwind_handler = scscm_printing_pre_unwind_handler; + catch_data.excp_matcher = NULL; + catch_data.stack = SCM_BOOL_F; + catch_data.catch_result = SCM_UNSPECIFIED; + + scm_with_guile (gdbscm_with_catch, &catch_data); + + return c_data.result; +} + +/* Another wrapper of scm_with_guile for use by the safe call/apply routines + in this file, as well as for general purpose calling other functions safely. + For these we want to record the exception, but leave the possible printing + of it to later. */ + +SCM +gdbscm_call_guile (SCM (*func) (void *), void *data, + excp_matcher_func *ok_excps) +{ + struct with_catch_data catch_data; + + catch_data.func = func; + catch_data.data = data; + catch_data.unwind_handler = scscm_recording_unwind_handler; + catch_data.pre_unwind_handler = scscm_recording_pre_unwind_handler; + catch_data.excp_matcher = ok_excps; + catch_data.stack = SCM_BOOL_F; + catch_data.catch_result = SCM_UNSPECIFIED; + +#if 0 + scm_c_with_continuation_barrier (gdbscm_with_catch, &catch_data); +#else + scm_with_guile (gdbscm_with_catch, &catch_data); +#endif + + return catch_data.catch_result; +} + +/* Utilities to safely call Scheme code, catching all exceptions, and + preventing continuation capture. + The result is the result of calling the function, or if an exception occurs + then the result is a <gdb:exception> smob, which can be tested for with + gdbscm_is_exception. */ + +/* Helper for gdbscm_safe_call_0. */ + +static SCM +scscm_call_0_body (void *argsp) +{ + SCM *args = argsp; + + return scm_call_0 (args[0]); +} + +SCM +gdbscm_safe_call_0 (SCM proc, excp_matcher_func *ok_excps) +{ + SCM args[] = { proc }; + + return gdbscm_call_guile (scscm_call_0_body, args, ok_excps); +} + +/* Helper for gdbscm_safe_call_1. */ + +static SCM +scscm_call_1_body (void *argsp) +{ + SCM *args = argsp; + + return scm_call_1 (args[0], args[1]); +} + +SCM +gdbscm_safe_call_1 (SCM proc, SCM arg0, excp_matcher_func *ok_excps) +{ + SCM args[] = { proc, arg0 }; + + return gdbscm_call_guile (scscm_call_1_body, args, ok_excps); +} + +/* Helper for gdbscm_safe_call_2. */ + +static SCM +scscm_call_2_body (void *argsp) +{ + SCM *args = argsp; + + return scm_call_2 (args[0], args[1], args[2]); +} + +SCM +gdbscm_safe_call_2 (SCM proc, SCM arg0, SCM arg1, excp_matcher_func *ok_excps) +{ + SCM args[] = { proc, arg0, arg1 }; + + return gdbscm_call_guile (scscm_call_2_body, args, ok_excps); +} + +/* Helper for gdbscm_safe_call_3. */ + +static SCM +scscm_call_3_body (void *argsp) +{ + SCM *args = argsp; + + return scm_call_3 (args[0], args[1], args[2], args[3]); +} + +SCM +gdbscm_safe_call_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3, + excp_matcher_func *ok_excps) +{ + SCM args[] = { proc, arg1, arg2, arg3 }; + + return gdbscm_call_guile (scscm_call_3_body, args, ok_excps); +} + +/* Helper for gdbscm_safe_call_4. */ + +static SCM +scscm_call_4_body (void *argsp) +{ + SCM *args = argsp; + + return scm_call_4 (args[0], args[1], args[2], args[3], args[4]); +} + +SCM +gdbscm_safe_call_4 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, + excp_matcher_func *ok_excps) +{ + SCM args[] = { proc, arg1, arg2, arg3, arg4 }; + + return gdbscm_call_guile (scscm_call_4_body, args, ok_excps); +} + +/* Helper for gdbscm_safe_apply_1. */ + +static SCM +scscm_apply_1_body (void *argsp) +{ + SCM *args = argsp; + + return scm_apply_1 (args[0], args[1], args[2]); +} + +SCM +gdbscm_safe_apply_1 (SCM proc, SCM arg0, SCM rest, excp_matcher_func *ok_excps) +{ + SCM args[] = { proc, arg0, rest }; + + return gdbscm_call_guile (scscm_apply_1_body, args, ok_excps); +} + +/* Utilities to call Scheme code, not catching exceptions, and + not preventing continuation capture. + The result is the result of calling the function. + If an exception occurs then Guile is left to handle the exception, + unwinding the stack as appropriate. + + USE THESE WITH CARE. + Typically these are called from functions that implement Scheme procedures, + and we don't want to catch the exception; otherwise it will get printed + twice: once when first caught and once if it ends up being rethrown and the + rethrow reaches the top repl, which will confuse the user. + + While these calls just pass the call off to the corresponding Guile + procedure, all such calls are routed through these ones to: + a) provide a place to put hooks or whatnot in if we need to, + b) add "unsafe" to the name to alert the reader. */ + +SCM +gdbscm_unsafe_call_1 (SCM proc, SCM arg0) +{ + return scm_call_1 (proc, arg0); +} + +/* Utilities for safely evaluating a Scheme expression string. */ + +struct eval_scheme_string_data +{ + const char *string; + int display_result; +}; + +/* Wrapper to eval a C string in the Guile interpreter. + This is passed to scm_with_guile. */ + +static void * +scscm_eval_scheme_string (void *datap) +{ + struct eval_scheme_string_data *data = datap; + SCM result = scm_c_eval_string (data->string); + + if (data->display_result && !scm_is_eq (result, SCM_UNSPECIFIED)) + { + SCM port = scm_current_output_port (); + + scm_write (result, port); + scm_newline (port); + } + + /* If we get here the eval succeeded. */ + return NULL; +} + +/* Evaluate EXPR in the Guile interpreter, catching all exceptions + and preventing continuation capture. + The result is NULL if no exception occurred. Otherwise, the exception is + printed according to "set guile print-stack" and the result is an error + message allocated with malloc, caller must free. */ + +char * +gdbscm_safe_eval_string (const char *string, int display_result) +{ + struct eval_scheme_string_data data = { string, display_result }; + void *result; + + result = gdbscm_with_guile (scscm_eval_scheme_string, (void *) &data); + + if (result != NULL) + return xstrdup (result); + return NULL; +} + +/* Utilities for safely loading Scheme scripts. */ + +/* Helper function for gdbscm_safe_source_scheme_script. */ + +static void * +scscm_source_scheme_script (void *data) +{ + const char *filename = data; + + /* The Guile docs don't specify what the result is. + Maybe it's SCM_UNSPECIFIED, but the docs should specify that. :-) */ + scm_c_primitive_load_path (filename); + + /* If we get here the load succeeded. */ + return NULL; +} + +/* Try to load a script, catching all exceptions, + and preventing continuation capture. + The result is NULL if the load succeeded. Otherwise, the exception is + printed according to "set guile print-stack" and the result is an error + message allocated with malloc, caller must free. */ + +char * +gdbscm_safe_source_script (const char *filename) +{ + /* scm_c_primitive_load_path only looks in %load-path for files with + relative paths. An alternative could be to temporarily add "." to + %load-path, but we don't want %load-path to be searched. At least not + by default. This function is invoked by the "source" GDB command which + already has its own path search support. */ + char *abs_filename = NULL; + void *result; + + if (!IS_ABSOLUTE_PATH (filename)) + { + abs_filename = gdb_realpath (filename); + filename = abs_filename; + } + + result = gdbscm_with_guile (scscm_source_scheme_script, + (void *) filename); + + xfree (abs_filename); + if (result != NULL) + return xstrdup (result); + return NULL; +} + +/* Utility for entering an interactive Guile repl. */ + +void +gdbscm_enter_repl (void) +{ + /* It's unfortunate to have to resort to something like this, but + scm_shell doesn't return. :-( I found this code on guile-user@. */ + gdbscm_safe_call_1 (scm_c_public_ref ("system repl repl", "start-repl"), + scm_from_latin1_symbol ("scheme"), NULL); +} |