OpenE2K
/
binutils-gdb
12
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Eliminate most remaining cleanups under gdb/guile/ 

The main complication with the Guile code is that we have two types of
exceptions to consider.  GDB/C++ exceptions, and Guile/SJLJ
exceptions.  Code that is facing the Guile interpreter must not throw
GDB exceptions, instead Scheme exceptions must be thrown.  Also,
because Guile exceptions are SJLJ based, Guile-facing code must not
use local objects with dtors, unless wrapped in a scope with a
TRY/CATCH, because the dtors won't otherwise be run when a Guile
exceptions is thrown.

This commit adds a new gdbscm_wrap wrapper function than encapsulates
a pattern I noticed in many of the functions using
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS.  The wrapper is written
such that you can pass either a lambda to it, or a function plus a
variable number of forwarded args.  I used a lambda when its body
would be reasonably short, and a separate function in the larger
cases.

This also convers a few functions that were using
GDBSCM_HANDLE_GDB_EXCEPTION to use gdbscm_wrap too because they
followed a similar pattern.

A few cases of make_cleanup calls are replaced with explicit xfree
calls.  The make_cleanup/do_cleanups calls in those cases are
pointless, because do_cleanups won't be called when a Scheme exception
is thrown.

We also have a couple cases of Guile-facing code using RAII-type
objects to manage memory, but those are incorrect, exactly because
their dtor won't be called if a Guile exception is thrown.

gdb/ChangeLog:
2018-07-18  Pedro Alves  <palves@redhat.com>

	* guile/guile-internal.h: Add comment about mixing GDB and Scheme
	exceptions.
	(GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS): Delete.
	(gdbscm_wrap): New.
	* guile/scm-frame.c (gdbscm_frame_read_register): Use xfree
	directly instead of a cleanup.
	* guile/scm-math.c (vlscm_unop_gdbthrow): New, factored out from ...
	(vlscm_unop): ... this.  Reimplement using gdbscm_wrap.
	(vlscm_binop_gdbthrow): New, factored out from ...
	(vlscm_binop): ... this.  Reimplement using gdbscm_wrap.
	(vlscm_rich_compare): Use gdbscm_wrap.
	* guile/scm-symbol.c (gdbscm_lookup_symbol): Use xfree directly
	instead of a cleanup.
	(gdbscm_lookup_global_symbol): Use xfree directly instead of a
	cleanup.
	* guile/scm-type.c (gdbscm_type_field, gdbscm_type_has_field_p):
	Use xfree directly instead of a cleanup.
	* guile/scm-value.c (gdbscm_make_value, gdbscm_make_lazy_value):
	Adjust to use gdbscm_wrap and scoped_value_mark.
	(gdbscm_value_optimized_out_p): Adjust to use gdbscm_wrap.
	(gdbscm_value_address, gdbscm_value_dereference)
	(gdbscm_value_referenced_value): Adjust to use gdbscm_wrap and
	scoped_value_mark.
	(gdbscm_value_dynamic_type): Use scoped_value_mark.
	(vlscm_do_cast, gdbscm_value_field): Adjust to use gdbscm_wrap and
	scoped_value_mark.
	(gdbscm_value_subscript, gdbscm_value_call): Adjust to use
	gdbscm_wrap and scoped_value_mark.
	(gdbscm_value_to_string): Use xfree directly instead of a
	cleanup.  Move 'buffer' unique_ptr to TRY scope.
	(gdbscm_value_to_lazy_string): Use xfree directly instead of a
	cleanup.  Move 'buffer' unique_ptr to TRY scope.  Use
	scoped_value_mark.
	(gdbscm_value_fetch_lazy_x): Use gdbscm_wrap.
	(gdbscm_parse_and_eval): Adjust to use gdbscm_wrap and
	scoped_value_mark.
	(gdbscm_history_ref, gdbscm_history_append_x): Adjust to use
	gdbscm_wrap.
This commit is contained in:
Pedro Alves 2018-07-18 22:55:59 +01:00
parent 42dc7699a2
commit 557e56be26
7 changed files with 412 additions and 575 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
gdb/ChangeLog
View File

@ -1,3 +1,44 @@
2018-07-18 Pedro Alves <palves@redhat.com>
* guile/guile-internal.h: Add comment about mixing GDB and Scheme
exceptions.
(GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS): Delete.
(gdbscm_wrap): New.
* guile/scm-frame.c (gdbscm_frame_read_register): Use xfree
directly instead of a cleanup.
* guile/scm-math.c (vlscm_unop_gdbthrow): New, factored out from ...
(vlscm_unop): ... this. Reimplement using gdbscm_wrap.
(vlscm_binop_gdbthrow): New, factored out from ...
(vlscm_binop): ... this. Reimplement using gdbscm_wrap.
(vlscm_rich_compare): Use gdbscm_wrap.
* guile/scm-symbol.c (gdbscm_lookup_symbol): Use xfree directly
instead of a cleanup.
(gdbscm_lookup_global_symbol): Use xfree directly instead of a
cleanup.
* guile/scm-type.c (gdbscm_type_field, gdbscm_type_has_field_p):
Use xfree directly instead of a cleanup.
* guile/scm-value.c (gdbscm_make_value, gdbscm_make_lazy_value):
Adjust to use gdbscm_wrap and scoped_value_mark.
(gdbscm_value_optimized_out_p): Adjust to use gdbscm_wrap.
(gdbscm_value_address, gdbscm_value_dereference)
(gdbscm_value_referenced_value): Adjust to use gdbscm_wrap and
scoped_value_mark.
(gdbscm_value_dynamic_type): Use scoped_value_mark.
(vlscm_do_cast, gdbscm_value_field): Adjust to use gdbscm_wrap and
scoped_value_mark.
(gdbscm_value_subscript, gdbscm_value_call): Adjust to use
gdbscm_wrap and scoped_value_mark.
(gdbscm_value_to_string): Use xfree directly instead of a
cleanup. Move 'buffer' unique_ptr to TRY scope.
(gdbscm_value_to_lazy_string): Use xfree directly instead of a
cleanup. Move 'buffer' unique_ptr to TRY scope. Use
scoped_value_mark.
(gdbscm_value_fetch_lazy_x): Use gdbscm_wrap.
(gdbscm_parse_and_eval): Adjust to use gdbscm_wrap and
scoped_value_mark.
(gdbscm_history_ref, gdbscm_history_append_x): Adjust to use
gdbscm_wrap.
2018-07-18 Tom de Vries <tdevries@suse.de>
* findvar.c (default_read_var_value): Also resolve dynamic type for

