1 /* GDB parameters implemented in Guile.
3 Copyright (C) 2008-2016 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 char *excp_text
= gdbscm_exception_message_to_string (exception
);
256 make_cleanup (xfree
, excp_text
);
257 error ("%s", excp_text
);
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 (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 struct cleanup
*cleanups
;
279 gdb_assert (gdbscm_is_procedure (p_smob
->set_func
));
281 self
= p_smob
->containing_scm
;
283 result
= gdbscm_safe_call_1 (p_smob
->set_func
, self
, gdbscm_user_error_p
);
285 if (gdbscm_is_exception (result
))
287 pascm_signal_setshow_error (result
,
288 _("Error occurred setting parameter."));
291 if (!scm_is_string (result
))
292 error (_("Result of %s set-func is not a string."), p_smob
->name
);
294 msg
= gdbscm_scm_to_host_string (result
, NULL
, &exception
);
297 gdbscm_print_gdb_exception (SCM_BOOL_F
, exception
);
298 error (_("Error converting show text to host string."));
301 cleanups
= make_cleanup (xfree
, msg
);
302 /* GDB is usually silent when a parameter is set. */
304 fprintf_filtered (gdb_stdout
, "%s\n", msg
);
305 do_cleanups (cleanups
);
308 /* A callback function that is registered against the respective
309 add_setshow_* show_func prototype. This function will call
310 the Scheme function "show_func" which must exist and must return a
311 string that is then printed to FILE. */
314 pascm_show_func (struct ui_file
*file
, int from_tty
,
315 struct cmd_list_element
*c
, const char *value
)
317 param_smob
*p_smob
= (param_smob
*) get_cmd_context (c
);
318 SCM value_scm
, self
, result
, exception
;
320 struct cleanup
*cleanups
;
322 gdb_assert (gdbscm_is_procedure (p_smob
->show_func
));
324 value_scm
= gdbscm_scm_from_host_string (value
, strlen (value
));
325 if (gdbscm_is_exception (value_scm
))
327 error (_("Error converting parameter value \"%s\" to Scheme string."),
330 self
= p_smob
->containing_scm
;
332 result
= gdbscm_safe_call_2 (p_smob
->show_func
, self
, value_scm
,
333 gdbscm_user_error_p
);
335 if (gdbscm_is_exception (result
))
337 pascm_signal_setshow_error (result
,
338 _("Error occurred showing parameter."));
341 msg
= gdbscm_scm_to_host_string (result
, NULL
, &exception
);
344 gdbscm_print_gdb_exception (SCM_BOOL_F
, exception
);
345 error (_("Error converting show text to host string."));
348 cleanups
= make_cleanup (xfree
, msg
);
349 fprintf_filtered (file
, "%s\n", msg
);
350 do_cleanups (cleanups
);
353 /* A helper function that dispatches to the appropriate add_setshow
357 add_setshow_generic (enum var_types param_type
, enum command_class cmd_class
,
358 char *cmd_name
, param_smob
*self
,
359 char *set_doc
, char *show_doc
, char *help_doc
,
360 cmd_sfunc_ftype
*set_func
,
361 show_value_ftype
*show_func
,
362 struct cmd_list_element
**set_list
,
363 struct cmd_list_element
**show_list
,
364 struct cmd_list_element
**set_cmd
,
365 struct cmd_list_element
**show_cmd
)
367 struct cmd_list_element
*param
= NULL
;
368 const char *tmp_name
= NULL
;
373 add_setshow_boolean_cmd (cmd_name
, cmd_class
,
375 set_doc
, show_doc
, help_doc
,
377 set_list
, show_list
);
381 case var_auto_boolean
:
382 add_setshow_auto_boolean_cmd (cmd_name
, cmd_class
,
383 &self
->value
.autoboolval
,
384 set_doc
, show_doc
, help_doc
,
386 set_list
, show_list
);
390 add_setshow_uinteger_cmd (cmd_name
, cmd_class
,
391 &self
->value
.uintval
,
392 set_doc
, show_doc
, help_doc
,
394 set_list
, show_list
);
398 add_setshow_zinteger_cmd (cmd_name
, cmd_class
,
400 set_doc
, show_doc
, help_doc
,
402 set_list
, show_list
);
406 add_setshow_zuinteger_cmd (cmd_name
, cmd_class
,
407 &self
->value
.uintval
,
408 set_doc
, show_doc
, help_doc
,
410 set_list
, show_list
);
413 case var_zuinteger_unlimited
:
414 add_setshow_zuinteger_unlimited_cmd (cmd_name
, cmd_class
,
416 set_doc
, show_doc
, help_doc
,
418 set_list
, show_list
);
422 add_setshow_string_cmd (cmd_name
, cmd_class
,
423 &self
->value
.stringval
,
424 set_doc
, show_doc
, help_doc
,
426 set_list
, show_list
);
429 case var_string_noescape
:
430 add_setshow_string_noescape_cmd (cmd_name
, cmd_class
,
431 &self
->value
.stringval
,
432 set_doc
, show_doc
, help_doc
,
434 set_list
, show_list
);
438 case var_optional_filename
:
439 add_setshow_optional_filename_cmd (cmd_name
, cmd_class
,
440 &self
->value
.stringval
,
441 set_doc
, show_doc
, help_doc
,
443 set_list
, show_list
);
447 add_setshow_filename_cmd (cmd_name
, cmd_class
,
448 &self
->value
.stringval
,
449 set_doc
, show_doc
, help_doc
,
451 set_list
, show_list
);
455 add_setshow_enum_cmd (cmd_name
, cmd_class
,
457 &self
->value
.cstringval
,
458 set_doc
, show_doc
, help_doc
,
460 set_list
, show_list
);
461 /* Initialize the value, just in case. */
462 self
->value
.cstringval
= self
->enumeration
[0];
466 gdb_assert_not_reached ("bad param_type value");
469 /* Lookup created parameter, and register Scheme object against the
470 parameter context. Perform this task against both lists. */
472 param
= lookup_cmd (&tmp_name
, *show_list
, "", 0, 1);
473 gdb_assert (param
!= NULL
);
474 set_cmd_context (param
, self
);
478 param
= lookup_cmd (&tmp_name
, *set_list
, "", 0, 1);
479 gdb_assert (param
!= NULL
);
480 set_cmd_context (param
, self
);
484 /* Return an array of strings corresponding to the enum values for
486 Throws an exception if there's a problem with the values.
487 Space for the result is allocated from the GC heap. */
489 static const char * const *
490 compute_enum_list (SCM enum_values_scm
, int arg_pos
, const char *func_name
)
494 const char * const *result
;
496 SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (enum_values_scm
)),
497 enum_values_scm
, arg_pos
, func_name
, _("list"));
499 size
= scm_ilength (enum_values_scm
);
502 gdbscm_out_of_range_error (FUNC_NAME
, arg_pos
, enum_values_scm
,
503 _("enumeration list is empty"));
506 enum_values
= XCNEWVEC (char *, size
+ 1);
509 while (!scm_is_eq (enum_values_scm
, SCM_EOL
))
511 SCM value
= scm_car (enum_values_scm
);
514 if (!scm_is_string (value
))
516 freeargv (enum_values
);
517 SCM_ASSERT_TYPE (0, value
, arg_pos
, func_name
, _("string"));
519 enum_values
[i
] = gdbscm_scm_to_host_string (value
, NULL
, &exception
);
520 if (enum_values
[i
] == NULL
)
522 freeargv (enum_values
);
523 gdbscm_throw (exception
);
526 enum_values_scm
= scm_cdr (enum_values_scm
);
528 gdb_assert (i
== size
);
530 result
= gdbscm_gc_dup_argv (enum_values
);
531 freeargv (enum_values
);
535 static const scheme_integer_constant parameter_types
[] =
537 /* Note: var_integer is deprecated, and intentionally does not
539 { "PARAM_BOOLEAN", var_boolean
}, /* ARI: var_boolean */
540 { "PARAM_AUTO_BOOLEAN", var_auto_boolean
},
541 { "PARAM_ZINTEGER", var_zinteger
},
542 { "PARAM_UINTEGER", var_uinteger
},
543 { "PARAM_ZUINTEGER", var_zuinteger
},
544 { "PARAM_ZUINTEGER_UNLIMITED", var_zuinteger_unlimited
},
545 { "PARAM_STRING", var_string
},
546 { "PARAM_STRING_NOESCAPE", var_string_noescape
},
547 { "PARAM_OPTIONAL_FILENAME", var_optional_filename
},
548 { "PARAM_FILENAME", var_filename
},
549 { "PARAM_ENUM", var_enum
},
551 END_INTEGER_CONSTANTS
554 /* Return non-zero if PARAM_TYPE is a valid parameter type. */
557 pascm_valid_parameter_type_p (int param_type
)
561 for (i
= 0; parameter_types
[i
].name
!= NULL
; ++i
)
563 if (parameter_types
[i
].value
== param_type
)
570 /* Return PARAM_TYPE as a string. */
573 pascm_param_type_name (enum var_types param_type
)
577 for (i
= 0; parameter_types
[i
].name
!= NULL
; ++i
)
579 if (parameter_types
[i
].value
== param_type
)
580 return parameter_types
[i
].name
;
583 gdb_assert_not_reached ("bad parameter type");
586 /* Return the value of a gdb parameter as a Scheme value.
587 If TYPE is not supported, then a <gdb:exception> object is returned. */
590 pascm_param_value (enum var_types type
, void *var
,
591 int arg_pos
, const char *func_name
)
593 /* Note: We *could* support var_integer here in case someone is trying to get
594 the value of a Python-created parameter (which is the only place that
595 still supports var_integer). To further discourage its use we do not. */
600 case var_string_noescape
:
601 case var_optional_filename
:
605 char *str
= * (char **) var
;
609 return gdbscm_scm_from_host_string (str
, strlen (str
));
620 case var_auto_boolean
:
622 enum auto_boolean ab
= * (enum auto_boolean
*) var
;
624 if (ab
== AUTO_BOOLEAN_TRUE
)
626 else if (ab
== AUTO_BOOLEAN_FALSE
)
632 case var_zuinteger_unlimited
:
633 if (* (int *) var
== -1)
634 return unlimited_keyword
;
635 gdb_assert (* (int *) var
>= 0);
638 return scm_from_int (* (int *) var
);
641 if (* (unsigned int *) var
== UINT_MAX
)
642 return unlimited_keyword
;
645 return scm_from_uint (* (unsigned int *) var
);
651 return gdbscm_make_out_of_range_error (func_name
, arg_pos
,
653 _("program error: unhandled type"));
656 /* Set the value of a parameter of type TYPE in VAR from VALUE.
657 ENUMERATION is the list of enum values for enum parameters, otherwise NULL.
658 Throws a Scheme exception if VALUE_SCM is invalid for TYPE. */
661 pascm_set_param_value_x (enum var_types type
, union pascm_variable
*var
,
662 const char * const *enumeration
,
663 SCM value
, int arg_pos
, const char *func_name
)
668 case var_string_noescape
:
669 case var_optional_filename
:
671 SCM_ASSERT_TYPE (scm_is_string (value
)
672 || (type
!= var_filename
673 && gdbscm_is_false (value
)),
674 value
, arg_pos
, func_name
,
675 _("string or #f for non-PARAM_FILENAME parameters"));
676 if (gdbscm_is_false (value
))
678 xfree (var
->stringval
);
679 if (type
== var_optional_filename
)
680 var
->stringval
= xstrdup ("");
682 var
->stringval
= NULL
;
689 string
= gdbscm_scm_to_host_string (value
, NULL
, &exception
);
691 gdbscm_throw (exception
);
692 xfree (var
->stringval
);
693 var
->stringval
= string
;
703 SCM_ASSERT_TYPE (scm_is_string (value
), value
, arg_pos
, func_name
,
705 str
= gdbscm_scm_to_host_string (value
, NULL
, &exception
);
707 gdbscm_throw (exception
);
708 for (i
= 0; enumeration
[i
]; ++i
)
710 if (strcmp (enumeration
[i
], str
) == 0)
714 if (enumeration
[i
] == NULL
)
716 gdbscm_out_of_range_error (func_name
, arg_pos
, value
,
717 _("not member of enumeration"));
719 var
->cstringval
= enumeration
[i
];
724 SCM_ASSERT_TYPE (gdbscm_is_bool (value
), value
, arg_pos
, func_name
,
726 var
->intval
= gdbscm_is_true (value
);
729 case var_auto_boolean
:
730 SCM_ASSERT_TYPE (gdbscm_is_bool (value
)
731 || scm_is_eq (value
, auto_keyword
),
732 value
, arg_pos
, func_name
,
733 _("boolean or #:auto"));
734 if (scm_is_eq (value
, auto_keyword
))
735 var
->autoboolval
= AUTO_BOOLEAN_AUTO
;
736 else if (gdbscm_is_true (value
))
737 var
->autoboolval
= AUTO_BOOLEAN_TRUE
;
739 var
->autoboolval
= AUTO_BOOLEAN_FALSE
;
745 case var_zuinteger_unlimited
:
746 if (type
== var_uinteger
747 || type
== var_zuinteger_unlimited
)
749 SCM_ASSERT_TYPE (gdbscm_is_bool (value
)
750 || scm_is_eq (value
, unlimited_keyword
),
751 value
, arg_pos
, func_name
,
752 _("integer or #:unlimited"));
753 if (scm_is_eq (value
, unlimited_keyword
))
755 if (type
== var_uinteger
)
756 var
->intval
= UINT_MAX
;
764 SCM_ASSERT_TYPE (scm_is_integer (value
), value
, arg_pos
, func_name
,
768 if (type
== var_uinteger
769 || type
== var_zuinteger
)
771 unsigned int u
= scm_to_uint (value
);
773 if (type
== var_uinteger
&& u
== 0)
779 int i
= scm_to_int (value
);
781 if (type
== var_zuinteger_unlimited
&& i
< -1)
783 gdbscm_out_of_range_error (func_name
, arg_pos
, value
,
791 gdb_assert_not_reached ("bad parameter type");
795 /* Parameter Scheme functions. */
797 /* (make-parameter name
798 [#:command-class cmd-class] [#:parameter-type param-type]
799 [#:enum-list enum-list] [#:set-func function] [#:show-func function]
800 [#:doc <string>] [#:set-doc <string>] [#:show-doc <string>]
801 [#:initial-value initial-value]) -> <gdb:parameter>
803 NAME is the name of the parameter. It may consist of multiple
804 words, in which case the final word is the name of the new parameter,
805 and earlier words must be prefix commands.
807 CMD-CLASS is the kind of command. It should be one of the COMMAND_*
808 constants defined in the gdb module.
810 PARAM_TYPE is the type of the parameter. It should be one of the
811 PARAM_* constants defined in the gdb module.
813 If PARAM-TYPE is PARAM_ENUM, then ENUM-LIST is a list of strings that
814 are the valid values for this parameter. The first value is the default.
816 SET-FUNC, if provided, is called after the parameter is set.
817 It is a function of one parameter: the <gdb:parameter> object.
818 It must return a string to be displayed to the user.
819 Setting a parameter is typically a silent operation, so typically ""
822 SHOW-FUNC, if provided, returns the string that is printed.
823 It is a function of two parameters: the <gdb:parameter> object
824 and the current value of the parameter as a string.
826 DOC, SET-DOC, SHOW-DOC are the doc strings for the parameter.
828 INITIAL-VALUE is the initial value of the parameter.
830 The result is the <gdb:parameter> Scheme object.
831 The parameter is not available to be used yet, however.
832 It must still be added to gdb with register-parameter!. */
835 gdbscm_make_parameter (SCM name_scm
, SCM rest
)
837 const SCM keywords
[] = {
838 command_class_keyword
, parameter_type_keyword
, enum_list_keyword
,
839 set_func_keyword
, show_func_keyword
,
840 doc_keyword
, set_doc_keyword
, show_doc_keyword
,
841 initial_value_keyword
, SCM_BOOL_F
843 int cmd_class_arg_pos
= -1, param_type_arg_pos
= -1;
844 int enum_list_arg_pos
= -1, set_func_arg_pos
= -1, show_func_arg_pos
= -1;
845 int doc_arg_pos
= -1, set_doc_arg_pos
= -1, show_doc_arg_pos
= -1;
846 int initial_value_arg_pos
= -1;
849 int cmd_class
= no_class
;
850 int param_type
= var_boolean
; /* ARI: var_boolean */
851 SCM enum_list_scm
= SCM_BOOL_F
;
852 SCM set_func
= SCM_BOOL_F
, show_func
= SCM_BOOL_F
;
853 char *doc
= NULL
, *set_doc
= NULL
, *show_doc
= NULL
;
854 SCM initial_value_scm
= SCM_BOOL_F
;
855 const char * const *enum_list
= NULL
;
859 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, keywords
, "s#iiOOOsssO",
860 name_scm
, &name
, rest
,
861 &cmd_class_arg_pos
, &cmd_class
,
862 ¶m_type_arg_pos
, ¶m_type
,
863 &enum_list_arg_pos
, &enum_list_scm
,
864 &set_func_arg_pos
, &set_func
,
865 &show_func_arg_pos
, &show_func
,
867 &set_doc_arg_pos
, &set_doc
,
868 &show_doc_arg_pos
, &show_doc
,
869 &initial_value_arg_pos
, &initial_value_scm
);
871 /* If doc is NULL, leave it NULL. See add_setshow_cmd_full. */
873 set_doc
= get_doc_string ();
874 if (show_doc
== NULL
)
875 show_doc
= get_doc_string ();
878 name
= gdbscm_canonicalize_command_name (s
, 0);
883 doc
= gdbscm_gc_xstrdup (s
);
887 set_doc
= gdbscm_gc_xstrdup (s
);
890 show_doc
= gdbscm_gc_xstrdup (s
);
893 if (!gdbscm_valid_command_class_p (cmd_class
))
895 gdbscm_out_of_range_error (FUNC_NAME
, cmd_class_arg_pos
,
896 scm_from_int (cmd_class
),
897 _("invalid command class argument"));
899 if (!pascm_valid_parameter_type_p (param_type
))
901 gdbscm_out_of_range_error (FUNC_NAME
, param_type_arg_pos
,
902 scm_from_int (param_type
),
903 _("invalid parameter type argument"));
905 if (enum_list_arg_pos
> 0 && param_type
!= var_enum
)
907 gdbscm_misc_error (FUNC_NAME
, enum_list_arg_pos
, enum_list_scm
,
908 _("#:enum-values can only be provided with PARAM_ENUM"));
910 if (enum_list_arg_pos
< 0 && param_type
== var_enum
)
912 gdbscm_misc_error (FUNC_NAME
, GDBSCM_ARG_NONE
, SCM_BOOL_F
,
913 _("PARAM_ENUM requires an enum-values argument"));
915 if (set_func_arg_pos
> 0)
917 SCM_ASSERT_TYPE (gdbscm_is_procedure (set_func
), set_func
,
918 set_func_arg_pos
, FUNC_NAME
, _("procedure"));
920 if (show_func_arg_pos
> 0)
922 SCM_ASSERT_TYPE (gdbscm_is_procedure (show_func
), show_func
,
923 show_func_arg_pos
, FUNC_NAME
, _("procedure"));
925 if (param_type
== var_enum
)
927 /* Note: enum_list lives in GC space, so we don't have to worry about
928 freeing it if we later throw an exception. */
929 enum_list
= compute_enum_list (enum_list_scm
, enum_list_arg_pos
,
933 /* If initial-value is a function, we need the parameter object constructed
934 to pass it to the function. A typical thing the function may want to do
935 is add an object-property to it to record the last known good value. */
936 p_scm
= pascm_make_param_smob ();
937 p_smob
= (param_smob
*) SCM_SMOB_DATA (p_scm
);
938 /* These are all stored in GC space so that we don't have to worry about
939 freeing them if we throw an exception. */
941 p_smob
->cmd_class
= (enum command_class
) cmd_class
;
942 p_smob
->type
= (enum var_types
) param_type
;
944 p_smob
->set_doc
= set_doc
;
945 p_smob
->show_doc
= show_doc
;
946 p_smob
->enumeration
= enum_list
;
947 p_smob
->set_func
= set_func
;
948 p_smob
->show_func
= show_func
;
950 if (initial_value_arg_pos
> 0)
952 if (gdbscm_is_procedure (initial_value_scm
))
954 initial_value_scm
= gdbscm_safe_call_1 (initial_value_scm
,
955 p_smob
->containing_scm
, NULL
);
956 if (gdbscm_is_exception (initial_value_scm
))
957 gdbscm_throw (initial_value_scm
);
959 pascm_set_param_value_x (p_smob
->type
, &p_smob
->value
, enum_list
,
961 initial_value_arg_pos
, FUNC_NAME
);
967 /* Subroutine of gdbscm_register_parameter_x to simplify it.
968 Return non-zero if parameter NAME is already defined in LIST. */
971 pascm_parameter_defined_p (const char *name
, struct cmd_list_element
*list
)
973 struct cmd_list_element
*c
;
975 c
= lookup_cmd_1 (&name
, list
, NULL
, 1);
977 /* If the name is ambiguous that's ok, it's a new parameter still. */
978 return c
!= NULL
&& c
!= CMD_LIST_AMBIGUOUS
;
981 /* (register-parameter! <gdb:parameter>) -> unspecified
983 It is an error to register a pre-existing parameter. */
986 gdbscm_register_parameter_x (SCM self
)
989 = pascm_get_param_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
991 struct cmd_list_element
**set_list
, **show_list
;
993 if (pascm_is_valid (p_smob
))
994 scm_misc_error (FUNC_NAME
, _("parameter is already registered"), SCM_EOL
);
996 cmd_name
= gdbscm_parse_command_name (p_smob
->name
, FUNC_NAME
, SCM_ARG1
,
997 &set_list
, &setlist
);
999 cmd_name
= gdbscm_parse_command_name (p_smob
->name
, FUNC_NAME
, SCM_ARG1
,
1000 &show_list
, &showlist
);
1001 p_smob
->cmd_name
= gdbscm_gc_xstrdup (cmd_name
);
1004 if (pascm_parameter_defined_p (p_smob
->cmd_name
, *set_list
))
1006 gdbscm_misc_error (FUNC_NAME
, SCM_ARG1
, self
,
1007 _("parameter exists, \"set\" command is already defined"));
1009 if (pascm_parameter_defined_p (p_smob
->cmd_name
, *show_list
))
1011 gdbscm_misc_error (FUNC_NAME
, SCM_ARG1
, self
,
1012 _("parameter exists, \"show\" command is already defined"));
1017 add_setshow_generic (p_smob
->type
, p_smob
->cmd_class
,
1018 p_smob
->cmd_name
, p_smob
,
1019 p_smob
->set_doc
, p_smob
->show_doc
, p_smob
->doc
,
1020 (gdbscm_is_procedure (p_smob
->set_func
)
1021 ? pascm_set_func
: NULL
),
1022 (gdbscm_is_procedure (p_smob
->show_func
)
1023 ? pascm_show_func
: NULL
),
1024 set_list
, show_list
,
1025 &p_smob
->set_command
, &p_smob
->show_command
);
1027 CATCH (except
, RETURN_MASK_ALL
)
1029 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
1033 /* Note: At this point the parameter exists in gdb.
1034 So no more errors after this point. */
1036 /* The owner of this parameter is not in GC-controlled memory, so we need
1037 to protect it from GC until the parameter is deleted. */
1038 scm_gc_protect_object (p_smob
->containing_scm
);
1040 return SCM_UNSPECIFIED
;
1043 /* (parameter-value <gdb:parameter>) -> value
1044 (parameter-value <string>) -> value */
1047 gdbscm_parameter_value (SCM self
)
1049 SCM_ASSERT_TYPE (pascm_is_parameter (self
) || scm_is_string (self
),
1050 self
, SCM_ARG1
, FUNC_NAME
, _("<gdb:parameter> or string"));
1052 if (pascm_is_parameter (self
))
1054 param_smob
*p_smob
= pascm_get_param_smob_arg_unsafe (self
, SCM_ARG1
,
1057 return pascm_param_value (p_smob
->type
, &p_smob
->value
,
1058 SCM_ARG1
, FUNC_NAME
);
1064 struct cmd_list_element
*alias
, *prefix
, *cmd
;
1068 struct gdb_exception except
= exception_none
;
1070 name
= gdbscm_scm_to_host_string (self
, NULL
, &except_scm
);
1072 gdbscm_throw (except_scm
);
1073 newarg
= concat ("show ", name
, (char *) NULL
);
1076 found
= lookup_cmd_composition (newarg
, &alias
, &prefix
, &cmd
);
1078 CATCH (ex
, RETURN_MASK_ALL
)
1086 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
1089 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG1
, self
,
1090 _("parameter not found"));
1092 if (cmd
->var
== NULL
)
1094 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG1
, self
,
1095 _("not a parameter"));
1098 return pascm_param_value (cmd
->var_type
, cmd
->var
, SCM_ARG1
, FUNC_NAME
);
1102 /* (set-parameter-value! <gdb:parameter> value) -> unspecified */
1105 gdbscm_set_parameter_value_x (SCM self
, SCM value
)
1107 param_smob
*p_smob
= pascm_get_param_smob_arg_unsafe (self
, SCM_ARG1
,
1110 pascm_set_param_value_x (p_smob
->type
, &p_smob
->value
, p_smob
->enumeration
,
1111 value
, SCM_ARG2
, FUNC_NAME
);
1113 return SCM_UNSPECIFIED
;
1116 /* Initialize the Scheme parameter support. */
1118 static const scheme_function parameter_functions
[] =
1120 { "make-parameter", 1, 0, 1, as_a_scm_t_subr (gdbscm_make_parameter
),
1122 Make a GDB parameter object.\n\
1125 [#:command-class <cmd-class>] [#:parameter-type <parameter-type>]\n\
1126 [#:enum-list <enum-list>]\n\
1127 [#:set-func function] [#:show-func function]\n\
1128 [#:doc string] [#:set-doc string] [#:show-doc string]\n\
1129 [#:initial-value initial-value]\n\
1130 name: The name of the command. It may consist of multiple words,\n\
1131 in which case the final word is the name of the new parameter, and\n\
1132 earlier words must be prefix commands.\n\
1133 cmd-class: The class of the command, one of COMMAND_*.\n\
1134 The default is COMMAND_NONE.\n\
1135 parameter-type: The kind of parameter, one of PARAM_*\n\
1136 The default is PARAM_BOOLEAN.\n\
1137 enum-list: If parameter-type is PARAM_ENUM, then this specifies the set\n\
1138 of values of the enum.\n\
1139 set-func: A function of one parameter: the <gdb:parameter> object.\n\
1140 Called *after* the parameter has been set. Returns either \"\" or a\n\
1141 non-empty string to be displayed to the user.\n\
1142 If non-empty, GDB will add a trailing newline.\n\
1143 show-func: A function of two parameters: the <gdb:parameter> object\n\
1144 and the string representation of the current value.\n\
1145 The result is a string to be displayed to the user.\n\
1146 GDB will add a trailing newline.\n\
1147 doc: The \"doc string\" of the parameter.\n\
1148 set-doc: The \"doc string\" when setting the parameter.\n\
1149 show-doc: The \"doc string\" when showing the parameter.\n\
1150 initial-value: The initial value of the parameter." },
1152 { "register-parameter!", 1, 0, 0,
1153 as_a_scm_t_subr (gdbscm_register_parameter_x
),
1155 Register a <gdb:parameter> object with GDB." },
1157 { "parameter?", 1, 0, 0, as_a_scm_t_subr (gdbscm_parameter_p
),
1159 Return #t if the object is a <gdb:parameter> object." },
1161 { "parameter-value", 1, 0, 0, as_a_scm_t_subr (gdbscm_parameter_value
),
1163 Return the value of a <gdb:parameter> object\n\
1164 or any gdb parameter if param is a string naming the parameter." },
1166 { "set-parameter-value!", 2, 0, 0,
1167 as_a_scm_t_subr (gdbscm_set_parameter_value_x
),
1169 Set the value of a <gdb:parameter> object.\n\
1171 Arguments: <gdb:parameter> value" },
1177 gdbscm_initialize_parameters (void)
1180 = gdbscm_make_smob_type (param_smob_name
, sizeof (param_smob
));
1181 scm_set_smob_print (parameter_smob_tag
, pascm_print_param_smob
);
1183 gdbscm_define_integer_constants (parameter_types
, 1);
1184 gdbscm_define_functions (parameter_functions
, 1);
1186 command_class_keyword
= scm_from_latin1_keyword ("command-class");
1187 parameter_type_keyword
= scm_from_latin1_keyword ("parameter-type");
1188 enum_list_keyword
= scm_from_latin1_keyword ("enum-list");
1189 set_func_keyword
= scm_from_latin1_keyword ("set-func");
1190 show_func_keyword
= scm_from_latin1_keyword ("show-func");
1191 doc_keyword
= scm_from_latin1_keyword ("doc");
1192 set_doc_keyword
= scm_from_latin1_keyword ("set-doc");
1193 show_doc_keyword
= scm_from_latin1_keyword ("show-doc");
1194 initial_value_keyword
= scm_from_latin1_keyword ("initial-value");
1195 auto_keyword
= scm_from_latin1_keyword ("auto");
1196 unlimited_keyword
= scm_from_latin1_keyword ("unlimited");