Don't define _FORTIFY_SOURCE on MinGW

[deliverable/binutils-gdb.git] / gdb / guile / scm-objfile.c

diff --git a/gdb/guile/scm-objfile.c b/gdb/guile/scm-objfile.c
index 54e4699234a300e58f99d6f1c9b337e876be504a..b1ff402fa1ea2d00fc6ad4155a1a6c73e619b028 100644 (file)
--- a/gdb/guile/scm-objfile.c
+++ b/gdb/guile/scm-objfile.c
@@ -1,6 +1,6 @@
 /* Scheme interface to objfiles.
 
-   Copyright (C) 2008-2014 Free Software Foundation, Inc.
+   Copyright (C) 2008-2020 Free Software Foundation, Inc.
 
    This file is part of GDB.
 
@@ -116,7 +116,7 @@ ofscm_release_objfile (objfile_smob *o_smob)
 static void
 ofscm_handle_objfile_deleted (struct objfile *objfile, void *datum)
 {
-  objfile_smob *o_smob = datum;
+  objfile_smob *o_smob = (objfile_smob *) datum;
 
   gdb_assert (o_smob->objfile == objfile);
 
@@ -148,7 +148,7 @@ ofscm_objfile_smob_from_objfile (struct objfile *objfile)
 {
   objfile_smob *o_smob;
 
-  o_smob = objfile_data (objfile, ofscm_objfile_data_key);
+  o_smob = (objfile_smob *) objfile_data (objfile, ofscm_objfile_data_key);
   if (o_smob == NULL)
     {
       SCM o_scm = ofscm_make_objfile_smob ();
@@ -252,6 +252,19 @@ gdbscm_objfile_filename (SCM self)
   return gdbscm_scm_from_c_string (objfile_name (o_smob->objfile));
 }
 
+/* (objfile-progspace <gdb:objfile>) -> <gdb:progspace>
+   Returns the objfile's progspace.
+   Throw's an exception if the underlying objfile is invalid.  */
+
+static SCM
+gdbscm_objfile_progspace (SCM self)
+{
+  objfile_smob *o_smob
+    = ofscm_get_valid_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return psscm_scm_from_pspace (o_smob->objfile->pspace);
+}
+
 /* (objfile-pretty-printers <gdb:objfile>) -> list
    Returns the list of pretty-printers for this objfile.  */
 
@@ -283,7 +296,8 @@ gdbscm_set_objfile_pretty_printers_x (SCM self, SCM printers)
 \f
 /* The "current" objfile.  This is set when gdb detects that a new
    objfile has been loaded.  It is only set for the duration of a call to
-   gdbscm_source_objfile_script; it is NULL at other times.  */
+   gdbscm_source_objfile_script and gdbscm_execute_objfile_script; it is NULL
+   at other times.  */
 static struct objfile *ofscm_current_objfile;
 
 /* Set the current objfile to OBJFILE and then read FILE named FILENAME
@@ -311,7 +325,28 @@ gdbscm_source_objfile_script (const struct extension_language_defn *extlang,
   ofscm_current_objfile = NULL;
 }
 
-/* (current-objfile) -> <gdb:obfjile>
+/* Set the current objfile to OBJFILE and then read FILE named FILENAME
+   as Guile code.  This does not throw any errors.  If an exception
+   occurs Guile will print the backtrace.
+   This is the extension_language_script_ops.objfile_script_sourcer
+   "method".  */
+
+void
+gdbscm_execute_objfile_script (const struct extension_language_defn *extlang,
+                              struct objfile *objfile, const char *name,
+                              const char *script)
+{
+  ofscm_current_objfile = objfile;
+
+  gdb::unique_xmalloc_ptr<char> msg
+    = gdbscm_safe_eval_string (script, 0 /* display_result */);
+  if (msg != NULL)
+    fprintf_filtered (gdb_stderr, "%s", msg.get ());
+
+  ofscm_current_objfile = NULL;
+}
+
+/* (current-objfile) -> <gdb:objfile>
    Return the current objfile, or #f if there isn't one.
    Ideally this would be named ofscm_current_objfile, but that name is
    taken by the variable recording the current objfile.  */
@@ -331,17 +366,16 @@ gdbscm_get_current_objfile (void)
 static SCM
 gdbscm_objfiles (void)
 {
-  struct objfile *objf;
   SCM result;
 
   result = SCM_EOL;
 
-  ALL_OBJFILES (objf)
-  {
-    SCM item = ofscm_scm_from_objfile (objf);
+  for (objfile *objf : current_program_space->objfiles ())
+    {
+      SCM item = ofscm_scm_from_objfile (objf);
 
-    result = scm_cons (item, result);
-  }
+      result = scm_cons (item, result);
+    }
 
   return scm_reverse_x (result, SCM_EOL);
 }
@@ -350,32 +384,37 @@ gdbscm_objfiles (void)
 
 static const scheme_function objfile_functions[] =
 {
-  { "objfile?", 1, 0, 0, gdbscm_objfile_p,
+  { "objfile?", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_p),
     "\
 Return #t if the object is a <gdb:objfile> object." },
 
-  { "objfile-valid?", 1, 0, 0, gdbscm_objfile_valid_p,
+  { "objfile-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_valid_p),
     "\
 Return #t if the objfile is valid (hasn't been deleted from gdb)." },
 
-  { "objfile-filename", 1, 0, 0, gdbscm_objfile_filename,
+  { "objfile-filename", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_filename),
     "\
 Return the file name of the objfile." },
 
-  { "objfile-pretty-printers", 1, 0, 0, gdbscm_objfile_pretty_printers,
+  { "objfile-progspace", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_progspace),
+    "\
+Return the progspace that the objfile lives in." },
+
+  { "objfile-pretty-printers", 1, 0, 0,
+    as_a_scm_t_subr (gdbscm_objfile_pretty_printers),
     "\
 Return a list of pretty-printers of the objfile." },
 
   { "set-objfile-pretty-printers!", 2, 0, 0,
-    gdbscm_set_objfile_pretty_printers_x,
+    as_a_scm_t_subr (gdbscm_set_objfile_pretty_printers_x),
     "\
 Set the list of pretty-printers of the objfile." },
 
-  { "current-objfile", 0, 0, 0, gdbscm_get_current_objfile,
+  { "current-objfile", 0, 0, 0, as_a_scm_t_subr (gdbscm_get_current_objfile),
     "\
 Return the current objfile if there is one or #f if there isn't one." },
 
-  { "objfiles", 0, 0, 0, gdbscm_objfiles,
+  { "objfiles", 0, 0, 0, as_a_scm_t_subr (gdbscm_objfiles),
     "\
 Return a list of all objfiles in the current program space." },