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-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 
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. */
50 
51  SCM stack;
53 };
54 
55 /* The "body" argument to scm_i_with_continuation_barrier.
56  Invoke the user-supplied function. */
57 
58 static SCM
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 *
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 #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 void *
171 gdbscm_with_guile (void *(*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;
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;
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 = argsp;
234 
235  return scm_call_0 (args[0]);
236 }
237 
238 SCM
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 = 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 = 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 = 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 = 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 = 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 
364 {
365  const char *string;
367 };
368 
369 /* Wrapper to eval a C string in the Guile interpreter.
370  This is passed to gdbscm_with_guile. */
371 
372 static void *
374 {
375  struct eval_scheme_string_data *data = datap;
376  SCM result = scm_c_eval_string (data->string);
377 
378  if (data->display_result && !scm_is_eq (result, SCM_UNSPECIFIED))
379  {
380  SCM port = scm_current_output_port ();
381 
382  scm_write (result, port);
383  scm_newline (port);
384  }
385 
386  /* If we get here the eval succeeded. */
387  return NULL;
388 }
389 
390 /* Evaluate EXPR in the Guile interpreter, catching all exceptions
391  and preventing continuation capture.
392  The result is NULL if no exception occurred. Otherwise, the exception is
393  printed according to "set guile print-stack" and the result is an error
394  message allocated with malloc, caller must free. */
395 
396 char *
397 gdbscm_safe_eval_string (const char *string, int display_result)
398 {
399  struct eval_scheme_string_data data = { string, display_result };
400  void *result;
401 
402  result = gdbscm_with_guile (scscm_eval_scheme_string, (void *) &data);
403 
404  if (result != NULL)
405  return xstrdup (result);
406  return NULL;
407 }
408 
409 /* Utilities for safely loading Scheme scripts. */
410 
411 /* Helper function for gdbscm_safe_source_scheme_script. */
412 
413 static void *
415 {
416  const char *filename = data;
417 
418  /* The Guile docs don't specify what the result is.
419  Maybe it's SCM_UNSPECIFIED, but the docs should specify that. :-) */
420  scm_c_primitive_load_path (filename);
421 
422  /* If we get here the load succeeded. */
423  return NULL;
424 }
425 
426 /* Try to load a script, catching all exceptions,
427  and preventing continuation capture.
428  The result is NULL if the load succeeded. Otherwise, the exception is
429  printed according to "set guile print-stack" and the result is an error
430  message allocated with malloc, caller must free. */
431 
432 char *
433 gdbscm_safe_source_script (const char *filename)
434 {
435  /* scm_c_primitive_load_path only looks in %load-path for files with
436  relative paths. An alternative could be to temporarily add "." to
437  %load-path, but we don't want %load-path to be searched. At least not
438  by default. This function is invoked by the "source" GDB command which
439  already has its own path search support. */
440  char *abs_filename = NULL;
441  void *result;
442 
443  if (!IS_ABSOLUTE_PATH (filename))
444  {
445  abs_filename = gdb_realpath (filename);
446  filename = abs_filename;
447  }
448 
450  (void *) filename);
451 
452  xfree (abs_filename);
453  if (result != NULL)
454  return xstrdup (result);
455  return NULL;
456 }
457 
458 /* Utility for entering an interactive Guile repl. */
459 
460 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 }
const char * string
Definition: signals.c:50
static SCM scscm_call_4_body(void *argsp)
SCM gdbscm_call_guile(SCM(*func)(void *), void *data, excp_matcher_func *ok_excps)
char * gdb_realpath(const char *filename)
Definition: utils.c:2840
void * data
Definition: scm-safe-call.c:32
scm_t_catch_handler pre_unwind_handler
Definition: scm-safe-call.c:44
void xfree(void *)
Definition: common-utils.c:97
static void * gdbscm_with_catch(void *data)
void(* func)(char *)
SCM gdbscm_unsafe_call_1(SCM proc, SCM arg0)
SCM gdbscm_safe_call_0(SCM proc, excp_matcher_func *ok_excps)
scm_t_catch_handler unwind_handler
Definition: scm-safe-call.c:43
void *(* func)(void *)
Definition: scm-safe-call.c:31
#define _(String)
Definition: gdb_locale.h:40
SCM gdbscm_safe_call_4(SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, excp_matcher_func *ok_excps)
#define gdbscm_is_true(scm)
int excp_matcher_func(SCM key)
static SCM scscm_recording_unwind_handler(void *datap, SCM key, SCM args)
static SCM scscm_apply_1_body(void *argsp)
Definition: gnu-nat.h:42
SCM gdbscm_make_exception(SCM tag, SCM args)
static void * scscm_source_scheme_script(void *data)
excp_matcher_func * excp_matcher
Definition: scm-safe-call.c:49
void * result
Definition: scm-safe-call.c:34
static SCM scscm_recording_pre_unwind_handler(void *datap, SCM key, SCM args)
Definition: scm-safe-call.c:98
static SCM scscm_nop_unwind_handler(void *data, SCM key, SCM args)
Definition: scm-safe-call.c:84
SCM gdbscm_safe_call_2(SCM proc, SCM arg0, SCM arg1, excp_matcher_func *ok_excps)
SCM gdbscm_safe_call_1(SCM proc, SCM arg0, excp_matcher_func *ok_excps)
scm_t_catch_body func
Definition: scm-safe-call.c:41
static SCM scscm_call_2_body(void *argsp)
SCM gdbscm_safe_call_3(SCM proc, SCM arg1, SCM arg2, SCM arg3, excp_matcher_func *ok_excps)
static SCM scscm_printing_pre_unwind_handler(void *data, SCM key, SCM args)
Definition: scm-safe-call.c:72
char * gdbscm_safe_source_script(const char *filename)
static void * scscm_eval_scheme_string(void *datap)
SCM gdbscm_safe_apply_1(SCM proc, SCM arg0, SCM rest, excp_matcher_func *ok_excps)
SCM gdbscm_make_exception_with_stack(SCM key, SCM args, SCM stack)
static SCM scscm_call_1_body(void *argsp)
void * gdbscm_with_guile(void *(*func)(void *), void *data)
void gdbscm_print_exception_with_stack(SCM port, SCM stack, SCM key, SCM args)
void gdbscm_enter_repl(void)
static SCM scscm_call_0_body(void *argsp)
static SCM scscm_call_3_body(void *argsp)
static SCM scscm_safe_call_body(void *d)
Definition: scm-safe-call.c:59
char * gdbscm_safe_eval_string(const char *string, int display_result)