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