1 /* GDB parameters implemented in Guile.
3 Copyright (C) 2008-2019 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 integer value, for boolean and integer types. */
37 /* Hold an auto_boolean. */
38 enum auto_boolean autoboolval
;
40 /* Hold an unsigned integer value, for uinteger. */
43 /* Hold a string, for the various string types. */
46 /* Hold a string, for enums. */
47 const char *cstringval
;
52 Note: Parameters are added to gdb using a two step process:
53 1) Call make-parameter to create a <gdb:parameter> object.
54 2) Call register-parameter! to add the parameter to gdb.
55 It is done this way so that the constructor, make-parameter, doesn't have
56 any side-effects. This means that the smob needs to store everything
57 that was passed to make-parameter.
59 N.B. There is no free function for this smob.
60 All objects pointed to by this smob must live in GC space. */
62 typedef struct _param_smob
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 /* The type of the parameter. */
81 /* The docs for the parameter. */
86 /* The corresponding gdb command objects.
87 These are NULL if the parameter has not been registered yet, or
88 is no longer registered. */
89 struct cmd_list_element
*set_command
;
90 struct cmd_list_element
*show_command
;
92 /* The value of the parameter. */
93 union pascm_variable value
;
95 /* For an enum parameter, the possible values. The vector lives in GC
96 space, it will be freed with the smob. */
97 const char * const *enumeration
;
99 /* The set_func funcion or #f if not specified.
100 This function is called *after* the parameter is set.
101 It returns a string that will be displayed to the user. */
104 /* The show_func function or #f if not specified.
105 This function returns the string that is printed. */
108 /* The <gdb:parameter> object we are contained in, needed to
109 protect/unprotect the object since a reference to it comes from
110 non-gc-managed space (the command context pointer). */
114 static const char param_smob_name
[] = "gdb:parameter";
116 /* The tag Guile knows the param smob by. */
117 static scm_t_bits parameter_smob_tag
;
119 /* Keywords used by make-parameter!. */
120 static SCM command_class_keyword
;
121 static SCM parameter_type_keyword
;
122 static SCM enum_list_keyword
;
123 static SCM set_func_keyword
;
124 static SCM show_func_keyword
;
125 static SCM doc_keyword
;
126 static SCM set_doc_keyword
;
127 static SCM show_doc_keyword
;
128 static SCM initial_value_keyword
;
129 static SCM auto_keyword
;
130 static SCM unlimited_keyword
;
132 static int pascm_is_valid (param_smob
*);
133 static const char *pascm_param_type_name (enum var_types type
);
134 static SCM
pascm_param_value (enum var_types type
, void *var
,
135 int arg_pos
, const char *func_name
);
137 /* Administrivia for parameter smobs. */
140 pascm_print_param_smob (SCM self
, SCM port
, scm_print_state
*pstate
)
142 param_smob
*p_smob
= (param_smob
*) SCM_SMOB_DATA (self
);
145 gdbscm_printf (port
, "#<%s", param_smob_name
);
147 gdbscm_printf (port
, " %s", p_smob
->name
);
149 if (! pascm_is_valid (p_smob
))
150 scm_puts (" {invalid}", port
);
152 gdbscm_printf (port
, " %s ", pascm_param_type_name (p_smob
->type
));
154 value
= pascm_param_value (p_smob
->type
, &p_smob
->value
,
155 GDBSCM_ARG_NONE
, NULL
);
156 scm_display (value
, port
);
158 scm_puts (">", port
);
160 scm_remember_upto_here_1 (self
);
162 /* Non-zero means success. */
166 /* Create an empty (uninitialized) parameter. */
169 pascm_make_param_smob (void)
171 param_smob
*p_smob
= (param_smob
*)
172 scm_gc_malloc (sizeof (param_smob
), param_smob_name
);
175 memset (p_smob
, 0, sizeof (*p_smob
));
176 p_smob
->cmd_class
= no_class
;
177 p_smob
->type
= var_boolean
; /* ARI: var_boolean */
178 p_smob
->set_func
= SCM_BOOL_F
;
179 p_smob
->show_func
= SCM_BOOL_F
;
180 p_scm
= scm_new_smob (parameter_smob_tag
, (scm_t_bits
) p_smob
);
181 p_smob
->containing_scm
= p_scm
;
182 gdbscm_init_gsmob (&p_smob
->base
);
187 /* Returns non-zero if SCM is a <gdb:parameter> object. */
190 pascm_is_parameter (SCM scm
)
192 return SCM_SMOB_PREDICATE (parameter_smob_tag
, scm
);
195 /* (gdb:parameter? scm) -> boolean */
198 gdbscm_parameter_p (SCM scm
)
200 return scm_from_bool (pascm_is_parameter (scm
));
203 /* Returns the <gdb:parameter> object in SELF.
204 Throws an exception if SELF is not a <gdb:parameter> object. */
207 pascm_get_param_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
209 SCM_ASSERT_TYPE (pascm_is_parameter (self
), self
, arg_pos
, func_name
,
215 /* Returns a pointer to the parameter smob of SELF.
216 Throws an exception if SELF is not a <gdb:parameter> object. */
219 pascm_get_param_smob_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
221 SCM p_scm
= pascm_get_param_arg_unsafe (self
, arg_pos
, func_name
);
222 param_smob
*p_smob
= (param_smob
*) SCM_SMOB_DATA (p_scm
);
227 /* Return non-zero if parameter P_SMOB is valid. */
230 pascm_is_valid (param_smob
*p_smob
)
232 return p_smob
->set_command
!= NULL
;
235 /* A helper function which return the default documentation string for
236 a parameter (which is to say that it's undocumented). */
239 get_doc_string (void)
241 return xstrdup (_("This command is not documented."));
244 /* Subroutine of pascm_set_func, pascm_show_func to simplify them.
245 Signal the error returned from calling set_func/show_func. */
248 pascm_signal_setshow_error (SCM exception
, const char *msg
)
250 /* Don't print the stack if this was an error signalled by the command
252 if (gdbscm_user_error_p (gdbscm_exception_key (exception
)))
254 gdb::unique_xmalloc_ptr
<char> excp_text
255 = gdbscm_exception_message_to_string (exception
);
257 error ("%s", excp_text
.get ());
261 gdbscm_print_gdb_exception (SCM_BOOL_F
, exception
);
266 /* A callback function that is registered against the respective
267 add_setshow_* set_func prototype. This function will call
268 the Scheme function "set_func" which must exist.
269 Note: ARGS is always passed as NULL. */
272 pascm_set_func (const char *args
, int from_tty
, struct cmd_list_element
*c
)
274 param_smob
*p_smob
= (param_smob
*) get_cmd_context (c
);
275 SCM self
, result
, exception
;
277 gdb_assert (gdbscm_is_procedure (p_smob
->set_func
));
279 self
= p_smob
->containing_scm
;
281 result
= gdbscm_safe_call_1 (p_smob
->set_func
, self
, gdbscm_user_error_p
);
283 if (gdbscm_is_exception (result
))
285 pascm_signal_setshow_error (result
,
286 _("Error occurred setting parameter."));
289 if (!scm_is_string (result
))
290 error (_("Result of %s set-func is not a string."), p_smob
->name
);
292 gdb::unique_xmalloc_ptr
<char> msg
= gdbscm_scm_to_host_string (result
, NULL
,
296 gdbscm_print_gdb_exception (SCM_BOOL_F
, exception
);
297 error (_("Error converting show text to host string."));
300 /* GDB is usually silent when a parameter is set. */
301 if (*msg
.get () != '\0')
302 fprintf_filtered (gdb_stdout
, "%s\n", msg
.get ());
305 /* A callback function that is registered against the respective
306 add_setshow_* show_func prototype. This function will call
307 the Scheme function "show_func" which must exist and must return a
308 string that is then printed to FILE. */
311 pascm_show_func (struct ui_file
*file
, int from_tty
,
312 struct cmd_list_element
*c
, const char *value
)
314 param_smob
*p_smob
= (param_smob
*) get_cmd_context (c
);
315 SCM value_scm
, self
, result
, exception
;
317 gdb_assert (gdbscm_is_procedure (p_smob
->show_func
));
319 value_scm
= gdbscm_scm_from_host_string (value
, strlen (value
));
320 if (gdbscm_is_exception (value_scm
))
322 error (_("Error converting parameter value \"%s\" to Scheme string."),
325 self
= p_smob
->containing_scm
;
327 result
= gdbscm_safe_call_2 (p_smob
->show_func
, self
, value_scm
,
328 gdbscm_user_error_p
);
330 if (gdbscm_is_exception (result
))
332 pascm_signal_setshow_error (result
,
333 _("Error occurred showing parameter."));
336 gdb::unique_xmalloc_ptr
<char> msg
= gdbscm_scm_to_host_string (result
, NULL
,
340 gdbscm_print_gdb_exception (SCM_BOOL_F
, exception
);
341 error (_("Error converting show text to host string."));
344 fprintf_filtered (file
, "%s\n", msg
.get ());
347 /* A helper function that dispatches to the appropriate add_setshow
351 add_setshow_generic (enum var_types param_type
, enum command_class cmd_class
,
352 char *cmd_name
, param_smob
*self
,
353 char *set_doc
, char *show_doc
, char *help_doc
,
354 cmd_const_sfunc_ftype
*set_func
,
355 show_value_ftype
*show_func
,
356 struct cmd_list_element
**set_list
,
357 struct cmd_list_element
**show_list
,
358 struct cmd_list_element
**set_cmd
,
359 struct cmd_list_element
**show_cmd
)
361 struct cmd_list_element
*param
= NULL
;
362 const char *tmp_name
= NULL
;
367 add_setshow_boolean_cmd (cmd_name
, cmd_class
,
369 set_doc
, show_doc
, help_doc
,
371 set_list
, show_list
);
375 case var_auto_boolean
:
376 add_setshow_auto_boolean_cmd (cmd_name
, cmd_class
,
377 &self
->value
.autoboolval
,
378 set_doc
, show_doc
, help_doc
,
380 set_list
, show_list
);
384 add_setshow_uinteger_cmd (cmd_name
, cmd_class
,
385 &self
->value
.uintval
,
386 set_doc
, show_doc
, help_doc
,
388 set_list
, show_list
);
392 add_setshow_zinteger_cmd (cmd_name
, cmd_class
,
394 set_doc
, show_doc
, help_doc
,
396 set_list
, show_list
);
400 add_setshow_zuinteger_cmd (cmd_name
, cmd_class
,
401 &self
->value
.uintval
,
402 set_doc
, show_doc
, help_doc
,
404 set_list
, show_list
);
407 case var_zuinteger_unlimited
:
408 add_setshow_zuinteger_unlimited_cmd (cmd_name
, cmd_class
,
410 set_doc
, show_doc
, help_doc
,
412 set_list
, show_list
);
416 add_setshow_string_cmd (cmd_name
, cmd_class
,
417 &self
->value
.stringval
,
418 set_doc
, show_doc
, help_doc
,
420 set_list
, show_list
);
423 case var_string_noescape
:
424 add_setshow_string_noescape_cmd (cmd_name
, cmd_class
,
425 &self
->value
.stringval
,
426 set_doc
, show_doc
, help_doc
,
428 set_list
, show_list
);
432 case var_optional_filename
:
433 add_setshow_optional_filename_cmd (cmd_name
, cmd_class
,
434 &self
->value
.stringval
,
435 set_doc
, show_doc
, help_doc
,
437 set_list
, show_list
);
441 add_setshow_filename_cmd (cmd_name
, cmd_class
,
442 &self
->value
.stringval
,
443 set_doc
, show_doc
, help_doc
,
445 set_list
, show_list
);
449 add_setshow_enum_cmd (cmd_name
, cmd_class
,
451 &self
->value
.cstringval
,
452 set_doc
, show_doc
, help_doc
,
454 set_list
, show_list
);
455 /* Initialize the value, just in case. */
456 self
->value
.cstringval
= self
->enumeration
[0];
460 gdb_assert_not_reached ("bad param_type value");
463 /* Lookup created parameter, and register Scheme object against the
464 parameter context. Perform this task against both lists. */
466 param
= lookup_cmd (&tmp_name
, *show_list
, "", 0, 1);
467 gdb_assert (param
!= NULL
);
468 set_cmd_context (param
, self
);
472 param
= lookup_cmd (&tmp_name
, *set_list
, "", 0, 1);
473 gdb_assert (param
!= NULL
);
474 set_cmd_context (param
, self
);
478 /* Return an array of strings corresponding to the enum values for
480 Throws an exception if there's a problem with the values.
481 Space for the result is allocated from the GC heap. */
483 static const char * const *
484 compute_enum_list (SCM enum_values_scm
, int arg_pos
, const char *func_name
)
488 const char * const *result
;
490 SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (enum_values_scm
)),
491 enum_values_scm
, arg_pos
, func_name
, _("list"));
493 size
= scm_ilength (enum_values_scm
);
496 gdbscm_out_of_range_error (FUNC_NAME
, arg_pos
, enum_values_scm
,
497 _("enumeration list is empty"));
500 enum_values
= XCNEWVEC (char *, size
+ 1);
503 while (!scm_is_eq (enum_values_scm
, SCM_EOL
))
505 SCM value
= scm_car (enum_values_scm
);
508 if (!scm_is_string (value
))
510 freeargv (enum_values
);
511 SCM_ASSERT_TYPE (0, value
, arg_pos
, func_name
, _("string"));
513 enum_values
[i
] = gdbscm_scm_to_host_string (value
, NULL
,
514 &exception
).release ();
515 if (enum_values
[i
] == NULL
)
517 freeargv (enum_values
);
518 gdbscm_throw (exception
);
521 enum_values_scm
= scm_cdr (enum_values_scm
);
523 gdb_assert (i
== size
);
525 result
= gdbscm_gc_dup_argv (enum_values
);
526 freeargv (enum_values
);
530 static const scheme_integer_constant parameter_types
[] =
532 /* Note: var_integer is deprecated, and intentionally does not
534 { "PARAM_BOOLEAN", var_boolean
}, /* ARI: var_boolean */
535 { "PARAM_AUTO_BOOLEAN", var_auto_boolean
},
536 { "PARAM_ZINTEGER", var_zinteger
},
537 { "PARAM_UINTEGER", var_uinteger
},
538 { "PARAM_ZUINTEGER", var_zuinteger
},
539 { "PARAM_ZUINTEGER_UNLIMITED", var_zuinteger_unlimited
},
540 { "PARAM_STRING", var_string
},
541 { "PARAM_STRING_NOESCAPE", var_string_noescape
},
542 { "PARAM_OPTIONAL_FILENAME", var_optional_filename
},
543 { "PARAM_FILENAME", var_filename
},
544 { "PARAM_ENUM", var_enum
},
546 END_INTEGER_CONSTANTS
549 /* Return non-zero if PARAM_TYPE is a valid parameter type. */
552 pascm_valid_parameter_type_p (int param_type
)
556 for (i
= 0; parameter_types
[i
].name
!= NULL
; ++i
)
558 if (parameter_types
[i
].value
== param_type
)
565 /* Return PARAM_TYPE as a string. */
568 pascm_param_type_name (enum var_types param_type
)
572 for (i
= 0; parameter_types
[i
].name
!= NULL
; ++i
)
574 if (parameter_types
[i
].value
== param_type
)
575 return parameter_types
[i
].name
;
578 gdb_assert_not_reached ("bad parameter type");
581 /* Return the value of a gdb parameter as a Scheme value.
582 If TYPE is not supported, then a <gdb:exception> object is returned. */
585 pascm_param_value (enum var_types type
, void *var
,
586 int arg_pos
, const char *func_name
)
588 /* Note: We *could* support var_integer here in case someone is trying to get
589 the value of a Python-created parameter (which is the only place that
590 still supports var_integer). To further discourage its use we do not. */
595 case var_string_noescape
:
596 case var_optional_filename
:
600 const char *str
= *(char **) var
;
604 return gdbscm_scm_from_host_string (str
, strlen (str
));
615 case var_auto_boolean
:
617 enum auto_boolean ab
= * (enum auto_boolean
*) var
;
619 if (ab
== AUTO_BOOLEAN_TRUE
)
621 else if (ab
== AUTO_BOOLEAN_FALSE
)
627 case var_zuinteger_unlimited
:
628 if (* (int *) var
== -1)
629 return unlimited_keyword
;
630 gdb_assert (* (int *) var
>= 0);
633 return scm_from_int (* (int *) var
);
636 if (* (unsigned int *) var
== UINT_MAX
)
637 return unlimited_keyword
;
640 return scm_from_uint (* (unsigned int *) var
);
646 return gdbscm_make_out_of_range_error (func_name
, arg_pos
,
648 _("program error: unhandled type"));
651 /* Set the value of a parameter of type TYPE in VAR from VALUE.
652 ENUMERATION is the list of enum values for enum parameters, otherwise NULL.
653 Throws a Scheme exception if VALUE_SCM is invalid for TYPE. */
656 pascm_set_param_value_x (enum var_types type
, union pascm_variable
*var
,
657 const char * const *enumeration
,
658 SCM value
, int arg_pos
, const char *func_name
)
663 case var_string_noescape
:
664 case var_optional_filename
:
666 SCM_ASSERT_TYPE (scm_is_string (value
)
667 || (type
!= var_filename
668 && gdbscm_is_false (value
)),
669 value
, arg_pos
, func_name
,
670 _("string or #f for non-PARAM_FILENAME parameters"));
671 if (gdbscm_is_false (value
))
673 xfree (var
->stringval
);
674 if (type
== var_optional_filename
)
675 var
->stringval
= xstrdup ("");
677 var
->stringval
= NULL
;
683 gdb::unique_xmalloc_ptr
<char> string
684 = gdbscm_scm_to_host_string (value
, NULL
, &exception
);
686 gdbscm_throw (exception
);
687 xfree (var
->stringval
);
688 var
->stringval
= string
.release ();
697 SCM_ASSERT_TYPE (scm_is_string (value
), value
, arg_pos
, func_name
,
699 gdb::unique_xmalloc_ptr
<char> str
700 = gdbscm_scm_to_host_string (value
, NULL
, &exception
);
702 gdbscm_throw (exception
);
703 for (i
= 0; enumeration
[i
]; ++i
)
705 if (strcmp (enumeration
[i
], str
.get ()) == 0)
708 if (enumeration
[i
] == NULL
)
710 gdbscm_out_of_range_error (func_name
, arg_pos
, value
,
711 _("not member of enumeration"));
713 var
->cstringval
= enumeration
[i
];
718 SCM_ASSERT_TYPE (gdbscm_is_bool (value
), value
, arg_pos
, func_name
,
720 var
->intval
= gdbscm_is_true (value
);
723 case var_auto_boolean
:
724 SCM_ASSERT_TYPE (gdbscm_is_bool (value
)
725 || scm_is_eq (value
, auto_keyword
),
726 value
, arg_pos
, func_name
,
727 _("boolean or #:auto"));
728 if (scm_is_eq (value
, auto_keyword
))
729 var
->autoboolval
= AUTO_BOOLEAN_AUTO
;
730 else if (gdbscm_is_true (value
))
731 var
->autoboolval
= AUTO_BOOLEAN_TRUE
;
733 var
->autoboolval
= AUTO_BOOLEAN_FALSE
;
739 case var_zuinteger_unlimited
:
740 if (type
== var_uinteger
741 || type
== var_zuinteger_unlimited
)
743 SCM_ASSERT_TYPE (gdbscm_is_bool (value
)
744 || scm_is_eq (value
, unlimited_keyword
),
745 value
, arg_pos
, func_name
,
746 _("integer or #:unlimited"));
747 if (scm_is_eq (value
, unlimited_keyword
))
749 if (type
== var_uinteger
)
750 var
->intval
= UINT_MAX
;
758 SCM_ASSERT_TYPE (scm_is_integer (value
), value
, arg_pos
, func_name
,
762 if (type
== var_uinteger
763 || type
== var_zuinteger
)
765 unsigned int u
= scm_to_uint (value
);
767 if (type
== var_uinteger
&& u
== 0)
773 int i
= scm_to_int (value
);
775 if (type
== var_zuinteger_unlimited
&& i
< -1)
777 gdbscm_out_of_range_error (func_name
, arg_pos
, value
,
785 gdb_assert_not_reached ("bad parameter type");
789 /* Parameter Scheme functions. */
791 /* (make-parameter name
792 [#:command-class cmd-class] [#:parameter-type param-type]
793 [#:enum-list enum-list] [#:set-func function] [#:show-func function]
794 [#:doc <string>] [#:set-doc <string>] [#:show-doc <string>]
795 [#:initial-value initial-value]) -> <gdb:parameter>
797 NAME is the name of the parameter. It may consist of multiple
798 words, in which case the final word is the name of the new parameter,
799 and earlier words must be prefix commands.
801 CMD-CLASS is the kind of command. It should be one of the COMMAND_*
802 constants defined in the gdb module.
804 PARAM_TYPE is the type of the parameter. It should be one of the
805 PARAM_* constants defined in the gdb module.
807 If PARAM-TYPE is PARAM_ENUM, then ENUM-LIST is a list of strings that
808 are the valid values for this parameter. The first value is the default.
810 SET-FUNC, if provided, is called after the parameter is set.
811 It is a function of one parameter: the <gdb:parameter> object.
812 It must return a string to be displayed to the user.
813 Setting a parameter is typically a silent operation, so typically ""
816 SHOW-FUNC, if provided, returns the string that is printed.
817 It is a function of two parameters: the <gdb:parameter> object
818 and the current value of the parameter as a string.
820 DOC, SET-DOC, SHOW-DOC are the doc strings for the parameter.
822 INITIAL-VALUE is the initial value of the parameter.
824 The result is the <gdb:parameter> Scheme object.
825 The parameter is not available to be used yet, however.
826 It must still be added to gdb with register-parameter!. */
829 gdbscm_make_parameter (SCM name_scm
, SCM rest
)
831 const SCM keywords
[] = {
832 command_class_keyword
, parameter_type_keyword
, enum_list_keyword
,
833 set_func_keyword
, show_func_keyword
,
834 doc_keyword
, set_doc_keyword
, show_doc_keyword
,
835 initial_value_keyword
, SCM_BOOL_F
837 int cmd_class_arg_pos
= -1, param_type_arg_pos
= -1;
838 int enum_list_arg_pos
= -1, set_func_arg_pos
= -1, show_func_arg_pos
= -1;
839 int doc_arg_pos
= -1, set_doc_arg_pos
= -1, show_doc_arg_pos
= -1;
840 int initial_value_arg_pos
= -1;
843 int cmd_class
= no_class
;
844 int param_type
= var_boolean
; /* ARI: var_boolean */
845 SCM enum_list_scm
= SCM_BOOL_F
;
846 SCM set_func
= SCM_BOOL_F
, show_func
= SCM_BOOL_F
;
847 char *doc
= NULL
, *set_doc
= NULL
, *show_doc
= NULL
;
848 SCM initial_value_scm
= SCM_BOOL_F
;
849 const char * const *enum_list
= NULL
;
853 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, keywords
, "s#iiOOOsssO",
854 name_scm
, &name
, rest
,
855 &cmd_class_arg_pos
, &cmd_class
,
856 ¶m_type_arg_pos
, ¶m_type
,
857 &enum_list_arg_pos
, &enum_list_scm
,
858 &set_func_arg_pos
, &set_func
,
859 &show_func_arg_pos
, &show_func
,
861 &set_doc_arg_pos
, &set_doc
,
862 &show_doc_arg_pos
, &show_doc
,
863 &initial_value_arg_pos
, &initial_value_scm
);
865 /* If doc is NULL, leave it NULL. See add_setshow_cmd_full. */
867 set_doc
= get_doc_string ();
868 if (show_doc
== NULL
)
869 show_doc
= get_doc_string ();
872 name
= gdbscm_canonicalize_command_name (s
, 0);
877 doc
= gdbscm_gc_xstrdup (s
);
881 set_doc
= gdbscm_gc_xstrdup (s
);
884 show_doc
= gdbscm_gc_xstrdup (s
);
887 if (!gdbscm_valid_command_class_p (cmd_class
))
889 gdbscm_out_of_range_error (FUNC_NAME
, cmd_class_arg_pos
,
890 scm_from_int (cmd_class
),
891 _("invalid command class argument"));
893 if (!pascm_valid_parameter_type_p (param_type
))
895 gdbscm_out_of_range_error (FUNC_NAME
, param_type_arg_pos
,
896 scm_from_int (param_type
),
897 _("invalid parameter type argument"));
899 if (enum_list_arg_pos
> 0 && param_type
!= var_enum
)
901 gdbscm_misc_error (FUNC_NAME
, enum_list_arg_pos
, enum_list_scm
,
902 _("#:enum-values can only be provided with PARAM_ENUM"));
904 if (enum_list_arg_pos
< 0 && param_type
== var_enum
)
906 gdbscm_misc_error (FUNC_NAME
, GDBSCM_ARG_NONE
, SCM_BOOL_F
,
907 _("PARAM_ENUM requires an enum-values argument"));
909 if (set_func_arg_pos
> 0)
911 SCM_ASSERT_TYPE (gdbscm_is_procedure (set_func
), set_func
,
912 set_func_arg_pos
, FUNC_NAME
, _("procedure"));
914 if (show_func_arg_pos
> 0)
916 SCM_ASSERT_TYPE (gdbscm_is_procedure (show_func
), show_func
,
917 show_func_arg_pos
, FUNC_NAME
, _("procedure"));
919 if (param_type
== var_enum
)
921 /* Note: enum_list lives in GC space, so we don't have to worry about
922 freeing it if we later throw an exception. */
923 enum_list
= compute_enum_list (enum_list_scm
, enum_list_arg_pos
,
927 /* If initial-value is a function, we need the parameter object constructed
928 to pass it to the function. A typical thing the function may want to do
929 is add an object-property to it to record the last known good value. */
930 p_scm
= pascm_make_param_smob ();
931 p_smob
= (param_smob
*) SCM_SMOB_DATA (p_scm
);
932 /* These are all stored in GC space so that we don't have to worry about
933 freeing them if we throw an exception. */
935 p_smob
->cmd_class
= (enum command_class
) cmd_class
;
936 p_smob
->type
= (enum var_types
) param_type
;
938 p_smob
->set_doc
= set_doc
;
939 p_smob
->show_doc
= show_doc
;
940 p_smob
->enumeration
= enum_list
;
941 p_smob
->set_func
= set_func
;
942 p_smob
->show_func
= show_func
;
944 if (initial_value_arg_pos
> 0)
946 if (gdbscm_is_procedure (initial_value_scm
))
948 initial_value_scm
= gdbscm_safe_call_1 (initial_value_scm
,
949 p_smob
->containing_scm
, NULL
);
950 if (gdbscm_is_exception (initial_value_scm
))
951 gdbscm_throw (initial_value_scm
);
953 pascm_set_param_value_x (p_smob
->type
, &p_smob
->value
, enum_list
,
955 initial_value_arg_pos
, FUNC_NAME
);
961 /* Subroutine of gdbscm_register_parameter_x to simplify it.
962 Return non-zero if parameter NAME is already defined in LIST. */
965 pascm_parameter_defined_p (const char *name
, struct cmd_list_element
*list
)
967 struct cmd_list_element
*c
;
969 c
= lookup_cmd_1 (&name
, list
, NULL
, 1);
971 /* If the name is ambiguous that's ok, it's a new parameter still. */
972 return c
!= NULL
&& c
!= CMD_LIST_AMBIGUOUS
;
975 /* (register-parameter! <gdb:parameter>) -> unspecified
977 It is an error to register a pre-existing parameter. */
980 gdbscm_register_parameter_x (SCM self
)
983 = pascm_get_param_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
985 struct cmd_list_element
**set_list
, **show_list
;
987 if (pascm_is_valid (p_smob
))
988 scm_misc_error (FUNC_NAME
, _("parameter is already registered"), SCM_EOL
);
990 cmd_name
= gdbscm_parse_command_name (p_smob
->name
, FUNC_NAME
, SCM_ARG1
,
991 &set_list
, &setlist
);
993 cmd_name
= gdbscm_parse_command_name (p_smob
->name
, FUNC_NAME
, SCM_ARG1
,
994 &show_list
, &showlist
);
995 p_smob
->cmd_name
= gdbscm_gc_xstrdup (cmd_name
);
998 if (pascm_parameter_defined_p (p_smob
->cmd_name
, *set_list
))
1000 gdbscm_misc_error (FUNC_NAME
, SCM_ARG1
, self
,
1001 _("parameter exists, \"set\" command is already defined"));
1003 if (pascm_parameter_defined_p (p_smob
->cmd_name
, *show_list
))
1005 gdbscm_misc_error (FUNC_NAME
, SCM_ARG1
, self
,
1006 _("parameter exists, \"show\" command is already defined"));
1011 add_setshow_generic (p_smob
->type
, p_smob
->cmd_class
,
1012 p_smob
->cmd_name
, p_smob
,
1013 p_smob
->set_doc
, p_smob
->show_doc
, p_smob
->doc
,
1014 (gdbscm_is_procedure (p_smob
->set_func
)
1015 ? pascm_set_func
: NULL
),
1016 (gdbscm_is_procedure (p_smob
->show_func
)
1017 ? pascm_show_func
: NULL
),
1018 set_list
, show_list
,
1019 &p_smob
->set_command
, &p_smob
->show_command
);
1021 CATCH (except
, RETURN_MASK_ALL
)
1023 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
1027 /* Note: At this point the parameter exists in gdb.
1028 So no more errors after this point. */
1030 /* The owner of this parameter is not in GC-controlled memory, so we need
1031 to protect it from GC until the parameter is deleted. */
1032 scm_gc_protect_object (p_smob
->containing_scm
);
1034 return SCM_UNSPECIFIED
;
1037 /* (parameter-value <gdb:parameter>) -> value
1038 (parameter-value <string>) -> value */
1041 gdbscm_parameter_value (SCM self
)
1043 SCM_ASSERT_TYPE (pascm_is_parameter (self
) || scm_is_string (self
),
1044 self
, SCM_ARG1
, FUNC_NAME
, _("<gdb:parameter> or string"));
1046 if (pascm_is_parameter (self
))
1048 param_smob
*p_smob
= pascm_get_param_smob_arg_unsafe (self
, SCM_ARG1
,
1051 return pascm_param_value (p_smob
->type
, &p_smob
->value
,
1052 SCM_ARG1
, FUNC_NAME
);
1057 struct cmd_list_element
*alias
, *prefix
, *cmd
;
1060 struct gdb_exception except
= exception_none
;
1062 gdb::unique_xmalloc_ptr
<char> name
1063 = gdbscm_scm_to_host_string (self
, NULL
, &except_scm
);
1065 gdbscm_throw (except_scm
);
1066 newarg
= concat ("show ", name
.get (), (char *) NULL
);
1069 found
= lookup_cmd_composition (newarg
, &alias
, &prefix
, &cmd
);
1071 CATCH (ex
, RETURN_MASK_ALL
)
1078 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
1081 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG1
, self
,
1082 _("parameter not found"));
1084 if (cmd
->var
== NULL
)
1086 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG1
, self
,
1087 _("not a parameter"));
1090 return pascm_param_value (cmd
->var_type
, cmd
->var
, SCM_ARG1
, FUNC_NAME
);
1094 /* (set-parameter-value! <gdb:parameter> value) -> unspecified */
1097 gdbscm_set_parameter_value_x (SCM self
, SCM value
)
1099 param_smob
*p_smob
= pascm_get_param_smob_arg_unsafe (self
, SCM_ARG1
,
1102 pascm_set_param_value_x (p_smob
->type
, &p_smob
->value
, p_smob
->enumeration
,
1103 value
, SCM_ARG2
, FUNC_NAME
);
1105 return SCM_UNSPECIFIED
;
1108 /* Initialize the Scheme parameter support. */
1110 static const scheme_function parameter_functions
[] =
1112 { "make-parameter", 1, 0, 1, as_a_scm_t_subr (gdbscm_make_parameter
),
1114 Make a GDB parameter object.\n\
1117 [#:command-class <cmd-class>] [#:parameter-type <parameter-type>]\n\
1118 [#:enum-list <enum-list>]\n\
1119 [#:set-func function] [#:show-func function]\n\
1120 [#:doc string] [#:set-doc string] [#:show-doc string]\n\
1121 [#:initial-value initial-value]\n\
1122 name: The name of the command. It may consist of multiple words,\n\
1123 in which case the final word is the name of the new parameter, and\n\
1124 earlier words must be prefix commands.\n\
1125 cmd-class: The class of the command, one of COMMAND_*.\n\
1126 The default is COMMAND_NONE.\n\
1127 parameter-type: The kind of parameter, one of PARAM_*\n\
1128 The default is PARAM_BOOLEAN.\n\
1129 enum-list: If parameter-type is PARAM_ENUM, then this specifies the set\n\
1130 of values of the enum.\n\
1131 set-func: A function of one parameter: the <gdb:parameter> object.\n\
1132 Called *after* the parameter has been set. Returns either \"\" or a\n\
1133 non-empty string to be displayed to the user.\n\
1134 If non-empty, GDB will add a trailing newline.\n\
1135 show-func: A function of two parameters: the <gdb:parameter> object\n\
1136 and the string representation of the current value.\n\
1137 The result is a string to be displayed to the user.\n\
1138 GDB will add a trailing newline.\n\
1139 doc: The \"doc string\" of the parameter.\n\
1140 set-doc: The \"doc string\" when setting the parameter.\n\
1141 show-doc: The \"doc string\" when showing the parameter.\n\
1142 initial-value: The initial value of the parameter." },
1144 { "register-parameter!", 1, 0, 0,
1145 as_a_scm_t_subr (gdbscm_register_parameter_x
),
1147 Register a <gdb:parameter> object with GDB." },
1149 { "parameter?", 1, 0, 0, as_a_scm_t_subr (gdbscm_parameter_p
),
1151 Return #t if the object is a <gdb:parameter> object." },
1153 { "parameter-value", 1, 0, 0, as_a_scm_t_subr (gdbscm_parameter_value
),
1155 Return the value of a <gdb:parameter> object\n\
1156 or any gdb parameter if param is a string naming the parameter." },
1158 { "set-parameter-value!", 2, 0, 0,
1159 as_a_scm_t_subr (gdbscm_set_parameter_value_x
),
1161 Set the value of a <gdb:parameter> object.\n\
1163 Arguments: <gdb:parameter> value" },
1169 gdbscm_initialize_parameters (void)
1172 = gdbscm_make_smob_type (param_smob_name
, sizeof (param_smob
));
1173 scm_set_smob_print (parameter_smob_tag
, pascm_print_param_smob
);
1175 gdbscm_define_integer_constants (parameter_types
, 1);
1176 gdbscm_define_functions (parameter_functions
, 1);
1178 command_class_keyword
= scm_from_latin1_keyword ("command-class");
1179 parameter_type_keyword
= scm_from_latin1_keyword ("parameter-type");
1180 enum_list_keyword
= scm_from_latin1_keyword ("enum-list");
1181 set_func_keyword
= scm_from_latin1_keyword ("set-func");
1182 show_func_keyword
= scm_from_latin1_keyword ("show-func");
1183 doc_keyword
= scm_from_latin1_keyword ("doc");
1184 set_doc_keyword
= scm_from_latin1_keyword ("set-doc");
1185 show_doc_keyword
= scm_from_latin1_keyword ("show-doc");
1186 initial_value_keyword
= scm_from_latin1_keyword ("initial-value");
1187 auto_keyword
= scm_from_latin1_keyword ("auto");
1188 unlimited_keyword
= scm_from_latin1_keyword ("unlimited");