1 /* Guile interface to program spaces. 2 3 Copyright (C) 2010-2019 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 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 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 struct program_space *ps; 357 SCM result; 358 359 result = SCM_EOL; 360 361 ALL_PSPACES (ps) 362 { 363 SCM item = psscm_scm_from_pspace (ps); 364 365 result = scm_cons (item, result); 366 } 367 368 return scm_reverse_x (result, SCM_EOL); 369 } 370 371 /* Initialize the Scheme program space support. */ 372 373 static const scheme_function pspace_functions[] = 374 { 375 { "progspace?", 1, 0, 0, as_a_scm_t_subr (gdbscm_progspace_p), 376 "\ 377 Return #t if the object is a <gdb:objfile> object." }, 378 379 { "progspace-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_progspace_valid_p), 380 "\ 381 Return #t if the progspace is valid (hasn't been deleted from gdb)." }, 382 383 { "progspace-filename", 1, 0, 0, as_a_scm_t_subr (gdbscm_progspace_filename), 384 "\ 385 Return the name of the main symbol file of the progspace." }, 386 387 { "progspace-objfiles", 1, 0, 0, as_a_scm_t_subr (gdbscm_progspace_objfiles), 388 "\ 389 Return the list of objfiles associated with the progspace.\n\ 390 Objfiles that are separate debug objfiles are not included in the result.\n\ 391 The order of appearance of objfiles in the result is arbitrary." }, 392 393 { "progspace-pretty-printers", 1, 0, 0, 394 as_a_scm_t_subr (gdbscm_progspace_pretty_printers), 395 "\ 396 Return a list of pretty-printers of the progspace." }, 397 398 { "set-progspace-pretty-printers!", 2, 0, 0, 399 as_a_scm_t_subr (gdbscm_set_progspace_pretty_printers_x), 400 "\ 401 Set the list of pretty-printers of the progspace." }, 402 403 { "current-progspace", 0, 0, 0, as_a_scm_t_subr (gdbscm_current_progspace), 404 "\ 405 Return the current program space if there is one or #f if there isn't one." }, 406 407 { "progspaces", 0, 0, 0, as_a_scm_t_subr (gdbscm_progspaces), 408 "\ 409 Return a list of all program spaces." }, 410 411 END_FUNCTIONS 412 }; 413 414 void 415 gdbscm_initialize_pspaces (void) 416 { 417 pspace_smob_tag 418 = gdbscm_make_smob_type (pspace_smob_name, sizeof (pspace_smob)); 419 scm_set_smob_print (pspace_smob_tag, psscm_print_pspace_smob); 420 421 gdbscm_define_functions (pspace_functions, 1); 422 423 psscm_pspace_data_key 424 = register_program_space_data_with_cleanup (NULL, 425 psscm_handle_pspace_deleted); 426 } 427