2014-06-03 10:58:15 +02:00
|
|
|
|
/* GDB parameters implemented in Guile.
|
|
|
|
|
|
|
|
|
|
Copyright (C) 2008-2014 Free Software Foundation, Inc.
|
|
|
|
|
|
|
|
|
|
This file is part of GDB.
|
|
|
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
|
|
|
it under the terms of the GNU General Public License as published by
|
|
|
|
|
the Free Software Foundation; either version 3 of the License, or
|
|
|
|
|
(at your option) any later version.
|
|
|
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
|
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
GNU General Public License for more details.
|
|
|
|
|
|
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
|
|
|
along with this program. If not, see <http://www.gnu.org/licenses/>. */
|
|
|
|
|
|
|
|
|
|
#include "defs.h"
|
|
|
|
|
#include "value.h"
|
|
|
|
|
#include "exceptions.h"
|
|
|
|
|
#include "charset.h"
|
|
|
|
|
#include "gdbcmd.h"
|
|
|
|
|
#include "cli/cli-decode.h"
|
|
|
|
|
#include "completer.h"
|
|
|
|
|
#include "language.h"
|
|
|
|
|
#include "arch-utils.h"
|
|
|
|
|
#include "guile-internal.h"
|
|
|
|
|
|
|
|
|
|
/* A union that can hold anything described by enum var_types. */
|
|
|
|
|
|
|
|
|
|
union pascm_variable
|
|
|
|
|
{
|
|
|
|
|
/* Hold an integer value, for boolean and integer types. */
|
|
|
|
|
int intval;
|
|
|
|
|
|
|
|
|
|
/* Hold an auto_boolean. */
|
|
|
|
|
enum auto_boolean autoboolval;
|
|
|
|
|
|
|
|
|
|
/* Hold an unsigned integer value, for uinteger. */
|
|
|
|
|
unsigned int uintval;
|
|
|
|
|
|
|
|
|
|
/* Hold a string, for the various string types. */
|
|
|
|
|
char *stringval;
|
|
|
|
|
|
|
|
|
|
/* Hold a string, for enums. */
|
|
|
|
|
const char *cstringval;
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
/* A GDB parameter.
|
|
|
|
|
|
|
|
|
|
Note: Parameters are added to gdb using a two step process:
|
|
|
|
|
1) Call make-parameter to create a <gdb:parameter> object.
|
|
|
|
|
2) Call register-parameter! to add the parameter to gdb.
|
|
|
|
|
It is done this way so that the constructor, make-parameter, doesn't have
|
|
|
|
|
any side-effects. This means that the smob needs to store everything
|
|
|
|
|
that was passed to make-parameter.
|
|
|
|
|
|
|
|
|
|
N.B. There is no free function for this smob.
|
|
|
|
|
All objects pointed to by this smob must live in GC space. */
|
|
|
|
|
|
|
|
|
|
typedef struct _param_smob
|
|
|
|
|
{
|
|
|
|
|
/* This always appears first. */
|
|
|
|
|
gdb_smob base;
|
|
|
|
|
|
|
|
|
|
/* The parameter name. */
|
|
|
|
|
char *name;
|
|
|
|
|
|
|
|
|
|
/* The last word of the command.
|
|
|
|
|
This is needed because add_cmd requires us to allocate space
|
|
|
|
|
for it. :-( */
|
|
|
|
|
char *cmd_name;
|
|
|
|
|
|
|
|
|
|
/* One of the COMMAND_* constants. */
|
|
|
|
|
enum command_class cmd_class;
|
|
|
|
|
|
|
|
|
|
/* The type of the parameter. */
|
|
|
|
|
enum var_types type;
|
|
|
|
|
|
|
|
|
|
/* The docs for the parameter. */
|
|
|
|
|
char *set_doc;
|
|
|
|
|
char *show_doc;
|
|
|
|
|
char *doc;
|
|
|
|
|
|
|
|
|
|
/* The corresponding gdb command objects.
|
|
|
|
|
These are NULL if the parameter has not been registered yet, or
|
|
|
|
|
is no longer registered. */
|
|
|
|
|
struct cmd_list_element *set_command;
|
|
|
|
|
struct cmd_list_element *show_command;
|
|
|
|
|
|
|
|
|
|
/* The value of the parameter. */
|
|
|
|
|
union pascm_variable value;
|
|
|
|
|
|
|
|
|
|
/* For an enum parameter, the possible values. The vector lives in GC
|
|
|
|
|
space, it will be freed with the smob. */
|
|
|
|
|
const char * const *enumeration;
|
|
|
|
|
|
|
|
|
|
/* The set_func funcion or #f if not specified.
|
|
|
|
|
This function is called *after* the parameter is set.
|
|
|
|
|
It returns a string that will be displayed to the user. */
|
|
|
|
|
SCM set_func;
|
|
|
|
|
|
|
|
|
|
/* The show_func function or #f if not specified.
|
|
|
|
|
This function returns the string that is printed. */
|
|
|
|
|
SCM show_func;
|
|
|
|
|
|
|
|
|
|
/* The <gdb:parameter> object we are contained in, needed to
|
|
|
|
|
protect/unprotect the object since a reference to it comes from
|
|
|
|
|
non-gc-managed space (the command context pointer). */
|
|
|
|
|
SCM containing_scm;
|
|
|
|
|
} param_smob;
|
|
|
|
|
|
|
|
|
|
static const char param_smob_name[] = "gdb:parameter";
|
|
|
|
|
|
|
|
|
|
/* The tag Guile knows the param smob by. */
|
|
|
|
|
static scm_t_bits parameter_smob_tag;
|
|
|
|
|
|
|
|
|
|
/* Keywords used by make-parameter!. */
|
|
|
|
|
static SCM command_class_keyword;
|
|
|
|
|
static SCM parameter_type_keyword;
|
|
|
|
|
static SCM enum_list_keyword;
|
|
|
|
|
static SCM set_func_keyword;
|
|
|
|
|
static SCM show_func_keyword;
|
|
|
|
|
static SCM doc_keyword;
|
|
|
|
|
static SCM set_doc_keyword;
|
|
|
|
|
static SCM show_doc_keyword;
|
|
|
|
|
static SCM initial_value_keyword;
|
|
|
|
|
static SCM auto_keyword;
|
|
|
|
|
static SCM unlimited_keyword;
|
|
|
|
|
|
|
|
|
|
static int pascm_is_valid (param_smob *);
|
|
|
|
|
static const char *pascm_param_type_name (enum var_types type);
|
|
|
|
|
static SCM pascm_param_value (enum var_types type, void *var,
|
|
|
|
|
int arg_pos, const char *func_name);
|
|
|
|
|
|
|
|
|
|
/* Administrivia for parameter smobs. */
|
|
|
|
|
|
|
|
|
|
static int
|
|
|
|
|
pascm_print_param_smob (SCM self, SCM port, scm_print_state *pstate)
|
|
|
|
|
{
|
|
|
|
|
param_smob *p_smob = (param_smob *) SCM_SMOB_DATA (self);
|
|
|
|
|
SCM value;
|
|
|
|
|
|
|
|
|
|
gdbscm_printf (port, "#<%s", param_smob_name);
|
|
|
|
|
|
|
|
|
|
gdbscm_printf (port, " %s", p_smob->name);
|
|
|
|
|
|
|
|
|
|
if (! pascm_is_valid (p_smob))
|
|
|
|
|
scm_puts (" {invalid}", port);
|
|
|
|
|
|
|
|
|
|
gdbscm_printf (port, " %s", pascm_param_type_name (p_smob->type));
|
|
|
|
|
|
|
|
|
|
value = pascm_param_value (p_smob->type, &p_smob->value,
|
|
|
|
|
GDBSCM_ARG_NONE, NULL);
|
|
|
|
|
scm_display (value, port);
|
|
|
|
|
|
|
|
|
|
scm_puts (">", port);
|
|
|
|
|
|
|
|
|
|
scm_remember_upto_here_1 (self);
|
|
|
|
|
|
|
|
|
|
/* Non-zero means success. */
|
|
|
|
|
return 1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Create an empty (uninitialized) parameter. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
pascm_make_param_smob (void)
|
|
|
|
|
{
|
|
|
|
|
param_smob *p_smob = (param_smob *)
|
|
|
|
|
scm_gc_malloc (sizeof (param_smob), param_smob_name);
|
|
|
|
|
SCM p_scm;
|
|
|
|
|
|
|
|
|
|
memset (p_smob, 0, sizeof (*p_smob));
|
|
|
|
|
p_smob->cmd_class = no_class;
|
2014-06-04 05:37:56 +02:00
|
|
|
|
p_smob->type = var_boolean; /* ARI: var_boolean */
|
2014-06-03 10:58:15 +02:00
|
|
|
|
p_smob->set_func = SCM_BOOL_F;
|
|
|
|
|
p_smob->show_func = SCM_BOOL_F;
|
|
|
|
|
p_scm = scm_new_smob (parameter_smob_tag, (scm_t_bits) p_smob);
|
|
|
|
|
p_smob->containing_scm = p_scm;
|
|
|
|
|
gdbscm_init_gsmob (&p_smob->base);
|
|
|
|
|
|
|
|
|
|
return p_scm;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Returns non-zero if SCM is a <gdb:parameter> object. */
|
|
|
|
|
|
|
|
|
|
static int
|
|
|
|
|
pascm_is_parameter (SCM scm)
|
|
|
|
|
{
|
|
|
|
|
return SCM_SMOB_PREDICATE (parameter_smob_tag, scm);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (gdb:parameter? scm) -> boolean */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_parameter_p (SCM scm)
|
|
|
|
|
{
|
|
|
|
|
return scm_from_bool (pascm_is_parameter (scm));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Returns the <gdb:parameter> object in SELF.
|
|
|
|
|
Throws an exception if SELF is not a <gdb:parameter> object. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
pascm_get_param_arg_unsafe (SCM self, int arg_pos, const char *func_name)
|
|
|
|
|
{
|
|
|
|
|
SCM_ASSERT_TYPE (pascm_is_parameter (self), self, arg_pos, func_name,
|
|
|
|
|
param_smob_name);
|
|
|
|
|
|
|
|
|
|
return self;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Returns a pointer to the parameter smob of SELF.
|
|
|
|
|
Throws an exception if SELF is not a <gdb:parameter> object. */
|
|
|
|
|
|
|
|
|
|
static param_smob *
|
|
|
|
|
pascm_get_param_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
|
|
|
|
|
{
|
|
|
|
|
SCM p_scm = pascm_get_param_arg_unsafe (self, arg_pos, func_name);
|
|
|
|
|
param_smob *p_smob = (param_smob *) SCM_SMOB_DATA (p_scm);
|
|
|
|
|
|
|
|
|
|
return p_smob;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Return non-zero if parameter P_SMOB is valid. */
|
|
|
|
|
|
|
|
|
|
static int
|
|
|
|
|
pascm_is_valid (param_smob *p_smob)
|
|
|
|
|
{
|
|
|
|
|
return p_smob->set_command != NULL;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* A helper function which return the default documentation string for
|
|
|
|
|
a parameter (which is to say that it's undocumented). */
|
|
|
|
|
|
|
|
|
|
static char *
|
|
|
|
|
get_doc_string (void)
|
|
|
|
|
{
|
|
|
|
|
return xstrdup (_("This command is not documented."));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Subroutine of pascm_set_func, pascm_show_func to simplify them.
|
|
|
|
|
Signal the error returned from calling set_func/show_func. */
|
|
|
|
|
|
|
|
|
|
static void
|
|
|
|
|
pascm_signal_setshow_error (SCM exception, const char *msg)
|
|
|
|
|
{
|
|
|
|
|
/* Don't print the stack if this was an error signalled by the command
|
|
|
|
|
itself. */
|
|
|
|
|
if (gdbscm_user_error_p (gdbscm_exception_key (exception)))
|
|
|
|
|
{
|
|
|
|
|
char *excp_text = gdbscm_exception_message_to_string (exception);
|
|
|
|
|
|
|
|
|
|
make_cleanup (xfree, excp_text);
|
|
|
|
|
error ("%s", excp_text);
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
{
|
|
|
|
|
gdbscm_print_gdb_exception (SCM_BOOL_F, exception);
|
|
|
|
|
error ("%s", msg);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* A callback function that is registered against the respective
|
|
|
|
|
add_setshow_* set_func prototype. This function will call
|
|
|
|
|
the Scheme function "set_func" which must exist.
|
|
|
|
|
Note: ARGS is always passed as NULL. */
|
|
|
|
|
|
|
|
|
|
static void
|
|
|
|
|
pascm_set_func (char *args, int from_tty, struct cmd_list_element *c)
|
|
|
|
|
{
|
|
|
|
|
param_smob *p_smob = (param_smob *) get_cmd_context (c);
|
|
|
|
|
SCM self, result, exception;
|
|
|
|
|
char *msg;
|
|
|
|
|
struct cleanup *cleanups;
|
|
|
|
|
|
|
|
|
|
gdb_assert (gdbscm_is_procedure (p_smob->set_func));
|
|
|
|
|
|
|
|
|
|
self = p_smob->containing_scm;
|
|
|
|
|
|
|
|
|
|
result = gdbscm_safe_call_1 (p_smob->set_func, self, gdbscm_user_error_p);
|
|
|
|
|
|
|
|
|
|
if (gdbscm_is_exception (result))
|
|
|
|
|
{
|
|
|
|
|
pascm_signal_setshow_error (result,
|
|
|
|
|
_("Error occurred setting parameter."));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
if (!scm_is_string (result))
|
|
|
|
|
error (_("Result of %s set-func is not a string."), p_smob->name);
|
|
|
|
|
|
|
|
|
|
msg = gdbscm_scm_to_host_string (result, NULL, &exception);
|
|
|
|
|
if (msg == NULL)
|
|
|
|
|
{
|
|
|
|
|
gdbscm_print_gdb_exception (SCM_BOOL_F, exception);
|
|
|
|
|
error (_("Error converting show text to host string."));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
cleanups = make_cleanup (xfree, msg);
|
|
|
|
|
/* GDB is usually silent when a parameter is set. */
|
|
|
|
|
if (*msg != '\0')
|
|
|
|
|
fprintf_filtered (gdb_stdout, "%s\n", msg);
|
|
|
|
|
do_cleanups (cleanups);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* A callback function that is registered against the respective
|
|
|
|
|
add_setshow_* show_func prototype. This function will call
|
|
|
|
|
the Scheme function "show_func" which must exist and must return a
|
|
|
|
|
string that is then printed to FILE. */
|
|
|
|
|
|
|
|
|
|
static void
|
|
|
|
|
pascm_show_func (struct ui_file *file, int from_tty,
|
|
|
|
|
struct cmd_list_element *c, const char *value)
|
|
|
|
|
{
|
|
|
|
|
param_smob *p_smob = (param_smob *) get_cmd_context (c);
|
|
|
|
|
SCM value_scm, self, result, exception;
|
|
|
|
|
char *msg;
|
|
|
|
|
struct cleanup *cleanups;
|
|
|
|
|
|
|
|
|
|
gdb_assert (gdbscm_is_procedure (p_smob->show_func));
|
|
|
|
|
|
|
|
|
|
value_scm = gdbscm_scm_from_host_string (value, strlen (value));
|
|
|
|
|
if (gdbscm_is_exception (value_scm))
|
|
|
|
|
{
|
|
|
|
|
error (_("Error converting parameter value \"%s\" to Scheme string."),
|
|
|
|
|
value);
|
|
|
|
|
}
|
|
|
|
|
self = p_smob->containing_scm;
|
|
|
|
|
|
|
|
|
|
result = gdbscm_safe_call_2 (p_smob->show_func, self, value_scm,
|
|
|
|
|
gdbscm_user_error_p);
|
|
|
|
|
|
|
|
|
|
if (gdbscm_is_exception (result))
|
|
|
|
|
{
|
|
|
|
|
pascm_signal_setshow_error (result,
|
|
|
|
|
_("Error occurred showing parameter."));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
msg = gdbscm_scm_to_host_string (result, NULL, &exception);
|
|
|
|
|
if (msg == NULL)
|
|
|
|
|
{
|
|
|
|
|
gdbscm_print_gdb_exception (SCM_BOOL_F, exception);
|
|
|
|
|
error (_("Error converting show text to host string."));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
cleanups = make_cleanup (xfree, msg);
|
|
|
|
|
fprintf_filtered (file, "%s\n", msg);
|
|
|
|
|
do_cleanups (cleanups);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* A helper function that dispatches to the appropriate add_setshow
|
|
|
|
|
function. */
|
|
|
|
|
|
|
|
|
|
static void
|
|
|
|
|
add_setshow_generic (enum var_types param_type, enum command_class cmd_class,
|
|
|
|
|
char *cmd_name, param_smob *self,
|
|
|
|
|
char *set_doc, char *show_doc, char *help_doc,
|
|
|
|
|
cmd_sfunc_ftype *set_func,
|
|
|
|
|
show_value_ftype *show_func,
|
|
|
|
|
struct cmd_list_element **set_list,
|
|
|
|
|
struct cmd_list_element **show_list,
|
|
|
|
|
struct cmd_list_element **set_cmd,
|
|
|
|
|
struct cmd_list_element **show_cmd)
|
|
|
|
|
{
|
|
|
|
|
struct cmd_list_element *param = NULL;
|
|
|
|
|
const char *tmp_name = NULL;
|
|
|
|
|
|
|
|
|
|
switch (param_type)
|
|
|
|
|
{
|
|
|
|
|
case var_boolean:
|
|
|
|
|
add_setshow_boolean_cmd (cmd_name, cmd_class,
|
|
|
|
|
&self->value.intval,
|
|
|
|
|
set_doc, show_doc, help_doc,
|
|
|
|
|
set_func, show_func,
|
|
|
|
|
set_list, show_list);
|
|
|
|
|
|
|
|
|
|
break;
|
|
|
|
|
|
|
|
|
|
case var_auto_boolean:
|
|
|
|
|
add_setshow_auto_boolean_cmd (cmd_name, cmd_class,
|
|
|
|
|
&self->value.autoboolval,
|
|
|
|
|
set_doc, show_doc, help_doc,
|
|
|
|
|
set_func, show_func,
|
|
|
|
|
set_list, show_list);
|
|
|
|
|
break;
|
|
|
|
|
|
|
|
|
|
case var_uinteger:
|
|
|
|
|
add_setshow_uinteger_cmd (cmd_name, cmd_class,
|
|
|
|
|
&self->value.uintval,
|
|
|
|
|
set_doc, show_doc, help_doc,
|
|
|
|
|
set_func, show_func,
|
|
|
|
|
set_list, show_list);
|
|
|
|
|
break;
|
|
|
|
|
|
|
|
|
|
case var_zinteger:
|
|
|
|
|
add_setshow_zinteger_cmd (cmd_name, cmd_class,
|
|
|
|
|
&self->value.intval,
|
|
|
|
|
set_doc, show_doc, help_doc,
|
|
|
|
|
set_func, show_func,
|
|
|
|
|
set_list, show_list);
|
|
|
|
|
break;
|
|
|
|
|
|
|
|
|
|
case var_zuinteger:
|
|
|
|
|
add_setshow_zuinteger_cmd (cmd_name, cmd_class,
|
|
|
|
|
&self->value.uintval,
|
|
|
|
|
set_doc, show_doc, help_doc,
|
|
|
|
|
set_func, show_func,
|
|
|
|
|
set_list, show_list);
|
|
|
|
|
break;
|
|
|
|
|
|
|
|
|
|
case var_zuinteger_unlimited:
|
|
|
|
|
add_setshow_zuinteger_unlimited_cmd (cmd_name, cmd_class,
|
|
|
|
|
&self->value.intval,
|
|
|
|
|
set_doc, show_doc, help_doc,
|
|
|
|
|
set_func, show_func,
|
|
|
|
|
set_list, show_list);
|
|
|
|
|
break;
|
|
|
|
|
|
|
|
|
|
case var_string:
|
|
|
|
|
add_setshow_string_cmd (cmd_name, cmd_class,
|
|
|
|
|
&self->value.stringval,
|
|
|
|
|
set_doc, show_doc, help_doc,
|
|
|
|
|
set_func, show_func,
|
|
|
|
|
set_list, show_list);
|
|
|
|
|
break;
|
|
|
|
|
|
|
|
|
|
case var_string_noescape:
|
|
|
|
|
add_setshow_string_noescape_cmd (cmd_name, cmd_class,
|
|
|
|
|
&self->value.stringval,
|
|
|
|
|
set_doc, show_doc, help_doc,
|
|
|
|
|
set_func, show_func,
|
|
|
|
|
set_list, show_list);
|
|
|
|
|
|
|
|
|
|
break;
|
|
|
|
|
|
|
|
|
|
case var_optional_filename:
|
|
|
|
|
add_setshow_optional_filename_cmd (cmd_name, cmd_class,
|
|
|
|
|
&self->value.stringval,
|
|
|
|
|
set_doc, show_doc, help_doc,
|
|
|
|
|
set_func, show_func,
|
|
|
|
|
set_list, show_list);
|
|
|
|
|
break;
|
|
|
|
|
|
|
|
|
|
case var_filename:
|
|
|
|
|
add_setshow_filename_cmd (cmd_name, cmd_class,
|
|
|
|
|
&self->value.stringval,
|
|
|
|
|
set_doc, show_doc, help_doc,
|
|
|
|
|
set_func, show_func,
|
|
|
|
|
set_list, show_list);
|
|
|
|
|
break;
|
|
|
|
|
|
|
|
|
|
case var_enum:
|
|
|
|
|
add_setshow_enum_cmd (cmd_name, cmd_class,
|
|
|
|
|
self->enumeration,
|
|
|
|
|
&self->value.cstringval,
|
|
|
|
|
set_doc, show_doc, help_doc,
|
|
|
|
|
set_func, show_func,
|
|
|
|
|
set_list, show_list);
|
|
|
|
|
/* Initialize the value, just in case. */
|
|
|
|
|
self->value.cstringval = self->enumeration[0];
|
|
|
|
|
break;
|
|
|
|
|
|
|
|
|
|
default:
|
|
|
|
|
gdb_assert_not_reached ("bad param_type value");
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Lookup created parameter, and register Scheme object against the
|
|
|
|
|
parameter context. Perform this task against both lists. */
|
|
|
|
|
tmp_name = cmd_name;
|
|
|
|
|
param = lookup_cmd (&tmp_name, *show_list, "", 0, 1);
|
|
|
|
|
gdb_assert (param != NULL);
|
|
|
|
|
set_cmd_context (param, self);
|
|
|
|
|
*set_cmd = param;
|
|
|
|
|
|
|
|
|
|
tmp_name = cmd_name;
|
|
|
|
|
param = lookup_cmd (&tmp_name, *set_list, "", 0, 1);
|
|
|
|
|
gdb_assert (param != NULL);
|
|
|
|
|
set_cmd_context (param, self);
|
|
|
|
|
*show_cmd = param;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Return an array of strings corresponding to the enum values for
|
|
|
|
|
ENUM_VALUES_SCM.
|
|
|
|
|
Throws an exception if there's a problem with the values.
|
|
|
|
|
Space for the result is allocated from the GC heap. */
|
|
|
|
|
|
|
|
|
|
static const char * const *
|
|
|
|
|
compute_enum_list (SCM enum_values_scm, int arg_pos, const char *func_name)
|
|
|
|
|
{
|
|
|
|
|
long i, size;
|
|
|
|
|
char **enum_values;
|
|
|
|
|
const char * const *result;
|
|
|
|
|
|
|
|
|
|
SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (enum_values_scm)),
|
|
|
|
|
enum_values_scm, arg_pos, func_name, _("list"));
|
|
|
|
|
|
|
|
|
|
size = scm_ilength (enum_values_scm);
|
|
|
|
|
if (size == 0)
|
|
|
|
|
{
|
|
|
|
|
gdbscm_out_of_range_error (FUNC_NAME, arg_pos, enum_values_scm,
|
|
|
|
|
_("enumeration list is empty"));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
enum_values = xmalloc ((size + 1) * sizeof (char *));
|
|
|
|
|
memset (enum_values, 0, (size + 1) * sizeof (char *));
|
|
|
|
|
|
|
|
|
|
i = 0;
|
|
|
|
|
while (!scm_is_eq (enum_values_scm, SCM_EOL))
|
|
|
|
|
{
|
|
|
|
|
SCM value = scm_car (enum_values_scm);
|
|
|
|
|
SCM exception;
|
|
|
|
|
|
|
|
|
|
if (!scm_is_string (value))
|
|
|
|
|
{
|
|
|
|
|
freeargv (enum_values);
|
|
|
|
|
SCM_ASSERT_TYPE (0, value, arg_pos, func_name, _("string"));
|
|
|
|
|
}
|
|
|
|
|
enum_values[i] = gdbscm_scm_to_host_string (value, NULL, &exception);
|
|
|
|
|
if (enum_values[i] == NULL)
|
|
|
|
|
{
|
|
|
|
|
freeargv (enum_values);
|
|
|
|
|
gdbscm_throw (exception);
|
|
|
|
|
}
|
|
|
|
|
++i;
|
|
|
|
|
enum_values_scm = scm_cdr (enum_values_scm);
|
|
|
|
|
}
|
|
|
|
|
gdb_assert (i == size);
|
|
|
|
|
|
|
|
|
|
result = gdbscm_gc_dup_argv (enum_values);
|
|
|
|
|
freeargv (enum_values);
|
|
|
|
|
return result;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
static const scheme_integer_constant parameter_types[] =
|
|
|
|
|
{
|
|
|
|
|
/* Note: var_integer is deprecated, and intentionally does not
|
|
|
|
|
appear here. */
|
|
|
|
|
{ "PARAM_BOOLEAN", var_boolean }, /* ARI: var_boolean */
|
|
|
|
|
{ "PARAM_AUTO_BOOLEAN", var_auto_boolean },
|
|
|
|
|
{ "PARAM_ZINTEGER", var_zinteger },
|
|
|
|
|
{ "PARAM_UINTEGER", var_uinteger },
|
|
|
|
|
{ "PARAM_ZUINTEGER", var_zuinteger },
|
|
|
|
|
{ "PARAM_ZUINTEGER_UNLIMITED", var_zuinteger_unlimited },
|
|
|
|
|
{ "PARAM_STRING", var_string },
|
|
|
|
|
{ "PARAM_STRING_NOESCAPE", var_string_noescape },
|
|
|
|
|
{ "PARAM_OPTIONAL_FILENAME", var_optional_filename },
|
|
|
|
|
{ "PARAM_FILENAME", var_filename },
|
|
|
|
|
{ "PARAM_ENUM", var_enum },
|
|
|
|
|
|
|
|
|
|
END_INTEGER_CONSTANTS
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
/* Return non-zero if PARAM_TYPE is a valid parameter type. */
|
|
|
|
|
|
|
|
|
|
static int
|
|
|
|
|
pascm_valid_parameter_type_p (int param_type)
|
|
|
|
|
{
|
|
|
|
|
int i;
|
|
|
|
|
|
|
|
|
|
for (i = 0; parameter_types[i].name != NULL; ++i)
|
|
|
|
|
{
|
|
|
|
|
if (parameter_types[i].value == param_type)
|
|
|
|
|
return 1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return 0;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Return PARAM_TYPE as a string. */
|
|
|
|
|
|
|
|
|
|
static const char *
|
|
|
|
|
pascm_param_type_name (enum var_types param_type)
|
|
|
|
|
{
|
|
|
|
|
int i;
|
|
|
|
|
|
|
|
|
|
for (i = 0; parameter_types[i].name != NULL; ++i)
|
|
|
|
|
{
|
|
|
|
|
if (parameter_types[i].value == param_type)
|
|
|
|
|
return parameter_types[i].name;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
gdb_assert_not_reached ("bad parameter type");
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Return the value of a gdb parameter as a Scheme value.
|
|
|
|
|
If TYPE is not supported, then a <gdb:exception> object is returned. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
pascm_param_value (enum var_types type, void *var,
|
|
|
|
|
int arg_pos, const char *func_name)
|
|
|
|
|
{
|
|
|
|
|
/* Note: We *could* support var_integer here in case someone is trying to get
|
|
|
|
|
the value of a Python-created parameter (which is the only place that
|
|
|
|
|
still supports var_integer). To further discourage its use we do not. */
|
|
|
|
|
|
|
|
|
|
switch (type)
|
|
|
|
|
{
|
|
|
|
|
case var_string:
|
|
|
|
|
case var_string_noescape:
|
|
|
|
|
case var_optional_filename:
|
|
|
|
|
case var_filename:
|
|
|
|
|
case var_enum:
|
|
|
|
|
{
|
|
|
|
|
char *str = * (char **) var;
|
|
|
|
|
|
|
|
|
|
if (str == NULL)
|
|
|
|
|
str = "";
|
|
|
|
|
return gdbscm_scm_from_host_string (str, strlen (str));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
case var_boolean:
|
|
|
|
|
{
|
|
|
|
|
if (* (int *) var)
|
|
|
|
|
return SCM_BOOL_T;
|
|
|
|
|
else
|
|
|
|
|
return SCM_BOOL_F;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
case var_auto_boolean:
|
|
|
|
|
{
|
|
|
|
|
enum auto_boolean ab = * (enum auto_boolean *) var;
|
|
|
|
|
|
|
|
|
|
if (ab == AUTO_BOOLEAN_TRUE)
|
|
|
|
|
return SCM_BOOL_T;
|
|
|
|
|
else if (ab == AUTO_BOOLEAN_FALSE)
|
|
|
|
|
return SCM_BOOL_F;
|
|
|
|
|
else
|
|
|
|
|
return auto_keyword;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
case var_zuinteger_unlimited:
|
|
|
|
|
if (* (int *) var == -1)
|
|
|
|
|
return unlimited_keyword;
|
|
|
|
|
gdb_assert (* (int *) var >= 0);
|
|
|
|
|
/* Fall through. */
|
|
|
|
|
case var_zinteger:
|
|
|
|
|
return scm_from_int (* (int *) var);
|
|
|
|
|
|
|
|
|
|
case var_uinteger:
|
|
|
|
|
if (* (unsigned int *) var == UINT_MAX)
|
|
|
|
|
return unlimited_keyword;
|
|
|
|
|
/* Fall through. */
|
|
|
|
|
case var_zuinteger:
|
|
|
|
|
return scm_from_uint (* (unsigned int *) var);
|
|
|
|
|
|
|
|
|
|
default:
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return gdbscm_make_out_of_range_error (func_name, arg_pos,
|
|
|
|
|
scm_from_int (type),
|
|
|
|
|
_("program error: unhandled type"));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Set the value of a parameter of type TYPE in VAR from VALUE.
|
|
|
|
|
ENUMERATION is the list of enum values for enum parameters, otherwise NULL.
|
|
|
|
|
Throws a Scheme exception if VALUE_SCM is invalid for TYPE. */
|
|
|
|
|
|
|
|
|
|
static void
|
|
|
|
|
pascm_set_param_value_x (enum var_types type, union pascm_variable *var,
|
|
|
|
|
const char * const *enumeration,
|
|
|
|
|
SCM value, int arg_pos, const char *func_name)
|
|
|
|
|
{
|
|
|
|
|
switch (type)
|
|
|
|
|
{
|
|
|
|
|
case var_string:
|
|
|
|
|
case var_string_noescape:
|
|
|
|
|
case var_optional_filename:
|
|
|
|
|
case var_filename:
|
|
|
|
|
SCM_ASSERT_TYPE (scm_is_string (value)
|
|
|
|
|
|| (type != var_filename
|
|
|
|
|
&& gdbscm_is_false (value)),
|
|
|
|
|
value, arg_pos, func_name,
|
|
|
|
|
_("string or #f for non-PARAM_FILENAME parameters"));
|
|
|
|
|
if (gdbscm_is_false (value))
|
|
|
|
|
{
|
|
|
|
|
xfree (var->stringval);
|
|
|
|
|
if (type == var_optional_filename)
|
|
|
|
|
var->stringval = xstrdup ("");
|
|
|
|
|
else
|
|
|
|
|
var->stringval = NULL;
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
{
|
|
|
|
|
char *string;
|
|
|
|
|
SCM exception;
|
|
|
|
|
|
|
|
|
|
string = gdbscm_scm_to_host_string (value, NULL, &exception);
|
|
|
|
|
if (string == NULL)
|
|
|
|
|
gdbscm_throw (exception);
|
|
|
|
|
xfree (var->stringval);
|
|
|
|
|
var->stringval = string;
|
|
|
|
|
}
|
|
|
|
|
break;
|
|
|
|
|
|
|
|
|
|
case var_enum:
|
|
|
|
|
{
|
|
|
|
|
int i;
|
|
|
|
|
char *str;
|
|
|
|
|
SCM exception;
|
|
|
|
|
|
|
|
|
|
SCM_ASSERT_TYPE (scm_is_string (value), value, arg_pos, func_name,
|
|
|
|
|
_("string"));
|
|
|
|
|
str = gdbscm_scm_to_host_string (value, NULL, &exception);
|
|
|
|
|
if (str == NULL)
|
|
|
|
|
gdbscm_throw (exception);
|
|
|
|
|
for (i = 0; enumeration[i]; ++i)
|
|
|
|
|
{
|
|
|
|
|
if (strcmp (enumeration[i], str) == 0)
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
xfree (str);
|
|
|
|
|
if (enumeration[i] == NULL)
|
|
|
|
|
{
|
|
|
|
|
gdbscm_out_of_range_error (func_name, arg_pos, value,
|
|
|
|
|
_("not member of enumeration"));
|
|
|
|
|
}
|
|
|
|
|
var->cstringval = enumeration[i];
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
case var_boolean:
|
|
|
|
|
SCM_ASSERT_TYPE (gdbscm_is_bool (value), value, arg_pos, func_name,
|
|
|
|
|
_("boolean"));
|
|
|
|
|
var->intval = gdbscm_is_true (value);
|
|
|
|
|
break;
|
|
|
|
|
|
|
|
|
|
case var_auto_boolean:
|
|
|
|
|
SCM_ASSERT_TYPE (gdbscm_is_bool (value)
|
|
|
|
|
|| scm_is_eq (value, auto_keyword),
|
|
|
|
|
value, arg_pos, func_name,
|
|
|
|
|
_("boolean or #:auto"));
|
|
|
|
|
if (scm_is_eq (value, auto_keyword))
|
|
|
|
|
var->autoboolval = AUTO_BOOLEAN_AUTO;
|
|
|
|
|
else if (gdbscm_is_true (value))
|
|
|
|
|
var->autoboolval = AUTO_BOOLEAN_TRUE;
|
|
|
|
|
else
|
|
|
|
|
var->autoboolval = AUTO_BOOLEAN_FALSE;
|
|
|
|
|
break;
|
|
|
|
|
|
|
|
|
|
case var_zinteger:
|
|
|
|
|
case var_uinteger:
|
|
|
|
|
case var_zuinteger:
|
|
|
|
|
case var_zuinteger_unlimited:
|
|
|
|
|
if (type == var_uinteger
|
|
|
|
|
|| type == var_zuinteger_unlimited)
|
|
|
|
|
{
|
|
|
|
|
SCM_ASSERT_TYPE (gdbscm_is_bool (value)
|
|
|
|
|
|| scm_is_eq (value, unlimited_keyword),
|
|
|
|
|
value, arg_pos, func_name,
|
|
|
|
|
_("integer or #:unlimited"));
|
|
|
|
|
if (scm_is_eq (value, unlimited_keyword))
|
|
|
|
|
{
|
|
|
|
|
if (type == var_uinteger)
|
|
|
|
|
var->intval = UINT_MAX;
|
|
|
|
|
else
|
|
|
|
|
var->intval = -1;
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
{
|
|
|
|
|
SCM_ASSERT_TYPE (scm_is_integer (value), value, arg_pos, func_name,
|
|
|
|
|
_("integer"));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
if (type == var_uinteger
|
|
|
|
|
|| type == var_zuinteger)
|
|
|
|
|
{
|
|
|
|
|
unsigned int u = scm_to_uint (value);
|
|
|
|
|
|
|
|
|
|
if (type == var_uinteger && u == 0)
|
|
|
|
|
u = UINT_MAX;
|
|
|
|
|
var->uintval = u;
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
{
|
|
|
|
|
int i = scm_to_int (value);
|
|
|
|
|
|
|
|
|
|
if (type == var_zuinteger_unlimited && i < -1)
|
|
|
|
|
{
|
|
|
|
|
gdbscm_out_of_range_error (func_name, arg_pos, value,
|
|
|
|
|
_("must be >= -1"));
|
|
|
|
|
}
|
|
|
|
|
var->intval = i;
|
|
|
|
|
}
|
|
|
|
|
break;
|
|
|
|
|
|
|
|
|
|
default:
|
|
|
|
|
gdb_assert_not_reached ("bad parameter type");
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Parameter Scheme functions. */
|
|
|
|
|
|
|
|
|
|
/* (make-parameter name
|
|
|
|
|
[#:command-class cmd-class] [#:parameter-type param-type]
|
|
|
|
|
[#:enum-list enum-list] [#:set-func function] [#:show-func function]
|
|
|
|
|
[#:doc <string>] [#:set-doc <string>] [#:show-doc <string>]
|
|
|
|
|
[#:initial-value initial-value]) -> <gdb:parameter>
|
|
|
|
|
|
|
|
|
|
NAME is the name of the parameter. It may consist of multiple
|
|
|
|
|
words, in which case the final word is the name of the new parameter,
|
|
|
|
|
and earlier words must be prefix commands.
|
|
|
|
|
|
|
|
|
|
CMD-CLASS is the kind of command. It should be one of the COMMAND_*
|
|
|
|
|
constants defined in the gdb module.
|
|
|
|
|
|
|
|
|
|
PARAM_TYPE is the type of the parameter. It should be one of the
|
|
|
|
|
PARAM_* constants defined in the gdb module.
|
|
|
|
|
|
|
|
|
|
If PARAM-TYPE is PARAM_ENUM, then ENUM-LIST is a list of strings that
|
|
|
|
|
are the valid values for this parameter. The first value is the default.
|
|
|
|
|
|
|
|
|
|
SET-FUNC, if provided, is called after the parameter is set.
|
|
|
|
|
It is a function of one parameter: the <gdb:parameter> object.
|
|
|
|
|
It must return a string to be displayed to the user.
|
|
|
|
|
Setting a parameter is typically a silent operation, so typically ""
|
|
|
|
|
should be returned.
|
|
|
|
|
|
|
|
|
|
SHOW-FUNC, if provided, returns the string that is printed.
|
|
|
|
|
It is a function of two parameters: the <gdb:parameter> object
|
|
|
|
|
and the current value of the parameter as a string.
|
|
|
|
|
|
|
|
|
|
DOC, SET-DOC, SHOW-DOC are the doc strings for the parameter.
|
|
|
|
|
|
|
|
|
|
INITIAL-VALUE is the initial value of the parameter.
|
|
|
|
|
|
|
|
|
|
The result is the <gdb:parameter> Scheme object.
|
|
|
|
|
The parameter is not available to be used yet, however.
|
|
|
|
|
It must still be added to gdb with register-parameter!. */
|
|
|
|
|
|
|
|
|
|
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;
|
2014-06-04 05:37:56 +02:00
|
|
|
|
int param_type = var_boolean; /* ARI: var_boolean */
|
2014-06-03 10:58:15 +02:00
|
|
|
|
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 = 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 (param_type, &p_smob->value, enum_list,
|
|
|
|
|
initial_value_scm,
|
|
|
|
|
initial_value_arg_pos, FUNC_NAME);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return p_scm;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (register-parameter! <gdb:parameter>) -> unspecified
|
|
|
|
|
|
|
|
|
|
It is an error to register a parameter more than once. */
|
|
|
|
|
|
|
|
|
|
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;
|
|
|
|
|
volatile struct gdb_exception except;
|
|
|
|
|
|
|
|
|
|
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);
|
|
|
|
|
|
|
|
|
|
TRY_CATCH (except, RETURN_MASK_ALL)
|
|
|
|
|
{
|
|
|
|
|
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);
|
|
|
|
|
}
|
|
|
|
|
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
|
|
|
|
|
|
|
|
|
/* Note: At this point the parameter exists in gdb.
|
|
|
|
|
So no more errors after this point. */
|
|
|
|
|
|
|
|
|
|
/* The owner of this parameter is not in GC-controlled memory, so we need
|
|
|
|
|
to protect it from GC until the parameter is deleted. */
|
|
|
|
|
scm_gc_protect_object (p_smob->containing_scm);
|
|
|
|
|
|
|
|
|
|
return SCM_UNSPECIFIED;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (parameter-value <gdb:parameter>) -> value
|
|
|
|
|
(parameter-value <string>) -> value */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_parameter_value (SCM self)
|
|
|
|
|
{
|
|
|
|
|
SCM_ASSERT_TYPE (pascm_is_parameter (self) || scm_is_string (self),
|
|
|
|
|
self, SCM_ARG1, FUNC_NAME, _("<gdb:parameter> or string"));
|
|
|
|
|
|
|
|
|
|
if (pascm_is_parameter (self))
|
|
|
|
|
{
|
|
|
|
|
param_smob *p_smob = pascm_get_param_smob_arg_unsafe (self, SCM_ARG1,
|
|
|
|
|
FUNC_NAME);
|
|
|
|
|
|
|
|
|
|
return pascm_param_value (p_smob->type, &p_smob->value,
|
|
|
|
|
SCM_ARG1, FUNC_NAME);
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
{
|
|
|
|
|
char *name;
|
|
|
|
|
SCM except_scm;
|
|
|
|
|
struct cmd_list_element *alias, *prefix, *cmd;
|
|
|
|
|
const char *arg;
|
|
|
|
|
char *newarg;
|
|
|
|
|
int found = -1;
|
|
|
|
|
volatile struct gdb_exception except;
|
|
|
|
|
|
|
|
|
|
name = gdbscm_scm_to_host_string (self, NULL, &except_scm);
|
|
|
|
|
if (name == NULL)
|
|
|
|
|
gdbscm_throw (except_scm);
|
|
|
|
|
newarg = concat ("show ", name, (char *) NULL);
|
|
|
|
|
TRY_CATCH (except, RETURN_MASK_ALL)
|
|
|
|
|
{
|
|
|
|
|
found = lookup_cmd_composition (newarg, &alias, &prefix, &cmd);
|
|
|
|
|
}
|
|
|
|
|
xfree (name);
|
|
|
|
|
xfree (newarg);
|
|
|
|
|
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
|
|
|
|
if (!found)
|
|
|
|
|
{
|
|
|
|
|
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
|
|
|
|
|
_("parameter not found"));
|
|
|
|
|
}
|
|
|
|
|
if (cmd->var == NULL)
|
|
|
|
|
{
|
|
|
|
|
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
|
|
|
|
|
_("not a parameter"));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return pascm_param_value (cmd->var_type, cmd->var, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (set-parameter-value! <gdb:parameter> value) -> unspecified */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_set_parameter_value_x (SCM self, SCM value)
|
|
|
|
|
{
|
|
|
|
|
param_smob *p_smob = pascm_get_param_smob_arg_unsafe (self, SCM_ARG1,
|
|
|
|
|
FUNC_NAME);
|
|
|
|
|
|
|
|
|
|
pascm_set_param_value_x (p_smob->type, &p_smob->value, p_smob->enumeration,
|
|
|
|
|
value, SCM_ARG2, FUNC_NAME);
|
|
|
|
|
|
|
|
|
|
return SCM_UNSPECIFIED;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Initialize the Scheme parameter support. */
|
|
|
|
|
|
|
|
|
|
static const scheme_function parameter_functions[] =
|
|
|
|
|
{
|
|
|
|
|
{ "make-parameter", 1, 0, 1, gdbscm_make_parameter,
|
|
|
|
|
"\
|
|
|
|
|
Make a GDB parameter object.\n\
|
|
|
|
|
\n\
|
|
|
|
|
Arguments: name\n\
|
|
|
|
|
[#:command-class <cmd-class>] [#:parameter-type <parameter-type>]\n\
|
|
|
|
|
[#:enum-list <enum-list>]\n\
|
|
|
|
|
[#:set-func function] [#:show-func function]\n\
|
|
|
|
|
[#:doc string] [#:set-doc string] [#:show-doc string]\n\
|
|
|
|
|
[#:initial-value initial-value]\n\
|
|
|
|
|
name: The name of the command. It may consist of multiple words,\n\
|
|
|
|
|
in which case the final word is the name of the new parameter, and\n\
|
|
|
|
|
earlier words must be prefix commands.\n\
|
|
|
|
|
cmd-class: The class of the command, one of COMMAND_*.\n\
|
|
|
|
|
The default is COMMAND_NONE.\n\
|
|
|
|
|
parameter-type: The kind of parameter, one of PARAM_*\n\
|
|
|
|
|
The default is PARAM_BOOLEAN.\n\
|
|
|
|
|
enum-list: If parameter-type is PARAM_ENUM, then this specifies the set\n\
|
|
|
|
|
of values of the enum.\n\
|
|
|
|
|
set-func: A function of one parameter: the <gdb:parameter> object.\n\
|
|
|
|
|
Called *after* the parameter has been set. Returns either \"\" or a\n\
|
|
|
|
|
non-empty string to be displayed to the user.\n\
|
|
|
|
|
If non-empty, GDB will add a trailing newline.\n\
|
|
|
|
|
show-func: A function of two parameters: the <gdb:parameter> object\n\
|
|
|
|
|
and the string representation of the current value.\n\
|
|
|
|
|
The result is a string to be displayed to the user.\n\
|
|
|
|
|
GDB will add a trailing newline.\n\
|
|
|
|
|
doc: The \"doc string\" of the parameter.\n\
|
|
|
|
|
set-doc: The \"doc string\" when setting the parameter.\n\
|
|
|
|
|
show-doc: The \"doc string\" when showing the parameter.\n\
|
|
|
|
|
initial-value: The initial value of the parameter." },
|
|
|
|
|
|
|
|
|
|
{ "register-parameter!", 1, 0, 0, gdbscm_register_parameter_x,
|
|
|
|
|
"\
|
|
|
|
|
Register a <gdb:parameter> object with GDB." },
|
|
|
|
|
|
|
|
|
|
{ "parameter?", 1, 0, 0, gdbscm_parameter_p,
|
|
|
|
|
"\
|
|
|
|
|
Return #t if the object is a <gdb:parameter> object." },
|
|
|
|
|
|
|
|
|
|
{ "parameter-value", 1, 0, 0, gdbscm_parameter_value,
|
|
|
|
|
"\
|
|
|
|
|
Return the value of a <gdb:parameter> object\n\
|
|
|
|
|
or any gdb parameter if param is a string naming the parameter." },
|
|
|
|
|
|
|
|
|
|
{ "set-parameter-value!", 2, 0, 0, gdbscm_set_parameter_value_x,
|
|
|
|
|
"\
|
|
|
|
|
Set the value of a <gdb:parameter> object.\n\
|
|
|
|
|
\n\
|
|
|
|
|
Arguments: <gdb:parameter> value" },
|
|
|
|
|
|
|
|
|
|
END_FUNCTIONS
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
void
|
|
|
|
|
gdbscm_initialize_parameters (void)
|
|
|
|
|
{
|
|
|
|
|
parameter_smob_tag
|
|
|
|
|
= gdbscm_make_smob_type (param_smob_name, sizeof (param_smob));
|
|
|
|
|
scm_set_smob_print (parameter_smob_tag, pascm_print_param_smob);
|
|
|
|
|
|
|
|
|
|
gdbscm_define_integer_constants (parameter_types, 1);
|
|
|
|
|
gdbscm_define_functions (parameter_functions, 1);
|
|
|
|
|
|
|
|
|
|
command_class_keyword = scm_from_latin1_keyword ("command-class");
|
|
|
|
|
parameter_type_keyword = scm_from_latin1_keyword ("parameter-type");
|
|
|
|
|
enum_list_keyword = scm_from_latin1_keyword ("enum-list");
|
|
|
|
|
set_func_keyword = scm_from_latin1_keyword ("set-func");
|
|
|
|
|
show_func_keyword = scm_from_latin1_keyword ("show-func");
|
|
|
|
|
doc_keyword = scm_from_latin1_keyword ("doc");
|
|
|
|
|
set_doc_keyword = scm_from_latin1_keyword ("set-doc");
|
|
|
|
|
show_doc_keyword = scm_from_latin1_keyword ("show-doc");
|
|
|
|
|
initial_value_keyword = scm_from_latin1_keyword ("initial-value");
|
|
|
|
|
auto_keyword = scm_from_latin1_keyword ("auto");
|
|
|
|
|
unlimited_keyword = scm_from_latin1_keyword ("unlimited");
|
|
|
|
|
}
|