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
parent
42dc7699a2
commit
557e56be26
7 changed files with 412 additions and 575 deletions
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue