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 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 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 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 } 428