1 /* GDB/Scheme support for safe calls into the Guile interpreter. 2 3 Copyright (C) 2014-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 "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 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 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 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 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 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 } 464