gdb/guile/scm-safe-call.c

   1 /* GDB/Scheme support for safe calls into the Guile interpreter.
   2
   3    Copyright (C) 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 "filenames.h"
  25 #include "gdb_assert.h"
  26 #include "guile-internal.h"
  27
  28 /* Struct to marshall args to scscm_safe_call_body.  */
  29
  30 struct c_data
  31 {
  32   void *(*func) (void *);
  33   void *data;
  34   /* An error message or NULL for success.  */
  35   void *result;
  36 };
  37
  38 /* Struct to marshall args through gdbscm_with_catch.  */
  39
  40 struct with_catch_data
  41 {
  42   scm_t_catch_body func;
  43   void *data;
  44   scm_t_catch_handler unwind_handler;
  45   scm_t_catch_handler pre_unwind_handler;
  46
  47   /* If EXCP_MATCHER is non-NULL, it is an excp_matcher_func function.
  48      If the exception is recognized by it, the exception is recorded as is,
  49      without wrapping it in gdb:with-stack.  */
  50   excp_matcher_func *excp_matcher;
  51
  52   SCM stack;
  53   SCM catch_result;
  54 };
  55
  56 /* The "body" argument to scm_i_with_continuation_barrier.
  57    Invoke the user-supplied function.  */
  58
  59 static SCM
  60 scscm_safe_call_body (void *d)
  61 {
  62   struct c_data *data = (struct c_data *) d;
  63
  64   data->result = data->func (data->data);
  65
  66   return SCM_UNSPECIFIED;
  67 }
  68
  69 /* A "pre-unwind handler" to scm_c_catch that prints the exception
  70    according to "set guile print-stack".  */
  71
  72 static SCM
  73 scscm_printing_pre_unwind_handler (void *data, SCM key, SCM args)
  74 {
  75   SCM stack = scm_make_stack (SCM_BOOL_T, scm_list_1 (scm_from_int (2)));
  76
  77   gdbscm_print_exception_with_stack (SCM_BOOL_F, stack, key, args);
  78
  79   return SCM_UNSPECIFIED;
  80 }
  81
  82 /* A no-op unwind handler.  */
  83
  84 static SCM
  85 scscm_nop_unwind_handler (void *data, SCM key, SCM args)
  86 {
  87   return SCM_UNSPECIFIED;
  88 }
  89
  90 /* The "pre-unwind handler" to scm_c_catch that records the exception
  91    for possible later printing.  We do this in the pre-unwind handler because
  92    we want the stack to include point where the exception occurred.
  93
  94    If DATA is non-NULL, it is an excp_matcher_func function.
  95    If the exception is recognized by it, the exception is recorded as is,
  96    without wrapping it in gdb:with-stack.  */
  97
  98 static SCM
  99 scscm_recording_pre_unwind_handler (void *datap, SCM key, SCM args)
 100 {
 101   struct with_catch_data *data = datap;
 102   excp_matcher_func *matcher = data->excp_matcher;
 103
 104   if (matcher != NULL && matcher (key))
 105     return SCM_UNSPECIFIED;
 106
 107   /* There's no need to record the whole stack if we're not going to print it.
 108      However, convention is to still print the stack frame in which the
 109      exception occurred, even if we're not going to print a full backtrace.
 110      For now, keep it simple.  */
 111
 112   data->stack = scm_make_stack (SCM_BOOL_T, scm_list_1 (scm_from_int (2)));
 113
 114   /* IWBN if we could return the <gdb:exception> here and skip the unwind
 115      handler, but it doesn't work that way.  If we want to return a
 116      <gdb:exception> object from the catch it needs to come from the unwind
 117      handler.  So what we do is save the stack for later use by the unwind
 118      handler.  */
 119
 120   return SCM_UNSPECIFIED;
 121 }
 122
 123 /* Part two of the recording unwind handler.
 124    Here we take the stack saved from the pre-unwind handler and create
 125    the <gdb:exception> object.  */
 126
 127 static SCM
 128 scscm_recording_unwind_handler (void *datap, SCM key, SCM args)
 129 {
 130   struct with_catch_data *data = datap;
 131
 132   /* We need to record the stack in the exception since we're about to
 133      throw and lose the location that got the exception.  We do this by
 134      wrapping the exception + stack in a new exception.  */
 135
 136   if (gdbscm_is_true (data->stack))
 137     return gdbscm_make_exception_with_stack (key, args, data->stack);
 138
 139   return gdbscm_make_exception (key, args);
 140 }
 141
 142 /* Ugh. :-(
 143    Guile doesn't export scm_i_with_continuation_barrier which is exactly
 144    what we need.  To cope, have our own wrapper around scm_c_catch and
 145    pass this as the "body" argument to scm_c_with_continuation_barrier.
 146    Darn darn darn.  */
 147
 148 static void *
 149 gdbscm_with_catch (void *data)
 150 {
 151   struct with_catch_data *d = data;
 152
 153   d->catch_result
 154     = scm_c_catch (SCM_BOOL_T,
 155                    d->func, d->data,
 156                    d->unwind_handler, d,
 157                    d->pre_unwind_handler, d);
 158
 159   return NULL;
 160 }
 161
 162 /* A wrapper around scm_with_guile that prints backtraces and exceptions
 163    according to "set guile print-stack".
 164    The result if NULL if no exception occurred, otherwise it is a statically
 165    allocated error message (caller must *not* free).  */
 166
 167 void *
 168 gdbscm_with_guile (void *(*func) (void *), void *data)
 169 {
 170   struct c_data c_data;
 171   struct with_catch_data catch_data;
 172
 173   c_data.func = func;
 174   c_data.data = data;
 175   /* Set this now in case an exception is thrown.  */
 176   c_data.result = _("Error while executing Scheme code.");
 177
 178   catch_data.func = scscm_safe_call_body;
 179   catch_data.data = &c_data;
 180   catch_data.unwind_handler = scscm_nop_unwind_handler;
 181   catch_data.pre_unwind_handler = scscm_printing_pre_unwind_handler;
 182   catch_data.excp_matcher = NULL;
 183   catch_data.stack = SCM_BOOL_F;
 184   catch_data.catch_result = SCM_UNSPECIFIED;
 185
 186   scm_with_guile (gdbscm_with_catch, &catch_data);
 187
 188   return c_data.result;
 189 }
 190
 191 /* Another wrapper of scm_with_guile for use by the safe call/apply routines
 192    in this file, as well as for general purpose calling other functions safely.
 193    For these we want to record the exception, but leave the possible printing
 194    of it to later.  */
 195
 196 SCM
 197 gdbscm_call_guile (SCM (*func) (void *), void *data,
 198                    excp_matcher_func *ok_excps)
 199 {
 200   struct with_catch_data catch_data;
 201
 202   catch_data.func = func;
 203   catch_data.data = data;
 204   catch_data.unwind_handler = scscm_recording_unwind_handler;
 205   catch_data.pre_unwind_handler = scscm_recording_pre_unwind_handler;
 206   catch_data.excp_matcher = ok_excps;
 207   catch_data.stack = SCM_BOOL_F;
 208   catch_data.catch_result = SCM_UNSPECIFIED;
 209
 210 #if 0
 211   scm_c_with_continuation_barrier (gdbscm_with_catch, &catch_data);
 212 #else
 213   scm_with_guile (gdbscm_with_catch, &catch_data);
 214 #endif
 215
 216   return catch_data.catch_result;
 217 }
 218 \f
 219 /* Utilities to safely call Scheme code, catching all exceptions, and
 220    preventing continuation capture.
 221    The result is the result of calling the function, or if an exception occurs
 222    then the result is a <gdb:exception> smob, which can be tested for with
 223    gdbscm_is_exception.  */
 224
 225 /* Helper for gdbscm_safe_call_0.  */
 226
 227 static SCM
 228 scscm_call_0_body (void *argsp)
 229 {
 230   SCM *args = argsp;
 231
 232   return scm_call_0 (args[0]);
 233 }
 234
 235 SCM
 236 gdbscm_safe_call_0 (SCM proc, excp_matcher_func *ok_excps)
 237 {
 238   SCM args[] = { proc };
 239
 240   return gdbscm_call_guile (scscm_call_0_body, args, ok_excps);
 241 }
 242
 243 /* Helper for gdbscm_safe_call_1.  */
 244
 245 static SCM
 246 scscm_call_1_body (void *argsp)
 247 {
 248   SCM *args = argsp;
 249
 250   return scm_call_1 (args[0], args[1]);
 251 }
 252
 253 SCM
 254 gdbscm_safe_call_1 (SCM proc, SCM arg0, excp_matcher_func *ok_excps)
 255 {
 256   SCM args[] = { proc, arg0 };
 257
 258   return gdbscm_call_guile (scscm_call_1_body, args, ok_excps);
 259 }
 260
 261 /* Helper for gdbscm_safe_call_2.  */
 262
 263 static SCM
 264 scscm_call_2_body (void *argsp)
 265 {
 266   SCM *args = argsp;
 267
 268   return scm_call_2 (args[0], args[1], args[2]);
 269 }
 270
 271 SCM
 272 gdbscm_safe_call_2 (SCM proc, SCM arg0, SCM arg1, excp_matcher_func *ok_excps)
 273 {
 274   SCM args[] = { proc, arg0, arg1 };
 275
 276   return gdbscm_call_guile (scscm_call_2_body, args, ok_excps);
 277 }
 278
 279 /* Helper for gdbscm_safe_call_3.  */
 280
 281 static SCM
 282 scscm_call_3_body (void *argsp)
 283 {
 284   SCM *args = argsp;
 285
 286   return scm_call_3 (args[0], args[1], args[2], args[3]);
 287 }
 288
 289 SCM
 290 gdbscm_safe_call_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3,
 291                     excp_matcher_func *ok_excps)
 292 {
 293   SCM args[] = { proc, arg1, arg2, arg3 };
 294
 295   return gdbscm_call_guile (scscm_call_3_body, args, ok_excps);
 296 }
 297
 298 /* Helper for gdbscm_safe_call_4.  */
 299
 300 static SCM
 301 scscm_call_4_body (void *argsp)
 302 {
 303   SCM *args = argsp;
 304
 305   return scm_call_4 (args[0], args[1], args[2], args[3], args[4]);
 306 }
 307
 308 SCM
 309 gdbscm_safe_call_4 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4,
 310                     excp_matcher_func *ok_excps)
 311 {
 312   SCM args[] = { proc, arg1, arg2, arg3, arg4 };
 313
 314   return gdbscm_call_guile (scscm_call_4_body, args, ok_excps);
 315 }
 316
 317 /* Helper for gdbscm_safe_apply_1.  */
 318
 319 static SCM
 320 scscm_apply_1_body (void *argsp)
 321 {
 322   SCM *args = argsp;
 323
 324   return scm_apply_1 (args[0], args[1], args[2]);
 325 }
 326
 327 SCM
 328 gdbscm_safe_apply_1 (SCM proc, SCM arg0, SCM rest, excp_matcher_func *ok_excps)
 329 {
 330   SCM args[] = { proc, arg0, rest };
 331
 332   return gdbscm_call_guile (scscm_apply_1_body, args, ok_excps);
 333 }
 334 \f
 335 /* Utilities to call Scheme code, not catching exceptions, and
 336    not preventing continuation capture.
 337    The result is the result of calling the function.
 338    If an exception occurs then Guile is left to handle the exception,
 339    unwinding the stack as appropriate.
 340
 341    USE THESE WITH CARE.
 342    Typically these are called from functions that implement Scheme procedures,
 343    and we don't want to catch the exception; otherwise it will get printed
 344    twice: once when first caught and once if it ends up being rethrown and the
 345    rethrow reaches the top repl, which will confuse the user.
 346
 347    While these calls just pass the call off to the corresponding Guile
 348    procedure, all such calls are routed through these ones to:
 349    a) provide a place to put hooks or whatnot in if we need to,
 350    b) add "unsafe" to the name to alert the reader.  */
 351
 352 SCM
 353 gdbscm_unsafe_call_1 (SCM proc, SCM arg0)
 354 {
 355   return scm_call_1 (proc, arg0);
 356 }
 357 \f
 358 /* Utilities for safely evaluating a Scheme expression string.  */
 359
 360 struct eval_scheme_string_data
 361 {
 362   const char *string;
 363   int display_result;
 364 };
 365
 366 /* Wrapper to eval a C string in the Guile interpreter.
 367    This is passed to scm_with_guile.  */
 368
 369 static void *
 370 scscm_eval_scheme_string (void *datap)
 371 {
 372   struct eval_scheme_string_data *data = datap;
 373   SCM result = scm_c_eval_string (data->string);
 374
 375   if (data->display_result && !scm_is_eq (result, SCM_UNSPECIFIED))
 376     {
 377       SCM port = scm_current_output_port ();
 378
 379       scm_write (result, port);
 380       scm_newline (port);
 381     }
 382
 383   /* If we get here the eval succeeded.  */
 384   return NULL;
 385 }
 386
 387 /* Evaluate EXPR in the Guile interpreter, catching all exceptions
 388    and preventing continuation capture.
 389    The result is NULL if no exception occurred.  Otherwise, the exception is
 390    printed according to "set guile print-stack" and the result is an error
 391    message allocated with malloc, caller must free.  */
 392
 393 char *
 394 gdbscm_safe_eval_string (const char *string, int display_result)
 395 {
 396   struct eval_scheme_string_data data = { string, display_result };
 397   void *result;
 398
 399   result = gdbscm_with_guile (scscm_eval_scheme_string, (void *) &data);
 400
 401   if (result != NULL)
 402     return xstrdup (result);
 403   return NULL;
 404 }
 405 \f
 406 /* Utilities for safely loading Scheme scripts.  */
 407
 408 /* Helper function for gdbscm_safe_source_scheme_script.  */
 409
 410 static void *
 411 scscm_source_scheme_script (void *data)
 412 {
 413   const char *filename = data;
 414
 415   /* The Guile docs don't specify what the result is.
 416      Maybe it's SCM_UNSPECIFIED, but the docs should specify that. :-) */
 417   scm_c_primitive_load_path (filename);
 418
 419   /* If we get here the load succeeded.  */
 420   return NULL;
 421 }
 422
 423 /* Try to load a script, catching all exceptions,
 424    and preventing continuation capture.
 425    The result is NULL if the load succeeded.  Otherwise, the exception is
 426    printed according to "set guile print-stack" and the result is an error
 427    message allocated with malloc, caller must free.  */
 428
 429 char *
 430 gdbscm_safe_source_script (const char *filename)
 431 {
 432   /* scm_c_primitive_load_path only looks in %load-path for files with
 433      relative paths.  An alternative could be to temporarily add "." to
 434      %load-path, but we don't want %load-path to be searched.  At least not
 435      by default.  This function is invoked by the "source" GDB command which
 436      already has its own path search support.  */
 437   char *abs_filename = NULL;
 438   void *result;
 439
 440   if (!IS_ABSOLUTE_PATH (filename))
 441     {
 442       abs_filename = gdb_realpath (filename);
 443       filename = abs_filename;
 444     }
 445
 446   result = gdbscm_with_guile (scscm_source_scheme_script,
 447                               (void *) filename);
 448
 449   xfree (abs_filename);
 450   if (result != NULL)
 451     return xstrdup (result);
 452   return NULL;
 453 }
 454 \f
 455 /* Utility for entering an interactive Guile repl.  */
 456
 457 void
 458 gdbscm_enter_repl (void)
 459 {
 460   /* It's unfortunate to have to resort to something like this, but
 461      scm_shell doesn't return.  :-(  I found this code on guile-user@.  */
 462   gdbscm_safe_call_1 (scm_c_public_ref ("system repl repl", "start-repl"),
 463                       scm_from_latin1_symbol ("scheme"), NULL);
 464 }