1 /* Scheme interface to objfiles. 2 3 Copyright (C) 2008-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 /* See README file in this directory for implementation notes, coding 21 conventions, et.al. */ 22 23 #include "defs.h" 24 #include "objfiles.h" 25 #include "language.h" 26 #include "guile-internal.h" 27 28 /* The <gdb:objfile> smob. */ 29 30 struct objfile_smob 31 { 32 /* This always appears first. */ 33 gdb_smob base; 34 35 /* The corresponding objfile. */ 36 struct objfile *objfile; 37 38 /* The pretty-printer list of functions. */ 39 SCM pretty_printers; 40 41 /* The <gdb:objfile> object we are contained in, needed to protect/unprotect 42 the object since a reference to it comes from non-gc-managed space 43 (the objfile). */ 44 SCM containing_scm; 45 }; 46 47 static const char objfile_smob_name[] = "gdb:objfile"; 48 49 /* The tag Guile knows the objfile smob by. */ 50 static scm_t_bits objfile_smob_tag; 51 52 /* Objfile registry cleanup handler for when an objfile is deleted. */ 53 struct ofscm_deleter 54 { 55 void operator() (objfile_smob *o_smob) 56 { 57 o_smob->objfile = NULL; 58 scm_gc_unprotect_object (o_smob->containing_scm); 59 } 60 }; 61 62 static const registry<objfile>::key<objfile_smob, ofscm_deleter> 63 ofscm_objfile_data_key; 64 65 /* Return the list of pretty-printers registered with O_SMOB. */ 66 67 SCM 68 ofscm_objfile_smob_pretty_printers (objfile_smob *o_smob) 69 { 70 return o_smob->pretty_printers; 71 } 72 73 /* Administrivia for objfile smobs. */ 74 75 /* The smob "print" function for <gdb:objfile>. */ 76 77 static int 78 ofscm_print_objfile_smob (SCM self, SCM port, scm_print_state *pstate) 79 { 80 objfile_smob *o_smob = (objfile_smob *) SCM_SMOB_DATA (self); 81 82 gdbscm_printf (port, "#<%s ", objfile_smob_name); 83 gdbscm_printf (port, "%s", 84 o_smob->objfile != NULL 85 ? objfile_name (o_smob->objfile) 86 : "{invalid}"); 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:objfile> object. 96 It's empty in the sense that an OBJFILE still needs to be associated 97 with it. */ 98 99 static SCM 100 ofscm_make_objfile_smob (void) 101 { 102 objfile_smob *o_smob = (objfile_smob *) 103 scm_gc_malloc (sizeof (objfile_smob), objfile_smob_name); 104 SCM o_scm; 105 106 o_smob->objfile = NULL; 107 o_smob->pretty_printers = SCM_EOL; 108 o_scm = scm_new_smob (objfile_smob_tag, (scm_t_bits) o_smob); 109 o_smob->containing_scm = o_scm; 110 gdbscm_init_gsmob (&o_smob->base); 111 112 return o_scm; 113 } 114 115 /* Return non-zero if SCM is a <gdb:objfile> object. */ 116 117 static int 118 ofscm_is_objfile (SCM scm) 119 { 120 return SCM_SMOB_PREDICATE (objfile_smob_tag, scm); 121 } 122 123 /* (objfile? object) -> boolean */ 124 125 static SCM 126 gdbscm_objfile_p (SCM scm) 127 { 128 return scm_from_bool (ofscm_is_objfile (scm)); 129 } 130 131 /* Return a pointer to the objfile_smob that encapsulates OBJFILE, 132 creating one if necessary. 133 The result is cached so that we have only one copy per objfile. */ 134 135 objfile_smob * 136 ofscm_objfile_smob_from_objfile (struct objfile *objfile) 137 { 138 objfile_smob *o_smob; 139 140 o_smob = ofscm_objfile_data_key.get (objfile); 141 if (o_smob == NULL) 142 { 143 SCM o_scm = ofscm_make_objfile_smob (); 144 145 o_smob = (objfile_smob *) SCM_SMOB_DATA (o_scm); 146 o_smob->objfile = objfile; 147 148 ofscm_objfile_data_key.set (objfile, o_smob); 149 scm_gc_protect_object (o_smob->containing_scm); 150 } 151 152 return o_smob; 153 } 154 155 /* Return the <gdb:objfile> object that encapsulates OBJFILE. */ 156 157 SCM 158 ofscm_scm_from_objfile (struct objfile *objfile) 159 { 160 objfile_smob *o_smob = ofscm_objfile_smob_from_objfile (objfile); 161 162 return o_smob->containing_scm; 163 } 164 165 /* Returns the <gdb:objfile> object in SELF. 166 Throws an exception if SELF is not a <gdb:objfile> object. */ 167 168 static SCM 169 ofscm_get_objfile_arg_unsafe (SCM self, int arg_pos, const char *func_name) 170 { 171 SCM_ASSERT_TYPE (ofscm_is_objfile (self), self, arg_pos, func_name, 172 objfile_smob_name); 173 174 return self; 175 } 176 177 /* Returns a pointer to the objfile smob of SELF. 178 Throws an exception if SELF is not a <gdb:objfile> object. */ 179 180 static objfile_smob * 181 ofscm_get_objfile_smob_arg_unsafe (SCM self, int arg_pos, 182 const char *func_name) 183 { 184 SCM o_scm = ofscm_get_objfile_arg_unsafe (self, arg_pos, func_name); 185 objfile_smob *o_smob = (objfile_smob *) SCM_SMOB_DATA (o_scm); 186 187 return o_smob; 188 } 189 190 /* Return non-zero if objfile O_SMOB is valid. */ 191 192 static int 193 ofscm_is_valid (objfile_smob *o_smob) 194 { 195 return o_smob->objfile != NULL; 196 } 197 198 /* Return the objfile smob in SELF, verifying it's valid. 199 Throws an exception if SELF is not a <gdb:objfile> object or is invalid. */ 200 201 static objfile_smob * 202 ofscm_get_valid_objfile_smob_arg_unsafe (SCM self, int arg_pos, 203 const char *func_name) 204 { 205 objfile_smob *o_smob 206 = ofscm_get_objfile_smob_arg_unsafe (self, arg_pos, func_name); 207 208 if (!ofscm_is_valid (o_smob)) 209 { 210 gdbscm_invalid_object_error (func_name, arg_pos, self, 211 _("<gdb:objfile>")); 212 } 213 214 return o_smob; 215 } 216 217 /* Objfile methods. */ 218 219 /* (objfile-valid? <gdb:objfile>) -> boolean 220 Returns #t if this object file still exists in GDB. */ 221 222 static SCM 223 gdbscm_objfile_valid_p (SCM self) 224 { 225 objfile_smob *o_smob 226 = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 227 228 return scm_from_bool (o_smob->objfile != NULL); 229 } 230 231 /* (objfile-filename <gdb:objfile>) -> string 232 Returns the objfile's file name. 233 Throw's an exception if the underlying objfile is invalid. */ 234 235 static SCM 236 gdbscm_objfile_filename (SCM self) 237 { 238 objfile_smob *o_smob 239 = ofscm_get_valid_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 240 241 return gdbscm_scm_from_c_string (objfile_name (o_smob->objfile)); 242 } 243 244 /* (objfile-progspace <gdb:objfile>) -> <gdb:progspace> 245 Returns the objfile's progspace. 246 Throw's an exception if the underlying objfile is invalid. */ 247 248 static SCM 249 gdbscm_objfile_progspace (SCM self) 250 { 251 objfile_smob *o_smob 252 = ofscm_get_valid_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 253 254 return psscm_scm_from_pspace (o_smob->objfile->pspace); 255 } 256 257 /* (objfile-pretty-printers <gdb:objfile>) -> list 258 Returns the list of pretty-printers for this objfile. */ 259 260 static SCM 261 gdbscm_objfile_pretty_printers (SCM self) 262 { 263 objfile_smob *o_smob 264 = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 265 266 return o_smob->pretty_printers; 267 } 268 269 /* (set-objfile-pretty-printers! <gdb:objfile> list) -> unspecified 270 Set the pretty-printers for this objfile. */ 271 272 static SCM 273 gdbscm_set_objfile_pretty_printers_x (SCM self, SCM printers) 274 { 275 objfile_smob *o_smob 276 = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 277 278 SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (printers)), printers, 279 SCM_ARG2, FUNC_NAME, _("list")); 280 281 o_smob->pretty_printers = printers; 282 283 return SCM_UNSPECIFIED; 284 } 285 286 /* The "current" objfile. This is set when gdb detects that a new 287 objfile has been loaded. It is only set for the duration of a call to 288 gdbscm_source_objfile_script and gdbscm_execute_objfile_script; it is NULL 289 at other times. */ 290 static struct objfile *ofscm_current_objfile; 291 292 /* Set the current objfile to OBJFILE and then read FILE named FILENAME 293 as Guile code. This does not throw any errors. If an exception 294 occurs Guile will print the backtrace. 295 This is the extension_language_script_ops.objfile_script_sourcer 296 "method". */ 297 298 void 299 gdbscm_source_objfile_script (const struct extension_language_defn *extlang, 300 struct objfile *objfile, FILE *file, 301 const char *filename) 302 { 303 ofscm_current_objfile = objfile; 304 305 gdb::unique_xmalloc_ptr<char> msg = gdbscm_safe_source_script (filename); 306 if (msg != NULL) 307 gdb_printf (gdb_stderr, "%s", msg.get ()); 308 309 ofscm_current_objfile = NULL; 310 } 311 312 /* Set the current objfile to OBJFILE and then read FILE named FILENAME 313 as Guile code. This does not throw any errors. If an exception 314 occurs Guile will print the backtrace. 315 This is the extension_language_script_ops.objfile_script_sourcer 316 "method". */ 317 318 void 319 gdbscm_execute_objfile_script (const struct extension_language_defn *extlang, 320 struct objfile *objfile, const char *name, 321 const char *script) 322 { 323 ofscm_current_objfile = objfile; 324 325 gdb::unique_xmalloc_ptr<char> msg 326 = gdbscm_safe_eval_string (script, 0 /* display_result */); 327 if (msg != NULL) 328 gdb_printf (gdb_stderr, "%s", msg.get ()); 329 330 ofscm_current_objfile = NULL; 331 } 332 333 /* (current-objfile) -> <gdb:objfile> 334 Return the current objfile, or #f if there isn't one. 335 Ideally this would be named ofscm_current_objfile, but that name is 336 taken by the variable recording the current objfile. */ 337 338 static SCM 339 gdbscm_get_current_objfile (void) 340 { 341 if (ofscm_current_objfile == NULL) 342 return SCM_BOOL_F; 343 344 return ofscm_scm_from_objfile (ofscm_current_objfile); 345 } 346 347 /* (objfiles) -> list 348 Return a list of all objfiles in the current program space. */ 349 350 static SCM 351 gdbscm_objfiles (void) 352 { 353 SCM result; 354 355 result = SCM_EOL; 356 357 for (objfile *objf : current_program_space->objfiles ()) 358 { 359 SCM item = ofscm_scm_from_objfile (objf); 360 361 result = scm_cons (item, result); 362 } 363 364 return scm_reverse_x (result, SCM_EOL); 365 } 366 367 /* Initialize the Scheme objfile support. */ 368 369 static const scheme_function objfile_functions[] = 370 { 371 { "objfile?", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_p), 372 "\ 373 Return #t if the object is a <gdb:objfile> object." }, 374 375 { "objfile-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_valid_p), 376 "\ 377 Return #t if the objfile is valid (hasn't been deleted from gdb)." }, 378 379 { "objfile-filename", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_filename), 380 "\ 381 Return the file name of the objfile." }, 382 383 { "objfile-progspace", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_progspace), 384 "\ 385 Return the progspace that the objfile lives in." }, 386 387 { "objfile-pretty-printers", 1, 0, 0, 388 as_a_scm_t_subr (gdbscm_objfile_pretty_printers), 389 "\ 390 Return a list of pretty-printers of the objfile." }, 391 392 { "set-objfile-pretty-printers!", 2, 0, 0, 393 as_a_scm_t_subr (gdbscm_set_objfile_pretty_printers_x), 394 "\ 395 Set the list of pretty-printers of the objfile." }, 396 397 { "current-objfile", 0, 0, 0, as_a_scm_t_subr (gdbscm_get_current_objfile), 398 "\ 399 Return the current objfile if there is one or #f if there isn't one." }, 400 401 { "objfiles", 0, 0, 0, as_a_scm_t_subr (gdbscm_objfiles), 402 "\ 403 Return a list of all objfiles in the current program space." }, 404 405 END_FUNCTIONS 406 }; 407 408 void 409 gdbscm_initialize_objfiles (void) 410 { 411 objfile_smob_tag 412 = gdbscm_make_smob_type (objfile_smob_name, sizeof (objfile_smob)); 413 scm_set_smob_print (objfile_smob_tag, ofscm_print_objfile_smob); 414 415 gdbscm_define_functions (objfile_functions, 1); 416 } 417