53
gdb/guile/guile-internal.h
View File

@ -639,8 +639,18 @@ extern void gdbscm_initialize_symtabs (void);
extern void gdbscm_initialize_types (void);
extern void gdbscm_initialize_values (void);
/* Use these after a TRY_CATCH to throw the appropriate Scheme exception
if a GDB error occurred. */
/* A complication with the Guile code is that we have two types of
exceptions to consider. GDB/C++ exceptions, and Guile/SJLJ
exceptions. Code that is facing the Guile interpreter must not
throw GDB exceptions, instead Scheme exceptions must be thrown.
Also, because Guile exceptions are SJLJ based, Guile-facing code
must not use local objects with dtors, unless wrapped in a scope
with a TRY/CATCH, because the dtors won't otherwise be run when a
Guile exceptions is thrown. */
/* Use this after a TRY/CATCH to throw the appropriate Scheme
exception if a GDB error occurred. */
#define GDBSCM_HANDLE_GDB_EXCEPTION(exception) \
do { \
@ -651,16 +661,35 @@ extern void gdbscm_initialize_values (void);
} \
} while (0)
/* If cleanups are establish outside the TRY_CATCH block, use this version. */
/* Use this to wrap a callable to throw the appropriate Scheme
exception if the callable throws a GDB error. ARGS are forwarded
to FUNC. Returns the result of FUNC, unless FUNC returns a Scheme
exception, in which case that exception is thrown. Note that while
the callable is free to use objects of types with destructors,
because GDB errors are C++ exceptions, the caller of gdbscm_wrap
must not use such objects, because their destructors would not be
called when a Scheme exception is thrown. */
#define GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS(exception, cleanups) \
do { \
if (exception.reason < 0) \
{ \
do_cleanups (cleanups); \
gdbscm_throw_gdb_exception (exception); \
/*NOTREACHED */ \
} \
} while (0)
template<typename Function, typename... Args>
SCM
gdbscm_wrap (Function &&func, Args... args)
{
SCM result = SCM_BOOL_F;
TRY
{
result = func (std::forward<Args> (args)...);
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION (except);
}
END_CATCH
if (gdbscm_is_exception (result))
gdbscm_throw (result);
return result;
}
#endif /* GDB_GUILE_INTERNAL_H */

11
gdb/guile/scm-frame.c
View File

