]> git.ipfire.org Git - thirdparty/binutils-gdb.git/blobdiff - gdb/guile/guile.c
Update copyright year range in all GDB files
[thirdparty/binutils-gdb.git] / gdb / guile / guile.c
index 575bb6ce76708142c81b4d9468e4026257ffd9c7..8fc12dd8761c0fbe1fc6491ef62cf11930d6dfe2 100644 (file)
@@ -1,6 +1,6 @@
 /* General GDB/Guile code.
 
-   Copyright (C) 2014 Free Software Foundation, Inc.
+   Copyright (C) 2014-2018 Free Software Foundation, Inc.
 
    This file is part of GDB.
 
 #include "cli/cli-utils.h"
 #include "command.h"
 #include "gdbcmd.h"
-#include "interps.h"
+#include "top.h"
 #include "extension-priv.h"
 #include "utils.h"
 #include "version.h"
 #ifdef HAVE_GUILE
 #include "guile.h"
 #include "guile-internal.h"
-#ifdef HAVE_GC_GC_H
-#include <gc/gc.h> /* PR 17185 */
-#endif
 #endif
+#include <signal.h>
 
 /* The Guile version we're using.
    We *could* use the macros in libguile/version.h but that would preclude
@@ -73,13 +71,13 @@ const char *gdbscm_print_excp = gdbscm_print_excp_message;
 
 #ifdef HAVE_GUILE
 /* Forward decls, these are defined later.  */
-static const struct extension_language_script_ops guile_extension_script_ops;
-static const struct extension_language_ops guile_extension_ops;
+extern const struct extension_language_script_ops guile_extension_script_ops;
+extern const struct extension_language_ops guile_extension_ops;
 #endif
 
 /* The main struct describing GDB's interface to the Guile
    extension language.  */
-const struct extension_language_defn extension_language_guile =
+extern const struct extension_language_defn extension_language_guile =
 {
   EXT_LANG_GUILE,
   "guile",
@@ -126,16 +124,17 @@ static const char boot_scm_filename[] = "boot.scm";
 
 /* The interface between gdb proper and loading of python scripts.  */
 
-static const struct extension_language_script_ops guile_extension_script_ops =
+const struct extension_language_script_ops guile_extension_script_ops =
 {
   gdbscm_source_script,
   gdbscm_source_objfile_script,
+  gdbscm_execute_objfile_script,
   gdbscm_auto_load_enabled
 };
 
 /* The interface between gdb proper and guile scripting.  */
 
-static const struct extension_language_ops guile_extension_ops =
+const struct extension_language_ops guile_extension_ops =
 {
   gdbscm_finish_initialization,
   gdbscm_initialized,
@@ -156,19 +155,15 @@ static const struct extension_language_ops guile_extension_ops =
   gdbscm_breakpoint_cond_says_stop,
 
   NULL, /* gdbscm_check_quit_flag, */
-  NULL, /* gdbscm_clear_quit_flag, */
   NULL, /* gdbscm_set_quit_flag, */
 };
 
 /* Implementation of the gdb "guile-repl" command.  */
 
 static void
-guile_repl_command (char *arg, int from_tty)
+guile_repl_command (const char *arg, int from_tty)
 {
-  struct cleanup *cleanup;
-
-  cleanup = make_cleanup_restore_integer (&interpreter_async);
-  interpreter_async = 0;
+  scoped_restore restore_async = make_scoped_restore (&current_ui->async, 0);
 
   arg = skip_spaces (arg);
 
@@ -185,8 +180,6 @@ guile_repl_command (char *arg, int from_tty)
       dont_repeat ();
       gdbscm_enter_repl ();
     }
-
-  do_cleanups (cleanup);
 }
 
 /* Implementation of the gdb "guile" command.
@@ -196,12 +189,9 @@ guile_repl_command (char *arg, int from_tty)
    TODO: Add the result to Guile's history?  */
 
 static void
