16ca2c52aSchristos /* GDB/Scheme support for safe calls into the Guile interpreter.
26ca2c52aSchristos
3*184b2d41Schristos Copyright (C) 2014-2020 Free Software Foundation, Inc.
46ca2c52aSchristos
56ca2c52aSchristos This file is part of GDB.
66ca2c52aSchristos
76ca2c52aSchristos This program is free software; you can redistribute it and/or modify
86ca2c52aSchristos it under the terms of the GNU General Public License as published by
96ca2c52aSchristos the Free Software Foundation; either version 3 of the License, or
106ca2c52aSchristos (at your option) any later version.
116ca2c52aSchristos
126ca2c52aSchristos This program is distributed in the hope that it will be useful,
136ca2c52aSchristos but WITHOUT ANY WARRANTY; without even the implied warranty of
146ca2c52aSchristos MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
156ca2c52aSchristos GNU General Public License for more details.
166ca2c52aSchristos
176ca2c52aSchristos You should have received a copy of the GNU General Public License
186ca2c52aSchristos along with this program. If not, see <http://www.gnu.org/licenses/>. */
196ca2c52aSchristos
206ca2c52aSchristos /* See README file in this directory for implementation notes, coding
216ca2c52aSchristos conventions, et.al. */
226ca2c52aSchristos
236ca2c52aSchristos #include "defs.h"
246ca2c52aSchristos #include "filenames.h"
256ca2c52aSchristos #include "guile-internal.h"
26*184b2d41Schristos #include "gdbsupport/pathstuff.h"
276ca2c52aSchristos
286ca2c52aSchristos /* Struct to marshall args to scscm_safe_call_body. */
296ca2c52aSchristos
306ca2c52aSchristos struct c_data
316ca2c52aSchristos {
32b2396a7bSchristos const char *(*func) (void *);
336ca2c52aSchristos void *data;
346ca2c52aSchristos /* An error message or NULL for success. */
35b2396a7bSchristos const char *result;
366ca2c52aSchristos };
376ca2c52aSchristos
386ca2c52aSchristos /* Struct to marshall args through gdbscm_with_catch. */
396ca2c52aSchristos
406ca2c52aSchristos struct with_catch_data
416ca2c52aSchristos {
426ca2c52aSchristos scm_t_catch_body func;
436ca2c52aSchristos void *data;
446ca2c52aSchristos scm_t_catch_handler unwind_handler;
456ca2c52aSchristos scm_t_catch_handler pre_unwind_handler;
466ca2c52aSchristos
476ca2c52aSchristos /* If EXCP_MATCHER is non-NULL, it is an excp_matcher_func function.
486ca2c52aSchristos If the exception is recognized by it, the exception is recorded as is,
496ca2c52aSchristos without wrapping it in gdb:with-stack. */
506ca2c52aSchristos excp_matcher_func *excp_matcher;
516ca2c52aSchristos
526ca2c52aSchristos SCM stack;
536ca2c52aSchristos SCM catch_result;
546ca2c52aSchristos };
556ca2c52aSchristos
566ca2c52aSchristos /* The "body" argument to scm_i_with_continuation_barrier.
576ca2c52aSchristos Invoke the user-supplied function. */
586ca2c52aSchristos
596ca2c52aSchristos static SCM
scscm_safe_call_body(void * d)606ca2c52aSchristos scscm_safe_call_body (void *d)
616ca2c52aSchristos {
626ca2c52aSchristos struct c_data *data = (struct c_data *) d;
636ca2c52aSchristos
646ca2c52aSchristos data->result = data->func (data->data);
656ca2c52aSchristos
666ca2c52aSchristos return SCM_UNSPECIFIED;
676ca2c52aSchristos }
686ca2c52aSchristos
696ca2c52aSchristos /* A "pre-unwind handler" to scm_c_catch that prints the exception
706ca2c52aSchristos according to "set guile print-stack". */
716ca2c52aSchristos
726ca2c52aSchristos static SCM
scscm_printing_pre_unwind_handler(void * data,SCM key,SCM args)736ca2c52aSchristos scscm_printing_pre_unwind_handler (void *data, SCM key, SCM args)
746ca2c52aSchristos {
756ca2c52aSchristos SCM stack = scm_make_stack (SCM_BOOL_T, scm_list_1 (scm_from_int (2)));
766ca2c52aSchristos
776ca2c52aSchristos gdbscm_print_exception_with_stack (SCM_BOOL_F, stack, key, args);
786ca2c52aSchristos
796ca2c52aSchristos return SCM_UNSPECIFIED;
806ca2c52aSchristos }
816ca2c52aSchristos
826ca2c52aSchristos /* A no-op unwind handler. */
836ca2c52aSchristos
846ca2c52aSchristos static SCM
scscm_nop_unwind_handler(void * data,SCM key,SCM args)856ca2c52aSchristos scscm_nop_unwind_handler (void *data, SCM key, SCM args)
866ca2c52aSchristos {
876ca2c52aSchristos return SCM_UNSPECIFIED;
886ca2c52aSchristos }
896ca2c52aSchristos
906ca2c52aSchristos /* The "pre-unwind handler" to scm_c_catch that records the exception
916ca2c52aSchristos for possible later printing. We do this in the pre-unwind handler because
926ca2c52aSchristos we want the stack to include point where the exception occurred.
936ca2c52aSchristos
946ca2c52aSchristos If DATA is non-NULL, it is an excp_matcher_func function.
956ca2c52aSchristos If the exception is recognized by it, the exception is recorded as is,
966ca2c52aSchristos without wrapping it in gdb:with-stack. */
976ca2c52aSchristos
986ca2c52aSchristos static SCM
scscm_recording_pre_unwind_handler(void * datap,SCM key,SCM args)996ca2c52aSchristos scscm_recording_pre_unwind_handler (void *datap, SCM key, SCM args)
1006ca2c52aSchristos {
101b2396a7bSchristos struct with_catch_data *data = (struct with_catch_data *) datap;
1026ca2c52aSchristos excp_matcher_func *matcher = data->excp_matcher;
1036ca2c52aSchristos
1046ca2c52aSchristos if (matcher != NULL && matcher (key))
1056ca2c52aSchristos return SCM_UNSPECIFIED;
1066ca2c52aSchristos
1076ca2c52aSchristos /* There's no need to record the whole stack if we're not going to print it.
1086ca2c52aSchristos However, convention is to still print the stack frame in which the
1096ca2c52aSchristos exception occurred, even if we're not going to print a full backtrace.
1106ca2c52aSchristos For now, keep it simple. */
1116ca2c52aSchristos
1126ca2c52aSchristos data->stack = scm_make_stack (SCM_BOOL_T, scm_list_1 (scm_from_int (2)));
1136ca2c52aSchristos
1146ca2c52aSchristos /* IWBN if we could return the <gdb:exception> here and skip the unwind
1156ca2c52aSchristos handler, but it doesn't work that way. If we want to return a
1166ca2c52aSchristos <gdb:exception> object from the catch it needs to come from the unwind
1176ca2c52aSchristos handler. So what we do is save the stack for later use by the unwind
1186ca2c52aSchristos handler. */
1196ca2c52aSchristos
1206ca2c52aSchristos return SCM_UNSPECIFIED;
1216ca2c52aSchristos }
1226ca2c52aSchristos
1236ca2c52aSchristos /* Part two of the recording unwind handler.
1246ca2c52aSchristos Here we take the stack saved from the pre-unwind handler and create
1256ca2c52aSchristos the <gdb:exception> object. */
1266ca2c52aSchristos
1276ca2c52aSchristos static SCM
scscm_recording_unwind_handler(void * datap,SCM key,SCM args)1286ca2c52aSchristos scscm_recording_unwind_handler (void *datap, SCM key, SCM args)
1296ca2c52aSchristos {
130b2396a7bSchristos struct with_catch_data *data = (struct with_catch_data *) datap;
1316ca2c52aSchristos
1326ca2c52aSchristos /* We need to record the stack in the exception since we're about to
1336ca2c52aSchristos throw and lose the location that got the exception. We do this by
1346ca2c52aSchristos wrapping the exception + stack in a new exception. */
1356ca2c52aSchristos
1366ca2c52aSchristos if (gdbscm_is_true (data->stack))
1376ca2c52aSchristos return gdbscm_make_exception_with_stack (key, args, data->stack);
1386ca2c52aSchristos
1396ca2c52aSchristos return gdbscm_make_exception (key, args);
1406ca2c52aSchristos }
1416ca2c52aSchristos
1426ca2c52aSchristos /* Ugh. :-(
1436ca2c52aSchristos Guile doesn't export scm_i_with_continuation_barrier which is exactly
1446ca2c52aSchristos what we need. To cope, have our own wrapper around scm_c_catch and
1456ca2c52aSchristos pass this as the "body" argument to scm_c_with_continuation_barrier.
1466ca2c52aSchristos Darn darn darn. */
1476ca2c52aSchristos
1486ca2c52aSchristos static void *
gdbscm_with_catch(void * data)1496ca2c52aSchristos gdbscm_with_catch (void *data)
1506ca2c52aSchristos {
151b2396a7bSchristos struct with_catch_data *d = (struct with_catch_data *) data;
1526ca2c52aSchristos
1536ca2c52aSchristos d->catch_result
1546ca2c52aSchristos = scm_c_catch (SCM_BOOL_T,
1556ca2c52aSchristos d->func, d->data,
1566ca2c52aSchristos d->unwind_handler, d,
1576ca2c52aSchristos d->pre_unwind_handler, d);
1586ca2c52aSchristos
1596ca2c52aSchristos #if HAVE_GUILE_MANUAL_FINALIZATION
1606ca2c52aSchristos scm_run_finalizers ();
1616ca2c52aSchristos #endif
1626ca2c52aSchristos
1636ca2c52aSchristos return NULL;
1646ca2c52aSchristos }
1656ca2c52aSchristos
1666ca2c52aSchristos /* A wrapper around scm_with_guile that prints backtraces and exceptions
1676ca2c52aSchristos according to "set guile print-stack".
1686ca2c52aSchristos The result if NULL if no exception occurred, otherwise it is a statically
1696ca2c52aSchristos allocated error message (caller must *not* free). */
1706ca2c52aSchristos
171b2396a7bSchristos const char *
gdbscm_with_guile(const char * (* func)(void *),void * data)172b2396a7bSchristos gdbscm_with_guile (const char *(*func) (void *), void *data)
1736ca2c52aSchristos {
1746ca2c52aSchristos struct c_data c_data;
1756ca2c52aSchristos struct with_catch_data catch_data;
1766ca2c52aSchristos
1776ca2c52aSchristos c_data.func = func;
1786ca2c52aSchristos c_data.data = data;
1796ca2c52aSchristos /* Set this now in case an exception is thrown. */
1806ca2c52aSchristos c_data.result = _("Error while executing Scheme code.");
1816ca2c52aSchristos
1826ca2c52aSchristos catch_data.func = scscm_safe_call_body;
1836ca2c52aSchristos catch_data.data = &c_data;
1846ca2c52aSchristos catch_data.unwind_handler = scscm_nop_unwind_handler;
1856ca2c52aSchristos catch_data.pre_unwind_handler = scscm_printing_pre_unwind_handler;
1866ca2c52aSchristos catch_data.excp_matcher = NULL;
1876ca2c52aSchristos catch_data.stack = SCM_BOOL_F;
1886ca2c52aSchristos catch_data.catch_result = SCM_UNSPECIFIED;
1896ca2c52aSchristos
1906ca2c52aSchristos scm_with_guile (gdbscm_with_catch, &catch_data);
1916ca2c52aSchristos
1926ca2c52aSchristos return c_data.result;
1936ca2c52aSchristos }
1946ca2c52aSchristos
1956ca2c52aSchristos /* Another wrapper of scm_with_guile for use by the safe call/apply routines
1966ca2c52aSchristos in this file, as well as for general purpose calling other functions safely.
1976ca2c52aSchristos For these we want to record the exception, but leave the possible printing
1986ca2c52aSchristos of it to later. */
1996ca2c52aSchristos
2006ca2c52aSchristos SCM
gdbscm_call_guile(SCM (* func)(void *),void * data,excp_matcher_func * ok_excps)2016ca2c52aSchristos gdbscm_call_guile (SCM (*func) (void *), void *data,
2026ca2c52aSchristos excp_matcher_func *ok_excps)
2036ca2c52aSchristos {
2046ca2c52aSchristos struct with_catch_data catch_data;
2056ca2c52aSchristos
2066ca2c52aSchristos catch_data.func = func;
2076ca2c52aSchristos catch_data.data = data;
2086ca2c52aSchristos catch_data.unwind_handler = scscm_recording_unwind_handler;
2096ca2c52aSchristos catch_data.pre_unwind_handler = scscm_recording_pre_unwind_handler;
2106ca2c52aSchristos catch_data.excp_matcher = ok_excps;
2116ca2c52aSchristos catch_data.stack = SCM_BOOL_F;
2126ca2c52aSchristos catch_data.catch_result = SCM_UNSPECIFIED;
2136ca2c52aSchristos
2146ca2c52aSchristos #if 0
2156ca2c52aSchristos scm_c_with_continuation_barrier (gdbscm_with_catch, &catch_data);
2166ca2c52aSchristos #else
2176ca2c52aSchristos scm_with_guile (gdbscm_with_catch, &catch_data);
2186ca2c52aSchristos #endif
2196ca2c52aSchristos
2206ca2c52aSchristos return catch_data.catch_result;
2216ca2c52aSchristos }
2226ca2c52aSchristos
2236ca2c52aSchristos /* Utilities to safely call Scheme code, catching all exceptions, and
2246ca2c52aSchristos preventing continuation capture.
2256ca2c52aSchristos The result is the result of calling the function, or if an exception occurs
2266ca2c52aSchristos then the result is a <gdb:exception> smob, which can be tested for with
2276ca2c52aSchristos gdbscm_is_exception. */
2286ca2c52aSchristos
2296ca2c52aSchristos /* Helper for gdbscm_safe_call_0. */
2306ca2c52aSchristos
2316ca2c52aSchristos static SCM
scscm_call_0_body(void * argsp)2326ca2c52aSchristos scscm_call_0_body (void *argsp)
2336ca2c52aSchristos {
234b2396a7bSchristos SCM *args = (SCM *) argsp;
2356ca2c52aSchristos
2366ca2c52aSchristos return scm_call_0 (args[0]);
2376ca2c52aSchristos }
2386ca2c52aSchristos
2396ca2c52aSchristos SCM
gdbscm_safe_call_0(SCM proc,excp_matcher_func * ok_excps)2406ca2c52aSchristos gdbscm_safe_call_0 (SCM proc, excp_matcher_func *ok_excps)
2416ca2c52aSchristos {
2426ca2c52aSchristos SCM args[] = { proc };
2436ca2c52aSchristos
2446ca2c52aSchristos return gdbscm_call_guile (scscm_call_0_body, args, ok_excps);
2456ca2c52aSchristos }
2466ca2c52aSchristos
2476ca2c52aSchristos /* Helper for gdbscm_safe_call_1. */
2486ca2c52aSchristos
2496ca2c52aSchristos static SCM
scscm_call_1_body(void * argsp)2506ca2c52aSchristos scscm_call_1_body (void *argsp)
2516ca2c52aSchristos {
252b2396a7bSchristos SCM *args = (SCM *) argsp;
2536ca2c52aSchristos
2546ca2c52aSchristos return scm_call_1 (args[0], args[1]);
2556ca2c52aSchristos }
2566ca2c52aSchristos
2576ca2c52aSchristos SCM
gdbscm_safe_call_1(SCM proc,SCM arg0,excp_matcher_func * ok_excps)2586ca2c52aSchristos gdbscm_safe_call_1 (SCM proc, SCM arg0, excp_matcher_func *ok_excps)
2596ca2c52aSchristos {
2606ca2c52aSchristos SCM args[] = { proc, arg0 };
2616ca2c52aSchristos
2626ca2c52aSchristos return gdbscm_call_guile (scscm_call_1_body, args, ok_excps);
2636ca2c52aSchristos }
2646ca2c52aSchristos
2656ca2c52aSchristos /* Helper for gdbscm_safe_call_2. */
2666ca2c52aSchristos
2676ca2c52aSchristos static SCM
scscm_call_2_body(void * argsp)2686ca2c52aSchristos scscm_call_2_body (void *argsp)
2696ca2c52aSchristos {
270b2396a7bSchristos SCM *args = (SCM *) argsp;
2716ca2c52aSchristos
2726ca2c52aSchristos return scm_call_2 (args[0], args[1], args[2]);
2736ca2c52aSchristos }
2746ca2c52aSchristos
2756ca2c52aSchristos SCM
gdbscm_safe_call_2(SCM proc,SCM arg0,SCM arg1,excp_matcher_func * ok_excps)2766ca2c52aSchristos gdbscm_safe_call_2 (SCM proc, SCM arg0, SCM arg1, excp_matcher_func *ok_excps)
2776ca2c52aSchristos {
2786ca2c52aSchristos SCM args[] = { proc, arg0, arg1 };
2796ca2c52aSchristos
2806ca2c52aSchristos return gdbscm_call_guile (scscm_call_2_body, args, ok_excps);
2816ca2c52aSchristos }
2826ca2c52aSchristos
2836ca2c52aSchristos /* Helper for gdbscm_safe_call_3. */
2846ca2c52aSchristos
2856ca2c52aSchristos static SCM
scscm_call_3_body(void * argsp)2866ca2c52aSchristos scscm_call_3_body (void *argsp)
2876ca2c52aSchristos {
288b2396a7bSchristos SCM *args = (SCM *) argsp;
2896ca2c52aSchristos
2906ca2c52aSchristos return scm_call_3 (args[0], args[1], args[2], args[3]);
2916ca2c52aSchristos }
2926ca2c52aSchristos
2936ca2c52aSchristos SCM
gdbscm_safe_call_3(SCM proc,SCM arg1,SCM arg2,SCM arg3,excp_matcher_func * ok_excps)2946ca2c52aSchristos gdbscm_safe_call_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3,
2956ca2c52aSchristos excp_matcher_func *ok_excps)
2966ca2c52aSchristos {
2976ca2c52aSchristos SCM args[] = { proc, arg1, arg2, arg3 };
2986ca2c52aSchristos
2996ca2c52aSchristos return gdbscm_call_guile (scscm_call_3_body, args, ok_excps);
3006ca2c52aSchristos }
3016ca2c52aSchristos
3026ca2c52aSchristos /* Helper for gdbscm_safe_call_4. */
3036ca2c52aSchristos
3046ca2c52aSchristos static SCM
scscm_call_4_body(void * argsp)3056ca2c52aSchristos scscm_call_4_body (void *argsp)
3066ca2c52aSchristos {
307b2396a7bSchristos SCM *args = (SCM *) argsp;
3086ca2c52aSchristos
3096ca2c52aSchristos return scm_call_4 (args[0], args[1], args[2], args[3], args[4]);
3106ca2c52aSchristos }
3116ca2c52aSchristos
3126ca2c52aSchristos SCM
gdbscm_safe_call_4(SCM proc,SCM arg1,SCM arg2,SCM arg3,SCM arg4,excp_matcher_func * ok_excps)3136ca2c52aSchristos gdbscm_safe_call_4 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4,
3146ca2c52aSchristos excp_matcher_func *ok_excps)
3156ca2c52aSchristos {
3166ca2c52aSchristos SCM args[] = { proc, arg1, arg2, arg3, arg4 };
3176ca2c52aSchristos
3186ca2c52aSchristos return gdbscm_call_guile (scscm_call_4_body, args, ok_excps);
3196ca2c52aSchristos }
3206ca2c52aSchristos
3216ca2c52aSchristos /* Helper for gdbscm_safe_apply_1. */
3226ca2c52aSchristos
3236ca2c52aSchristos static SCM
scscm_apply_1_body(void * argsp)3246ca2c52aSchristos scscm_apply_1_body (void *argsp)
3256ca2c52aSchristos {
326b2396a7bSchristos SCM *args = (SCM *) argsp;
3276ca2c52aSchristos
3286ca2c52aSchristos return scm_apply_1 (args[0], args[1], args[2]);
3296ca2c52aSchristos }
3306ca2c52aSchristos
3316ca2c52aSchristos SCM
gdbscm_safe_apply_1(SCM proc,SCM arg0,SCM rest,excp_matcher_func * ok_excps)3326ca2c52aSchristos gdbscm_safe_apply_1 (SCM proc, SCM arg0, SCM rest, excp_matcher_func *ok_excps)
3336ca2c52aSchristos {
3346ca2c52aSchristos SCM args[] = { proc, arg0, rest };
3356ca2c52aSchristos
3366ca2c52aSchristos return gdbscm_call_guile (scscm_apply_1_body, args, ok_excps);
3376ca2c52aSchristos }
3386ca2c52aSchristos
3396ca2c52aSchristos /* Utilities to call Scheme code, not catching exceptions, and
3406ca2c52aSchristos not preventing continuation capture.
3416ca2c52aSchristos The result is the result of calling the function.
3426ca2c52aSchristos If an exception occurs then Guile is left to handle the exception,
3436ca2c52aSchristos unwinding the stack as appropriate.
3446ca2c52aSchristos
3456ca2c52aSchristos USE THESE WITH CARE.
3466ca2c52aSchristos Typically these are called from functions that implement Scheme procedures,
3476ca2c52aSchristos and we don't want to catch the exception; otherwise it will get printed
3486ca2c52aSchristos twice: once when first caught and once if it ends up being rethrown and the
3496ca2c52aSchristos rethrow reaches the top repl, which will confuse the user.
3506ca2c52aSchristos
3516ca2c52aSchristos While these calls just pass the call off to the corresponding Guile
3526ca2c52aSchristos procedure, all such calls are routed through these ones to:
3536ca2c52aSchristos a) provide a place to put hooks or whatnot in if we need to,
3546ca2c52aSchristos b) add "unsafe" to the name to alert the reader. */
3556ca2c52aSchristos
3566ca2c52aSchristos SCM
gdbscm_unsafe_call_1(SCM proc,SCM arg0)3576ca2c52aSchristos gdbscm_unsafe_call_1 (SCM proc, SCM arg0)
3586ca2c52aSchristos {
3596ca2c52aSchristos return scm_call_1 (proc, arg0);
3606ca2c52aSchristos }
3616ca2c52aSchristos
3626ca2c52aSchristos /* Utilities for safely evaluating a Scheme expression string. */
3636ca2c52aSchristos
3646ca2c52aSchristos struct eval_scheme_string_data
3656ca2c52aSchristos {
3666ca2c52aSchristos const char *string;
3676ca2c52aSchristos int display_result;
3686ca2c52aSchristos };
3696ca2c52aSchristos
3706ca2c52aSchristos /* Wrapper to eval a C string in the Guile interpreter.
3716ca2c52aSchristos This is passed to gdbscm_with_guile. */
3726ca2c52aSchristos
373b2396a7bSchristos static const char *
scscm_eval_scheme_string(void * datap)3746ca2c52aSchristos scscm_eval_scheme_string (void *datap)
3756ca2c52aSchristos {
376b2396a7bSchristos struct eval_scheme_string_data *data
377b2396a7bSchristos = (struct eval_scheme_string_data *) datap;
3786ca2c52aSchristos SCM result = scm_c_eval_string (data->string);
3796ca2c52aSchristos
3806ca2c52aSchristos if (data->display_result && !scm_is_eq (result, SCM_UNSPECIFIED))
3816ca2c52aSchristos {
3826ca2c52aSchristos SCM port = scm_current_output_port ();
3836ca2c52aSchristos
3846ca2c52aSchristos scm_write (result, port);
3856ca2c52aSchristos scm_newline (port);
3866ca2c52aSchristos }
3876ca2c52aSchristos
3886ca2c52aSchristos /* If we get here the eval succeeded. */
3896ca2c52aSchristos return NULL;
3906ca2c52aSchristos }
3916ca2c52aSchristos
3926ca2c52aSchristos /* Evaluate EXPR in the Guile interpreter, catching all exceptions
3936ca2c52aSchristos and preventing continuation capture.
3946ca2c52aSchristos The result is NULL if no exception occurred. Otherwise, the exception is
3956ca2c52aSchristos printed according to "set guile print-stack" and the result is an error
396051580eeSchristos message. */
3976ca2c52aSchristos
398051580eeSchristos gdb::unique_xmalloc_ptr<char>
gdbscm_safe_eval_string(const char * string,int display_result)3996ca2c52aSchristos gdbscm_safe_eval_string (const char *string, int display_result)
4006ca2c52aSchristos {
4016ca2c52aSchristos struct eval_scheme_string_data data = { string, display_result };
402b2396a7bSchristos const char *result;
4036ca2c52aSchristos
4046ca2c52aSchristos result = gdbscm_with_guile (scscm_eval_scheme_string, (void *) &data);
4056ca2c52aSchristos
4066ca2c52aSchristos if (result != NULL)
407*184b2d41Schristos return make_unique_xstrdup (result);
4086ca2c52aSchristos return NULL;
4096ca2c52aSchristos }
4106ca2c52aSchristos
4116ca2c52aSchristos /* Utilities for safely loading Scheme scripts. */
4126ca2c52aSchristos
4136ca2c52aSchristos /* Helper function for gdbscm_safe_source_scheme_script. */
4146ca2c52aSchristos
415b2396a7bSchristos static const char *
scscm_source_scheme_script(void * data)4166ca2c52aSchristos scscm_source_scheme_script (void *data)
4176ca2c52aSchristos {
418b2396a7bSchristos const char *filename = (const char *) data;
4196ca2c52aSchristos
4206ca2c52aSchristos /* The Guile docs don't specify what the result is.
4216ca2c52aSchristos Maybe it's SCM_UNSPECIFIED, but the docs should specify that. :-) */
4226ca2c52aSchristos scm_c_primitive_load_path (filename);
4236ca2c52aSchristos
4246ca2c52aSchristos /* If we get here the load succeeded. */
4256ca2c52aSchristos return NULL;
4266ca2c52aSchristos }
4276ca2c52aSchristos
4286ca2c52aSchristos /* Try to load a script, catching all exceptions,
4296ca2c52aSchristos and preventing continuation capture.
4306ca2c52aSchristos The result is NULL if the load succeeded. Otherwise, the exception is
4316ca2c52aSchristos printed according to "set guile print-stack" and the result is an error
4326ca2c52aSchristos message allocated with malloc, caller must free. */
4336ca2c52aSchristos
4346ca2c52aSchristos char *
gdbscm_safe_source_script(const char * filename)4356ca2c52aSchristos gdbscm_safe_source_script (const char *filename)
4366ca2c52aSchristos {
4376ca2c52aSchristos /* scm_c_primitive_load_path only looks in %load-path for files with
4386ca2c52aSchristos relative paths. An alternative could be to temporarily add "." to
4396ca2c52aSchristos %load-path, but we don't want %load-path to be searched. At least not
4406ca2c52aSchristos by default. This function is invoked by the "source" GDB command which
4416ca2c52aSchristos already has its own path search support. */
442051580eeSchristos gdb::unique_xmalloc_ptr<char> abs_filename;
443b2396a7bSchristos const char *result;
4446ca2c52aSchristos
4456ca2c52aSchristos if (!IS_ABSOLUTE_PATH (filename))
4466ca2c52aSchristos {
4476ca2c52aSchristos abs_filename = gdb_realpath (filename);
448051580eeSchristos filename = abs_filename.get ();
4496ca2c52aSchristos }
4506ca2c52aSchristos
4516ca2c52aSchristos result = gdbscm_with_guile (scscm_source_scheme_script,
4526ca2c52aSchristos (void *) filename);
4536ca2c52aSchristos
4546ca2c52aSchristos if (result != NULL)
4556ca2c52aSchristos return xstrdup (result);
4566ca2c52aSchristos return NULL;
4576ca2c52aSchristos }
4586ca2c52aSchristos
4596ca2c52aSchristos /* Utility for entering an interactive Guile repl. */
4606ca2c52aSchristos
4616ca2c52aSchristos void
gdbscm_enter_repl(void)4626ca2c52aSchristos gdbscm_enter_repl (void)
4636ca2c52aSchristos {
4646ca2c52aSchristos /* It's unfortunate to have to resort to something like this, but
4656ca2c52aSchristos scm_shell doesn't return. :-( I found this code on guile-user@. */
4666ca2c52aSchristos gdbscm_safe_call_1 (scm_c_public_ref ("system repl repl", "start-repl"),
4676ca2c52aSchristos scm_from_latin1_symbol ("scheme"), NULL);
4686ca2c52aSchristos }
469