@ -783,13 +783,13 @@ gdbscm_frame_read_register (SCM self, SCM register_scm)
char *register_str;
struct value *value = NULL;
struct frame_info *frame = NULL;
struct cleanup *cleanup;
frame_smob *f_smob;
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, NULL, "s",
register_scm, &register_str);
cleanup = make_cleanup (xfree, register_str);
struct gdb_exception except = exception_none;
TRY
{
@ -805,13 +805,14 @@ gdbscm_frame_read_register (SCM self, SCM register_scm)
value = value_of_register (regnum, frame);
}
}
CATCH (except, RETURN_MASK_ALL)
CATCH (ex, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION (except);
except = ex;
}
END_CATCH
do_cleanups (cleanup);
xfree (register_str);
GDBSCM_HANDLE_GDB_EXCEPTION (except);
if (frame == NULL)
{

398
gdb/guile/scm-math.c
View File

@ -67,79 +67,186 @@ enum valscm_binary_opcode
#define STRIP_REFERENCE(TYPE) \
((TYPE_CODE (TYPE) == TYPE_CODE_REF) ? (TYPE_TARGET_TYPE (TYPE)) : (TYPE))
/* Returns a value object which is the result of applying the operation
specified by OPCODE to the given argument.
If there's an error a Scheme exception is thrown. */
/* Helper for vlscm_unop. Contains all the code that may throw a GDB
exception. */
static SCM
vlscm_unop_gdbthrow (enum valscm_unary_opcode opcode, SCM x,
const char *func_name)
{
struct gdbarch *gdbarch = get_current_arch ();
const struct language_defn *language = current_language;
SCM result = SCM_BOOL_F;
scoped_value_mark free_values;
SCM except_scm;
value *arg1 = vlscm_convert_value_from_scheme (func_name, SCM_ARG1, x,
&except_scm, gdbarch,
language);
if (arg1 == NULL)
return except_scm;
struct value *res_val = NULL;
switch (opcode)
{
case VALSCM_NOT:
/* Alas gdb and guile use the opposite meaning for "logical
not". */
{
struct type *type = language_bool_type (language, gdbarch);
res_val
= value_from_longest (type,
(LONGEST) value_logical_not (arg1));
}
break;
case VALSCM_NEG:
res_val = value_neg (arg1);
break;
case VALSCM_NOP:
/* Seemingly a no-op, but if X was a Scheme value it is now a
<gdb:value> object. */
res_val = arg1;
break;
case VALSCM_ABS:
if (value_less (arg1, value_zero (value_type (arg1), not_lval)))
res_val = value_neg (arg1);
else
res_val = arg1;
break;
case VALSCM_LOGNOT:
res_val = value_complement (arg1);
break;
default:
gdb_assert_not_reached ("unsupported operation");
}
gdb_assert (res_val != NULL);
return vlscm_scm_from_value (res_val);
}
static SCM
vlscm_unop (enum valscm_unary_opcode opcode, SCM x, const char *func_name)
{
return gdbscm_wrap (vlscm_unop_gdbthrow, opcode, x, func_name);
}
/* Helper for vlscm_binop. Contains all the code that may throw a GDB
exception. */
static SCM
vlscm_binop_gdbthrow (enum valscm_binary_opcode opcode, SCM x, SCM y,
const char *func_name)
{
struct gdbarch *gdbarch = get_current_arch ();
const struct language_defn *language = current_language;
struct value *arg1;
struct value *arg1, *arg2;
SCM result = SCM_BOOL_F;
struct value *res_val = NULL;
SCM except_scm;
struct cleanup *cleanups;
cleanups = make_cleanup_value_free_to_mark (value_mark ());
scoped_value_mark free_values;
arg1 = vlscm_convert_value_from_scheme (func_name, SCM_ARG1, x,
&except_scm, gdbarch, language);
if (arg1 == NULL)
{
do_cleanups (cleanups);
gdbscm_throw (except_scm);
}
return except_scm;
TRY
arg2 = vlscm_convert_value_from_scheme (func_name, SCM_ARG2, y,
&except_scm, gdbarch, language);
if (arg2 == NULL)
return except_scm;
switch (opcode)
{
switch (opcode)
{
case VALSCM_NOT:
/* Alas gdb and guile use the opposite meaning for "logical not". */
case VALSCM_ADD:
{
struct type *ltype = value_type (arg1);
struct type *rtype = value_type (arg2);
ltype = check_typedef (ltype);
ltype = STRIP_REFERENCE (ltype);
rtype = check_typedef (rtype);
rtype = STRIP_REFERENCE (rtype);
if (TYPE_CODE (ltype) == TYPE_CODE_PTR
&& is_integral_type (rtype))
res_val = value_ptradd (arg1, value_as_long (arg2));
else if (TYPE_CODE (rtype) == TYPE_CODE_PTR
&& is_integral_type (ltype))
res_val = value_ptradd (arg2, value_as_long (arg1));
else
res_val = value_binop (arg1, arg2, BINOP_ADD);
}
break;
case VALSCM_SUB:
{
struct type *ltype = value_type (arg1);
struct type *rtype = value_type (arg2);
ltype = check_typedef (ltype);
ltype = STRIP_REFERENCE (ltype);
rtype = check_typedef (rtype);
rtype = STRIP_REFERENCE (rtype);
if (TYPE_CODE (ltype) == TYPE_CODE_PTR
&& TYPE_CODE (rtype) == TYPE_CODE_PTR)
{
struct type *type = language_bool_type (language, gdbarch);
/* A ptrdiff_t for the target would be preferable here. */
res_val
= value_from_longest (type, (LONGEST) value_logical_not (arg1));
= value_from_longest (builtin_type (gdbarch)->builtin_long,
value_ptrdiff (arg1, arg2));
}
break;
case VALSCM_NEG:
res_val = value_neg (arg1);
break;
case VALSCM_NOP:
/* Seemingly a no-op, but if X was a Scheme value it is now
a <gdb:value> object. */
res_val = arg1;
break;
case VALSCM_ABS:
if (value_less (arg1, value_zero (value_type (arg1), not_lval)))
res_val = value_neg (arg1);
else
res_val = arg1;
break;
case VALSCM_LOGNOT:
res_val = value_complement (arg1);
break;
default:
gdb_assert_not_reached ("unsupported operation");
}
else if (TYPE_CODE (ltype) == TYPE_CODE_PTR
&& is_integral_type (rtype))
res_val = value_ptradd (arg1, - value_as_long (arg2));
else
res_val = value_binop (arg1, arg2, BINOP_SUB);
}
break;
case VALSCM_MUL:
res_val = value_binop (arg1, arg2, BINOP_MUL);
break;
case VALSCM_DIV:
res_val = value_binop (arg1, arg2, BINOP_DIV);
break;
case VALSCM_REM:
res_val = value_binop (arg1, arg2, BINOP_REM);
break;
case VALSCM_MOD:
res_val = value_binop (arg1, arg2, BINOP_MOD);
break;
case VALSCM_POW:
res_val = value_binop (arg1, arg2, BINOP_EXP);
break;
case VALSCM_LSH:
res_val = value_binop (arg1, arg2, BINOP_LSH);
break;
case VALSCM_RSH:
res_val = value_binop (arg1, arg2, BINOP_RSH);
break;
case VALSCM_MIN:
res_val = value_binop (arg1, arg2, BINOP_MIN);
break;
case VALSCM_MAX:
res_val = value_binop (arg1, arg2, BINOP_MAX);
break;
case VALSCM_BITAND:
res_val = value_binop (arg1, arg2, BINOP_BITWISE_AND);
break;
case VALSCM_BITOR:
res_val = value_binop (arg1, arg2, BINOP_BITWISE_IOR);
break;
case VALSCM_BITXOR:
res_val = value_binop (arg1, arg2, BINOP_BITWISE_XOR);
break;
default:
gdb_assert_not_reached ("unsupported operation");
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
}
END_CATCH
gdb_assert (res_val != NULL);
result = vlscm_scm_from_value (res_val);
do_cleanups (cleanups);
if (gdbscm_is_exception (result))
gdbscm_throw (result);
return result;
return vlscm_scm_from_value (res_val);
}
/* Returns a value object which is the result of applying the operation
@ -150,135 +257,7 @@ static SCM
vlscm_binop (enum valscm_binary_opcode opcode, SCM x, SCM y,
const char *func_name)
{
struct gdbarch *gdbarch = get_current_arch ();
const struct language_defn *language = current_language;
struct value *arg1, *arg2;
SCM result = SCM_BOOL_F;
struct value *res_val = NULL;
SCM except_scm;
struct cleanup *cleanups;
cleanups = make_cleanup_value_free_to_mark (value_mark ());
arg1 = vlscm_convert_value_from_scheme (func_name, SCM_ARG1, x,
&except_scm, gdbarch, language);
if (arg1 == NULL)
{
do_cleanups (cleanups);
gdbscm_throw (except_scm);
}
arg2 = vlscm_convert_value_from_scheme (func_name, SCM_ARG2, y,
&except_scm, gdbarch, language);
if (arg2 == NULL)
{
do_cleanups (cleanups);
gdbscm_throw (except_scm);
}
TRY
{
switch (opcode)
{
case VALSCM_ADD:
{
struct type *ltype = value_type (arg1);
struct type *rtype = value_type (arg2);
ltype = check_typedef (ltype);
ltype = STRIP_REFERENCE (ltype);
rtype = check_typedef (rtype);
rtype = STRIP_REFERENCE (rtype);
if (TYPE_CODE (ltype) == TYPE_CODE_PTR
&& is_integral_type (rtype))
res_val = value_ptradd (arg1, value_as_long (arg2));
else if (TYPE_CODE (rtype) == TYPE_CODE_PTR
&& is_integral_type (ltype))
res_val = value_ptradd (arg2, value_as_long (arg1));
else
res_val = value_binop (arg1, arg2, BINOP_ADD);
}
break;
case VALSCM_SUB:
{
struct type *ltype = value_type (arg1);
struct type *rtype = value_type (arg2);
ltype = check_typedef (ltype);
ltype = STRIP_REFERENCE (ltype);
rtype = check_typedef (rtype);
rtype = STRIP_REFERENCE (rtype);
if (TYPE_CODE (ltype) == TYPE_CODE_PTR
&& TYPE_CODE (rtype) == TYPE_CODE_PTR)
{
/* A ptrdiff_t for the target would be preferable here. */
res_val
= value_from_longest (builtin_type (gdbarch)->builtin_long,
value_ptrdiff (arg1, arg2));
}
else if (TYPE_CODE (ltype) == TYPE_CODE_PTR
&& is_integral_type (rtype))
res_val = value_ptradd (arg1, - value_as_long (arg2));
else
res_val = value_binop (arg1, arg2, BINOP_SUB);
}
break;
case VALSCM_MUL:
res_val = value_binop (arg1, arg2, BINOP_MUL);
break;
case VALSCM_DIV:
res_val = value_binop (arg1, arg2, BINOP_DIV);
break;
case VALSCM_REM:
res_val = value_binop (arg1, arg2, BINOP_REM);
break;
case VALSCM_MOD:
res_val = value_binop (arg1, arg2, BINOP_MOD);
break;
case VALSCM_POW:
res_val = value_binop (arg1, arg2, BINOP_EXP);
break;
case VALSCM_LSH:
res_val = value_binop (arg1, arg2, BINOP_LSH);
break;
case VALSCM_RSH:
res_val = value_binop (arg1, arg2, BINOP_RSH);
break;
case VALSCM_MIN:
res_val = value_binop (arg1, arg2, BINOP_MIN);
break;
case VALSCM_MAX:
res_val = value_binop (arg1, arg2, BINOP_MAX);
break;
case VALSCM_BITAND:
res_val = value_binop (arg1, arg2, BINOP_BITWISE_AND);
break;
case VALSCM_BITOR:
res_val = value_binop (arg1, arg2, BINOP_BITWISE_IOR);
break;
case VALSCM_BITXOR:
res_val = value_binop (arg1, arg2, BINOP_BITWISE_XOR);
break;
default:
gdb_assert_not_reached ("unsupported operation");
}
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
}
END_CATCH
gdb_assert (res_val != NULL);
result = vlscm_scm_from_value (res_val);
do_cleanups (cleanups);
if (gdbscm_is_exception (result))
gdbscm_throw (result);
return result;
return gdbscm_wrap (vlscm_binop_gdbthrow, opcode, x, y, func_name);
}
/* (value-add x y) -> <gdb:value> */
@ -439,33 +418,27 @@ gdbscm_value_logxor (SCM x, SCM y)
static SCM
vlscm_rich_compare (int op, SCM x, SCM y, const char *func_name)
{
struct gdbarch *gdbarch = get_current_arch ();
const struct language_defn *language = current_language;
struct value *v1, *v2;
int result = 0;
SCM except_scm;
struct cleanup *cleanups;
struct gdb_exception except = exception_none;
cleanups = make_cleanup_value_free_to_mark (value_mark ());
v1 = vlscm_convert_value_from_scheme (func_name, SCM_ARG1, x,
&except_scm, gdbarch, language);
if (v1 == NULL)
return gdbscm_wrap ([=]
{
do_cleanups (cleanups);
gdbscm_throw (except_scm);
}
v2 = vlscm_convert_value_from_scheme (func_name, SCM_ARG2, y,
&except_scm, gdbarch, language);
if (v2 == NULL)
{
do_cleanups (cleanups);
gdbscm_throw (except_scm);
}
struct gdbarch *gdbarch = get_current_arch ();
const struct language_defn *language = current_language;
SCM except_scm;
TRY
{
scoped_value_mark free_values;
value *v1
= vlscm_convert_value_from_scheme (func_name, SCM_ARG1, x,
&except_scm, gdbarch, language);
if (v1 == NULL)
return except_scm;
value *v2
= vlscm_convert_value_from_scheme (func_name, SCM_ARG2, y,
&except_scm, gdbarch, language);
if (v2 == NULL)
return except_scm;
int result;
switch (op)
{
case BINOP_LESS:
@ -489,18 +462,9 @@ vlscm_rich_compare (int op, SCM x, SCM y, const char *func_name)
break;
default:
gdb_assert_not_reached ("invalid <gdb:value> comparison");
}
}
CATCH (ex, RETURN_MASK_ALL)
{
except = ex;
}
END_CATCH
do_cleanups (cleanups);
GDBSCM_HANDLE_GDB_EXCEPTION (except);
return scm_from_bool (result);
}
return scm_from_bool (result);
});
}
/* (value=? x y) -> boolean

17
gdb/guile/scm-symbol.c
View File

@ -582,16 +582,12 @@ gdbscm_lookup_symbol (SCM name_scm, SCM rest)
int block_arg_pos = -1, domain_arg_pos = -1;
struct field_of_this_result is_a_field_of_this;
struct symbol *symbol = NULL;
struct cleanup *cleanups;
struct gdb_exception except = exception_none;
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#Oi",
name_scm, &name, rest,
&block_arg_pos, &block_scm,
&domain_arg_pos, &domain);
cleanups = make_cleanup (xfree, name);
if (block_arg_pos >= 0)
{
SCM except_scm;
@ -600,7 +596,7 @@ gdbscm_lookup_symbol (SCM name_scm, SCM rest)
&except_scm);
if (block == NULL)
{
do_cleanups (cleanups);
xfree (name);
gdbscm_throw (except_scm);
}
}
@ -615,11 +611,13 @@ gdbscm_lookup_symbol (SCM name_scm, SCM rest)
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
xfree (name);
GDBSCM_HANDLE_GDB_EXCEPTION (except);
}
END_CATCH
}
struct gdb_exception except = exception_none;
TRY
{
symbol = lookup_symbol (name, block, (domain_enum) domain,
@ -631,7 +629,7 @@ gdbscm_lookup_symbol (SCM name_scm, SCM rest)
}
END_CATCH
do_cleanups (cleanups);
xfree (name);
GDBSCM_HANDLE_GDB_EXCEPTION (except);
if (symbol == NULL)
@ -652,15 +650,12 @@ gdbscm_lookup_global_symbol (SCM name_scm, SCM rest)
int domain_arg_pos = -1;
int domain = VAR_DOMAIN;
struct symbol *symbol = NULL;
struct cleanup *cleanups;
struct gdb_exception except = exception_none;
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#i",
name_scm, &name, rest,
&domain_arg_pos, &domain);
cleanups = make_cleanup (xfree, name);
TRY
{
symbol = lookup_global_symbol (name, NULL, (domain_enum) domain).symbol;
@ -671,7 +666,7 @@ gdbscm_lookup_global_symbol (SCM name_scm, SCM rest)
}
END_CATCH
do_cleanups (cleanups);
xfree (name);
GDBSCM_HANDLE_GDB_EXCEPTION (except);
if (symbol == NULL)

16
gdb/guile/scm-type.c
View File

@ -977,7 +977,6 @@ gdbscm_type_field (SCM self, SCM field_scm)
struct type *type = t_smob->type;
char *field;
int i;
struct cleanup *cleanups;
SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
_("string"));
@ -992,7 +991,6 @@ gdbscm_type_field (SCM self, SCM field_scm)
_(not_composite_error));
field = gdbscm_scm_to_c_string (field_scm);
cleanups = make_cleanup (xfree, field);
for (i = 0; i < TYPE_NFIELDS (type); i++)
{
@ -1000,12 +998,12 @@ gdbscm_type_field (SCM self, SCM field_scm)
if (t_field_name && (strcmp_iw (t_field_name, field) == 0))
{
do_cleanups (cleanups);
return tyscm_make_field_smob (self, i);
xfree (field);
return tyscm_make_field_smob (self, i);
}
}
do_cleanups (cleanups);
xfree (field);
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, field_scm,
_("Unknown field"));
@ -1022,7 +1020,6 @@ gdbscm_type_has_field_p (SCM self, SCM field_scm)
struct type *type = t_smob->type;
char *field;
int i;
struct cleanup *cleanups;
SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
_("string"));
@ -1037,7 +1034,6 @@ gdbscm_type_has_field_p (SCM self, SCM field_scm)
_(not_composite_error));
field = gdbscm_scm_to_c_string (field_scm);
cleanups = make_cleanup (xfree, field);
for (i = 0; i < TYPE_NFIELDS (type); i++)
{
@ -1045,12 +1041,12 @@ gdbscm_type_has_field_p (SCM self, SCM field_scm)
if (t_field_name && (strcmp_iw (t_field_name, field) == 0))
{
do_cleanups (cleanups);
return SCM_BOOL_T;
xfree (field);
return SCM_BOOL_T;
}
}
do_cleanups (cleanups);
xfree (field);
return SCM_BOOL_F;
}

451
gdb/guile/scm-value.c
View File

@ -303,46 +303,38 @@ vlscm_scm_to_value (SCM v_scm)
static SCM
gdbscm_make_value (SCM x, SCM rest)
{
struct gdbarch *gdbarch = get_current_arch ();
const struct language_defn *language = current_language;
const SCM keywords[] = { type_keyword, SCM_BOOL_F };
int type_arg_pos = -1;
SCM type_scm = SCM_UNDEFINED;
SCM except_scm, result;
type_smob *t_smob;
struct type *type = NULL;
struct value *value;
struct cleanup *cleanups;
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#O", rest,
&type_arg_pos, &type_scm);
struct type *type = NULL;
if (type_arg_pos > 0)
{
t_smob = tyscm_get_type_smob_arg_unsafe (type_scm, type_arg_pos,
FUNC_NAME);
type_smob *t_smob = tyscm_get_type_smob_arg_unsafe (type_scm,
type_arg_pos,
FUNC_NAME);
type = tyscm_type_smob_type (t_smob);
}
cleanups = make_cleanup_value_free_to_mark (value_mark ());
return gdbscm_wrap ([=]
{
scoped_value_mark free_values;
value = vlscm_convert_typed_value_from_scheme (FUNC_NAME, SCM_ARG1, x,
SCM except_scm;
struct value *value
= vlscm_convert_typed_value_from_scheme (FUNC_NAME, SCM_ARG1, x,
type_arg_pos, type_scm, type,
&except_scm,
gdbarch, language);
if (value == NULL)
{
do_cleanups (cleanups);
gdbscm_throw (except_scm);
}
get_current_arch (),
current_language);
if (value == NULL)
return except_scm;
result = vlscm_scm_from_value (value);
do_cleanups (cleanups);
if (gdbscm_is_exception (result))
gdbscm_throw (result);
return result;
return vlscm_scm_from_value (value);
});
}
/* (make-lazy-value <gdb:type> address) -> <gdb:value> */
@ -350,40 +342,22 @@ gdbscm_make_value (SCM x, SCM rest)
static SCM
gdbscm_make_lazy_value (SCM type_scm, SCM address_scm)
{
type_smob *t_smob;
struct type *type;
type_smob *t_smob = tyscm_get_type_smob_arg_unsafe (type_scm,
SCM_ARG1, FUNC_NAME);
struct type *type = tyscm_type_smob_type (t_smob);
ULONGEST address;
struct value *value = NULL;
SCM result;
struct cleanup *cleanups;
t_smob = tyscm_get_type_smob_arg_unsafe (type_scm, SCM_ARG1, FUNC_NAME);
type = tyscm_type_smob_type (t_smob);
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, NULL, "U",
address_scm, &address);
cleanups = make_cleanup_value_free_to_mark (value_mark ());
/* There's no (current) need to wrap this in a TRY_CATCH, but for consistency
and future-proofing we do. */
TRY
{
value = value_from_contents_and_address (type, NULL, address);
}
CATCH (except, RETURN_MASK_ALL)
return gdbscm_wrap ([=]
{
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
}
END_CATCH
scoped_value_mark free_values;
result = vlscm_scm_from_value (value);
do_cleanups (cleanups);
if (gdbscm_is_exception (result))
gdbscm_throw (result);
return result;
struct value *value = value_from_contents_and_address (type, NULL,
address);
return vlscm_scm_from_value (value);
});
}
/* (value-optimized-out? <gdb:value>) -> boolean */
@ -393,20 +367,11 @@ gdbscm_value_optimized_out_p (SCM self)
{
value_smob *v_smob
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct value *value = v_smob->value;
int opt = 0;
TRY
return gdbscm_wrap ([=]
{
opt = value_optimized_out (value);
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION (except);
}
END_CATCH
return scm_from_bool (opt);
return scm_from_bool (value_optimized_out (v_smob->value));
});
}
/* (value-address <gdb:value>) -> integer
@ -419,30 +384,31 @@ gdbscm_value_address (SCM self)
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct value *value = v_smob->value;
if (SCM_UNBNDP (v_smob->address))
return gdbscm_wrap ([=]
{
struct cleanup *cleanup
= make_cleanup_value_free_to_mark (value_mark ());
SCM address = SCM_BOOL_F;
TRY
if (SCM_UNBNDP (v_smob->address))
{
address = vlscm_scm_from_value (value_addr (value));
scoped_value_mark free_values;
SCM address = SCM_BOOL_F;
TRY
{
address = vlscm_scm_from_value (value_addr (value));
}
CATCH (except, RETURN_MASK_ALL)
{
}
END_CATCH
if (gdbscm_is_exception (address))
return address;
v_smob->address = address;
}
CATCH (except, RETURN_MASK_ALL)
{
}
END_CATCH
do_cleanups (cleanup);
if (gdbscm_is_exception (address))
gdbscm_throw (address);
v_smob->address = address;
}
return v_smob->address;
return v_smob->address;
});
}
/* (value-dereference <gdb:value>) -> <gdb:value>
@ -453,31 +419,14 @@ gdbscm_value_dereference (SCM self)
{
value_smob *v_smob
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct value *value = v_smob->value;
SCM result;
struct value *res_val = NULL;
struct cleanup *cleanups;
cleanups = make_cleanup_value_free_to_mark (value_mark ());
TRY
return gdbscm_wrap ([=]
{
res_val = value_ind (value);
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
}
END_CATCH
scoped_value_mark free_values;
result = vlscm_scm_from_value (res_val);
do_cleanups (cleanups);
if (gdbscm_is_exception (result))
gdbscm_throw (result);
return result;
struct value *res_val = value_ind (v_smob->value);
return vlscm_scm_from_value (res_val);
});
}
/* (value-referenced-value <gdb:value>) -> <gdb:value>
@ -495,14 +444,13 @@ gdbscm_value_referenced_value (SCM self)
value_smob *v_smob
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct value *value = v_smob->value;
SCM result;
struct value *res_val = NULL;
struct cleanup *cleanups;
cleanups = make_cleanup_value_free_to_mark (value_mark ());
TRY
return gdbscm_wrap ([=]
{
scoped_value_mark free_values;
struct value *res_val;
switch (TYPE_CODE (check_typedef (value_type (value))))
{
case TYPE_CODE_PTR:
@ -515,21 +463,9 @@ gdbscm_value_referenced_value (SCM self)
error (_("Trying to get the referenced value from a value which is"
" neither a pointer nor a reference"));
}
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
}
END_CATCH
result = vlscm_scm_from_value (res_val);
do_cleanups (cleanups);
if (gdbscm_is_exception (result))
gdbscm_throw (result);
return result;
return vlscm_scm_from_value (res_val);
});
}
/* (value-type <gdb:value>) -> <gdb:type> */
@ -562,8 +498,7 @@ gdbscm_value_dynamic_type (SCM self)
TRY
{
struct cleanup *cleanup
= make_cleanup_value_free_to_mark (value_mark ());
scoped_value_mark free_values;
type = value_type (value);
type = check_typedef (type);
@ -596,8 +531,6 @@ gdbscm_value_dynamic_type (SCM self)
/* Re-use object's static type. */
type = NULL;
}
do_cleanups (cleanup);
}
CATCH (except, RETURN_MASK_ALL)
{
@ -625,14 +558,12 @@ vlscm_do_cast (SCM self, SCM type_scm, enum exp_opcode op,
type_smob *t_smob
= tyscm_get_type_smob_arg_unsafe (type_scm, SCM_ARG2, FUNC_NAME);
struct type *type = tyscm_type_smob_type (t_smob);
SCM result;
struct value *res_val = NULL;
struct cleanup *cleanups;
cleanups = make_cleanup_value_free_to_mark (value_mark ());
TRY
return gdbscm_wrap ([=]
{
scoped_value_mark free_values;
struct value *res_val;
if (op == UNOP_DYNAMIC_CAST)
res_val = value_dynamic_cast (type, value);
else if (op == UNOP_REINTERPRET_CAST)
@ -642,22 +573,9 @@ vlscm_do_cast (SCM self, SCM type_scm, enum exp_opcode op,
gdb_assert (op == UNOP_CAST);
res_val = value_cast (type, value);
}
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
}
END_CATCH
gdb_assert (res_val != NULL);
result = vlscm_scm_from_value (res_val);
do_cleanups (cleanups);
if (gdbscm_is_exception (result))
gdbscm_throw (result);
return result;
return vlscm_scm_from_value (res_val);
});
}
/* (value-cast <gdb:value> <gdb:type>) -> <gdb:value> */
@ -693,42 +611,29 @@ gdbscm_value_field (SCM self, SCM field_scm)
{
value_smob *v_smob
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct value *value = v_smob->value;
char *field = NULL;
struct value *res_val = NULL;
SCM result;
struct cleanup *cleanups;
SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
_("string"));
cleanups = make_cleanup_value_free_to_mark (value_mark ());
field = gdbscm_scm_to_c_string (field_scm);
make_cleanup (xfree, field);
TRY
return gdbscm_wrap ([=]
{
struct value *tmp = value;
scoped_value_mark free_values;
res_val = value_struct_elt (&tmp, NULL, field, NULL,
"struct/class/union");
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
}
END_CATCH
char *field = gdbscm_scm_to_c_string (field_scm);
gdb_assert (res_val != NULL);
result = vlscm_scm_from_value (res_val);
struct cleanup *cleanups = make_cleanup (xfree, field);
do_cleanups (cleanups);
struct value *tmp = v_smob->value;
if (gdbscm_is_exception (result))
gdbscm_throw (result);
struct value *res_val = value_struct_elt (&tmp, NULL, field, NULL,
"struct/class/union");
return result;
SCM result = vlscm_scm_from_value (res_val);
do_cleanups (cleanups);
return result;
});
}
/* (value-subscript <gdb:value> integer|<gdb:value>) -> <gdb:value>
@ -740,61 +645,36 @@ gdbscm_value_subscript (SCM self, SCM index_scm)
value_smob *v_smob
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct value *value = v_smob->value;
struct value *index = NULL;
struct value *res_val = NULL;
struct type *type = value_type (value);
struct gdbarch *gdbarch;
SCM result, except_scm;
struct cleanup *cleanups;
/* The sequencing here, as everywhere else, is important.
We can't have existing cleanups when a Scheme exception is thrown. */
SCM_ASSERT (type != NULL, self, SCM_ARG2, FUNC_NAME);
gdbarch = get_type_arch (type);
cleanups = make_cleanup_value_free_to_mark (value_mark ());
return gdbscm_wrap ([=]
{
scoped_value_mark free_values;
index = vlscm_convert_value_from_scheme (FUNC_NAME, SCM_ARG2, index_scm,
SCM except_scm;
struct value *index
= vlscm_convert_value_from_scheme (FUNC_NAME, SCM_ARG2, index_scm,
&except_scm,
gdbarch, current_language);
if (index == NULL)
{
do_cleanups (cleanups);
gdbscm_throw (except_scm);
}
TRY
{
struct value *tmp = value;
get_type_arch (type),
current_language);
if (index == NULL)
return except_scm;
/* Assume we are attempting an array access, and let the value code
throw an exception if the index has an invalid type.
Check the value's type is something that can be accessed via
a subscript. */
tmp = coerce_ref (tmp);
type = check_typedef (value_type (tmp));
if (TYPE_CODE (type) != TYPE_CODE_ARRAY
&& TYPE_CODE (type) != TYPE_CODE_PTR)
struct value *tmp = coerce_ref (value);
struct type *tmp_type = check_typedef (value_type (tmp));
if (TYPE_CODE (tmp_type) != TYPE_CODE_ARRAY
&& TYPE_CODE (tmp_type) != TYPE_CODE_PTR)
error (_("Cannot subscript requested type"));
res_val = value_subscript (tmp, value_as_long (index));
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
}
END_CATCH
gdb_assert (res_val != NULL);
result = vlscm_scm_from_value (res_val);
do_cleanups (cleanups);
if (gdbscm_is_exception (result))
gdbscm_throw (result);
return result;
struct value *res_val = value_subscript (tmp, value_as_long (index));
return vlscm_scm_from_value (res_val);
});
}
/* (value-call <gdb:value> arg-list) -> <gdb:value>
@ -854,25 +734,14 @@ gdbscm_value_call (SCM self, SCM args)
gdb_assert (gdbscm_is_true (scm_null_p (args)));
}
TRY
return gdbscm_wrap ([=]
{
struct cleanup *cleanup = make_cleanup_value_free_to_mark (mark);
struct value *return_value;
scoped_value_mark free_values;
return_value = call_function_by_hand (function, NULL, args_count, vargs);
result = vlscm_scm_from_value (return_value);
do_cleanups (cleanup);
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION (except);
}
END_CATCH
if (gdbscm_is_exception (result))
gdbscm_throw (result);
return result;
value *return_value = call_function_by_hand (function, NULL,
args_count, vargs);
return vlscm_scm_from_value (return_value);
});
}
/* (value->bytevector <gdb:value>) -> bytevector */
@ -1105,12 +974,11 @@ gdbscm_value_to_string (SCM self, SCM rest)
int encoding_arg_pos = -1, errors_arg_pos = -1, length_arg_pos = -1;
char *encoding = NULL;
SCM errors = SCM_BOOL_F;
gdb_byte *buffer_contents;
int length = -1;
gdb::unique_xmalloc_ptr<gdb_byte> buffer;
const char *la_encoding = NULL;
struct type *char_type = NULL;
SCM result;
struct cleanup *cleanups;
/* The sequencing here, as everywhere else, is important.
We can't have existing cleanups when a Scheme exception is thrown. */
@ -1120,8 +988,6 @@ gdbscm_value_to_string (SCM self, SCM rest)
&errors_arg_pos, &errors,
&length_arg_pos, &length);
cleanups = make_cleanup (xfree, encoding);
if (errors_arg_pos > 0
&& errors != SCM_BOOL_F
&& !scm_is_eq (errors, error_symbol)
@ -1131,7 +997,7 @@ gdbscm_value_to_string (SCM self, SCM rest)
= gdbscm_make_out_of_range_error (FUNC_NAME, errors_arg_pos, errors,
_("invalid error kind"));
do_cleanups (cleanups);
xfree (encoding);
gdbscm_throw (excp);
}
if (errors == SCM_BOOL_F)
@ -1148,22 +1014,23 @@ gdbscm_value_to_string (SCM self, SCM rest)
TRY
{
gdb::unique_xmalloc_ptr<gdb_byte> buffer;
LA_GET_STRING (value, &buffer, &length, &char_type, &la_encoding);
buffer_contents = buffer.release ();
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
xfree (encoding);
GDBSCM_HANDLE_GDB_EXCEPTION (except);
}
END_CATCH
/* If errors is "error" scm_from_stringn may throw a Scheme exception.
/* If errors is "error", scm_from_stringn may throw a Scheme exception.
Make sure we don't leak. This is done via scm_dynwind_begin, et.al. */
discard_cleanups (cleanups);
scm_dynwind_begin ((scm_t_dynwind_flags) 0);
gdbscm_dynwind_xfree (encoding);
gdb_byte *buffer_contents = buffer.release ();
gdbscm_dynwind_xfree (buffer_contents);
result = scm_from_stringn ((const char *) buffer_contents,
@ -1202,7 +1069,6 @@ gdbscm_value_to_lazy_string (SCM self, SCM rest)
char *encoding = NULL;
int length = -1;
SCM result = SCM_BOOL_F; /* -Wall */
struct cleanup *cleanups;
struct gdb_exception except = exception_none;
/* The sequencing here, as everywhere else, is important.
@ -1219,12 +1085,10 @@ gdbscm_value_to_lazy_string (SCM self, SCM rest)
_("invalid length"));
}
cleanups = make_cleanup (xfree, encoding);
TRY
{
struct cleanup *inner_cleanup
= make_cleanup_value_free_to_mark (value_mark ());
scoped_value_mark free_values;
struct type *type, *realtype;
CORE_ADDR addr;
@ -1275,8 +1139,6 @@ gdbscm_value_to_lazy_string (SCM self, SCM rest)
}
result = lsscm_make_lazy_string (addr, length, encoding, type);
do_cleanups (inner_cleanup);
}
CATCH (ex, RETURN_MASK_ALL)
{
@ -1284,7 +1146,7 @@ gdbscm_value_to_lazy_string (SCM self, SCM rest)
}
END_CATCH
do_cleanups (cleanups);
xfree (encoding);
GDBSCM_HANDLE_GDB_EXCEPTION (except);
if (gdbscm_is_exception (result))
@ -1314,18 +1176,12 @@ gdbscm_value_fetch_lazy_x (SCM self)
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct value *value = v_smob->value;
TRY
return gdbscm_wrap ([=]
{
if (value_lazy (value))
value_fetch_lazy (value);
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION (except);
}
END_CATCH
return SCM_UNSPECIFIED;
return SCM_UNSPECIFIED;
});
}
/* (value-print <gdb:value>) -> string */
@ -1369,38 +1225,14 @@ static SCM
gdbscm_parse_and_eval (SCM expr_scm)
{
char *expr_str;
struct value *res_val = NULL;
SCM result;
struct cleanup *cleanups;
/* The sequencing here, as everywhere else, is important.
We can't have existing cleanups when a Scheme exception is thrown. */
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "s",
expr_scm, &expr_str);
cleanups = make_cleanup_value_free_to_mark (value_mark ());
make_cleanup (xfree, expr_str);
TRY
return gdbscm_wrap ([=]
{
res_val = parse_and_eval (expr_str);
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
}
END_CATCH
gdb_assert (res_val != NULL);
result = vlscm_scm_from_value (res_val);
do_cleanups (cleanups);
if (gdbscm_is_exception (result))
gdbscm_throw (result);
return result;
scoped_value_mark free_values;
return vlscm_scm_from_value (parse_and_eval (expr_str));
});
}
/* (history-ref integer) -> <gdb:value>
@ -1410,21 +1242,12 @@ static SCM
gdbscm_history_ref (SCM index)
{
int i;
struct value *res_val = NULL; /* Initialize to appease gcc warning. */
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "i", index, &i);
TRY
return gdbscm_wrap ([=]
{
res_val = access_value_history (i);
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION (except);
}
END_CATCH
return vlscm_scm_from_value (res_val);
return vlscm_scm_from_value (access_value_history (i));
});
}
/* (history-append! <gdb:value>) -> index
@ -1433,24 +1256,12 @@ gdbscm_history_ref (SCM index)
static SCM
gdbscm_history_append_x (SCM value)
{
int res_index = -1;
struct value *v;
value_smob *v_smob;
v_smob = vlscm_get_value_smob_arg_unsafe (value, SCM_ARG1, FUNC_NAME);
v = v_smob->value;
TRY
value_smob *v_smob
= vlscm_get_value_smob_arg_unsafe (value, SCM_ARG1, FUNC_NAME);
return gdbscm_wrap ([=]
{
res_index = record_latest_value (v);
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION (except);
}
END_CATCH
return scm_from_int (res_index);
return scm_from_int (record_latest_value (v_smob->value));
});
}
/* Initialize the Scheme value code. */