1 /* GDB/Scheme support for safe calls into the Guile interpreter.
3 Copyright (C) 2014 Free Software Foundation, Inc.
5 This file is part of GDB.
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.
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.
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/>. */
20 /* See README file in this directory for implementation notes, coding
21 conventions, et.al. */
24 #include "filenames.h"
25 #include "guile-internal.h"
27 /* Struct to marshall args to scscm_safe_call_body. */
31 void *(*func
) (void *);
33 /* An error message or NULL for success. */
37 /* Struct to marshall args through gdbscm_with_catch. */
39 struct with_catch_data
41 scm_t_catch_body func
;
43 scm_t_catch_handler unwind_handler
;
44 scm_t_catch_handler pre_unwind_handler
;
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
;
55 /* The "body" argument to scm_i_with_continuation_barrier.
56 Invoke the user-supplied function. */
59 scscm_safe_call_body (void *d
)
61 struct c_data
*data
= (struct c_data
*) d
;
63 data
->result
= data
->func (data
->data
);
65 return SCM_UNSPECIFIED
;
68 /* A "pre-unwind handler" to scm_c_catch that prints the exception
69 according to "set guile print-stack". */
72 scscm_printing_pre_unwind_handler (void *data
, SCM key
, SCM args
)
74 SCM stack
= scm_make_stack (SCM_BOOL_T
, scm_list_1 (scm_from_int (2)));
76 gdbscm_print_exception_with_stack (SCM_BOOL_F
, stack
, key
, args
);
78 return SCM_UNSPECIFIED
;
81 /* A no-op unwind handler. */
84 scscm_nop_unwind_handler (void *data
, SCM key
, SCM args
)
86 return SCM_UNSPECIFIED
;
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.
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. */
98 scscm_recording_pre_unwind_handler (void *datap
, SCM key
, SCM args
)
100 struct with_catch_data
*data
= datap
;
101 excp_matcher_func
*matcher
= data
->excp_matcher
;
103 if (matcher
!= NULL
&& matcher (key
))
104 return SCM_UNSPECIFIED
;
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. */
111 data
->stack
= scm_make_stack (SCM_BOOL_T
, scm_list_1 (scm_from_int (2)));
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
119 return SCM_UNSPECIFIED
;
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. */
127 scscm_recording_unwind_handler (void *datap
, SCM key
, SCM args
)
129 struct with_catch_data
*data
= datap
;
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. */
135 if (gdbscm_is_true (data
->stack
))
136 return gdbscm_make_exception_with_stack (key
, args
, data
->stack
);
138 return gdbscm_make_exception (key
, args
);
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.
148 gdbscm_with_catch (void *data
)
150 struct with_catch_data
*d
= data
;
153 = scm_c_catch (SCM_BOOL_T
,
155 d
->unwind_handler
, d
,
156 d
->pre_unwind_handler
, d
);
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). */
167 gdbscm_with_guile (void *(*func
) (void *), void *data
)
169 struct c_data c_data
;
170 struct with_catch_data catch_data
;
174 /* Set this now in case an exception is thrown. */
175 c_data
.result
= _("Error while executing Scheme code.");
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
;
185 scm_with_guile (gdbscm_with_catch
, &catch_data
);
187 return c_data
.result
;
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
196 gdbscm_call_guile (SCM (*func
) (void *), void *data
,
197 excp_matcher_func
*ok_excps
)
199 struct with_catch_data catch_data
;
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
;
210 scm_c_with_continuation_barrier (gdbscm_with_catch
, &catch_data
);
212 scm_with_guile (gdbscm_with_catch
, &catch_data
);
215 return catch_data
.catch_result
;
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. */
224 /* Helper for gdbscm_safe_call_0. */
227 scscm_call_0_body (void *argsp
)
231 return scm_call_0 (args
[0]);
235 gdbscm_safe_call_0 (SCM proc
, excp_matcher_func
*ok_excps
)
237 SCM args
[] = { proc
};
239 return gdbscm_call_guile (scscm_call_0_body
, args
, ok_excps
);
242 /* Helper for gdbscm_safe_call_1. */
245 scscm_call_1_body (void *argsp
)
249 return scm_call_1 (args
[0], args
[1]);
253 gdbscm_safe_call_1 (SCM proc
, SCM arg0
, excp_matcher_func
*ok_excps
)
255 SCM args
[] = { proc
, arg0
};
257 return gdbscm_call_guile (scscm_call_1_body
, args
, ok_excps
);
260 /* Helper for gdbscm_safe_call_2. */
263 scscm_call_2_body (void *argsp
)
267 return scm_call_2 (args
[0], args
[1], args
[2]);
271 gdbscm_safe_call_2 (SCM proc
, SCM arg0
, SCM arg1
, excp_matcher_func
*ok_excps
)
273 SCM args
[] = { proc
, arg0
, arg1
};
275 return gdbscm_call_guile (scscm_call_2_body
, args
, ok_excps
);
278 /* Helper for gdbscm_safe_call_3. */
281 scscm_call_3_body (void *argsp
)
285 return scm_call_3 (args
[0], args
[1], args
[2], args
[3]);
289 gdbscm_safe_call_3 (SCM proc
, SCM arg1
, SCM arg2
, SCM arg3
,
290 excp_matcher_func
*ok_excps
)
292 SCM args
[] = { proc
, arg1
, arg2
, arg3
};
294 return gdbscm_call_guile (scscm_call_3_body
, args
, ok_excps
);
297 /* Helper for gdbscm_safe_call_4. */
300 scscm_call_4_body (void *argsp
)
304 return scm_call_4 (args
[0], args
[1], args
[2], args
[3], args
[4]);
308 gdbscm_safe_call_4 (SCM proc
, SCM arg1
, SCM arg2
, SCM arg3
, SCM arg4
,
309 excp_matcher_func
*ok_excps
)
311 SCM args
[] = { proc
, arg1
, arg2
, arg3
, arg4
};
313 return gdbscm_call_guile (scscm_call_4_body
, args
, ok_excps
);
316 /* Helper for gdbscm_safe_apply_1. */
319 scscm_apply_1_body (void *argsp
)
323 return scm_apply_1 (args
[0], args
[1], args
[2]);
327 gdbscm_safe_apply_1 (SCM proc
, SCM arg0
, SCM rest
, excp_matcher_func
*ok_excps
)
329 SCM args
[] = { proc
, arg0
, rest
};
331 return gdbscm_call_guile (scscm_apply_1_body
, args
, ok_excps
);
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.
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.
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. */
352 gdbscm_unsafe_call_1 (SCM proc
, SCM arg0
)
354 return scm_call_1 (proc
, arg0
);
357 /* Utilities for safely evaluating a Scheme expression string. */
359 struct eval_scheme_string_data
365 /* Wrapper to eval a C string in the Guile interpreter.
366 This is passed to gdbscm_with_guile. */
369 scscm_eval_scheme_string (void *datap
)
371 struct eval_scheme_string_data
*data
= datap
;
372 SCM result
= scm_c_eval_string (data
->string
);
374 if (data
->display_result
&& !scm_is_eq (result
, SCM_UNSPECIFIED
))
376 SCM port
= scm_current_output_port ();
378 scm_write (result
, port
);
382 /* If we get here the eval succeeded. */
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. */
393 gdbscm_safe_eval_string (const char *string
, int display_result
)
395 struct eval_scheme_string_data data
= { string
, display_result
};
398 result
= gdbscm_with_guile (scscm_eval_scheme_string
, (void *) &data
);
401 return xstrdup (result
);
405 /* Utilities for safely loading Scheme scripts. */
407 /* Helper function for gdbscm_safe_source_scheme_script. */
410 scscm_source_scheme_script (void *data
)
412 const char *filename
= data
;
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
);
418 /* If we get here the load succeeded. */
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. */
429 gdbscm_safe_source_script (const char *filename
)
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
;
439 if (!IS_ABSOLUTE_PATH (filename
))
441 abs_filename
= gdb_realpath (filename
);
442 filename
= abs_filename
;
445 result
= gdbscm_with_guile (scscm_source_scheme_script
,
448 xfree (abs_filename
);
450 return xstrdup (result
);
454 /* Utility for entering an interactive Guile repl. */
457 gdbscm_enter_repl (void)
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
);