-guile_command (char *arg, int from_tty)
+guile_command (const char *arg, int from_tty)
 {
-  struct cleanup *cleanup;
-
-  cleanup = make_cleanup_restore_integer (&interpreter_async);
-  interpreter_async = 0;
+  scoped_restore restore_async = make_scoped_restore (&current_ui->async, 0);
 
   arg = skip_spaces (arg);
 
@@ -211,19 +201,18 @@ guile_command (char *arg, int from_tty)
 
       if (msg != NULL)
        {
+         /* It is ok that this is a "dangling cleanup" because we
+            throw immediately.  */
          make_cleanup (xfree, msg);
          error ("%s", msg);
        }
     }
   else
     {
-      struct command_line *l = get_command_line (guile_control, "");
+      command_line_up l = get_command_line (guile_control, "");
 
-      make_cleanup_free_command_lines (&l);
-      execute_control_command_untraced (l);
+      execute_control_command_untraced (l.get ());
     }
-
-  do_cleanups (cleanup);
 }
 
 /* Given a command_line, return a command string suitable for passing
@@ -242,7 +231,7 @@ compute_scheme_string (struct command_line *l)
   for (iter = l; iter; iter = iter->next)
     size += strlen (iter->line) + 1;
 
-  script = xmalloc (size + 1);
+  script = (char *) xmalloc (size + 1);
   here = 0;
   for (iter = l; iter; iter = iter->next)
     {
@@ -311,11 +300,10 @@ gdbscm_execute_gdb_command (SCM command_scm, SCM rest)
 {
   int from_tty_arg_pos = -1, to_string_arg_pos = -1;
   int from_tty = 0, to_string = 0;
-  volatile struct gdb_exception except;
   const SCM keywords[] = { from_tty_keyword, to_string_keyword, SCM_BOOL_F };
   char *command;
-  char *result = NULL;
   struct cleanup *cleanups;
+  struct gdb_exception except = exception_none;
 
   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#tt",
                              command_scm, &command, rest,
@@ -326,36 +314,33 @@ gdbscm_execute_gdb_command (SCM command_scm, SCM rest)
      executed.  */
   cleanups = make_cleanup (xfree, command);
 
-  TRY_CATCH (except, RETURN_MASK_ALL)
-    {
-      struct cleanup *inner_cleanups;
+  std::string to_string_res;
 
-      inner_cleanups = make_cleanup_restore_integer (&interpreter_async);
-      interpreter_async = 0;
+  TRY
+    {
+      scoped_restore restore_async = make_scoped_restore (&current_ui->async,
+                                                         0);
 
-      prevent_dont_repeat ();
+      scoped_restore preventer = prevent_dont_repeat ();
       if (to_string)
-       result = execute_command_to_string (command, from_tty);
+       to_string_res = execute_command_to_string (command, from_tty);
       else
-       {
-         execute_command (command, from_tty);
-         result = NULL;
-       }
+       execute_command (command, from_tty);
 
       /* Do any commands attached to breakpoint we stopped at.  */
       bpstat_do_actions ();
-
-      do_cleanups (inner_cleanups);
     }
+  CATCH (ex, RETURN_MASK_ALL)
+    {
+      except = ex;
+    }
+  END_CATCH
+
   do_cleanups (cleanups);
   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 
-  if (result)
-    {
-      SCM r = gdbscm_scm_from_c_string (result);
-      xfree (result);
-      return r;
-    }
+  if (to_string)
+    return gdbscm_scm_from_c_string (to_string_res.c_str ());
   return SCM_UNSPECIFIED;
 }
 
@@ -405,7 +390,7 @@ gdbscm_target_config (void)
    commands. */
 
 static void
-guile_repl_command (char *arg, int from_tty)
+guile_repl_command (const char *arg, int from_tty)
 {
   arg = skip_spaces (arg);
   if (arg && *arg)
@@ -414,7 +399,7 @@ guile_repl_command (char *arg, int from_tty)
 }
 
 static void
