1 /* GDB parameters implemented in Guile.
3 Copyright (C) 2008-2024 Free Software Foundation, Inc.
5 This file is part of GDB.
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3 of the License, or
10 (at your option) any later version.
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program. If not, see <http://www.gnu.org/licenses/>. */
24 #include "cli/cli-decode.h"
25 #include "completer.h"
27 #include "arch-utils.h"
28 #include "guile-internal.h"
30 /* A union that can hold anything described by enum var_types. */
34 /* Hold an boolean value. */
37 /* Hold an integer value. */
40 /* Hold an auto_boolean. */
41 enum auto_boolean autoboolval
;
43 /* Hold an unsigned integer value, for uinteger. */
46 /* Hold a string, for the various string types. */
47 std::string
*stringval
;
49 /* Hold a string, for enums. */
50 const char *cstringval
;
55 Note: Parameters are added to gdb using a two step process:
56 1) Call make-parameter to create a <gdb:parameter> object.
57 2) Call register-parameter! to add the parameter to gdb.
58 It is done this way so that the constructor, make-parameter, doesn't have
59 any side-effects. This means that the smob needs to store everything
60 that was passed to make-parameter. */
64 /* This always appears first. */
67 /* The parameter name. */
70 /* The last word of the command.
71 This is needed because add_cmd requires us to allocate space
75 /* One of the COMMAND_* constants. */
76 enum command_class cmd_class
;
78 /* Guile parameter type name. */
81 /* The type of the parameter. */
84 /* Extra literals, such as `unlimited', accepted in lieu of a number. */
85 const literal_def
*extra_literals
;
87 /* The docs for the parameter. */
92 /* The corresponding gdb command objects.
93 These are NULL if the parameter has not been registered yet, or
94 is no longer registered. */
95 set_show_commands commands
;
97 /* The value of the parameter. */
98 union pascm_variable value
;
100 /* For an enum parameter, the possible values. The vector lives in GC
101 space, it will be freed with the smob. */
102 const char * const *enumeration
;
104 /* The set_func function or #f if not specified.
105 This function is called *after* the parameter is set.
106 It returns a string that will be displayed to the user. */
109 /* The show_func function or #f if not specified.
110 This function returns the string that is printed. */
113 /* The <gdb:parameter> object we are contained in, needed to
114 protect/unprotect the object since a reference to it comes from
115 non-gc-managed space (the command context pointer). */
119 /* Guile parameter types as in PARAMETER_TYPES later on. */
128 param_zuinteger_unlimited
,
130 param_string_noescape
,
131 param_optional_filename
,
136 /* Translation from Guile parameters to GDB variable types. Keep in the
137 same order as SCM_PARAM_TYPES due to C++'s lack of designated initializers. */
141 /* The type of the parameter. */
144 /* Extra literals, such as `unlimited', accepted in lieu of a number. */
145 const literal_def
*extra_literals
;
150 { var_auto_boolean
},
152 { var_uinteger
, uinteger_unlimited_literals
},
154 { var_pinteger
, pinteger_unlimited_literals
},
156 { var_string_noescape
},
157 { var_optional_filename
},
162 /* Wraps a setting around an existing param_smob. This abstraction
163 is used to manipulate the value in S->VALUE in a type safe manner using
164 the setting interface. */
167 make_setting (param_smob
*s
)
169 enum var_types type
= s
->type
;
171 if (var_type_uses
<bool> (type
))
172 return setting (type
, &s
->value
.boolval
);
173 else if (var_type_uses
<int> (type
))
174 return setting (type
, &s
->value
.intval
, s
->extra_literals
);
175 else if (var_type_uses
<auto_boolean
> (type
))
176 return setting (type
, &s
->value
.autoboolval
);
177 else if (var_type_uses
<unsigned int> (type
))
178 return setting (type
, &s
->value
.uintval
, s
->extra_literals
);
179 else if (var_type_uses
<std::string
> (type
))
180 return setting (type
, s
->value
.stringval
);
181 else if (var_type_uses
<const char *> (type
))
182 return setting (type
, &s
->value
.cstringval
);
184 gdb_assert_not_reached ("unhandled var type");
187 static const char param_smob_name
[] = "gdb:parameter";
189 /* The tag Guile knows the param smob by. */
190 static scm_t_bits parameter_smob_tag
;
192 /* Keywords used by make-parameter!. */
193 static SCM command_class_keyword
;
194 static SCM parameter_type_keyword
;
195 static SCM enum_list_keyword
;
196 static SCM set_func_keyword
;
197 static SCM show_func_keyword
;
198 static SCM doc_keyword
;
199 static SCM set_doc_keyword
;
200 static SCM show_doc_keyword
;
201 static SCM initial_value_keyword
;
202 static SCM auto_keyword
;
204 static int pascm_is_valid (param_smob
*);
205 static const char *pascm_param_type_name (enum scm_param_types type
);
206 static SCM
pascm_param_value (const setting
&var
, int arg_pos
,
207 const char *func_name
);
209 /* Administrivia for parameter smobs. */
212 pascm_print_param_smob (SCM self
, SCM port
, scm_print_state
*pstate
)
214 param_smob
*p_smob
= (param_smob
*) SCM_SMOB_DATA (self
);
217 gdbscm_printf (port
, "#<%s", param_smob_name
);
219 gdbscm_printf (port
, " %s", p_smob
->name
);
221 if (! pascm_is_valid (p_smob
))
222 scm_puts (" {invalid}", port
);
224 gdbscm_printf (port
, " %s ", p_smob
->pname
);
226 value
= pascm_param_value (make_setting (p_smob
), GDBSCM_ARG_NONE
, NULL
);
227 scm_display (value
, port
);
229 scm_puts (">", port
);
231 scm_remember_upto_here_1 (self
);
233 /* Non-zero means success. */
237 /* Create an empty (uninitialized) parameter. */
240 pascm_make_param_smob (void)
242 param_smob
*p_smob
= (param_smob
*)
243 scm_gc_malloc (sizeof (param_smob
), param_smob_name
);
246 memset (p_smob
, 0, sizeof (*p_smob
));
247 p_smob
->cmd_class
= no_class
;
248 p_smob
->type
= var_boolean
; /* ARI: var_boolean */
249 p_smob
->set_func
= SCM_BOOL_F
;
250 p_smob
->show_func
= SCM_BOOL_F
;
251 p_scm
= scm_new_smob (parameter_smob_tag
, (scm_t_bits
) p_smob
);
252 p_smob
->containing_scm
= p_scm
;
253 gdbscm_init_gsmob (&p_smob
->base
);
258 /* Returns non-zero if SCM is a <gdb:parameter> object. */
261 pascm_is_parameter (SCM scm
)
263 return SCM_SMOB_PREDICATE (parameter_smob_tag
, scm
);
266 /* (gdb:parameter? scm) -> boolean */
269 gdbscm_parameter_p (SCM scm
)
271 return scm_from_bool (pascm_is_parameter (scm
));
274 /* Returns the <gdb:parameter> object in SELF.
275 Throws an exception if SELF is not a <gdb:parameter> object. */
278 pascm_get_param_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
280 SCM_ASSERT_TYPE (pascm_is_parameter (self
), self
, arg_pos
, func_name
,
286 /* Returns a pointer to the parameter smob of SELF.
287 Throws an exception if SELF is not a <gdb:parameter> object. */
290 pascm_get_param_smob_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
292 SCM p_scm
= pascm_get_param_arg_unsafe (self
, arg_pos
, func_name
);
293 param_smob
*p_smob
= (param_smob
*) SCM_SMOB_DATA (p_scm
);
298 /* Return non-zero if parameter P_SMOB is valid. */
301 pascm_is_valid (param_smob
*p_smob
)
303 return p_smob
->commands
.set
!= nullptr;
306 /* A helper function which return the default documentation string for
307 a parameter (which is to say that it's undocumented). */
310 get_doc_string (void)
312 return xstrdup (_("This command is not documented."));
315 /* Subroutine of pascm_set_func, pascm_show_func to simplify them.
316 Signal the error returned from calling set_func/show_func. */
319 pascm_signal_setshow_error (SCM exception
, const char *msg
)
321 /* Don't print the stack if this was an error signalled by the command
323 if (gdbscm_user_error_p (gdbscm_exception_key (exception
)))
325 gdb::unique_xmalloc_ptr
<char> excp_text
326 = gdbscm_exception_message_to_string (exception
);
328 error ("%s", excp_text
.get ());
332 gdbscm_print_gdb_exception (SCM_BOOL_F
, exception
);
337 /* A callback function that is registered against the respective
338 add_setshow_* set_func prototype. This function will call
339 the Scheme function "set_func" which must exist.
340 Note: ARGS is always passed as NULL. */
343 pascm_set_func (const char *args
, int from_tty
, struct cmd_list_element
*c
)
345 param_smob
*p_smob
= (param_smob
*) c
->context ();
346 SCM self
, result
, exception
;
348 gdb_assert (gdbscm_is_procedure (p_smob
->set_func
));
350 self
= p_smob
->containing_scm
;
352 result
= gdbscm_safe_call_1 (p_smob
->set_func
, self
, gdbscm_user_error_p
);
354 if (gdbscm_is_exception (result
))
356 pascm_signal_setshow_error (result
,
357 _("Error occurred setting parameter."));
360 if (!scm_is_string (result
))
361 error (_("Result of %s set-func is not a string."), p_smob
->name
);
363 gdb::unique_xmalloc_ptr
<char> msg
= gdbscm_scm_to_host_string (result
, NULL
,
367 gdbscm_print_gdb_exception (SCM_BOOL_F
, exception
);
368 error (_("Error converting show text to host string."));
371 /* GDB is usually silent when a parameter is set. */
372 if (*msg
.get () != '\0')
373 gdb_printf ("%s\n", msg
.get ());
376 /* A callback function that is registered against the respective
377 add_setshow_* show_func prototype. This function will call
378 the Scheme function "show_func" which must exist and must return a
379 string that is then printed to FILE. */
382 pascm_show_func (struct ui_file
*file
, int from_tty
,
383 struct cmd_list_element
*c
, const char *value
)
385 param_smob
*p_smob
= (param_smob
*) c
->context ();
386 SCM value_scm
, self
, result
, exception
;
388 gdb_assert (gdbscm_is_procedure (p_smob
->show_func
));
390 value_scm
= gdbscm_scm_from_host_string (value
, strlen (value
));
391 if (gdbscm_is_exception (value_scm
))
393 error (_("Error converting parameter value \"%s\" to Scheme string."),
396 self
= p_smob
->containing_scm
;
398 result
= gdbscm_safe_call_2 (p_smob
->show_func
, self
, value_scm
,
399 gdbscm_user_error_p
);
401 if (gdbscm_is_exception (result
))
403 pascm_signal_setshow_error (result
,
404 _("Error occurred showing parameter."));
407 gdb::unique_xmalloc_ptr
<char> msg
= gdbscm_scm_to_host_string (result
, NULL
,
411 gdbscm_print_gdb_exception (SCM_BOOL_F
, exception
);
412 error (_("Error converting show text to host string."));
415 gdb_printf (file
, "%s\n", msg
.get ());
418 /* A helper function that dispatches to the appropriate add_setshow
421 static set_show_commands
422 add_setshow_generic (enum var_types param_type
,
423 const literal_def
*extra_literals
,
424 enum command_class cmd_class
,
425 char *cmd_name
, param_smob
*self
,
426 char *set_doc
, char *show_doc
, char *help_doc
,
427 cmd_func_ftype
*set_func
,
428 show_value_ftype
*show_func
,
429 struct cmd_list_element
**set_list
,
430 struct cmd_list_element
**show_list
)
432 set_show_commands commands
;
437 commands
= add_setshow_boolean_cmd (cmd_name
, cmd_class
,
438 &self
->value
.boolval
, set_doc
,
439 show_doc
, help_doc
, set_func
,
440 show_func
, set_list
, show_list
);
443 case var_auto_boolean
:
444 commands
= add_setshow_auto_boolean_cmd (cmd_name
, cmd_class
,
445 &self
->value
.autoboolval
,
446 set_doc
, show_doc
, help_doc
,
447 set_func
, show_func
, set_list
,
452 commands
= add_setshow_uinteger_cmd (cmd_name
, cmd_class
,
453 &self
->value
.uintval
,
454 extra_literals
, set_doc
,
455 show_doc
, help_doc
, set_func
,
456 show_func
, set_list
, show_list
);
460 commands
= add_setshow_integer_cmd (cmd_name
, cmd_class
,
462 extra_literals
, set_doc
,
463 show_doc
, help_doc
, set_func
,
464 show_func
, set_list
, show_list
);
468 commands
= add_setshow_pinteger_cmd (cmd_name
, cmd_class
,
470 extra_literals
, set_doc
,
471 show_doc
, help_doc
, set_func
,
472 show_func
, set_list
, show_list
);
476 commands
= add_setshow_string_cmd (cmd_name
, cmd_class
,
477 self
->value
.stringval
, set_doc
,
478 show_doc
, help_doc
, set_func
,
479 show_func
, set_list
, show_list
);
482 case var_string_noescape
:
483 commands
= add_setshow_string_noescape_cmd (cmd_name
, cmd_class
,
484 self
->value
.stringval
,
485 set_doc
, show_doc
, help_doc
,
486 set_func
, show_func
, set_list
,
491 case var_optional_filename
:
492 commands
= add_setshow_optional_filename_cmd (cmd_name
, cmd_class
,
493 self
->value
.stringval
,
494 set_doc
, show_doc
, help_doc
,
496 set_list
, show_list
);
500 commands
= add_setshow_filename_cmd (cmd_name
, cmd_class
,
501 self
->value
.stringval
, set_doc
,
502 show_doc
, help_doc
, set_func
,
503 show_func
, set_list
, show_list
);
507 /* Initialize the value, just in case. */
508 make_setting (self
).set
<const char *> (self
->enumeration
[0]);
509 commands
= add_setshow_enum_cmd (cmd_name
, cmd_class
, self
->enumeration
,
510 &self
->value
.cstringval
, set_doc
,
511 show_doc
, help_doc
, set_func
, show_func
,
512 set_list
, show_list
);
516 gdb_assert_not_reached ("bad param_type value");
519 /* Register Scheme object against the commandsparameter context. Perform this
520 task against both lists. */
521 commands
.set
->set_context (self
);
522 commands
.show
->set_context (self
);
527 /* Return an array of strings corresponding to the enum values for
529 Throws an exception if there's a problem with the values.
530 Space for the result is allocated from the GC heap. */
532 static const char * const *
533 compute_enum_list (SCM enum_values_scm
, int arg_pos
, const char *func_name
)
537 const char * const *result
;
539 SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (enum_values_scm
)),
540 enum_values_scm
, arg_pos
, func_name
, _("list"));
542 size
= scm_ilength (enum_values_scm
);
545 gdbscm_out_of_range_error (FUNC_NAME
, arg_pos
, enum_values_scm
,
546 _("enumeration list is empty"));
549 enum_values
= XCNEWVEC (char *, size
+ 1);
552 while (!scm_is_eq (enum_values_scm
, SCM_EOL
))
554 SCM value
= scm_car (enum_values_scm
);
557 if (!scm_is_string (value
))
559 freeargv (enum_values
);
560 SCM_ASSERT_TYPE (0, value
, arg_pos
, func_name
, _("string"));
562 enum_values
[i
] = gdbscm_scm_to_host_string (value
, NULL
,
563 &exception
).release ();
564 if (enum_values
[i
] == NULL
)
566 freeargv (enum_values
);
567 gdbscm_throw (exception
);
570 enum_values_scm
= scm_cdr (enum_values_scm
);
572 gdb_assert (i
== size
);
574 result
= gdbscm_gc_dup_argv (enum_values
);
575 freeargv (enum_values
);
579 static const scheme_integer_constant parameter_types
[] =
581 { "PARAM_BOOLEAN", param_boolean
}, /* ARI: param_boolean */
582 { "PARAM_AUTO_BOOLEAN", param_auto_boolean
},
583 { "PARAM_ZINTEGER", param_zinteger
},
584 { "PARAM_UINTEGER", param_uinteger
},
585 { "PARAM_ZUINTEGER", param_zuinteger
},
586 { "PARAM_ZUINTEGER_UNLIMITED", param_zuinteger_unlimited
},
587 { "PARAM_STRING", param_string
},
588 { "PARAM_STRING_NOESCAPE", param_string_noescape
},
589 { "PARAM_OPTIONAL_FILENAME", param_optional_filename
},
590 { "PARAM_FILENAME", param_filename
},
591 { "PARAM_ENUM", param_enum
},
593 END_INTEGER_CONSTANTS
596 /* Return non-zero if PARAM_TYPE is a valid parameter type. */
599 pascm_valid_parameter_type_p (int param_type
)
603 for (i
= 0; parameter_types
[i
].name
!= NULL
; ++i
)
605 if (parameter_types
[i
].value
== param_type
)
612 /* Return PARAM_TYPE as a string. */
615 pascm_param_type_name (enum scm_param_types param_type
)
619 for (i
= 0; parameter_types
[i
].name
!= NULL
; ++i
)
621 if (parameter_types
[i
].value
== param_type
)
622 return parameter_types
[i
].name
;
625 gdb_assert_not_reached ("bad parameter type");
628 /* Return the value of a gdb parameter as a Scheme value.
629 If the var_type of VAR is not supported, then a <gdb:exception> object is
633 pascm_param_value (const setting
&var
, int arg_pos
, const char *func_name
)
638 case var_string_noescape
:
639 case var_optional_filename
:
642 const std::string
&str
= var
.get
<std::string
> ();
643 return gdbscm_scm_from_host_string (str
.c_str (), str
.length ());
648 const char *str
= var
.get
<const char *> ();
651 return gdbscm_scm_from_host_string (str
, strlen (str
));
656 if (var
.get
<bool> ())
662 case var_auto_boolean
:
664 enum auto_boolean ab
= var
.get
<enum auto_boolean
> ();
666 if (ab
== AUTO_BOOLEAN_TRUE
)
668 else if (ab
== AUTO_BOOLEAN_FALSE
)
679 = (var
.type () == var_uinteger
680 ? static_cast<LONGEST
> (var
.get
<unsigned int> ())
681 : static_cast<LONGEST
> (var
.get
<int> ()));
683 if (var
.extra_literals () != nullptr)
684 for (const literal_def
*l
= var
.extra_literals ();
685 l
->literal
!= nullptr;
688 return scm_from_latin1_keyword (l
->literal
);
689 if (var
.type () == var_pinteger
)
690 gdb_assert (value
>= 0);
692 if (var
.type () == var_uinteger
)
693 return scm_from_uint (static_cast<unsigned int> (value
));
695 return scm_from_int (static_cast<int> (value
));
702 return gdbscm_make_out_of_range_error (func_name
, arg_pos
,
703 scm_from_int (var
.type ()),
704 _("program error: unhandled type"));
707 /* Set the value of a parameter of type P_SMOB->TYPE in P_SMOB->VAR from VALUE.
708 ENUMERATION is the list of enum values for enum parameters, otherwise NULL.
709 Throws a Scheme exception if VALUE_SCM is invalid for TYPE. */
712 pascm_set_param_value_x (param_smob
*p_smob
,
713 const char * const *enumeration
,
714 SCM value
, int arg_pos
, const char *func_name
)
716 setting var
= make_setting (p_smob
);
721 case var_string_noescape
:
722 case var_optional_filename
:
724 SCM_ASSERT_TYPE (scm_is_string (value
)
725 || (var
.type () != var_filename
726 && gdbscm_is_false (value
)),
727 value
, arg_pos
, func_name
,
728 _("string or #f for non-PARAM_FILENAME parameters"));
729 if (gdbscm_is_false (value
))
730 var
.set
<std::string
> ("");
735 gdb::unique_xmalloc_ptr
<char> string
736 = gdbscm_scm_to_host_string (value
, nullptr, &exception
);
737 if (string
== nullptr)
738 gdbscm_throw (exception
);
739 var
.set
<std::string
> (string
.release ());
748 SCM_ASSERT_TYPE (scm_is_string (value
), value
, arg_pos
, func_name
,
750 gdb::unique_xmalloc_ptr
<char> str
751 = gdbscm_scm_to_host_string (value
, nullptr, &exception
);
753 gdbscm_throw (exception
);
754 for (i
= 0; enumeration
[i
]; ++i
)
756 if (strcmp (enumeration
[i
], str
.get ()) == 0)
759 if (enumeration
[i
] == nullptr)
761 gdbscm_out_of_range_error (func_name
, arg_pos
, value
,
762 _("not member of enumeration"));
764 var
.set
<const char *> (enumeration
[i
]);
769 SCM_ASSERT_TYPE (gdbscm_is_bool (value
), value
, arg_pos
, func_name
,
771 var
.set
<bool> (gdbscm_is_true (value
));
774 case var_auto_boolean
:
775 SCM_ASSERT_TYPE (gdbscm_is_bool (value
)
776 || scm_is_eq (value
, auto_keyword
),
777 value
, arg_pos
, func_name
,
778 _("boolean or #:auto"));
779 if (scm_is_eq (value
, auto_keyword
))
780 var
.set
<enum auto_boolean
> (AUTO_BOOLEAN_AUTO
);
781 else if (gdbscm_is_true (value
))
782 var
.set
<enum auto_boolean
> (AUTO_BOOLEAN_TRUE
);
784 var
.set
<enum auto_boolean
> (AUTO_BOOLEAN_FALSE
);
791 const literal_def
*extra_literals
= p_smob
->extra_literals
;
792 enum tribool allowed
= TRIBOOL_UNKNOWN
;
793 enum var_types var_type
= var
.type ();
794 bool integer
= scm_is_integer (value
);
795 bool keyword
= scm_is_keyword (value
);
796 std::string buffer
= "";
800 if (extra_literals
!= nullptr)
801 for (const literal_def
*l
= extra_literals
;
802 l
->literal
!= nullptr;
807 buffer
= buffer
+ "#:" + l
->literal
;
809 && allowed
== TRIBOOL_UNKNOWN
811 scm_from_latin1_keyword (l
->literal
)))
814 allowed
= TRIBOOL_TRUE
;
818 if (allowed
== TRIBOOL_UNKNOWN
)
820 if (extra_literals
== nullptr)
821 SCM_ASSERT_TYPE (integer
, value
, arg_pos
, func_name
,
824 SCM_ASSERT_TYPE (integer
, value
, arg_pos
, func_name
,
825 string_printf (_("integer or one of: %s"),
826 buffer
.c_str ()).c_str ());
828 SCM_ASSERT_TYPE (integer
, value
, arg_pos
, func_name
,
829 string_printf (_("integer or %s"),
830 buffer
.c_str ()).c_str ());
832 val
= (var_type
== var_uinteger
833 ? static_cast<LONGEST
> (scm_to_uint (value
))
834 : static_cast<LONGEST
> (scm_to_int (value
)));
836 if (extra_literals
!= nullptr)
837 for (const literal_def
*l
= extra_literals
;
838 l
->literal
!= nullptr;
841 if (l
->val
.has_value () && val
== *l
->val
)
843 allowed
= TRIBOOL_TRUE
;
847 else if (val
== l
->use
)
848 allowed
= TRIBOOL_FALSE
;
852 if (allowed
== TRIBOOL_UNKNOWN
)
854 if (val
> UINT_MAX
|| val
< INT_MIN
855 || (var_type
== var_uinteger
&& val
< 0)
856 || (var_type
== var_integer
&& val
> INT_MAX
)
857 || (var_type
== var_pinteger
&& val
< 0)
858 || (var_type
== var_pinteger
&& val
> INT_MAX
))
859 allowed
= TRIBOOL_FALSE
;
861 if (allowed
== TRIBOOL_FALSE
)
862 gdbscm_out_of_range_error (func_name
, arg_pos
, value
,
863 _("integer out of range"));
865 if (var_type
== var_uinteger
)
866 var
.set
<unsigned int> (static_cast<unsigned int> (val
));
868 var
.set
<int> (static_cast<int> (val
));
874 gdb_assert_not_reached ("bad parameter type");
878 /* Free function for a param_smob. */
880 pascm_free_parameter_smob (SCM self
)
882 param_smob
*p_smob
= (param_smob
*) SCM_SMOB_DATA (self
);
884 if (var_type_uses
<std::string
> (p_smob
->type
))
886 delete p_smob
->value
.stringval
;
887 p_smob
->value
.stringval
= nullptr;
893 /* Parameter Scheme functions. */
895 /* (make-parameter name
896 [#:command-class cmd-class] [#:parameter-type param-type]
897 [#:enum-list enum-list] [#:set-func function] [#:show-func function]
898 [#:doc <string>] [#:set-doc <string>] [#:show-doc <string>]
899 [#:initial-value initial-value]) -> <gdb:parameter>
901 NAME is the name of the parameter. It may consist of multiple
902 words, in which case the final word is the name of the new parameter,
903 and earlier words must be prefix commands.
905 CMD-CLASS is the kind of command. It should be one of the COMMAND_*
906 constants defined in the gdb module.
908 PARAM_TYPE is the type of the parameter. It should be one of the
909 PARAM_* constants defined in the gdb module.
911 If PARAM-TYPE is PARAM_ENUM, then ENUM-LIST is a list of strings that
912 are the valid values for this parameter. The first value is the default.
914 SET-FUNC, if provided, is called after the parameter is set.
915 It is a function of one parameter: the <gdb:parameter> object.
916 It must return a string to be displayed to the user.
917 Setting a parameter is typically a silent operation, so typically ""
920 SHOW-FUNC, if provided, returns the string that is printed.
921 It is a function of two parameters: the <gdb:parameter> object
922 and the current value of the parameter as a string.
924 DOC, SET-DOC, SHOW-DOC are the doc strings for the parameter.
926 INITIAL-VALUE is the initial value of the parameter.
928 The result is the <gdb:parameter> Scheme object.
929 The parameter is not available to be used yet, however.
930 It must still be added to gdb with register-parameter!. */
933 gdbscm_make_parameter (SCM name_scm
, SCM rest
)
935 const SCM keywords
[] = {
936 command_class_keyword
, parameter_type_keyword
, enum_list_keyword
,
937 set_func_keyword
, show_func_keyword
,
938 doc_keyword
, set_doc_keyword
, show_doc_keyword
,
939 initial_value_keyword
, SCM_BOOL_F
941 int cmd_class_arg_pos
= -1, param_type_arg_pos
= -1;
942 int enum_list_arg_pos
= -1, set_func_arg_pos
= -1, show_func_arg_pos
= -1;
943 int doc_arg_pos
= -1, set_doc_arg_pos
= -1, show_doc_arg_pos
= -1;
944 int initial_value_arg_pos
= -1;
947 int cmd_class
= no_class
;
948 int param_type
= param_boolean
; /* ARI: param_boolean */
949 SCM enum_list_scm
= SCM_BOOL_F
;
950 SCM set_func
= SCM_BOOL_F
, show_func
= SCM_BOOL_F
;
951 char *doc
= NULL
, *set_doc
= NULL
, *show_doc
= NULL
;
952 SCM initial_value_scm
= SCM_BOOL_F
;
953 const char * const *enum_list
= NULL
;
957 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, keywords
, "s#iiOOOsssO",
958 name_scm
, &name
, rest
,
959 &cmd_class_arg_pos
, &cmd_class
,
960 ¶m_type_arg_pos
, ¶m_type
,
961 &enum_list_arg_pos
, &enum_list_scm
,
962 &set_func_arg_pos
, &set_func
,
963 &show_func_arg_pos
, &show_func
,
965 &set_doc_arg_pos
, &set_doc
,
966 &show_doc_arg_pos
, &show_doc
,
967 &initial_value_arg_pos
, &initial_value_scm
);
969 /* If doc is NULL, leave it NULL. See add_setshow_cmd_full. */
971 set_doc
= get_doc_string ();
972 if (show_doc
== NULL
)
973 show_doc
= get_doc_string ();
976 name
= gdbscm_canonicalize_command_name (s
, 0);
981 doc
= gdbscm_gc_xstrdup (s
);
985 set_doc
= gdbscm_gc_xstrdup (s
);
988 show_doc
= gdbscm_gc_xstrdup (s
);
991 if (!gdbscm_valid_command_class_p (cmd_class
))
993 gdbscm_out_of_range_error (FUNC_NAME
, cmd_class_arg_pos
,
994 scm_from_int (cmd_class
),
995 _("invalid command class argument"));
997 if (!pascm_valid_parameter_type_p (param_type
))
999 gdbscm_out_of_range_error (FUNC_NAME
, param_type_arg_pos
,
1000 scm_from_int (param_type
),
1001 _("invalid parameter type argument"));
1003 if (enum_list_arg_pos
> 0 && param_type
!= param_enum
)
1005 gdbscm_misc_error (FUNC_NAME
, enum_list_arg_pos
, enum_list_scm
,
1006 _("#:enum-values can only be provided with PARAM_ENUM"));
1008 if (enum_list_arg_pos
< 0 && param_type
== param_enum
)
1010 gdbscm_misc_error (FUNC_NAME
, GDBSCM_ARG_NONE
, SCM_BOOL_F
,
1011 _("PARAM_ENUM requires an enum-values argument"));
1013 if (set_func_arg_pos
> 0)
1015 SCM_ASSERT_TYPE (gdbscm_is_procedure (set_func
), set_func
,
1016 set_func_arg_pos
, FUNC_NAME
, _("procedure"));
1018 if (show_func_arg_pos
> 0)
1020 SCM_ASSERT_TYPE (gdbscm_is_procedure (show_func
), show_func
,
1021 show_func_arg_pos
, FUNC_NAME
, _("procedure"));
1023 if (param_type
== param_enum
)
1025 /* Note: enum_list lives in GC space, so we don't have to worry about
1026 freeing it if we later throw an exception. */
1027 enum_list
= compute_enum_list (enum_list_scm
, enum_list_arg_pos
,
1031 /* If initial-value is a function, we need the parameter object constructed
1032 to pass it to the function. A typical thing the function may want to do
1033 is add an object-property to it to record the last known good value. */
1034 p_scm
= pascm_make_param_smob ();
1035 p_smob
= (param_smob
*) SCM_SMOB_DATA (p_scm
);
1036 /* These are all stored in GC space so that we don't have to worry about
1037 freeing them if we throw an exception. */
1038 p_smob
->name
= name
;
1039 p_smob
->cmd_class
= (enum command_class
) cmd_class
;
1041 = pascm_param_type_name (static_cast<enum scm_param_types
> (param_type
));
1042 p_smob
->type
= param_to_var
[param_type
].type
;
1043 p_smob
->extra_literals
= param_to_var
[param_type
].extra_literals
;
1045 p_smob
->set_doc
= set_doc
;
1046 p_smob
->show_doc
= show_doc
;
1047 p_smob
->enumeration
= enum_list
;
1048 p_smob
->set_func
= set_func
;
1049 p_smob
->show_func
= show_func
;
1051 scm_set_smob_free (parameter_smob_tag
, pascm_free_parameter_smob
);
1052 if (var_type_uses
<std::string
> (p_smob
->type
))
1053 p_smob
->value
.stringval
= new std::string
;
1055 if (initial_value_arg_pos
> 0)
1057 if (gdbscm_is_procedure (initial_value_scm
))
1059 initial_value_scm
= gdbscm_safe_call_1 (initial_value_scm
,
1060 p_smob
->containing_scm
, NULL
);
1061 if (gdbscm_is_exception (initial_value_scm
))
1062 gdbscm_throw (initial_value_scm
);
1064 pascm_set_param_value_x (p_smob
, enum_list
,
1066 initial_value_arg_pos
, FUNC_NAME
);
1072 /* Subroutine of gdbscm_register_parameter_x to simplify it.
1073 Return non-zero if parameter NAME is already defined in LIST. */
1076 pascm_parameter_defined_p (const char *name
, struct cmd_list_element
*list
)
1078 struct cmd_list_element
*c
;
1080 c
= lookup_cmd_1 (&name
, list
, NULL
, NULL
, 1);
1082 /* If the name is ambiguous that's ok, it's a new parameter still. */
1083 return c
!= NULL
&& c
!= CMD_LIST_AMBIGUOUS
;
1086 /* (register-parameter! <gdb:parameter>) -> unspecified
1088 It is an error to register a pre-existing parameter. */
1091 gdbscm_register_parameter_x (SCM self
)
1094 = pascm_get_param_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
1096 struct cmd_list_element
**set_list
, **show_list
;
1098 if (pascm_is_valid (p_smob
))
1099 scm_misc_error (FUNC_NAME
, _("parameter is already registered"), SCM_EOL
);
1101 cmd_name
= gdbscm_parse_command_name (p_smob
->name
, FUNC_NAME
, SCM_ARG1
,
1102 &set_list
, &setlist
);
1104 cmd_name
= gdbscm_parse_command_name (p_smob
->name
, FUNC_NAME
, SCM_ARG1
,
1105 &show_list
, &showlist
);
1106 p_smob
->cmd_name
= gdbscm_gc_xstrdup (cmd_name
);
1109 if (pascm_parameter_defined_p (p_smob
->cmd_name
, *set_list
))
1111 gdbscm_misc_error (FUNC_NAME
, SCM_ARG1
, self
,
1112 _("parameter exists, \"set\" command is already defined"));
1114 if (pascm_parameter_defined_p (p_smob
->cmd_name
, *show_list
))
1116 gdbscm_misc_error (FUNC_NAME
, SCM_ARG1
, self
,
1117 _("parameter exists, \"show\" command is already defined"));
1120 gdbscm_gdb_exception exc
{};
1123 p_smob
->commands
= add_setshow_generic
1124 (p_smob
->type
, p_smob
->extra_literals
,
1125 p_smob
->cmd_class
, p_smob
->cmd_name
, p_smob
,
1126 p_smob
->set_doc
, p_smob
->show_doc
, p_smob
->doc
,
1127 (gdbscm_is_procedure (p_smob
->set_func
) ? pascm_set_func
: NULL
),
1128 (gdbscm_is_procedure (p_smob
->show_func
) ? pascm_show_func
: NULL
),
1129 set_list
, show_list
);
1131 catch (const gdb_exception
&except
)
1133 exc
= unpack (except
);
1136 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
1137 /* Note: At this point the parameter exists in gdb.
1138 So no more errors after this point. */
1140 /* The owner of this parameter is not in GC-controlled memory, so we need
1141 to protect it from GC until the parameter is deleted. */
1142 scm_gc_protect_object (p_smob
->containing_scm
);
1144 return SCM_UNSPECIFIED
;
1147 /* (parameter-value <gdb:parameter>) -> value
1148 (parameter-value <string>) -> value */
1151 gdbscm_parameter_value (SCM self
)
1153 SCM_ASSERT_TYPE (pascm_is_parameter (self
) || scm_is_string (self
),
1154 self
, SCM_ARG1
, FUNC_NAME
, _("<gdb:parameter> or string"));
1156 if (pascm_is_parameter (self
))
1158 param_smob
*p_smob
= pascm_get_param_smob_arg_unsafe (self
, SCM_ARG1
,
1161 return pascm_param_value (make_setting (p_smob
), SCM_ARG1
, FUNC_NAME
);
1166 struct cmd_list_element
*alias
, *prefix
, *cmd
;
1169 gdbscm_gdb_exception except
{};
1171 gdb::unique_xmalloc_ptr
<char> name
1172 = gdbscm_scm_to_host_string (self
, NULL
, &except_scm
);
1174 gdbscm_throw (except_scm
);
1175 newarg
= concat ("show ", name
.get (), (char *) NULL
);
1178 found
= lookup_cmd_composition (newarg
, &alias
, &prefix
, &cmd
);
1180 catch (const gdb_exception
&ex
)
1182 except
= unpack (ex
);
1186 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
1189 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG1
, self
,
1190 _("parameter not found"));
1193 if (!cmd
->var
.has_value ())
1195 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG1
, self
,
1196 _("not a parameter"));
1199 return pascm_param_value (*cmd
->var
, SCM_ARG1
, FUNC_NAME
);
1203 /* (set-parameter-value! <gdb:parameter> value) -> unspecified */
1206 gdbscm_set_parameter_value_x (SCM self
, SCM value
)
1208 param_smob
*p_smob
= pascm_get_param_smob_arg_unsafe (self
, SCM_ARG1
,
1211 pascm_set_param_value_x (p_smob
, p_smob
->enumeration
,
1212 value
, SCM_ARG2
, FUNC_NAME
);
1214 return SCM_UNSPECIFIED
;
1217 /* Initialize the Scheme parameter support. */
1219 static const scheme_function parameter_functions
[] =
1221 { "make-parameter", 1, 0, 1, as_a_scm_t_subr (gdbscm_make_parameter
),
1223 Make a GDB parameter object.\n\
1226 [#:command-class <cmd-class>] [#:parameter-type <parameter-type>]\n\
1227 [#:enum-list <enum-list>]\n\
1228 [#:set-func function] [#:show-func function]\n\
1229 [#:doc string] [#:set-doc string] [#:show-doc string]\n\
1230 [#:initial-value initial-value]\n\
1231 name: The name of the command. It may consist of multiple words,\n\
1232 in which case the final word is the name of the new parameter, and\n\
1233 earlier words must be prefix commands.\n\
1234 cmd-class: The class of the command, one of COMMAND_*.\n\
1235 The default is COMMAND_NONE.\n\
1236 parameter-type: The kind of parameter, one of PARAM_*\n\
1237 The default is PARAM_BOOLEAN.\n\
1238 enum-list: If parameter-type is PARAM_ENUM, then this specifies the set\n\
1239 of values of the enum.\n\
1240 set-func: A function of one parameter: the <gdb:parameter> object.\n\
1241 Called *after* the parameter has been set. Returns either \"\" or a\n\
1242 non-empty string to be displayed to the user.\n\
1243 If non-empty, GDB will add a trailing newline.\n\
1244 show-func: A function of two parameters: the <gdb:parameter> object\n\
1245 and the string representation of the current value.\n\
1246 The result is a string to be displayed to the user.\n\
1247 GDB will add a trailing newline.\n\
1248 doc: The \"doc string\" of the parameter.\n\
1249 set-doc: The \"doc string\" when setting the parameter.\n\
1250 show-doc: The \"doc string\" when showing the parameter.\n\
1251 initial-value: The initial value of the parameter." },
1253 { "register-parameter!", 1, 0, 0,
1254 as_a_scm_t_subr (gdbscm_register_parameter_x
),
1256 Register a <gdb:parameter> object with GDB." },
1258 { "parameter?", 1, 0, 0, as_a_scm_t_subr (gdbscm_parameter_p
),
1260 Return #t if the object is a <gdb:parameter> object." },
1262 { "parameter-value", 1, 0, 0, as_a_scm_t_subr (gdbscm_parameter_value
),
1264 Return the value of a <gdb:parameter> object\n\
1265 or any gdb parameter if param is a string naming the parameter." },
1267 { "set-parameter-value!", 2, 0, 0,
1268 as_a_scm_t_subr (gdbscm_set_parameter_value_x
),
1270 Set the value of a <gdb:parameter> object.\n\
1272 Arguments: <gdb:parameter> value" },
1278 gdbscm_initialize_parameters (void)
1281 = gdbscm_make_smob_type (param_smob_name
, sizeof (param_smob
));
1282 scm_set_smob_print (parameter_smob_tag
, pascm_print_param_smob
);
1284 gdbscm_define_integer_constants (parameter_types
, 1);
1285 gdbscm_define_functions (parameter_functions
, 1);
1287 command_class_keyword
= scm_from_latin1_keyword ("command-class");
1288 parameter_type_keyword
= scm_from_latin1_keyword ("parameter-type");
1289 enum_list_keyword
= scm_from_latin1_keyword ("enum-list");
1290 set_func_keyword
= scm_from_latin1_keyword ("set-func");
1291 show_func_keyword
= scm_from_latin1_keyword ("show-func");
1292 doc_keyword
= scm_from_latin1_keyword ("doc");
1293 set_doc_keyword
= scm_from_latin1_keyword ("set-doc");
1294 show_doc_keyword
= scm_from_latin1_keyword ("show-doc");
1295 initial_value_keyword
= scm_from_latin1_keyword ("initial-value");
1296 auto_keyword
= scm_from_latin1_keyword ("auto");