1 /* Scheme interface to objfiles. 2 3 Copyright (C) 2008-2015 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 = 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_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-pretty-printers <gdb:objfile>) -> list 256 Returns the list of pretty-printers for this objfile. */ 257 258 static SCM 259 gdbscm_objfile_pretty_printers (SCM self) 260 { 261 objfile_smob *o_smob 262 = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 263 264 return o_smob->pretty_printers; 265 } 266 267 /* (set-objfile-pretty-printers! <gdb:objfile> list) -> unspecified 268 Set the pretty-printers for this objfile. */ 269 270 static SCM 271 gdbscm_set_objfile_pretty_printers_x (SCM self, SCM printers) 272 { 273 objfile_smob *o_smob 274 = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 275 276 SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (printers)), printers, 277 SCM_ARG2, FUNC_NAME, _("list")); 278 279 o_smob->pretty_printers = printers; 280 281 return SCM_UNSPECIFIED; 282 } 283 284 /* The "current" objfile. This is set when gdb detects that a new 285 objfile has been loaded. It is only set for the duration of a call to 286 gdbscm_source_objfile_script; it is NULL at other times. */ 287 static struct objfile *ofscm_current_objfile; 288 289 /* Set the current objfile to OBJFILE and then read FILE named FILENAME 290 as Guile code. This does not throw any errors. If an exception 291 occurs Guile will print the backtrace. 292 This is the extension_language_script_ops.objfile_script_sourcer 293 "method". */ 294 295 void 296 gdbscm_source_objfile_script (const struct extension_language_defn *extlang, 297 struct objfile *objfile, FILE *file, 298 const char *filename) 299 { 300 char *msg; 301 302 ofscm_current_objfile = objfile; 303 304 msg = gdbscm_safe_source_script (filename); 305 if (msg != NULL) 306 { 307 fprintf_filtered (gdb_stderr, "%s", msg); 308 xfree (msg); 309 } 310 311 ofscm_current_objfile = NULL; 312 } 313 314 /* (current-objfile) -> <gdb:obfjile> 315 Return the current objfile, or #f if there isn't one. 316 Ideally this would be named ofscm_current_objfile, but that name is 317 taken by the variable recording the current objfile. */ 318 319 static SCM 320 gdbscm_get_current_objfile (void) 321 { 322 if (ofscm_current_objfile == NULL) 323 return SCM_BOOL_F; 324 325 return ofscm_scm_from_objfile (ofscm_current_objfile); 326 } 327 328 /* (objfiles) -> list 329 Return a list of all objfiles in the current program space. */ 330 331 static SCM 332 gdbscm_objfiles (void) 333 { 334 struct objfile *objf; 335 SCM result; 336 337 result = SCM_EOL; 338 339 ALL_OBJFILES (objf) 340 { 341 SCM item = ofscm_scm_from_objfile (objf); 342 343 result = scm_cons (item, result); 344 } 345 346 return scm_reverse_x (result, SCM_EOL); 347 } 348 349 /* Initialize the Scheme objfile support. */ 350 351 static const scheme_function objfile_functions[] = 352 { 353 { "objfile?", 1, 0, 0, gdbscm_objfile_p, 354 "\ 355 Return #t if the object is a <gdb:objfile> object." }, 356 357 { "objfile-valid?", 1, 0, 0, gdbscm_objfile_valid_p, 358 "\ 359 Return #t if the objfile is valid (hasn't been deleted from gdb)." }, 360 361 { "objfile-filename", 1, 0, 0, gdbscm_objfile_filename, 362 "\ 363 Return the file name of the objfile." }, 364 365 { "objfile-pretty-printers", 1, 0, 0, gdbscm_objfile_pretty_printers, 366 "\ 367 Return a list of pretty-printers of the objfile." }, 368 369 { "set-objfile-pretty-printers!", 2, 0, 0, 370 gdbscm_set_objfile_pretty_printers_x, 371 "\ 372 Set the list of pretty-printers of the objfile." }, 373 374 { "current-objfile", 0, 0, 0, gdbscm_get_current_objfile, 375 "\ 376 Return the current objfile if there is one or #f if there isn't one." }, 377 378 { "objfiles", 0, 0, 0, gdbscm_objfiles, 379 "\ 380 Return a list of all objfiles in the current program space." }, 381 382 END_FUNCTIONS 383 }; 384 385 void 386 gdbscm_initialize_objfiles (void) 387 { 388 objfile_smob_tag 389 = gdbscm_make_smob_type (objfile_smob_name, sizeof (objfile_smob)); 390 scm_set_smob_print (objfile_smob_tag, ofscm_print_objfile_smob); 391 392 gdbscm_define_functions (objfile_functions, 1); 393 394 ofscm_objfile_data_key 395 = register_objfile_data_with_cleanup (NULL, ofscm_handle_objfile_deleted); 396 } 397