gdb/guile/scm-progspace.c

   1 /* Guile interface to program spaces.
   2
   3    Copyright (C) 2010-2017 Free Software Foundation, Inc.
   4
   5    This file is part of GDB.
   6
   7    This program is free software; you can redistribute it and/or modify
   8    it under the terms of the GNU General Public License as published by
   9    the Free Software Foundation; either version 3 of the License, or
  10    (at your option) any later version.
  11
  12    This program is distributed in the hope that it will be useful,
  13    but WITHOUT ANY WARRANTY; without even the implied warranty of
  14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15    GNU General Public License for more details.
  16
  17    You should have received a copy of the GNU General Public License
  18    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  19
  20 #include "defs.h"
  21 #include "charset.h"
  22 #include "progspace.h"
  23 #include "objfiles.h"
  24 #include "language.h"
  25 #include "arch-utils.h"
  26 #include "guile-internal.h"
  27
  28 /* NOTE: Python exports the name "Progspace", so we export "progspace".
  29    Internally we shorten that to "pspace".  */
  30
  31 /* The <gdb:progspace> smob.
  32    The typedef for this struct is in guile-internal.h.  */
  33
  34 struct _pspace_smob
  35 {
  36   /* This always appears first.  */
  37   gdb_smob base;
  38
  39   /* The corresponding pspace.  */
  40   struct program_space *pspace;
  41
  42   /* The pretty-printer list of functions.  */
  43   SCM pretty_printers;
  44
  45   /* The <gdb:progspace> object we are contained in, needed to
  46      protect/unprotect the object since a reference to it comes from
  47      non-gc-managed space (the progspace).  */
  48   SCM containing_scm;
  49 };
  50
  51 static const char pspace_smob_name[] = "gdb:progspace";
  52
  53 /* The tag Guile knows the pspace smob by.  */
  54 static scm_t_bits pspace_smob_tag;
  55
  56 static const struct program_space_data *psscm_pspace_data_key;
  57
  58 /* Return the list of pretty-printers registered with P_SMOB.  */
  59
  60 SCM
  61 psscm_pspace_smob_pretty_printers (const pspace_smob *p_smob)
  62 {
  63   return p_smob->pretty_printers;
  64 }
  65 \f
  66 /* Administrivia for progspace smobs.  */
  67
  68 /* The smob "print" function for <gdb:progspace>.  */
  69
  70 static int
  71 psscm_print_pspace_smob (SCM self, SCM port, scm_print_state *pstate)
  72 {
  73   pspace_smob *p_smob = (pspace_smob *) SCM_SMOB_DATA (self);
  74
  75   gdbscm_printf (port, "#<%s ", pspace_smob_name);
  76   if (p_smob->pspace != NULL)
  77     {
  78       struct objfile *objfile = p_smob->pspace->symfile_object_file;
  79
  80       gdbscm_printf (port, "%s",
  81                      objfile != NULL
  82                      ? objfile_name (objfile)
  83                      : "{no symfile}");
  84     }
  85   else
  86     scm_puts ("{invalid}", port);
  87   scm_puts (">", port);
  88
  89   scm_remember_upto_here_1 (self);
  90
  91   /* Non-zero means success.  */
  92   return 1;
  93 }
  94
  95 /* Low level routine to create a <gdb:progspace> object.
  96    It's empty in the sense that a progspace still needs to be associated
  97    with it.  */
  98
  99 static SCM
 100 psscm_make_pspace_smob (void)
 101 {
 102   pspace_smob *p_smob = (pspace_smob *)
 103     scm_gc_malloc (sizeof (pspace_smob), pspace_smob_name);
 104   SCM p_scm;
 105
 106   p_smob->pspace = NULL;
 107   p_smob->pretty_printers = SCM_EOL;
 108   p_scm = scm_new_smob (pspace_smob_tag, (scm_t_bits) p_smob);
 109   p_smob->containing_scm = p_scm;
 110   gdbscm_init_gsmob (&p_smob->base);
 111
 112   return p_scm;
 113 }
 114
 115 /* Clear the progspace pointer in P_SMOB and unprotect the object from GC.  */
 116
 117 static void
 118 psscm_release_pspace (pspace_smob *p_smob)
 119 {
 120   p_smob->pspace = NULL;
 121   scm_gc_unprotect_object (p_smob->containing_scm);
 122 }
 123
 124 /* Progspace registry cleanup handler for when a progspace is deleted.  */
 125
 126 static void
 127 psscm_handle_pspace_deleted (struct program_space *pspace, void *datum)
 128 {
 129   pspace_smob *p_smob = (pspace_smob *) datum;
 130
 131   gdb_assert (p_smob->pspace == pspace);
 132
 133   psscm_release_pspace (p_smob);
 134 }
 135
 136 /* Return non-zero if SCM is a <gdb:progspace> object.  */
 137
 138 static int
 139 psscm_is_pspace (SCM scm)
 140 {
 141   return SCM_SMOB_PREDICATE (pspace_smob_tag, scm);
 142 }
 143
 144 /* (progspace? object) -> boolean */
 145
 146 static SCM
 147 gdbscm_progspace_p (SCM scm)
 148 {
 149   return scm_from_bool (psscm_is_pspace (scm));
 150 }
 151
 152 /* Return a pointer to the progspace_smob that encapsulates PSPACE,
 153    creating one if necessary.
 154    The result is cached so that we have only one copy per objfile.  */
 155
 156 pspace_smob *
 157 psscm_pspace_smob_from_pspace (struct program_space *pspace)
 158 {
 159   pspace_smob *p_smob;
 160
 161   p_smob = (pspace_smob *) program_space_data (pspace, psscm_pspace_data_key);
 162   if (p_smob == NULL)
 163     {
 164       SCM p_scm = psscm_make_pspace_smob ();
 165
 166       p_smob = (pspace_smob *) SCM_SMOB_DATA (p_scm);
 167       p_smob->pspace = pspace;
 168
 169       set_program_space_data (pspace, psscm_pspace_data_key, p_smob);
 170       scm_gc_protect_object (p_smob->containing_scm);
 171     }
 172
 173   return p_smob;
 174 }
 175
 176 /* Return the <gdb:progspace> object that encapsulates PSPACE.  */
 177
 178 SCM
 179 psscm_scm_from_pspace (struct program_space *pspace)
 180 {
 181   pspace_smob *p_smob = psscm_pspace_smob_from_pspace (pspace);
 182
 183   return p_smob->containing_scm;
 184 }
 185
 186 /* Returns the <gdb:progspace> object in SELF.
 187    Throws an exception if SELF is not a <gdb:progspace> object.  */
 188
 189 static SCM
 190 psscm_get_pspace_arg_unsafe (SCM self, int arg_pos, const char *func_name)
 191 {
 192   SCM_ASSERT_TYPE (psscm_is_pspace (self), self, arg_pos, func_name,
 193                    pspace_smob_name);
 194
 195   return self;
 196 }
 197
 198 /* Returns a pointer to the pspace smob of SELF.
 199    Throws an exception if SELF is not a <gdb:progspace> object.  */
 200
 201 static pspace_smob *
 202 psscm_get_pspace_smob_arg_unsafe (SCM self, int arg_pos,
 203                                   const char *func_name)
 204 {
 205   SCM p_scm = psscm_get_pspace_arg_unsafe (self, arg_pos, func_name);
 206   pspace_smob *p_smob = (pspace_smob *) SCM_SMOB_DATA (p_scm);
 207
 208   return p_smob;
 209 }
 210
 211 /* Return non-zero if pspace P_SMOB is valid.  */
 212
 213 static int
 214 psscm_is_valid (pspace_smob *p_smob)
 215 {
 216   return p_smob->pspace != NULL;
 217 }
 218
 219 /* Return the pspace smob in SELF, verifying it's valid.
 220    Throws an exception if SELF is not a <gdb:progspace> object or is
 221    invalid.  */
 222
 223 static pspace_smob *
 224 psscm_get_valid_pspace_smob_arg_unsafe (SCM self, int arg_pos,
 225                                         const char *func_name)
 226 {
 227   pspace_smob *p_smob
 228     = psscm_get_pspace_smob_arg_unsafe (self, arg_pos, func_name);
 229
 230   if (!psscm_is_valid (p_smob))
 231     {
 232       gdbscm_invalid_object_error (func_name, arg_pos, self,
 233                                    _("<gdb:progspace>"));
 234     }
 235
 236   return p_smob;
 237 }
 238 \f
 239 /* Program space methods.  */
 240
 241 /* (progspace-valid? <gdb:progspace>) -> boolean
 242    Returns #t if this program space still exists in GDB.  */
 243
 244 static SCM
 245 gdbscm_progspace_valid_p (SCM self)
 246 {
 247   pspace_smob *p_smob
 248     = psscm_get_pspace_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 249
 250   return scm_from_bool (p_smob->pspace != NULL);
 251 }
 252
 253 /* (progspace-filename <gdb:progspace>) -> string
 254    Returns the name of the main symfile associated with the progspace,
 255    or #f if there isn't one.
 256    Throw's an exception if the underlying pspace is invalid.  */
 257
 258 static SCM
 259 gdbscm_progspace_filename (SCM self)
 260 {
 261   pspace_smob *p_smob
 262     = psscm_get_valid_pspace_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 263   struct objfile *objfile = p_smob->pspace->symfile_object_file;
 264
 265   if (objfile != NULL)
 266     return gdbscm_scm_from_c_string (objfile_name (objfile));
 267   return SCM_BOOL_F;
 268 }
 269
 270 /* (progspace-objfiles <gdb:progspace>) -> list
 271    Return the list of objfiles in the progspace.
 272    Objfiles that are separate debug objfiles are *not* included in the result,
 273    only the "original/real" one appears in the result.
 274    The order of appearance of objfiles in the result is arbitrary.
 275    Throw's an exception if the underlying pspace is invalid.
 276
 277    Some apps can have 1000s of shared libraries.  Seriously.
 278    A future extension here could be to provide, e.g., a regexp to select
 279    just the ones the caller is interested in (rather than building the list
 280    and then selecting the desired ones).  Another alternative is passing a
 281    predicate, then the filter criteria can be more general.  */
 282
 283 static SCM
 284 gdbscm_progspace_objfiles (SCM self)
 285 {
 286   pspace_smob *p_smob
 287     = psscm_get_valid_pspace_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 288   struct objfile *objfile;
 289   SCM result;
 290
 291   result = SCM_EOL;
 292
 293   ALL_PSPACE_OBJFILES (p_smob->pspace, objfile)
 294   {
 295     if (objfile->separate_debug_objfile_backlink == NULL)
 296       {
 297         SCM item = ofscm_scm_from_objfile (objfile);
 298
 299         result = scm_cons (item, result);
 300       }
 301   }
 302
 303   /* We don't really have to return the list in the same order as recorded
 304      internally, but for consistency we do.  We still advertise that one
 305      cannot assume anything about the order.  */
 306   return scm_reverse_x (result, SCM_EOL);
 307 }
 308
 309 /* (progspace-pretty-printers <gdb:progspace>) -> list
 310    Returns the list of pretty-printers for this program space.  */
 311
 312 static SCM
 313 gdbscm_progspace_pretty_printers (SCM self)
 314 {
 315   pspace_smob *p_smob
 316     = psscm_get_pspace_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 317
 318   return p_smob->pretty_printers;
 319 }
 320
 321 /* (set-progspace-pretty-printers! <gdb:progspace> list) -> unspecified
 322    Set the pretty-printers for this program space.  */
 323
 324 static SCM
 325 gdbscm_set_progspace_pretty_printers_x (SCM self, SCM printers)
 326 {
 327   pspace_smob *p_smob
 328     = psscm_get_pspace_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 329
 330   SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (printers)), printers,
 331                    SCM_ARG2, FUNC_NAME, _("list"));
 332
 333   p_smob->pretty_printers = printers;
 334
 335   return SCM_UNSPECIFIED;
 336 }
 337
 338 /* (current-progspace) -> <gdb:progspace>
 339    Return the current program space.  There always is one.  */
 340
 341 static SCM
 342 gdbscm_current_progspace (void)
 343 {
 344   SCM result;
 345
 346   result = psscm_scm_from_pspace (current_program_space);
 347
 348   return result;
 349 }
 350
 351 /* (progspaces) -> list
 352    Return a list of all progspaces.  */
 353
 354 static SCM
 355 gdbscm_progspaces (void)
 356 {
 357   struct program_space *ps;
 358   SCM result;
 359
 360   result = SCM_EOL;
 361
 362   ALL_PSPACES (ps)
 363   {
 364     SCM item = psscm_scm_from_pspace (ps);
 365
 366     result = scm_cons (item, result);
 367   }
 368
 369   return scm_reverse_x (result, SCM_EOL);
 370 }
 371 \f
 372 /* Initialize the Scheme program space support.  */
 373
 374 static const scheme_function pspace_functions[] =
 375 {
 376   { "progspace?", 1, 0, 0, as_a_scm_t_subr (gdbscm_progspace_p),
 377     "\
 378 Return #t if the object is a <gdb:objfile> object." },
 379
 380   { "progspace-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_progspace_valid_p),
 381     "\
 382 Return #t if the progspace is valid (hasn't been deleted from gdb)." },
 383
 384   { "progspace-filename", 1, 0, 0, as_a_scm_t_subr (gdbscm_progspace_filename),
 385     "\
 386 Return the name of the main symbol file of the progspace." },
 387
 388   { "progspace-objfiles", 1, 0, 0, as_a_scm_t_subr (gdbscm_progspace_objfiles),
 389     "\
 390 Return the list of objfiles associated with the progspace.\n\
 391 Objfiles that are separate debug objfiles are not included in the result.\n\
 392 The order of appearance of objfiles in the result is arbitrary." },
 393
 394   { "progspace-pretty-printers", 1, 0, 0,
 395     as_a_scm_t_subr (gdbscm_progspace_pretty_printers),
 396     "\
 397 Return a list of pretty-printers of the progspace." },
 398
 399   { "set-progspace-pretty-printers!", 2, 0, 0,
 400     as_a_scm_t_subr (gdbscm_set_progspace_pretty_printers_x),
 401     "\
 402 Set the list of pretty-printers of the progspace." },
 403
 404   { "current-progspace", 0, 0, 0, as_a_scm_t_subr (gdbscm_current_progspace),
 405     "\
 406 Return the current program space if there is one or #f if there isn't one." },
 407
 408   { "progspaces", 0, 0, 0, as_a_scm_t_subr (gdbscm_progspaces),
 409     "\
 410 Return a list of all program spaces." },
 411
 412   END_FUNCTIONS
 413 };
 414
 415 void
 416 gdbscm_initialize_pspaces (void)
 417 {
 418   pspace_smob_tag
 419     = gdbscm_make_smob_type (pspace_smob_name, sizeof (pspace_smob));
 420   scm_set_smob_print (pspace_smob_tag, psscm_print_pspace_smob);
 421
 422   gdbscm_define_functions (pspace_functions, 1);
 423
 424   psscm_pspace_data_key
 425     = register_program_space_data_with_cleanup (NULL,
 426                                                 psscm_handle_pspace_deleted);
 427 }