gdb/guile/scm-progspace.c

   1 /* Guile interface to program spaces.
   2
   3    Copyright (C) 2010-2020 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   SCM result;
 289
 290   result = SCM_EOL;
 291
 292   for (objfile *objfile : p_smob->pspace->objfiles ())
 293     {
 294       if (objfile->separate_debug_objfile_backlink == NULL)
 295         {
 296           SCM item = ofscm_scm_from_objfile (objfile);
 297
 298           result = scm_cons (item, result);
 299         }
 300     }
 301
 302   /* We don't really have to return the list in the same order as recorded
 303      internally, but for consistency we do.  We still advertise that one
 304      cannot assume anything about the order.  */
 305   return scm_reverse_x (result, SCM_EOL);
 306 }
 307
 308 /* (progspace-pretty-printers <gdb:progspace>) -> list
 309    Returns the list of pretty-printers for this program space.  */
 310
 311 static SCM
 312 gdbscm_progspace_pretty_printers (SCM self)
 313 {
 314   pspace_smob *p_smob
 315     = psscm_get_pspace_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 316
 317   return p_smob->pretty_printers;
 318 }
 319
 320 /* (set-progspace-pretty-printers! <gdb:progspace> list) -> unspecified
 321    Set the pretty-printers for this program space.  */
 322
 323 static SCM
 324 gdbscm_set_progspace_pretty_printers_x (SCM self, SCM printers)
 325 {
 326   pspace_smob *p_smob
 327     = psscm_get_pspace_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 328
 329   SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (printers)), printers,
 330                    SCM_ARG2, FUNC_NAME, _("list"));
 331
 332   p_smob->pretty_printers = printers;
 333
 334   return SCM_UNSPECIFIED;
 335 }
 336
 337 /* (current-progspace) -> <gdb:progspace>
 338    Return the current program space.  There always is one.  */
 339
 340 static SCM
 341 gdbscm_current_progspace (void)
 342 {
 343   SCM result;
 344
 345   result = psscm_scm_from_pspace (current_program_space);
 346
 347   return result;
 348 }
 349
 350 /* (progspaces) -> list
 351    Return a list of all progspaces.  */
 352
 353 static SCM
 354 gdbscm_progspaces (void)
 355 {
 356   SCM result;
 357
 358   result = SCM_EOL;
 359
 360   for (struct program_space *ps : program_spaces)
 361     {
 362       SCM item = psscm_scm_from_pspace (ps);
 363
 364       result = scm_cons (item, result);
 365     }
 366
 367   return scm_reverse_x (result, SCM_EOL);
 368 }
 369 \f
 370 /* Initialize the Scheme program space support.  */
 371
 372 static const scheme_function pspace_functions[] =
 373 {
 374   { "progspace?", 1, 0, 0, as_a_scm_t_subr (gdbscm_progspace_p),
 375     "\
 376 Return #t if the object is a <gdb:objfile> object." },
 377
 378   { "progspace-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_progspace_valid_p),
 379     "\
 380 Return #t if the progspace is valid (hasn't been deleted from gdb)." },
 381
 382   { "progspace-filename", 1, 0, 0, as_a_scm_t_subr (gdbscm_progspace_filename),
 383     "\
 384 Return the name of the main symbol file of the progspace." },
 385
 386   { "progspace-objfiles", 1, 0, 0, as_a_scm_t_subr (gdbscm_progspace_objfiles),
 387     "\
 388 Return the list of objfiles associated with the progspace.\n\
 389 Objfiles that are separate debug objfiles are not included in the result.\n\
 390 The order of appearance of objfiles in the result is arbitrary." },
 391
 392   { "progspace-pretty-printers", 1, 0, 0,
 393     as_a_scm_t_subr (gdbscm_progspace_pretty_printers),
 394     "\
 395 Return a list of pretty-printers of the progspace." },
 396
 397   { "set-progspace-pretty-printers!", 2, 0, 0,
 398     as_a_scm_t_subr (gdbscm_set_progspace_pretty_printers_x),
 399     "\
 400 Set the list of pretty-printers of the progspace." },
 401
 402   { "current-progspace", 0, 0, 0, as_a_scm_t_subr (gdbscm_current_progspace),
 403     "\
 404 Return the current program space if there is one or #f if there isn't one." },
 405
 406   { "progspaces", 0, 0, 0, as_a_scm_t_subr (gdbscm_progspaces),
 407     "\
 408 Return a list of all program spaces." },
 409
 410   END_FUNCTIONS
 411 };
 412
 413 void
 414 gdbscm_initialize_pspaces (void)
 415 {
 416   pspace_smob_tag
 417     = gdbscm_make_smob_type (pspace_smob_name, sizeof (pspace_smob));
 418   scm_set_smob_print (pspace_smob_tag, psscm_print_pspace_smob);
 419
 420   gdbscm_define_functions (pspace_functions, 1);
 421
 422   psscm_pspace_data_key
 423     = register_program_space_data_with_cleanup (NULL,
 424                                                 psscm_handle_pspace_deleted);
 425 }