static SCM
gdbscm_register_parameter_x (SCM self)
{
param_smob *p_smob
= pascm_get_param_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
char *cmd_name;
struct cmd_list_element **set_list, **show_list;
if (pascm_is_valid (p_smob))
scm_misc_error (FUNC_NAME, _("parameter is already registered"), SCM_EOL);
cmd_name = gdbscm_parse_command_name (p_smob->name, FUNC_NAME, SCM_ARG1,
&set_list, &setlist);
xfree (cmd_name);
cmd_name = gdbscm_parse_command_name (p_smob->name, FUNC_NAME, SCM_ARG1,
&show_list, &showlist);
p_smob->cmd_name = gdbscm_gc_xstrdup (cmd_name);
xfree (cmd_name);
if (pascm_parameter_defined_p (p_smob->cmd_name, *set_list))
{
gdbscm_misc_error (FUNC_NAME, SCM_ARG1, self,
_("parameter exists, \"set\" command is already defined"));
}
if (pascm_parameter_defined_p (p_smob->cmd_name, *show_list))
{
gdbscm_misc_error (FUNC_NAME, SCM_ARG1, self,
_("parameter exists, \"show\" command is already defined"));
}
TRY
{
add_setshow_generic (p_smob->type, p_smob->cmd_class,
p_smob->cmd_name, p_smob,
p_smob->set_doc, p_smob->show_doc, p_smob->doc,
(gdbscm_is_procedure (p_smob->set_func)
? pascm_set_func : NULL),
(gdbscm_is_procedure (p_smob->show_func)
? pascm_show_func : NULL),
set_list, show_list,
&p_smob->set_command, &p_smob->show_command);
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION (except);
}
static SCM
gdbscm_make_breakpoint (SCM location_scm, SCM rest)
{
const SCM keywords[] = {
type_keyword, wp_class_keyword, internal_keyword, SCM_BOOL_F
};
char *s;
char *location;
int type_arg_pos = -1, access_type_arg_pos = -1, internal_arg_pos = -1;
enum bptype type = bp_breakpoint;
enum target_hw_bp_type access_type = hw_write;
int internal = 0;
SCM result;
breakpoint_smob *bp_smob;
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#iit",
location_scm, &location, rest,
&type_arg_pos, &type,
&access_type_arg_pos, &access_type,
&internal_arg_pos, &internal);
result = bpscm_make_breakpoint_smob ();
bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (result);
s = location;
location = gdbscm_gc_xstrdup (s);
xfree (s);
switch (type)
{
case bp_breakpoint:
if (access_type_arg_pos > 0)
{
gdbscm_misc_error (FUNC_NAME, access_type_arg_pos,
scm_from_int (access_type),
_("access type with breakpoint is not allowed"));
}
break;
case bp_watchpoint:
switch (access_type)
{
case hw_write:
case hw_access:
case hw_read:
break;
default:
gdbscm_out_of_range_error (FUNC_NAME, access_type_arg_pos,
scm_from_int (access_type),
_("invalid watchpoint class"));
}
break;
default:
gdbscm_out_of_range_error (FUNC_NAME, access_type_arg_pos,
scm_from_int (type),
_("invalid breakpoint type"));
}
bp_smob->is_scheme_bkpt = 1;
bp_smob->spec.location = location;
bp_smob->spec.type = type;
bp_smob->spec.access_type = access_type;
bp_smob->spec.is_internal = internal;
return result;
}
static SCM
gdbscm_make_parameter (SCM name_scm, SCM rest)
{
const SCM keywords[] = {
command_class_keyword, parameter_type_keyword, enum_list_keyword,
set_func_keyword, show_func_keyword,
doc_keyword, set_doc_keyword, show_doc_keyword,
initial_value_keyword, SCM_BOOL_F
};
int cmd_class_arg_pos = -1, param_type_arg_pos = -1;
int enum_list_arg_pos = -1, set_func_arg_pos = -1, show_func_arg_pos = -1;
int doc_arg_pos = -1, set_doc_arg_pos = -1, show_doc_arg_pos = -1;
int initial_value_arg_pos = -1;
char *s;
char *name;
int cmd_class = no_class;
int param_type = var_boolean; /* ARI: var_boolean */
SCM enum_list_scm = SCM_BOOL_F;
SCM set_func = SCM_BOOL_F, show_func = SCM_BOOL_F;
char *doc = NULL, *set_doc = NULL, *show_doc = NULL;
SCM initial_value_scm = SCM_BOOL_F;
const char * const *enum_list = NULL;
SCM p_scm;
param_smob *p_smob;
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#iiOOOsssO",
name_scm, &name, rest,
&cmd_class_arg_pos, &cmd_class,
¶m_type_arg_pos, ¶m_type,
&enum_list_arg_pos, &enum_list_scm,
&set_func_arg_pos, &set_func,
&show_func_arg_pos, &show_func,
&doc_arg_pos, &doc,
&set_doc_arg_pos, &set_doc,
&show_doc_arg_pos, &show_doc,
&initial_value_arg_pos, &initial_value_scm);
/* If doc is NULL, leave it NULL. See add_setshow_cmd_full. */
if (set_doc == NULL)
set_doc = get_doc_string ();
if (show_doc == NULL)
show_doc = get_doc_string ();
s = name;
name = gdbscm_canonicalize_command_name (s, 0);
xfree (s);
if (doc != NULL)
{
s = doc;
doc = gdbscm_gc_xstrdup (s);
xfree (s);
}
s = set_doc;
set_doc = gdbscm_gc_xstrdup (s);
xfree (s);
s = show_doc;
show_doc = gdbscm_gc_xstrdup (s);
xfree (s);
if (!gdbscm_valid_command_class_p (cmd_class))
{
gdbscm_out_of_range_error (FUNC_NAME, cmd_class_arg_pos,
scm_from_int (cmd_class),
_("invalid command class argument"));
}
if (!pascm_valid_parameter_type_p (param_type))
{
gdbscm_out_of_range_error (FUNC_NAME, param_type_arg_pos,
scm_from_int (param_type),
_("invalid parameter type argument"));
}
if (enum_list_arg_pos > 0 && param_type != var_enum)
{
gdbscm_misc_error (FUNC_NAME, enum_list_arg_pos, enum_list_scm,
_("#:enum-values can only be provided with PARAM_ENUM"));
}
if (enum_list_arg_pos < 0 && param_type == var_enum)
{
gdbscm_misc_error (FUNC_NAME, GDBSCM_ARG_NONE, SCM_BOOL_F,
_("PARAM_ENUM requires an enum-values argument"));
}
if (set_func_arg_pos > 0)
{
SCM_ASSERT_TYPE (gdbscm_is_procedure (set_func), set_func,
set_func_arg_pos, FUNC_NAME, _("procedure"));
}
if (show_func_arg_pos > 0)
{
SCM_ASSERT_TYPE (gdbscm_is_procedure (show_func), show_func,
show_func_arg_pos, FUNC_NAME, _("procedure"));
}
if (param_type == var_enum)
{
/* Note: enum_list lives in GC space, so we don't have to worry about
freeing it if we later throw an exception. */
enum_list = compute_enum_list (enum_list_scm, enum_list_arg_pos,
FUNC_NAME);
}
/* If initial-value is a function, we need the parameter object constructed
to pass it to the function. A typical thing the function may want to do
is add an object-property to it to record the last known good value. */
p_scm = pascm_make_param_smob ();
p_smob = (param_smob *) SCM_SMOB_DATA (p_scm);
/* These are all stored in GC space so that we don't have to worry about
freeing them if we throw an exception. */
p_smob->name = name;
p_smob->cmd_class = (enum command_class) cmd_class;
p_smob->type = (enum var_types) param_type;
p_smob->doc = doc;
p_smob->set_doc = set_doc;
p_smob->show_doc = show_doc;
p_smob->enumeration = enum_list;
p_smob->set_func = set_func;
p_smob->show_func = show_func;
if (initial_value_arg_pos > 0)
{
if (gdbscm_is_procedure (initial_value_scm))
{
initial_value_scm = gdbscm_safe_call_1 (initial_value_scm,
p_smob->containing_scm, NULL);
if (gdbscm_is_exception (initial_value_scm))
gdbscm_throw (initial_value_scm);
}
pascm_set_param_value_x (p_smob->type, &p_smob->value, enum_list,
initial_value_scm,
initial_value_arg_pos, FUNC_NAME);
}
return p_scm;
}