-guile_command (char *arg, int from_tty)
+guile_command (const char *arg, int from_tty)
 {
   arg = skip_spaces (arg);
   if (arg && *arg)
@@ -423,11 +408,9 @@ guile_command (char *arg, int from_tty)
     {
       /* Even if Guile isn't enabled, we still have to slurp the
         command list to the corresponding "end".  */
-      struct command_line *l = get_command_line (guile_control, "");
-      struct cleanup *cleanups = make_cleanup_free_command_lines (&l);
+      command_line_up l = get_command_line (guile_control, "");
 
-      execute_control_command_untraced (l);
-      do_cleanups (cleanups);
+      execute_control_command_untraced (l.get ());
     }
 }
 
@@ -442,7 +425,7 @@ static struct cmd_list_element *info_guile_list;
 /* Function for use by 'set guile' prefix command.  */
 
 static void
-set_guile_command (char *args, int from_tty)
+set_guile_command (const char *args, int from_tty)
 {
   help_list (set_guile_list, "set guile ", all_commands, gdb_stdout);
 }
@@ -450,7 +433,7 @@ set_guile_command (char *args, int from_tty)
 /* Function for use by 'show guile' prefix command.  */
 
 static void
-show_guile_command (char *args, int from_tty)
+show_guile_command (const char *args, int from_tty)
 {
   cmd_show_list (show_guile_list, from_tty, "");
 }
@@ -460,7 +443,7 @@ show_guile_command (char *args, int from_tty)
    "info scheme" with no args.  */
 
 static void
