GDB (xrefs)

scm-safe-call.c
Go to the documentation of this file.
1 /* GDB/Scheme support for safe calls into the Guile interpreter.
2
3 Copyright (C) 2014-2018 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 const char *(*func) (void *);
32 void *data;
33 /* An error message or NULL for success. */
34 const char *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 = (struct with_catch_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 = (struct with_catch_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 = (struct with_catch_data *) 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 #if HAVE_GUILE_MANUAL_FINALIZATION
159 scm_run_finalizers ();
160 #endif
161
162 return NULL;
163 }
164
165 /* A wrapper around scm_with_guile that prints backtraces and exceptions
166 according to "set guile print-stack".
167 The result if NULL if no exception occurred, otherwise it is a statically
168 allocated error message (caller must *not* free). */
169
170 const char *
171 gdbscm_with_guile (const char *(*func) (void *), void *data)
172 {
173 struct c_data c_data;
174 struct with_catch_data catch_data;
175
176 c_data.func = func;
177 c_data.data = data;
178 /* Set this now in case an exception is thrown. */
179 c_data.result = _("Error while executing Scheme code.");
180
181 catch_data.func = scscm_safe_call_body;
182 catch_data.data = &c_data;
183 catch_data.unwind_handler = scscm_nop_unwind_handler;
184 catch_data.pre_unwind_handler = scscm_printing_pre_unwind_handler;
185 catch_data.excp_matcher = NULL;
186 catch_data.stack = SCM_BOOL_F;
187 catch_data.catch_result = SCM_UNSPECIFIED;
188
189 scm_with_guile (gdbscm_with_catch, &catch_data);
190
191 return c_data.result;
192 }
193
194 /* Another wrapper of scm_with_guile for use by the safe call/apply routines
195 in this file, as well as for general purpose calling other functions safely.
196 For these we want to record the exception, but leave the possible printing
197 of it to later. */
198
199 SCM
200 gdbscm_call_guile (SCM (*func) (void *), void *data,
201 excp_matcher_func *ok_excps)
202 {
203 struct with_catch_data catch_data;
204
205 catch_data.func = func;
206 catch_data.data = data;
207 catch_data.unwind_handler = scscm_recording_unwind_handler;
208 catch_data.pre_unwind_handler = scscm_recording_pre_unwind_handler;
209 catch_data.excp_matcher = ok_excps;
210 catch_data.stack = SCM_BOOL_F;
211 catch_data.catch_result = SCM_UNSPECIFIED;
212
213 #if 0
214 scm_c_with_continuation_barrier (gdbscm_with_catch, &catch_data);
215 #else
216 scm_with_guile (gdbscm_with_catch, &catch_data);
217 #endif
218
219 return catch_data.catch_result;
220 }
221
222 /* Utilities to safely call Scheme code, catching all exceptions, and
223 preventing continuation capture.
224 The result is the result of calling the function, or if an exception occurs
225 then the result is a <gdb:exception> smob, which can be tested for with
226 gdbscm_is_exception. */
227
228 /* Helper for gdbscm_safe_call_0. */
229
230 static SCM
231 scscm_call_0_body (void *argsp)
232 {
233 SCM *args = (SCM *) argsp;
234
235 return scm_call_0 (args[0]);
236 }
237
238 SCM
239 gdbscm_safe_call_0 (SCM proc, excp_matcher_func *ok_excps)
240 {
241 SCM args[] = { proc };
242
243 return gdbscm_call_guile (scscm_call_0_body, args, ok_excps);
244 }
245
246 /* Helper for gdbscm_safe_call_1. */
247
248 static SCM
249 scscm_call_1_body (void *argsp)
250 {
251 SCM *args = (SCM *) argsp;
252
253 return scm_call_1 (args[0], args[1]);
254 }
255
256 SCM
257 gdbscm_safe_call_1 (SCM proc, SCM arg0, excp_matcher_func *ok_excps)
258 {
259 SCM args[] = { proc, arg0 };
260
261 return gdbscm_call_guile (scscm_call_1_body, args, ok_excps);
262 }
263
264 /* Helper for gdbscm_safe_call_2. */
265
266 static SCM
267 scscm_call_2_body (void *argsp)
268 {
269 SCM *args = (SCM *) argsp;
270
271 return scm_call_2 (args[0], args[1], args[2]);
272 }
273
274 SCM
275 gdbscm_safe_call_2 (SCM proc, SCM arg0, SCM arg1, excp_matcher_func *ok_excps)
276 {
277 SCM args[] = { proc, arg0, arg1 };
278
279 return gdbscm_call_guile (scscm_call_2_body, args, ok_excps);
280 }
281
282 /* Helper for gdbscm_safe_call_3. */
283
284 static SCM
285 scscm_call_3_body (void *argsp)
286 {
287 SCM *args = (SCM *) argsp;
288
289 return scm_call_3 (args[0], args[1], args[2], args[3]);
290 }
291
292 SCM
293 gdbscm_safe_call_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3,
294 excp_matcher_func *ok_excps)
295 {
296 SCM args[] = { proc, arg1, arg2, arg3 };
297
298 return gdbscm_call_guile (scscm_call_3_body, args, ok_excps);
299 }
300
301 /* Helper for gdbscm_safe_call_4. */
302
303 static SCM
304 scscm_call_4_body (void *argsp)
305 {
306 SCM *args = (SCM *) argsp;
307
308 return scm_call_4 (args[0], args[1], args[2], args[3], args[4]);
309 }
310
311 SCM
312 gdbscm_safe_call_4 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4,
313 excp_matcher_func *ok_excps)
314 {
315 SCM args[] = { proc, arg1, arg2, arg3, arg4 };
316
317 return gdbscm_call_guile (scscm_call_4_body, args, ok_excps);
318 }
319
320 /* Helper for gdbscm_safe_apply_1. */
321
322 static SCM
323 scscm_apply_1_body (void *argsp)
324 {
325 SCM *args = (SCM *) argsp;
326
327 return scm_apply_1 (args[0], args[1], args[2]);
328 }
329
330 SCM
331 gdbscm_safe_apply_1 (SCM proc, SCM arg0, SCM rest, excp_matcher_func *ok_excps)
332 {
333 SCM args[] = { proc, arg0, rest };
334
335 return gdbscm_call_guile (scscm_apply_1_body, args, ok_excps);
336 }
337
338 /* Utilities to call Scheme code, not catching exceptions, and
339 not preventing continuation capture.
340 The result is the result of calling the function.
341 If an exception occurs then Guile is left to handle the exception,
342 unwinding the stack as appropriate.
343
344 USE THESE WITH CARE.
345 Typically these are called from functions that implement Scheme procedures,
346 and we don't want to catch the exception; otherwise it will get printed
347 twice: once when first caught and once if it ends up being rethrown and the
348 rethrow reaches the top repl, which will confuse the user.
349
350 While these calls just pass the call off to the corresponding Guile
351 procedure, all such calls are routed through these ones to:
352 a) provide a place to put hooks or whatnot in if we need to,
353 b) add "unsafe" to the name to alert the reader. */
354
355 SCM
356 gdbscm_unsafe_call_1 (SCM proc, SCM arg0)
357 {
358 return scm_call_1 (proc, arg0);
359 }
360
361 /* Utilities for safely evaluating a Scheme expression string. */
362
363 struct eval_scheme_string_data
364 {
365 const char *string;
366 int display_result;
367 };
368
369 /* Wrapper to eval a C string in the Guile interpreter.
370 This is passed to gdbscm_with_guile. */
371
372 static const char *
373 scscm_eval_scheme_string (void *datap)
374 {
375 struct eval_scheme_string_data *data
376 = (struct eval_scheme_string_data *) datap;
377 SCM result = scm_c_eval_string (data->string);
378
379 if (data->display_result && !scm_is_eq (result, SCM_UNSPECIFIED))
380 {
381 SCM port = scm_current_output_port ();
382
383 scm_write (result, port);
384 scm_newline (port);
385 }
386
387 /* If we get here the eval succeeded. */
388 return NULL;
389 }
390
391 /* Evaluate EXPR in the Guile interpreter, catching all exceptions
392 and preventing continuation capture.
393 The result is NULL if no exception occurred. Otherwise, the exception is
394 printed according to "set guile print-stack" and the result is an error
395 message allocated with malloc, caller must free. */
396
397 char *
398 gdbscm_safe_eval_string (const char *string, int display_result)
399 {
400 struct eval_scheme_string_data data = { string, display_result };
401 const char *result;
402
403 result = gdbscm_with_guile (scscm_eval_scheme_string, (void *) &data);
404
405 if (result != NULL)
406 return xstrdup (result);
407 return NULL;
408 }
409
410 /* Utilities for safely loading Scheme scripts. */
411
412 /* Helper function for gdbscm_safe_source_scheme_script. */
413
414 static const char *
415 scscm_source_scheme_script (void *data)
416 {
417 const char *filename = (const char *) data;
418
419 /* The Guile docs don't specify what the result is.
420 Maybe it's SCM_UNSPECIFIED, but the docs should specify that. :-) */
421 scm_c_primitive_load_path (filename);
422
423 /* If we get here the load succeeded. */
424 return NULL;
425 }
426
427 /* Try to load a script, catching all exceptions,
428 and preventing continuation capture.
429 The result is NULL if the load succeeded. Otherwise, the exception is
430 printed according to "set guile print-stack" and the result is an error
431 message allocated with malloc, caller must free. */
432
433 char *
434 gdbscm_safe_source_script (const char *filename)
435 {
436 /* scm_c_primitive_load_path only looks in %load-path for files with
437 relative paths. An alternative could be to temporarily add "." to
438 %load-path, but we don't want %load-path to be searched. At least not
439 by default. This function is invoked by the "source" GDB command which
440 already has its own path search support. */
441 gdb::unique_xmalloc_ptr<char> abs_filename;
442 const char *result;
443
444 if (!IS_ABSOLUTE_PATH (filename))
445 {
446 abs_filename = gdb_realpath (filename);
447 filename = abs_filename.get ();
448 }
449
450 result = gdbscm_with_guile (scscm_source_scheme_script,
451 (void *) filename);
452
453 if (result != NULL)
454 return xstrdup (result);
455 return NULL;
456 }
457
458 /* Utility for entering an interactive Guile repl. */
459
460 void
461 gdbscm_enter_repl (void)
462 {
463 /* It's unfortunate to have to resort to something like this, but
464 scm_shell doesn't return. :-( I found this code on guile-user@. */
465 gdbscm_safe_call_1 (scm_c_public_ref ("system repl repl", "start-repl"),
466 scm_from_latin1_symbol ("scheme"), NULL);
467 }
string
const char * string
Definition: signals.c:50
scscm_call_4_body
static SCM scscm_call_4_body(void *argsp)
Definition: scm-safe-call.c:304
gdbscm_call_guile
SCM gdbscm_call_guile(SCM(*func)(void *), void *data, excp_matcher_func *ok_excps)
Definition: scm-safe-call.c:200
gdbscm_with_guile
const char * gdbscm_with_guile(const char *(*func)(void *), void *data)
Definition: scm-safe-call.c:171
c_data::data
void * data
Definition: scm-safe-call.c:32
with_catch_data::pre_unwind_handler
scm_t_catch_handler pre_unwind_handler
Definition: scm-safe-call.c:44
gdbscm_with_catch
static void * gdbscm_with_catch(void *data)
Definition: scm-safe-call.c:148
func
void(* func)(char *)
Definition: remote-fileio.c:1104
gdbscm_unsafe_call_1
SCM gdbscm_unsafe_call_1(SCM proc, SCM arg0)
Definition: scm-safe-call.c:356
gdbscm_safe_call_0
SCM gdbscm_safe_call_0(SCM proc, excp_matcher_func *ok_excps)
Definition: scm-safe-call.c:239
with_catch_data::unwind_handler
scm_t_catch_handler unwind_handler
Definition: scm-safe-call.c:43
with_catch_data::data
void * data
Definition: scm-safe-call.c:42
guile-internal.h
gdb_realpath
gdb::unique_xmalloc_ptr< char > gdb_realpath(const char *filename)
Definition: utils.c:2842
_
#define _(String)
Definition: gdb_locale.h:35
defs.h
gdbscm_safe_call_4
SCM gdbscm_safe_call_4(SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, excp_matcher_func *ok_excps)
Definition: scm-safe-call.c:312
gdbscm_is_true
#define gdbscm_is_true(scm)
Definition: guile-internal.h:134
excp_matcher_func
int excp_matcher_func(SCM key)
Definition: guile-internal.h:38
c_data::result
const char * result
Definition: scm-safe-call.c:34
scscm_recording_unwind_handler
static SCM scscm_recording_unwind_handler(void *datap, SCM key, SCM args)
Definition: scm-safe-call.c:127
scscm_apply_1_body
static SCM scscm_apply_1_body(void *argsp)
Definition: scm-safe-call.c:323
proc
Definition: gnu-nat.h:42
gdbscm_make_exception
SCM gdbscm_make_exception(SCM tag, SCM args)
Definition: scm-exception.c:128
gdb::unique_xmalloc_ptr
std::unique_ptr< T, xfree_deleter< T > > unique_xmalloc_ptr
Definition: gdb_unique_ptr.h:48
with_catch_data::catch_result
SCM catch_result
Definition: scm-safe-call.c:52
eval_scheme_string_data::string
const char * string
Definition: scm-safe-call.c:365
with_catch_data::excp_matcher
excp_matcher_func * excp_matcher
Definition: scm-safe-call.c:49
scscm_recording_pre_unwind_handler
static SCM scscm_recording_pre_unwind_handler(void *datap, SCM key, SCM args)
Definition: scm-safe-call.c:98
c_data
Definition: scm-safe-call.c:29
scscm_eval_scheme_string
static const char * scscm_eval_scheme_string(void *datap)
Definition: scm-safe-call.c:373
eval_scheme_string_data::display_result
int display_result
Definition: scm-safe-call.c:366
scscm_nop_unwind_handler
static SCM scscm_nop_unwind_handler(void *data, SCM key, SCM args)
Definition: scm-safe-call.c:84
gdbscm_safe_call_2
SCM gdbscm_safe_call_2(SCM proc, SCM arg0, SCM arg1, excp_matcher_func *ok_excps)
Definition: scm-safe-call.c:275
with_catch_data
Definition: scm-safe-call.c:39
gdbscm_safe_call_1
SCM gdbscm_safe_call_1(SCM proc, SCM arg0, excp_matcher_func *ok_excps)
Definition: scm-safe-call.c:257
with_catch_data::func
scm_t_catch_body func
Definition: scm-safe-call.c:41
scscm_source_scheme_script
static const char * scscm_source_scheme_script(void *data)
Definition: scm-safe-call.c:415
scscm_call_2_body
static SCM scscm_call_2_body(void *argsp)
Definition: scm-safe-call.c:267
gdbscm_safe_call_3
SCM gdbscm_safe_call_3(SCM proc, SCM arg1, SCM arg2, SCM arg3, excp_matcher_func *ok_excps)
Definition: scm-safe-call.c:293
scscm_printing_pre_unwind_handler
static SCM scscm_printing_pre_unwind_handler(void *data, SCM key, SCM args)
Definition: scm-safe-call.c:72
c_data::func
const char *(* func)(void *)
Definition: scm-safe-call.c:31
gdbscm_safe_source_script
char * gdbscm_safe_source_script(const char *filename)
Definition: scm-safe-call.c:434
gdbscm_safe_apply_1
SCM gdbscm_safe_apply_1(SCM proc, SCM arg0, SCM rest, excp_matcher_func *ok_excps)
Definition: scm-safe-call.c:331
gdbscm_make_exception_with_stack
SCM gdbscm_make_exception_with_stack(SCM key, SCM args, SCM stack)
Definition: scm-exception.c:192
scscm_call_1_body
static SCM scscm_call_1_body(void *argsp)
Definition: scm-safe-call.c:249
eval_scheme_string_data
Definition: scm-safe-call.c:363
gdbscm_print_exception_with_stack
void gdbscm_print_exception_with_stack(SCM port, SCM stack, SCM key, SCM args)
Definition: scm-exception.c:526
gdbscm_enter_repl
void gdbscm_enter_repl(void)
Definition: scm-safe-call.c:461
scscm_call_0_body
static SCM scscm_call_0_body(void *argsp)
Definition: scm-safe-call.c:231
scscm_call_3_body
static SCM scscm_call_3_body(void *argsp)
Definition: scm-safe-call.c:285
with_catch_data::stack
SCM stack
Definition: scm-safe-call.c:51
scscm_safe_call_body
static SCM scscm_safe_call_body(void *d)
Definition: scm-safe-call.c:59
gdbscm_safe_eval_string
char * gdbscm_safe_eval_string(const char *string, int display_result)
Definition: scm-safe-call.c:398