1 /* General utility routines for GDB/Scheme code.
3 Copyright (C) 2014 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/>. */
20 /* See README file in this directory for implementation notes, coding
21 conventions, et.al. */
26 #include "gdb_assert.h"
27 #include "guile-internal.h"
29 /* Define VARIABLES in the gdb module. */
32 gdbscm_define_variables (const scheme_variable *variables, int public)
34 const scheme_variable *sv;
36 for (sv = variables; sv->name != NULL; ++sv)
38 scm_c_define (sv->name, sv->value);
40 scm_c_export (sv->name, NULL);
44 /* Define FUNCTIONS in the gdb module. */
47 gdbscm_define_functions (const scheme_function *functions, int public)
49 const scheme_function *sf;
51 for (sf = functions; sf->name != NULL; ++sf)
53 SCM proc = scm_c_define_gsubr (sf->name, sf->required, sf->optional,
56 scm_set_procedure_property_x (proc, gdbscm_documentation_symbol,
57 gdbscm_scm_from_c_string (sf->doc_string));
59 scm_c_export (sf->name, NULL);
63 /* Define CONSTANTS in the gdb module. */
66 gdbscm_define_integer_constants (const scheme_integer_constant *constants,
69 const scheme_integer_constant *sc;
71 for (sc = constants; sc->name != NULL; ++sc)
73 scm_c_define (sc->name, scm_from_int (sc->value));
75 scm_c_export (sc->name, NULL);
79 /* scm_printf, alas it doesn't exist. */
82 gdbscm_printf (SCM port, const char *format, ...)
87 va_start (args, format);
88 string = xstrvprintf (format, args);
90 scm_puts (string, port);
94 /* Utility for calling from gdb to "display" an SCM object. */
97 gdbscm_debug_display (SCM obj)
99 SCM port = scm_current_output_port ();
101 scm_display (obj, port);
103 scm_force_output (port);
106 /* Utility for calling from gdb to "write" an SCM object. */
109 gdbscm_debug_write (SCM obj)
111 SCM port = scm_current_output_port ();
113 scm_write (obj, port);
115 scm_force_output (port);
118 /* Subroutine of gdbscm_parse_function_args to simplify it.
119 Return the number of keyword arguments. */
122 count_keywords (const SCM *keywords)
126 if (keywords == NULL)
128 for (i = 0; keywords[i] != SCM_BOOL_F; ++i)
134 /* Subroutine of gdbscm_parse_function_args to simplify it.
135 Validate an argument format string.
136 The result is a boolean indicating if "." was seen. */
139 validate_arg_format (const char *format)
142 int length = strlen (format);
143 int optional_position = -1;
144 int keyword_position = -1;
147 gdb_assert (length > 0);
149 for (p = format; *p != '\0'; ++p)
164 gdb_assert (keyword_position < 0);
165 gdb_assert (optional_position < 0);
166 optional_position = p - format;
169 gdb_assert (keyword_position < 0);
170 keyword_position = p - format;
173 gdb_assert (p[1] == '\0');
177 gdb_assert_not_reached ("invalid argument format character");
184 /* Our version of SCM_ASSERT_TYPE that calls gdbscm_make_type_error. */
185 #define CHECK_TYPE(ok, arg, position, func_name, expected_type) \
189 return gdbscm_make_type_error ((func_name), (position), (arg), \
194 /* Subroutine of gdbscm_parse_function_args to simplify it.
195 Check the type of ARG against FORMAT_CHAR and extract the value.
196 POSITION is the position of ARG in the argument list.
197 The result is #f upon success or a <gdb:exception> object. */
200 extract_arg (char format_char, SCM arg, void *argp,
201 const char *func_name, int position)
207 char **arg_ptr = argp;
209 CHECK_TYPE (gdbscm_is_true (scm_string_p (arg)), arg, position,
210 func_name, _("string"));
211 *arg_ptr = gdbscm_scm_to_c_string (arg);
218 /* While in Scheme, anything non-#f is "true", we're strict. */
219 CHECK_TYPE (gdbscm_is_bool (arg), arg, position, func_name,
221 *arg_ptr = gdbscm_is_true (arg);
228 CHECK_TYPE (scm_is_signed_integer (arg, INT_MIN, INT_MAX),
229 arg, position, func_name, _("int"));
230 *arg_ptr = scm_to_int (arg);
237 CHECK_TYPE (scm_is_unsigned_integer (arg, 0, UINT_MAX),
238 arg, position, func_name, _("unsigned int"));
239 *arg_ptr = scm_to_uint (arg);
244 long *arg_ptr = argp;
246 CHECK_TYPE (scm_is_signed_integer (arg, LONG_MIN, LONG_MAX),
247 arg, position, func_name, _("long"));
248 *arg_ptr = scm_to_long (arg);
253 unsigned long *arg_ptr = argp;
255 CHECK_TYPE (scm_is_unsigned_integer (arg, 0, ULONG_MAX),
256 arg, position, func_name, _("unsigned long"));
257 *arg_ptr = scm_to_ulong (arg);
262 LONGEST *arg_ptr = argp;
264 CHECK_TYPE (scm_is_signed_integer (arg, INT64_MIN, INT64_MAX),
265 arg, position, func_name, _("LONGEST"));
266 *arg_ptr = gdbscm_scm_to_longest (arg);
271 ULONGEST *arg_ptr = argp;
273 CHECK_TYPE (scm_is_unsigned_integer (arg, 0, UINT64_MAX),
274 arg, position, func_name, _("ULONGEST"));
275 *arg_ptr = gdbscm_scm_to_ulongest (arg);
286 gdb_assert_not_reached ("invalid argument format character");
294 /* Look up KEYWORD in KEYWORD_LIST.
295 The result is the index of the keyword in the list or -1 if not found. */
298 lookup_keyword (const SCM *keyword_list, SCM keyword)
302 while (keyword_list[i] != SCM_BOOL_F)
304 if (scm_is_eq (keyword_list[i], keyword))
312 /* Utility to parse required, optional, and keyword arguments to Scheme
313 functions. Modelled on PyArg_ParseTupleAndKeywords, but no attempt is made
314 at similarity or functionality.
315 There is no result, if there's an error a Scheme exception is thrown.
317 Guile provides scm_c_bind_keyword_arguments, and feel free to use it.
318 This is for times when we want a bit more parsing.
320 BEGINNING_ARG_POS is the position of the first argument passed to this
321 routine. It should be one of the SCM_ARGn values. It could be > SCM_ARG1
322 if the caller chooses not to parse one or more required arguments.
324 KEYWORDS may be NULL if there are no keywords.
327 s - string -> char *, malloc'd
328 t - boolean (gdb uses "t", for biT?) -> int
335 O - random scheme object
336 | - indicates the next set is for optional arguments
337 # - indicates the next set is for keyword arguments (must follow |)
338 . - indicates "rest" arguments are present, this character must appear last
340 FORMAT must match the definition from scm_c_{make,define}_gsubr.
341 Required and optional arguments appear in order in the format string.
342 Afterwards, keyword-based arguments are processed. There must be as many
343 remaining characters in the format string as their are keywords.
344 Except for "|#.", the number of characters in the format string must match
345 #required + #optional + #keywords.
347 The function is required to be defined in a compatible manner:
348 #required-args and #optional-arguments must match, and rest-arguments
349 must be specified if keyword args are desired, and/or regular "rest" args.
351 Example: For this function,
352 scm_c_define_gsubr ("execute", 2, 3, 1, foo);
353 the format string + keyword list could be any of:
354 1) "ss|ttt#tt", { "key1", "key2", NULL }
355 2) "ss|ttt.", { NULL }
356 3) "ss|ttt#t.", { "key1", NULL }
358 For required and optional args pass the SCM of the argument, and a
359 pointer to the value to hold the parsed result (type depends on format
360 char). After that pass the SCM containing the "rest" arguments followed
361 by pointers to values to hold parsed keyword arguments, and if specified
362 a pointer to hold the remaining contents of "rest".
364 For keyword arguments pass two pointers: the first is a pointer to an int
365 that will contain the position of the argument in the arg list, and the
366 second will contain result of processing the argument. The int pointed
367 to by the first value should be initialized to -1. It can then be used
368 to tell whether the keyword was present.
370 If both keyword and rest arguments are present, the caller must pass a
371 pointer to contain the new value of rest (after keyword args have been
374 There's currently no way, that I know of, to specify default values for
375 optional arguments in C-provided functions. At the moment they're a
376 work-in-progress. The caller should test SCM_UNBNDP for each optional
377 argument. Unbound optional arguments are ignored. */
380 gdbscm_parse_function_args (const char *func_name,
381 int beginning_arg_pos,
383 const char *format, ...)
387 int i, have_rest, num_keywords, length, position;
388 int have_optional = 0;
391 /* Keep track of malloc'd strings. We need to free them upon error. */
392 VEC (char_ptr) *allocated_strings = NULL;
395 have_rest = validate_arg_format (format);
396 num_keywords = count_keywords (keywords);
398 va_start (args, format);
401 position = beginning_arg_pos;
403 /* Process required, optional arguments. */
405 while (*p && *p != '#' && *p != '.')
417 arg = va_arg (args, SCM);
418 if (!have_optional || !SCM_UNBNDP (arg))
420 arg_ptr = va_arg (args, void *);
421 status = extract_arg (*p, arg, arg_ptr, func_name, position);
422 if (!gdbscm_is_false (status))
425 VEC_safe_push (char_ptr, allocated_strings, *(char **) arg_ptr);
431 /* Process keyword arguments. */
433 if (have_rest || num_keywords > 0)
434 rest = va_arg (args, SCM);
436 if (num_keywords > 0)
438 SCM *keyword_args = (SCM *) alloca (num_keywords * sizeof (SCM));
439 int *keyword_positions = (int *) alloca (num_keywords * sizeof (int));
441 gdb_assert (*p == '#');
444 for (i = 0; i < num_keywords; ++i)
446 keyword_args[i] = SCM_UNSPECIFIED;
447 keyword_positions[i] = -1;
450 while (scm_is_pair (rest)
451 && scm_is_keyword (scm_car (rest)))
453 SCM keyword = scm_car (rest);
455 i = lookup_keyword (keywords, keyword);
458 status = gdbscm_make_error (scm_arg_type_key, func_name,
459 _("Unrecognized keyword: ~a"),
460 scm_list_1 (keyword), keyword);
463 if (!scm_is_pair (scm_cdr (rest)))
465 status = gdbscm_make_error
466 (scm_arg_type_key, func_name,
467 _("Missing value for keyword argument"),
468 scm_list_1 (keyword), keyword);
471 keyword_args[i] = scm_cadr (rest);
472 keyword_positions[i] = position + 1;
473 rest = scm_cddr (rest);
477 for (i = 0; i < num_keywords; ++i)
479 int *arg_pos_ptr = va_arg (args, int *);
480 void *arg_ptr = va_arg (args, void *);
481 SCM arg = keyword_args[i];
483 if (! scm_is_eq (arg, SCM_UNSPECIFIED))
485 *arg_pos_ptr = keyword_positions[i];
486 status = extract_arg (p[i], arg, arg_ptr, func_name,
487 keyword_positions[i]);
488 if (!gdbscm_is_false (status))
492 VEC_safe_push (char_ptr, allocated_strings,
499 /* Process "rest" arguments. */
503 if (num_keywords > 0)
505 SCM *rest_ptr = va_arg (args, SCM *);
512 if (! scm_is_null (rest))
514 status = gdbscm_make_error (scm_args_number_key, func_name,
515 _("Too many arguments"),
516 SCM_EOL, SCM_BOOL_F);
522 VEC_free (char_ptr, allocated_strings);
527 for (i = 0; VEC_iterate (char_ptr, allocated_strings, i, ptr); ++i)
529 VEC_free (char_ptr, allocated_strings);
530 gdbscm_throw (status);
533 /* Return longest L as a scheme object. */
536 gdbscm_scm_from_longest (LONGEST l)
538 return scm_from_int64 (l);
541 /* Convert scheme object L to LONGEST.
542 It is an error to call this if L is not an integer in range of LONGEST.
543 (because the underlying Scheme function will thrown an exception,
544 which is not part of our contract with the caller). */
547 gdbscm_scm_to_longest (SCM l)
549 return scm_to_int64 (l);
552 /* Return unsigned longest L as a scheme object. */
555 gdbscm_scm_from_ulongest (ULONGEST l)
557 return scm_from_uint64 (l);
560 /* Convert scheme object U to ULONGEST.
561 It is an error to call this if U is not an integer in range of ULONGEST
562 (because the underlying Scheme function will thrown an exception,
563 which is not part of our contract with the caller). */
566 gdbscm_scm_to_ulongest (SCM u)
568 return scm_to_uint64 (u);
571 /* Same as scm_dynwind_free, but uses xfree. */
574 gdbscm_dynwind_xfree (void *ptr)
576 scm_dynwind_unwind_handler (xfree, ptr, SCM_F_WIND_EXPLICITLY);
579 /* Return non-zero if PROC is a procedure. */
582 gdbscm_is_procedure (SCM proc)
584 return gdbscm_is_true (scm_procedure_p (proc));
587 /* Same as xstrdup, but the string is allocated on the GC heap. */
590 gdbscm_gc_xstrdup (const char *str)
592 size_t len = strlen (str);
593 char *result = scm_gc_malloc_pointerless (len + 1, "gdbscm_gc_xstrdup");
595 strcpy (result, str);
599 /* Return a duplicate of ARGV living on the GC heap. */
602 gdbscm_gc_dup_argv (char **argv)
608 for (len = 0, string_space = 0; argv[len] != NULL; ++len)
609 string_space += strlen (argv[len]) + 1;
611 /* Allocating "pointerless" works because the pointers are all
612 self-contained within the object. */
613 result = scm_gc_malloc_pointerless (((len + 1) * sizeof (char *))
614 + string_space, "parameter enum list");
615 p = (char *) &result[len + 1];
617 for (i = 0; i < len; ++i)
625 return (const char * const *) result;
628 /* Return non-zero if the version of Guile being used it at least
629 MAJOR.MINOR.MICRO. */
632 gdbscm_guile_version_is_at_least (int major, int minor, int micro)
634 if (major > gdbscm_guile_major_version)
636 if (major < gdbscm_guile_major_version)
638 if (minor > gdbscm_guile_minor_version)
640 if (minor < gdbscm_guile_minor_version)
642 if (micro > gdbscm_guile_micro_version)