gdb/guile/scm-objfile.c

   1 /* Scheme interface to objfiles.
   2
   3    Copyright (C) 2008-2014 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 \f
  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 \f
 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 \f
 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 \f
 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 }