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