diff options
author | Doug Evans <xdje42@gmail.com> | 2014-02-09 19:40:01 -0800 |
---|---|---|
committer | Doug Evans <xdje42@gmail.com> | 2014-02-09 19:40:01 -0800 |
commit | ed3ef33944c39d9a3cea72b9a7cef3c20f0e3461 (patch) | |
tree | 4e67d95b8ea65bb36a9cade5e37df2ad6289052e /gdb/guile/scm-utils.c | |
parent | 7026a7c16ee82d39e84823f8cc3097a9a940ddb2 (diff) | |
download | gdb-ed3ef33944c39d9a3cea72b9a7cef3c20f0e3461.zip gdb-ed3ef33944c39d9a3cea72b9a7cef3c20f0e3461.tar.gz gdb-ed3ef33944c39d9a3cea72b9a7cef3c20f0e3461.tar.bz2 |
Add Guile as an extension language.
* NEWS: Mention Guile scripting.
* Makefile.in (SUBDIR_GUILE_OBS): New variable.
(SUBDIR_GUILE_SRCS, SUBDIR_GUILE_DEPS): New variables
(SUBDIR_GUILE_LDFLAGS, SUBDIR_GUILE_CFLAGS): New variables.
(INTERNAL_CPPFLAGS): Add GUILE_CPPFLAGS.
(CLIBS): Add GUILE_LIBS.
(install-guile): New rule.
(guile.o): New rule.
(scm-arch.o, scm-auto-load.o, scm-block.o): New rules.
(scm-breakpoint.o, scm-disasm.o, scm-exception.o): New rules.
(scm-frame.o, scm-iterator.o, scm-lazy-string.o): New rules.
(scm-math.o, scm-objfile.o, scm-ports.o): New rules.
(scm-pretty-print.o, scm-safe-call.o, scm-gsmob.o): New rules.
(scm-string.o, scm-symbol.o, scm-symtab.o): New rules.
(scm-type.o, scm-utils.o, scm-value.o): New rules.
* configure.ac: New option --with-guile.
* configure: Regenerate.
* config.in: Regenerate.
* auto-load.c: Remove #include "python/python.h". Add #include
"gdb/section-scripts.h".
(source_section_scripts): Handle Guile scripts.
(_initialize_auto_load): Add name of Guile objfile script to
scripts-directory help text.
* breakpoint.c (condition_command): Tweak comment to include Scheme.
* breakpoint.h (gdbscm_breakpoint_object): Add forward decl.
(struct breakpoint): New member scm_bp_object.
* defs.h (enum command_control_type): New value guile_control.
* cli/cli-cmds.c: Remove #include "python/python.h". Add #include
"extension.h".
(show_user): Update comment.
(_initialize_cli_cmds): Update help text for "show user". Update help
text for max-user-call-depth.
* cli/cli-script.c: Remove #include "python/python.h". Add #include
"extension.h".
(multi_line_command_p): Add guile_control.
(print_command_lines): Handle guile_control.
(execute_control_command, recurse_read_control_structure): Ditto.
(process_next_line): Recognize "guile" commands.
* disasm.c (gdb_disassemble_info): Make non-static.
* disasm.h: #include "dis-asm.h".
(struct gdbarch): Add forward decl.
(gdb_disassemble_info): Declare.
* extension.c: #include "guile/guile.h".
(extension_languages): Add guile.
(get_ext_lang_defn): Handle EXT_LANG_GDB.
* extension.h (enum extension_language): New value EXT_LANG_GUILE.
* gdbtypes.c (get_unsigned_type_max): New function.
(get_signed_type_minmax): New function.
* gdbtypes.h (get_unsigned_type_max): Declare.
(get_signed_type_minmax): Declare.
* guile/README: New file.
* guile/guile-internal.h: New file.
* guile/guile.c: New file.
* guile/guile.h: New file.
* guile/scm-arch.c: New file.
* guile/scm-auto-load.c: New file.
* guile/scm-block.c: New file.
* guile/scm-breakpoint.c: New file.
* guile/scm-disasm.c: New file.
* guile/scm-exception.c: New file.
* guile/scm-frame.c: New file.
* guile/scm-gsmob.c: New file.
* guile/scm-iterator.c: New file.
* guile/scm-lazy-string.c: New file.
* guile/scm-math.c: New file.
* guile/scm-objfile.c: New file.
* guile/scm-ports.c: New file.
* guile/scm-pretty-print.c: New file.
* guile/scm-safe-call.c: New file.
* guile/scm-string.c: New file.
* guile/scm-symbol.c: New file.
* guile/scm-symtab.c: New file.
* guile/scm-type.c: New file.
* guile/scm-utils.c: New file.
* guile/scm-value.c: New file.
* guile/lib/gdb.scm: New file.
* guile/lib/gdb/boot.scm: New file.
* guile/lib/gdb/experimental.scm: New file.
* guile/lib/gdb/init.scm: New file.
* guile/lib/gdb/iterator.scm: New file.
* guile/lib/gdb/printing.scm: New file.
* guile/lib/gdb/types.scm: New file.
* data-directory/Makefile.in (GUILE_SRCDIR): New variable.
(VPATH): Add $(GUILE_SRCDIR).
(GUILE_DIR): New variable.
(GUILE_INSTALL_DIR, GUILE_FILES): New variables.
(all): Add stamp-guile dependency.
(stamp-guile): New rule.
(clean-guile, install-guile, uninstall-guile): New rules.
(install-only): Add install-guile dependency.
(uninstall): Add uninstall-guile dependency.
(clean): Add clean-guile dependency.
doc/
* Makefile.in (GDB_DOC_FILES): Add guile.texi.
* gdb.texinfo (Auto-loading): Add set/show auto-load guile-scripts.
(Extending GDB): New menu entries Guile, Multiple Extension Languages.
(Guile docs): Include guile.texi.
(objfile-gdbdotext file): Add objfile-gdb.scm.
(dotdebug_gdb_scripts section): Mention Guile scripts.
(Multiple Extension Languages): New node.
* guile.texi: New file.
testsuite/
* configure.ac (AC_OUTPUT): Add gdb.guile.
* configure: Regenerate.
* lib/gdb-guile.exp: New file.
* lib/gdb.exp (get_target_charset): New function.
* gdb.base/help.exp: Update expected output from "apropos apropos".
* gdb.guile/Makefile.in: New file.
* gdb.guile/guile.exp: New file.
* gdb.guile/scm-arch.c: New file.
* gdb.guile/scm-arch.exp: New file.
* gdb.guile/scm-block.c: New file.
* gdb.guile/scm-block.exp: New file.
* gdb.guile/scm-breakpoint.c: New file.
* gdb.guile/scm-breakpoint.exp: New file.
* gdb.guile/scm-disasm.c: New file.
* gdb.guile/scm-disasm.exp: New file.
* gdb.guile/scm-equal.c: New file.
* gdb.guile/scm-equal.exp: New file.
* gdb.guile/scm-error.exp: New file.
* gdb.guile/scm-error.scm: New file.
* gdb.guile/scm-frame-args.c: New file.
* gdb.guile/scm-frame-args.exp: New file.
* gdb.guile/scm-frame-args.scm: New file.
* gdb.guile/scm-frame-inline.c: New file.
* gdb.guile/scm-frame-inline.exp: New file.
* gdb.guile/scm-frame.c: New file.
* gdb.guile/scm-frame.exp: New file.
* gdb.guile/scm-generics.exp: New file.
* gdb.guile/scm-gsmob.exp: New file.
* gdb.guile/scm-iterator.c: New file.
* gdb.guile/scm-iterator.exp: New file.
* gdb.guile/scm-math.c: New file.
* gdb.guile/scm-math.exp: New file.
* gdb.guile/scm-objfile-script-gdb.in: New file.
* gdb.guile/scm-objfile-script.c: New file.
* gdb.guile/scm-objfile-script.exp: New file.
* gdb.guile/scm-objfile.c: New file.
* gdb.guile/scm-objfile.exp: New file.
* gdb.guile/scm-ports.exp: New file.
* gdb.guile/scm-pretty-print.c: New file.
* gdb.guile/scm-pretty-print.exp: New file.
* gdb.guile/scm-pretty-print.scm: New file.
* gdb.guile/scm-section-script.c: New file.
* gdb.guile/scm-section-script.exp: New file.
* gdb.guile/scm-section-script.scm: New file.
* gdb.guile/scm-symbol.c: New file.
* gdb.guile/scm-symbol.exp: New file.
* gdb.guile/scm-symtab-2.c: New file.
* gdb.guile/scm-symtab.c: New file.
* gdb.guile/scm-symtab.exp: New file.
* gdb.guile/scm-type.c: New file.
* gdb.guile/scm-type.exp: New file.
* gdb.guile/scm-value-cc.cc: New file.
* gdb.guile/scm-value-cc.exp: New file.
* gdb.guile/scm-value.c: New file.
* gdb.guile/scm-value.exp: New file.
* gdb.guile/source2.scm: New file.
* gdb.guile/types-module.cc: New file.
* gdb.guile/types-module.exp: New file.
Diffstat (limited to 'gdb/guile/scm-utils.c')
-rw-r--r-- | gdb/guile/scm-utils.c | 585 |
1 files changed, 585 insertions, 0 deletions
diff --git a/gdb/guile/scm-utils.c b/gdb/guile/scm-utils.c new file mode 100644 index 0000000..9e9901d --- /dev/null +++ b/gdb/guile/scm-utils.c @@ -0,0 +1,585 @@ +/* General utility routines for GDB/Scheme code. + + Copyright (C) 2014 Free Software Foundation, Inc. + + This file is part of GDB. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see <http://www.gnu.org/licenses/>. */ + +/* See README file in this directory for implementation notes, coding + conventions, et.al. */ + +#include "defs.h" +#include <stdarg.h> +#include <stdint.h> +#include "gdb_assert.h" +#include "guile-internal.h" + +/* Define VARIABLES in the gdb module. */ + +void +gdbscm_define_variables (const scheme_variable *variables, int public) +{ + const scheme_variable *sv; + + for (sv = variables; sv->name != NULL; ++sv) + { + scm_c_define (sv->name, sv->value); + if (public) + scm_c_export (sv->name, NULL); + } +} + +/* Define FUNCTIONS in the gdb module. */ + +void +gdbscm_define_functions (const scheme_function *functions, int public) +{ + const scheme_function *sf; + + for (sf = functions; sf->name != NULL; ++sf) + { + SCM proc = scm_c_define_gsubr (sf->name, sf->required, sf->optional, + sf->rest, sf->func); + + scm_set_procedure_property_x (proc, gdbscm_documentation_symbol, + gdbscm_scm_from_c_string (sf->doc_string)); + if (public) + scm_c_export (sf->name, NULL); + } +} + +/* Define CONSTANTS in the gdb module. */ + +void +gdbscm_define_integer_constants (const scheme_integer_constant *constants, + int public) +{ + const scheme_integer_constant *sc; + + for (sc = constants; sc->name != NULL; ++sc) + { + scm_c_define (sc->name, scm_from_int (sc->value)); + if (public) + scm_c_export (sc->name, NULL); + } +} + +/* scm_printf, alas it doesn't exist. */ + +void +gdbscm_printf (SCM port, const char *format, ...) +{ + va_list args; + char *string; + + va_start (args, format); + string = xstrvprintf (format, args); + va_end (args); + scm_puts (string, port); + xfree (string); +} + +/* Utility for calling from gdb to "display" an SCM object. */ + +void +gdbscm_debug_display (SCM obj) +{ + SCM port = scm_current_output_port (); + + scm_display (obj, port); + scm_newline (port); + scm_force_output (port); +} + +/* Utility for calling from gdb to "write" an SCM object. */ + +void +gdbscm_debug_write (SCM obj) +{ + SCM port = scm_current_output_port (); + + scm_write (obj, port); + scm_newline (port); + scm_force_output (port); +} + +/* Subroutine of gdbscm_parse_function_args to simplify it. + Return the number of keyword arguments. */ + +static int +count_keywords (const SCM *keywords) +{ + int i; + + if (keywords == NULL) + return 0; + for (i = 0; keywords[i] != SCM_BOOL_F; ++i) + continue; + + return i; +} + +/* Subroutine of gdbscm_parse_function_args to simplify it. + Validate an argument format string. + The result is a boolean indicating if "." was seen. */ + +static int +validate_arg_format (const char *format) +{ + const char *p; + int length = strlen (format); + int optional_position = -1; + int keyword_position = -1; + int dot_seen = 0; + + gdb_assert (length > 0); + + for (p = format; *p != '\0'; ++p) + { + switch (*p) + { + case 's': + case 't': + case 'i': + case 'u': + case 'l': + case 'n': + case 'L': + case 'U': + case 'O': + break; + case '|': + gdb_assert (keyword_position < 0); + gdb_assert (optional_position < 0); + optional_position = p - format; + break; + case '#': + gdb_assert (keyword_position < 0); + keyword_position = p - format; + break; + case '.': + gdb_assert (p[1] == '\0'); + dot_seen = 1; + break; + default: + gdb_assert_not_reached ("invalid argument format character"); + } + } + + return dot_seen; +} + +/* Our version of SCM_ASSERT_TYPE that calls gdbscm_make_type_error. */ +#define CHECK_TYPE(ok, arg, position, func_name, expected_type) \ + do { \ + if (!(ok)) \ + { \ + return gdbscm_make_type_error ((func_name), (position), (arg), \ + (expected_type)); \ + } \ + } while (0) + +/* Subroutine of gdbscm_parse_function_args to simplify it. + Check the type of ARG against FORMAT_CHAR and extract the value. + POSITION is the position of ARG in the argument list. + The result is #f upon success or a <gdb:exception> object. */ + +static SCM +extract_arg (char format_char, SCM arg, void *argp, + const char *func_name, int position) +{ + switch (format_char) + { + case 's': + { + char **arg_ptr = argp; + + CHECK_TYPE (gdbscm_is_true (scm_string_p (arg)), arg, position, + func_name, _("string")); + *arg_ptr = gdbscm_scm_to_c_string (arg); + break; + } + case 't': + { + int *arg_ptr = argp; + + /* While in Scheme, anything non-#f is "true", we're strict. */ + CHECK_TYPE (gdbscm_is_bool (arg), arg, position, func_name, + _("boolean")); + *arg_ptr = gdbscm_is_true (arg); + break; + } + case 'i': + { + int *arg_ptr = argp; + + CHECK_TYPE (scm_is_signed_integer (arg, INT_MIN, INT_MAX), + arg, position, func_name, _("int")); + *arg_ptr = scm_to_int (arg); + break; + } + case 'u': + { + int *arg_ptr = argp; + + CHECK_TYPE (scm_is_unsigned_integer (arg, 0, UINT_MAX), + arg, position, func_name, _("unsigned int")); + *arg_ptr = scm_to_uint (arg); + break; + } + case 'l': + { + long *arg_ptr = argp; + + CHECK_TYPE (scm_is_signed_integer (arg, LONG_MIN, LONG_MAX), + arg, position, func_name, _("long")); + *arg_ptr = scm_to_long (arg); + break; + } + case 'n': + { + unsigned long *arg_ptr = argp; + + CHECK_TYPE (scm_is_unsigned_integer (arg, 0, ULONG_MAX), + arg, position, func_name, _("unsigned long")); + *arg_ptr = scm_to_ulong (arg); + break; + } + case 'L': + { + LONGEST *arg_ptr = argp; + + CHECK_TYPE (scm_is_signed_integer (arg, INT64_MIN, INT64_MAX), + arg, position, func_name, _("LONGEST")); + *arg_ptr = gdbscm_scm_to_longest (arg); + break; + } + case 'U': + { + ULONGEST *arg_ptr = argp; + + CHECK_TYPE (scm_is_unsigned_integer (arg, 0, UINT64_MAX), + arg, position, func_name, _("ULONGEST")); + *arg_ptr = gdbscm_scm_to_ulongest (arg); + break; + } + case 'O': + { + SCM *arg_ptr = argp; + + *arg_ptr = arg; + break; + } + default: + gdb_assert_not_reached ("invalid argument format character"); + } + + return SCM_BOOL_F; +} + +#undef CHECK_TYPE + +/* Look up KEYWORD in KEYWORD_LIST. + The result is the index of the keyword in the list or -1 if not found. */ + +static int +lookup_keyword (const SCM *keyword_list, SCM keyword) +{ + int i = 0; + + while (keyword_list[i] != SCM_BOOL_F) + { + if (scm_is_eq (keyword_list[i], keyword)) + return i; + ++i; + } + + return -1; +} + +/* Utility to parse required, optional, and keyword arguments to Scheme + functions. Modelled on PyArg_ParseTupleAndKeywords, but no attempt is made + at similarity or functionality. + There is no result, if there's an error a Scheme exception is thrown. + + Guile provides scm_c_bind_keyword_arguments, and feel free to use it. + This is for times when we want a bit more parsing. + + BEGINNING_ARG_POS is the position of the first argument passed to this + routine. It should be one of the SCM_ARGn values. It could be > SCM_ARG1 + if the caller chooses not to parse one or more required arguments. + + KEYWORDS may be NULL if there are no keywords. + + FORMAT: + s - string -> char *, malloc'd + t - boolean (gdb uses "t", for biT?) -> int + i - int + u - unsigned int + l - long + n - unsigned long + L - longest + U - unsigned longest + O - random scheme object + | - indicates the next set is for optional arguments + # - indicates the next set is for keyword arguments (must follow |) + . - indicates "rest" arguments are present, this character must appear last + + FORMAT must match the definition from scm_c_{make,define}_gsubr. + Required and optional arguments appear in order in the format string. + Afterwards, keyword-based arguments are processed. There must be as many + remaining characters in the format string as their are keywords. + Except for "|#.", the number of characters in the format string must match + #required + #optional + #keywords. + + The function is required to be defined in a compatible manner: + #required-args and #optional-arguments must match, and rest-arguments + must be specified if keyword args are desired, and/or regular "rest" args. + + Example: For this function, + scm_c_define_gsubr ("execute", 2, 3, 1, foo); + the format string + keyword list could be any of: + 1) "ss|ttt#tt", { "key1", "key2", NULL } + 2) "ss|ttt.", { NULL } + 3) "ss|ttt#t.", { "key1", NULL } + + For required and optional args pass the SCM of the argument, and a + pointer to the value to hold the parsed result (type depends on format + char). After that pass the SCM containing the "rest" arguments followed + by pointers to values to hold parsed keyword arguments, and if specified + a pointer to hold the remaining contents of "rest". + + For keyword arguments pass two pointers: the first is a pointer to an int + that will contain the position of the argument in the arg list, and the + second will contain result of processing the argument. The int pointed + to by the first value should be initialized to -1. It can then be used + to tell whether the keyword was present. + + If both keyword and rest arguments are present, the caller must pass a + pointer to contain the new value of rest (after keyword args have been + removed). + + There's currently no way, that I know of, to specify default values for + optional arguments in C-provided functions. At the moment they're a + work-in-progress. The caller should test SCM_UNBNDP for each optional + argument. Unbound optional arguments are ignored. */ + +void +gdbscm_parse_function_args (const char *func_name, + int beginning_arg_pos, + const SCM *keywords, + const char *format, ...) +{ + va_list args; + const char *p; + int i, have_rest, num_keywords, length, position; + int have_optional = 0; + SCM status; + SCM rest = SCM_EOL; + /* Keep track of malloc'd strings. We need to free them upon error. */ + VEC (char_ptr) *allocated_strings = NULL; + char *ptr; + + have_rest = validate_arg_format (format); + num_keywords = count_keywords (keywords); + + va_start (args, format); + + p = format; + position = beginning_arg_pos; + + /* Process required, optional arguments. */ + + while (*p && *p != '#' && *p != '.') + { + SCM arg; + void *arg_ptr; + + if (*p == '|') + { + have_optional = 1; + ++p; + continue; + } + + arg = va_arg (args, SCM); + if (!have_optional || !SCM_UNBNDP (arg)) + { + arg_ptr = va_arg (args, void *); + status = extract_arg (*p, arg, arg_ptr, func_name, position); + if (!gdbscm_is_false (status)) + goto fail; + if (*p == 's') + VEC_safe_push (char_ptr, allocated_strings, *(char **) arg_ptr); + } + ++p; + ++position; + } + + /* Process keyword arguments. */ + + if (have_rest || num_keywords > 0) + rest = va_arg (args, SCM); + + if (num_keywords > 0) + { + SCM *keyword_args = (SCM *) alloca (num_keywords * sizeof (SCM)); + int *keyword_positions = (int *) alloca (num_keywords * sizeof (int)); + + gdb_assert (*p == '#'); + ++p; + + for (i = 0; i < num_keywords; ++i) + { + keyword_args[i] = SCM_UNSPECIFIED; + keyword_positions[i] = -1; + } + + while (scm_is_pair (rest) + && scm_is_keyword (scm_car (rest))) + { + SCM keyword = scm_car (rest); + + i = lookup_keyword (keywords, keyword); + if (i < 0) + { + status = gdbscm_make_error (scm_arg_type_key, func_name, + _("Unrecognized keyword: ~a"), + scm_list_1 (keyword), keyword); + goto fail; + } + if (!scm_is_pair (scm_cdr (rest))) + { + status = gdbscm_make_error + (scm_arg_type_key, func_name, + _("Missing value for keyword argument"), + scm_list_1 (keyword), keyword); + goto fail; + } + keyword_args[i] = scm_cadr (rest); + keyword_positions[i] = position + 1; + rest = scm_cddr (rest); + position += 2; + } + + for (i = 0; i < num_keywords; ++i) + { + int *arg_pos_ptr = va_arg (args, int *); + void *arg_ptr = va_arg (args, void *); + SCM arg = keyword_args[i]; + + if (! scm_is_eq (arg, SCM_UNSPECIFIED)) + { + *arg_pos_ptr = keyword_positions[i]; + status = extract_arg (p[i], arg, arg_ptr, func_name, + keyword_positions[i]); + if (!gdbscm_is_false (status)) + goto fail; + if (p[i] == 's') + { + VEC_safe_push (char_ptr, allocated_strings, + *(char **) arg_ptr); + } + } + } + } + + /* Process "rest" arguments. */ + + if (have_rest) + { + if (num_keywords > 0) + { + SCM *rest_ptr = va_arg (args, SCM *); + + *rest_ptr = rest; + } + } + else + { + if (! scm_is_null (rest)) + { + status = gdbscm_make_error (scm_args_number_key, func_name, + _("Too many arguments"), + SCM_EOL, SCM_BOOL_F); + goto fail; + } + } + + va_end (args); + VEC_free (char_ptr, allocated_strings); + return; + + fail: + va_end (args); + for (i = 0; VEC_iterate (char_ptr, allocated_strings, i, ptr); ++i) + xfree (ptr); + VEC_free (char_ptr, allocated_strings); + gdbscm_throw (status); +} + +/* Return longest L as a scheme object. */ + +SCM +gdbscm_scm_from_longest (LONGEST l) +{ + return scm_from_int64 (l); +} + +/* Convert scheme object L to LONGEST. + It is an error to call this if L is not an integer in range of LONGEST. + (because the underlying Scheme function will thrown an exception, + which is not part of our contract with the caller). */ + +LONGEST +gdbscm_scm_to_longest (SCM l) +{ + return scm_to_int64 (l); +} + +/* Return unsigned longest L as a scheme object. */ + +SCM +gdbscm_scm_from_ulongest (ULONGEST l) +{ + return scm_from_uint64 (l); +} + +/* Convert scheme object U to ULONGEST. + It is an error to call this if U is not an integer in range of ULONGEST + (because the underlying Scheme function will thrown an exception, + which is not part of our contract with the caller). */ + +ULONGEST +gdbscm_scm_to_ulongest (SCM u) +{ + return scm_to_uint64 (u); +} + +/* Same as scm_dynwind_free, but uses xfree. */ + +void +gdbscm_dynwind_xfree (void *ptr) +{ + scm_dynwind_unwind_handler (xfree, ptr, SCM_F_WIND_EXPLICITLY); +} + +/* Return non-zero if PROC is a procedure. */ + +int +gdbscm_is_procedure (SCM proc) +{ + return gdbscm_is_true (scm_procedure_p (proc)); +} |