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