1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207 |
- /* GDB parameters implemented in Guile.
- Copyright (C) 2008-2022 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 "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 boolean value. */
- bool boolval;
- /* Hold an integer value. */
- 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. */
- std::string *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. */
- 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. */
- set_show_commands commands;
- /* 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;
- };
- /* Wraps a setting around an existing param_smob. This abstraction
- is used to manipulate the value in S->VALUE in a type safe manner using
- the setting interface. */
- static setting
- make_setting (param_smob *s)
- {
- if (var_type_uses<bool> (s->type))
- return setting (s->type, &s->value.boolval);
- else if (var_type_uses<int> (s->type))
- return setting (s->type, &s->value.intval);
- else if (var_type_uses<auto_boolean> (s->type))
- return setting (s->type, &s->value.autoboolval);
- else if (var_type_uses<unsigned int> (s->type))
- return setting (s->type, &s->value.uintval);
- else if (var_type_uses<std::string> (s->type))
- return setting (s->type, s->value.stringval);
- else if (var_type_uses<const char *> (s->type))
- return setting (s->type, &s->value.cstringval);
- else
- gdb_assert_not_reached ("unhandled var type");
- }
- 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 (const setting &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 (make_setting (p_smob), 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;
- p_smob->type = var_boolean; /* ARI: var_boolean */
- 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->commands.set != nullptr;
- }
- /* 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)))
- {
- gdb::unique_xmalloc_ptr<char> excp_text
- = gdbscm_exception_message_to_string (exception);
- error ("%s", excp_text.get ());
- }
- 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 (const char *args, int from_tty, struct cmd_list_element *c)
- {
- param_smob *p_smob = (param_smob *) c->context ();
- SCM self, result, exception;
- 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);
- gdb::unique_xmalloc_ptr<char> 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."));
- }
- /* GDB is usually silent when a parameter is set. */
- if (*msg.get () != '\0')
- gdb_printf ("%s\n", msg.get ());
- }
- /* 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 *) c->context ();
- SCM value_scm, self, result, exception;
- 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."));
- }
- gdb::unique_xmalloc_ptr<char> 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."));
- }
- gdb_printf (file, "%s\n", msg.get ());
- }
- /* A helper function that dispatches to the appropriate add_setshow
- function. */
- static set_show_commands
- 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_func_ftype *set_func,
- show_value_ftype *show_func,
- struct cmd_list_element **set_list,
- struct cmd_list_element **show_list)
- {
- set_show_commands commands;
- switch (param_type)
- {
- case var_boolean:
- commands = add_setshow_boolean_cmd (cmd_name, cmd_class,
- &self->value.boolval, set_doc,
- show_doc, help_doc, set_func,
- show_func, set_list, show_list);
- break;
- case var_auto_boolean:
- commands = 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:
- commands = 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:
- commands = 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:
- commands = 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:
- commands = 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:
- commands = 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:
- commands = 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:
- commands = 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:
- commands = 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:
- /* Initialize the value, just in case. */
- make_setting (self).set<const char *> (self->enumeration[0]);
- commands = 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);
- break;
- default:
- gdb_assert_not_reached ("bad param_type value");
- }
- /* Register Scheme object against the commandsparameter context. Perform this
- task against both lists. */
- commands.set->set_context (self);
- commands.show->set_context (self);
- return commands;
- }
- /* 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 = XCNEWVEC (char *, size + 1);
- 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).release ();
- 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 the var_type of VAR is not supported, then a <gdb:exception> object is
- returned. */
- static SCM
- pascm_param_value (const setting &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 (var.type ())
- {
- case var_string:
- case var_string_noescape:
- case var_optional_filename:
- case var_filename:
- {
- const std::string &str = var.get<std::string> ();
- return gdbscm_scm_from_host_string (str.c_str (), str.length ());
- }
- case var_enum:
- {
- const char *str = var.get<const char *> ();
- if (str == nullptr)
- str = "";
- return gdbscm_scm_from_host_string (str, strlen (str));
- }
- case var_boolean:
- {
- if (var.get<bool> ())
- return SCM_BOOL_T;
- else
- return SCM_BOOL_F;
- }
- case var_auto_boolean:
- {
- enum auto_boolean ab = var.get<enum auto_boolean> ();
- 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 (var.get<int> () == -1)
- return unlimited_keyword;
- gdb_assert (var.get<int> () >= 0);
- /* Fall through. */
- case var_zinteger:
- return scm_from_int (var.get<int> ());
- case var_uinteger:
- if (var.get<unsigned int> ()== UINT_MAX)
- return unlimited_keyword;
- /* Fall through. */
- case var_zuinteger:
- return scm_from_uint (var.get<unsigned int> ());
- default:
- break;
- }
- return gdbscm_make_out_of_range_error (func_name, arg_pos,
- scm_from_int (var.type ()),
- _("program error: unhandled type"));
- }
- /* Set the value of a parameter of type P_SMOB->TYPE in P_SMOB->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 (param_smob *p_smob,
- const char * const *enumeration,
- SCM value, int arg_pos, const char *func_name)
- {
- setting var = make_setting (p_smob);
- switch (var.type ())
- {
- case var_string:
- case var_string_noescape:
- case var_optional_filename:
- case var_filename:
- SCM_ASSERT_TYPE (scm_is_string (value)
- || (var.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))
- var.set<std::string> ("");
- else
- {
- SCM exception;
- gdb::unique_xmalloc_ptr<char> string
- = gdbscm_scm_to_host_string (value, nullptr, &exception);
- if (string == nullptr)
- gdbscm_throw (exception);
- var.set<std::string> (string.release ());
- }
- break;
- case var_enum:
- {
- int i;
- SCM exception;
- SCM_ASSERT_TYPE (scm_is_string (value), value, arg_pos, func_name,
- _("string"));
- gdb::unique_xmalloc_ptr<char> str
- = gdbscm_scm_to_host_string (value, nullptr, &exception);
- if (str == nullptr)
- gdbscm_throw (exception);
- for (i = 0; enumeration[i]; ++i)
- {
- if (strcmp (enumeration[i], str.get ()) == 0)
- break;
- }
- if (enumeration[i] == nullptr)
- {
- gdbscm_out_of_range_error (func_name, arg_pos, value,
- _("not member of enumeration"));
- }
- var.set<const char *> (enumeration[i]);
- break;
- }
- case var_boolean:
- SCM_ASSERT_TYPE (gdbscm_is_bool (value), value, arg_pos, func_name,
- _("boolean"));
- var.set<bool> (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.set<enum auto_boolean> (AUTO_BOOLEAN_AUTO);
- else if (gdbscm_is_true (value))
- var.set<enum auto_boolean> (AUTO_BOOLEAN_TRUE);
- else
- var.set<enum auto_boolean> (AUTO_BOOLEAN_FALSE);
- break;
- case var_zinteger:
- case var_uinteger:
- case var_zuinteger:
- case var_zuinteger_unlimited:
- if (var.type () == var_uinteger
- || var.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 (var.type () == var_uinteger)
- var.set<unsigned int> (UINT_MAX);
- else
- var.set<int> (-1);
- break;
- }
- }
- else
- {
- SCM_ASSERT_TYPE (scm_is_integer (value), value, arg_pos, func_name,
- _("integer"));
- }
- if (var.type () == var_uinteger
- || var.type () == var_zuinteger)
- {
- unsigned int u = scm_to_uint (value);
- if (var.type () == var_uinteger && u == 0)
- u = UINT_MAX;
- var.set<unsigned int> (u);
- }
- else
- {
- int i = scm_to_int (value);
- if (var.type () == var_zuinteger_unlimited && i < -1)
- {
- gdbscm_out_of_range_error (func_name, arg_pos, value,
- _("must be >= -1"));
- }
- var.set<int> (i);
- }
- break;
- default:
- gdb_assert_not_reached ("bad parameter type");
- }
- }
- /* Free function for a param_smob. */
- static size_t
- pascm_free_parameter_smob (SCM self)
- {
- param_smob *p_smob = (param_smob *) SCM_SMOB_DATA (self);
- if (var_type_uses<std::string> (p_smob->type))
- {
- delete p_smob->value.stringval;
- p_smob->value.stringval = nullptr;
- }
- return 0;
- }
- /* 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;
- 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;
- scm_set_smob_free (parameter_smob_tag, pascm_free_parameter_smob);
- if (var_type_uses<std::string> (p_smob->type))
- p_smob->value.stringval = new std::string;
- 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, enum_list,
- initial_value_scm,
- initial_value_arg_pos, FUNC_NAME);
- }
- return p_scm;
- }
- /* Subroutine of gdbscm_register_parameter_x to simplify it.
- Return non-zero if parameter NAME is already defined in LIST. */
- static int
- pascm_parameter_defined_p (const char *name, struct cmd_list_element *list)
- {
- struct cmd_list_element *c;
- c = lookup_cmd_1 (&name, list, NULL, NULL, 1);
- /* If the name is ambiguous that's ok, it's a new parameter still. */
- return c != NULL && c != CMD_LIST_AMBIGUOUS;
- }
- /* (register-parameter! <gdb:parameter>) -> unspecified
- It is an error to register a pre-existing parameter. */
- 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"));
- }
- gdbscm_gdb_exception exc {};
- try
- {
- p_smob->commands = 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);
- }
- catch (const gdb_exception &except)
- {
- exc = unpack (except);
- }
- GDBSCM_HANDLE_GDB_EXCEPTION (exc);
- /* 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 (make_setting (p_smob), SCM_ARG1, FUNC_NAME);
- }
- else
- {
- SCM except_scm;
- struct cmd_list_element *alias, *prefix, *cmd;
- char *newarg;
- int found = -1;
- gdbscm_gdb_exception except {};
- gdb::unique_xmalloc_ptr<char> name
- = gdbscm_scm_to_host_string (self, NULL, &except_scm);
- if (name == NULL)
- gdbscm_throw (except_scm);
- newarg = concat ("show ", name.get (), (char *) NULL);
- try
- {
- found = lookup_cmd_composition (newarg, &alias, &prefix, &cmd);
- }
- catch (const gdb_exception &ex)
- {
- except = unpack (ex);
- }
- 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.has_value ())
- {
- gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
- _("not a parameter"));
- }
- return pascm_param_value (*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, 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, as_a_scm_t_subr (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,
- as_a_scm_t_subr (gdbscm_register_parameter_x),
- "\
- Register a <gdb:parameter> object with GDB." },
- { "parameter?", 1, 0, 0, as_a_scm_t_subr (gdbscm_parameter_p),
- "\
- Return #t if the object is a <gdb:parameter> object." },
- { "parameter-value", 1, 0, 0, as_a_scm_t_subr (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,
- as_a_scm_t_subr (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");
- }
|