-info_guile_command (char *args, int from_tty)
+info_guile_command (const char *args, int from_tty)
 {
   printf_unfiltered (_("\"info guile\" must be followed"
                       " by the name of an info command.\n"));
@@ -473,7 +456,7 @@ info_guile_command (char *args, int from_tty)
 
 static const scheme_function misc_guile_functions[] =
 {
-  { "execute", 1, 0, 1, gdbscm_execute_gdb_command,
+  { "execute", 1, 0, 1, as_a_scm_t_subr (gdbscm_execute_gdb_command),
   "\
 Execute the given GDB command.\n\
 \n\
@@ -486,23 +469,24 @@ Execute the given GDB command.\n\
   Returns: The result of the command if #:to-string is true.\n\
     Otherwise returns unspecified." },
 
-  { "data-directory", 0, 0, 0, gdbscm_data_directory,
+  { "data-directory", 0, 0, 0, as_a_scm_t_subr (gdbscm_data_directory),
     "\
 Return the name of GDB's data directory." },
 
-  { "guile-data-directory", 0, 0, 0, gdbscm_guile_data_directory,
+  { "guile-data-directory", 0, 0, 0,
+    as_a_scm_t_subr (gdbscm_guile_data_directory),
     "\
 Return the name of the Guile directory within GDB's data directory." },
 
-  { "gdb-version", 0, 0, 0, gdbscm_gdb_version,
+  { "gdb-version", 0, 0, 0, as_a_scm_t_subr (gdbscm_gdb_version),
     "\
 Return GDB's version string." },
 
-  { "host-config", 0, 0, 0, gdbscm_host_config,
+  { "host-config", 0, 0, 0, as_a_scm_t_subr (gdbscm_host_config),
     "\
 Return the name of the host configuration." },
 
-  { "target-config", 0, 0, 0, gdbscm_target_config,
+  { "target-config", 0, 0, 0, as_a_scm_t_subr (gdbscm_target_config),
     "\
 Return the name of the target configuration." },
 
@@ -621,11 +605,10 @@ static void
 initialize_scheme_side (void)
 {
   char *boot_scm_path;
-  char *msg;
 
-  guile_datadir = concat (gdb_datadir, SLASH_STRING, "guile", NULL);
+  guile_datadir = concat (gdb_datadir, SLASH_STRING, "guile", (char *) NULL);
   boot_scm_path = concat (guile_datadir, SLASH_STRING, "gdb",
-                         SLASH_STRING, boot_scm_filename, NULL);
+                         SLASH_STRING, boot_scm_filename, (char *) NULL);
 
   scm_c_catch (SCM_BOOL_T, boot_guile_support, boot_scm_path,
               handle_boot_error, boot_scm_path, NULL, NULL);
@@ -699,6 +682,10 @@ call_initialize_gdb_module (void *data)
      performed within the desired module.  */
   scm_c_define_module (gdbscm_module_name, initialize_gdb_module, NULL);
 
+#if HAVE_GUILE_MANUAL_FINALIZATION
+  scm_run_finalizers ();
+#endif
+
   return NULL;
 }
 
@@ -827,45 +814,56 @@ message == an error message without a stack will be printed."),
                        &set_guile_list, &show_guile_list);
 }
 
-/* Provide a prototype to silence -Wmissing-prototypes.  */
-extern initialize_file_ftype _initialize_guile;
-
 void
 _initialize_guile (void)
 {
-  char *msg;
-
   install_gdb_commands ();
 
 #if HAVE_GUILE
-  /* The Python support puts the C side in module "_gdb", leaving the Python
-     side to define module "gdb" which imports "_gdb".  There is evidently no
-     similar convention in Guile so we skip this.  */
-
-  /* PR 17185 There are problems with using libgc 7.4.0.
-     Copy over the workaround Guile uses (Guile is working around a different
-     problem, but the workaround is the same).  */
-#if (GC_VERSION_MAJOR == 7 && GC_VERSION_MINOR == 4 && GC_VERSION_MICRO == 0)
-  /* The bug is only known to appear with pthreads.  We assume any system
-     using pthreads also uses setenv (and not putenv).  That is why we don't
-     have a similar call to putenv here.  */
-#if defined (HAVE_SETENV)
-  setenv ("GC_MARKERS", "1", 1);
+  {
+#ifdef HAVE_SIGPROCMASK
+    sigset_t sigchld_mask, prev_mask;
 #endif
+
+    /* The Python support puts the C side in module "_gdb", leaving the Python
+       side to define module "gdb" which imports "_gdb".  There is evidently no
+       similar convention in Guile so we skip this.  */
+
+#if HAVE_GUILE_MANUAL_FINALIZATION
+    /* Our SMOB free functions are not thread-safe, as GDB itself is not
+       intended to be thread-safe.  Disable automatic finalization so that
+       finalizers aren't run in other threads.  */
+    scm_set_automatic_finalization_enabled (0);
+#endif
+
+#ifdef HAVE_SIGPROCMASK
+    /* Before we initialize Guile, block SIGCHLD.
+       This is done so that all threads created during Guile initialization
+       have SIGCHLD blocked.  PR 17247.
+       Really libgc and Guile should do this, but we need to work with
+       libgc 7.4.x.  */
+    sigemptyset (&sigchld_mask);
+    sigaddset (&sigchld_mask, SIGCHLD);
+    sigprocmask (SIG_BLOCK, &sigchld_mask, &prev_mask);
+#endif
+
+    /* scm_with_guile is the most portable way to initialize Guile.
+       Plus we need to initialize the Guile support while in Guile mode
+       (e.g., called from within a call to scm_with_guile).  */
+    scm_with_guile (call_initialize_gdb_module, NULL);
+
+#ifdef HAVE_SIGPROCMASK
+    sigprocmask (SIG_SETMASK, &prev_mask, NULL);
 #endif
 
-  /* scm_with_guile is the most portable way to initialize Guile.
-     Plus we need to initialize the Guile support while in Guile mode
-     (e.g., called from within a call to scm_with_guile).  */
-  scm_with_guile (call_initialize_gdb_module, NULL);
-
-  /* Set Guile's backtrace to match the "set guile print-stack" default.
-     [N.B. The two settings are still separate.]
-     But only do this after we've initialized Guile, it's nice to see a
-     backtrace if there's an error during initialization.
-     OTOH, if the error is that gdb/init.scm wasn't found because gdb is being
-     run from the build tree, the backtrace is more noise than signal.
-     Sigh.  */
-  gdbscm_set_backtrace (0);
+    /* Set Guile's backtrace to match the "set guile print-stack" default.
+       [N.B. The two settings are still separate.]
+       But only do this after we've initialized Guile, it's nice to see a
+       backtrace if there's an error during initialization.
+       OTOH, if the error is that gdb/init.scm wasn't found because gdb is
+       being run from the build tree, the backtrace is more noise than signal.
+       Sigh.  */
+    gdbscm_set_backtrace (0);
+  }
 #endif
 }