gdb/configure.ac | 2 src/gdb/Makefile.in | 10 + src/gdb/eval.c | 6 src/gdb/gdbtypes.c | 5 src/gdb/gdbtypes.h | 7 - src/gdb/guile.c | 342 +++++++++++++++++++++++++++++++++++++++++++++++++ src/gdb/guile.h | 39 +++++ src/gdb/infcall.c | 2 src/gdb/main.c | 17 ++ src/gdb/mi/mi-cmds.h | 3 src/gdb/mi/mi-interp.c | 2 src/gdb/mi/mi-main.c | 54 ++++--- src/gdb/typeprint.c | 8 + src/gdb/valops.c | 33 ++++ src/gdb/valprint.c | 12 + 15 files changed, 507 insertions(+), 35 deletions(-) Index: src/gdb/Makefile.in =================================================================== --- src.orig/gdb/Makefile.in 2006-12-26 10:09:48.000000000 -0500 +++ src/gdb/Makefile.in 2006-12-27 14:55:00.000000000 -0500 @@ -532,6 +532,7 @@ SFILES = ada-exp.y ada-lang.c ada-typepr frame-base.c \ frame-unwind.c \ gdbarch.c arch-utils.c gdbtypes.c gnu-v2-abi.c gnu-v3-abi.c \ + guile.c \ hpacc-abi.c \ inf-loop.c \ infcall.c \ @@ -935,6 +936,7 @@ COMMON_OBS = $(DEPFILES) $(CONFIG_OBS) $ infcmd.o infrun.o \ expprint.o environ.o stack.o thread.o \ exceptions.o \ + guile.o \ inf-child.o \ interps.o \ main.o \ @@ -1966,7 +1968,7 @@ environ.o: environ.c $(defs_h) $(environ eval.o: eval.c $(defs_h) $(gdb_string_h) $(symtab_h) $(gdbtypes_h) \ $(value_h) $(expression_h) $(target_h) $(frame_h) $(language_h) \ $(f_lang_h) $(cp_abi_h) $(infcall_h) $(objc_lang_h) $(block_h) \ - $(parser_defs_h) $(cp_support_h) $(gdb_assert_h) + $(parser_defs_h) $(cp_support_h) $(guile_h) $(gdb_assert_h) event-loop.o: event-loop.c $(defs_h) $(event_loop_h) $(event_top_h) \ $(gdb_string_h) $(exceptions_h) $(gdb_assert_h) $(gdb_select_h) event-top.o: event-top.c $(defs_h) $(top_h) $(inferior_h) $(target_h) \ @@ -2050,6 +2052,8 @@ go32-nat.o: go32-nat.c $(defs_h) $(infer $(command_h) $(gdbcmd_h) $(floatformat_h) $(buildsym_h) \ $(i387_tdep_h) $(i386_tdep_h) $(value_h) $(regcache_h) \ $(gdb_string_h) $(top_h) +guile.o: guile.c $(defs_h) $(command_h) $(ui_out_h) $(mi_out_h) $(mi_cmds_h) \ + $(gdbtypes_h) $(value_h) h8300-tdep.o: h8300-tdep.c $(defs_h) $(value_h) $(arch_utils_h) $(regcache_h) \ $(gdbcore_h) $(objfiles_h) $(gdb_assert_h) $(dis_asm_h) \ $(dwarf2_frame_h) $(frame_base_h) $(frame_unwind_h) @@ -2801,7 +2805,7 @@ tramp-frame.o: tramp-frame.c $(defs_h) $ typeprint.o: typeprint.c $(defs_h) $(gdb_obstack_h) $(bfd_h) $(symtab_h) \ $(gdbtypes_h) $(expression_h) $(value_h) $(gdbcore_h) $(command_h) \ $(gdbcmd_h) $(target_h) $(language_h) $(cp_abi_h) $(typeprint_h) \ - $(gdb_string_h) + $(gdb_string_h) $(guile_h) ui-file.o: ui-file.c $(defs_h) $(ui_file_h) $(gdb_string_h) ui-out.o: ui-out.c $(defs_h) $(gdb_string_h) $(expression_h) $(language_h) \ $(ui_out_h) $(gdb_assert_h) @@ -2829,7 +2833,7 @@ valops.o: valops.c $(defs_h) $(symtab_h) valprint.o: valprint.c $(defs_h) $(gdb_string_h) $(symtab_h) $(gdbtypes_h) \ $(value_h) $(gdbcore_h) $(gdbcmd_h) $(target_h) $(language_h) \ $(annotate_h) $(valprint_h) $(floatformat_h) $(doublest_h) \ - $(exceptions_h) + $(exceptions_h) $(guile_h) value.o: value.c $(defs_h) $(gdb_string_h) $(symtab_h) $(gdbtypes_h) \ $(value_h) $(gdbcore_h) $(command_h) $(gdbcmd_h) $(target_h) \ $(language_h) $(scm_lang_h) $(demangle_h) $(doublest_h) \ Index: src/gdb/config.in =================================================================== Index: src/gdb/configure =================================================================== Index: src/gdb/configure.ac =================================================================== --- src.orig/gdb/configure.ac 2006-12-26 10:09:48.000000000 -0500 +++ src/gdb/configure.ac 2006-12-27 14:55:00.000000000 -0500 @@ -327,6 +327,8 @@ if test "$HAVE_LIBEXPAT" != yes; then AC_MSG_WARN([expat is missing or unusable; some features may be disabled.]) fi +AC_CHECK_LIB(guile, scm_boot_guile) + # ------------------------- # # Checks for header files. # # ------------------------- # Index: src/gdb/guile.c =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 +++ src/gdb/guile.c 2006-12-27 14:55:00.000000000 -0500 @@ -0,0 +1,342 @@ +/* Guile support for GDB. + + Copyright 2006 + 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 2 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, write to the Free Software + Foundation, Inc., 59 Temple Place - Suite 330, + Boston, MA 02111-1307, USA. */ + +/* TODO: A command allowing to enter multi-line Guile would be nice, + doing read-eval-print until the braces close. */ + +#include "defs.h" + +#ifdef HAVE_LIBGUILE + +#include "command.h" +#include "gdbtypes.h" +#include "ui-out.h" +#include "value.h" + +#include "mi/mi-cmds.h" +#include "mi/mi-out.h" + +#include "gdb_string.h" + +#include + +static const char *tmp_args; + +static SCM +guile_mi_command (SCM cmd) +{ + static struct ui_out *local_uiout; + struct ui_file *str_stream = mem_fileopen (), *saved_stdout = raw_stdout; + struct ui_out *saved_uiout = uiout; + char *str; + long length; + struct cleanup *back_to = make_cleanup (null_cleanup, NULL); + + /* FIXME: Should we be able to specify the MI level? */ + if (local_uiout == NULL) + local_uiout = mi_out_new (2); + + SCM_ASSERT (SCM_STRINGP (cmd), cmd, SCM_ARG1, "guile_mi_command"); + + uiout = local_uiout; +#if 0 + /* If we're in MI, leave errors to the normal MI channel. If we're + not, then direct them to the stream. Should we discard them instead? + Or turn them into Scheme exceptions? */ + if (raw_stdout == NULL) + raw_stdout = str_stream; +#else + if (raw_stdout == NULL) + { + raw_stdout = mem_fileopen (); + make_cleanup ((void (*) (void *)) ui_file_delete, raw_stdout); + } +#endif + mi_execute_command (SCM_STRING_CHARS (cmd), 0, str_stream); + uiout = saved_uiout; + str = ui_file_xstrdup (str_stream, &length); + do_cleanups (back_to); + raw_stdout = saved_stdout; + return scm_take_str (str, length); +} + +struct scm_and_value +{ + SCM scm; + struct value *value; +}; + +static SCM +scm_catch_return_f (void *data, SCM key, SCM args) +{ + return SCM_BOOL_F; +} + +/* FIXME: Add support for values that fit in long long, unsigned long? */ + +static SCM +scm_to_long (void *data) +{ + struct scm_and_value *args = data; + LONGEST num; + + num = scm_num2long (args->scm, SCM_ARGn, "scm_to_long"); + args->value = value_from_longest (builtin_type_long_long, num); + return SCM_BOOL_T; +} + +static struct value * +scm_to_value (SCM obj) +{ + struct value *value; + extern struct value *value_string_raw (char *ptr, int len); + + if (SCM_STRINGP (obj)) + return value_string_raw (SCM_STRING_CHARS (obj), + SCM_STRING_LENGTH (obj) + 1); + + if (SCM_NUMBERP (obj)) + { + struct scm_and_value args; + args.scm = obj; + if (scm_internal_catch (SCM_BOOL_T, scm_to_long, &args, + scm_catch_return_f, NULL) == SCM_BOOL_T) + return args.value; + } + + if (SCM_BOOLP (obj)) + { + if (SCM_FALSEP (obj)) + return value_from_longest (builtin_type_bool, 0); + else + return value_from_longest (builtin_type_bool, 1); + } + + if (obj == SCM_UNSPECIFIED) + return value_zero (builtin_type_void, not_lval); + + value = allocate_value (builtin_type_extern); + memcpy (value_contents_writeable (value), &obj, sizeof (obj)); + + /* FIXME: We never call scm_gc_unprotect_object. We would need + a destructor, hooked into value_free. And in that case probably + hooked into value_copy too. */ + scm_gc_protect_object (obj); + + return value; +} + +static SCM +value_to_scm (struct value *val) +{ + struct type *type; + + type = check_typedef (value_type (val)); + if ((TYPE_CODE (type) == TYPE_CODE_STRING + || TYPE_CODE (type) == TYPE_CODE_ARRAY) + && VALUE_LVAL (val) == not_lval + && TYPE_LENGTH (type) > 0) + { + struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type)); + + if (TYPE_LENGTH (elttype) == 1 + && (TYPE_CODE (elttype) == TYPE_CODE_INT + || TYPE_CODE (elttype) == TYPE_CODE_CHAR)) + { + /* For a char[4], create a string not including the final + zero byte, unless the string is not terminated. */ + int length = TYPE_LENGTH (type); + if (value_contents (val)[length - 1] == '\0') + length--; + return scm_mem2string (value_contents (val), length); + } + } + + if (TYPE_CODE (type) == TYPE_CODE_INT) + { + /* FIXME: Support for things that don't fit in a LONGEST? */ + return scm_long2num (value_as_long (val)); + } + + if (TYPE_CODE (type) == TYPE_CODE_BOOL) + { + if (value_as_long (val) != 0) + return SCM_BOOL_T; + else + return SCM_BOOL_F; + } + + if (TYPE_CODE (type) == TYPE_CODE_EXTERN) + { + SCM obj; + + memcpy (&obj, value_contents (val), sizeof (SCM)); + return obj; + } + + /* FIXME: Numbers, at least... */ + error (_("Can not pass GDB values to Guile functions (yet?)")); +} + +static SCM +guile_set_cvar (SCM cvar, SCM obj) +{ + struct value *value; + char *name; + + SCM_ASSERT (SCM_STRINGP (cvar), cvar, SCM_ARG1, "guile_set_cvar"); + name = SCM_STRING_CHARS (cvar); + + set_internalvar (lookup_internalvar (name), scm_to_value (obj)); + + return SCM_BOOL_T; +} + +/* A catch handler for Scheme code that feeds the error message + to GDB's error routine. */ + +static SCM +guile_catch_error (void *data, SCM tag, SCM throw_args) +{ + SCM old_port = scm_current_error_port (); + SCM new_port = scm_open_output_string (); + char *errmsg, *new_errmsg; + + /* Have Scheme format the error message to a temporary port. */ + scm_set_current_error_port (new_port); + scm_handle_by_message_noexit ("gdb" /* FIXME: Save argv[0] */, + tag, throw_args); + scm_set_current_error_port (old_port); + + /* Remove the trailing newline from Scheme's error message, since + GDB will add one. */ + errmsg = SCM_STRING_CHARS (scm_get_output_string (new_port)); + new_errmsg = xstrdup (errmsg); + new_errmsg[strlen (errmsg) - 1] = '\0'; + make_cleanup (xfree, new_errmsg); + + error ("%s", new_errmsg); +} + +/* The guile-exec command, which evaluates a Scheme expression + and discards the result. */ + +static void +guile_exec_command (char *args, int from_tty) +{ + scm_internal_catch (SCM_BOOL_T, + (scm_t_catch_body) scm_c_eval_string, args, + guile_catch_error, NULL); +} + +/* The guile-eval command, which evaluates a Scheme expression + and displays the result. */ + +static void +guile_eval_command (char *args, int from_tty) +{ + SCM result = scm_internal_catch (SCM_BOOL_T, + (scm_t_catch_body) scm_c_eval_string, args, + guile_catch_error, NULL); + + scm_display (result, scm_current_output_port ()); + scm_newline (scm_current_output_port ()); +} + +/* Define all Scheme procedures provided by GDB. */ + +static void +guile_init_procs (void) +{ + scm_c_define_gsubr ("gdb-mi-command", 1, 0, 0, guile_mi_command); + scm_c_define_gsubr ("gdb-set-cvar", 2, 0, 0, guile_set_cvar); +} +#endif /* HAVE_LIBGUILE */ + +void +guile_print_type (struct type *type, char *varstring, + struct ui_file *stream, int show) +{ + fprintf_filtered (stream, _("")); +} + +int +guile_val_print (struct type *type, const gdb_byte *valaddr, + int embedded_offset, CORE_ADDR address, + struct ui_file *stream, int format, + int deref_ref, int recurse, enum val_prettyprint pretty) +{ + fprintf_filtered (stream, _("")); + return 0; +} + +int guile_value_print (struct value *val, struct ui_file *stream, int format, + enum val_prettyprint pretty) +{ + return guile_val_print (value_type (val), value_contents_all (val), + value_embedded_offset (val), value_offset (val), + stream, format, 1, 0, pretty); +} + +struct value * +guile_call_function (struct value *function, int nargs, struct value **args) +{ +#ifdef HAVE_LIBGUILE + int i; + SCM scmargs, scmret, scmfunc; + + scmargs = SCM_EOL; + for (i = nargs - 1; i >= 0; i--) + { + SCM this_arg = value_to_scm (args[i]); + scmargs = scm_cons (this_arg, scmargs); + } + + scmfunc = value_to_scm (function); + scmargs = scm_cons (scmfunc, scmargs); + + scmret = scm_internal_catch (SCM_BOOL_T, + (scm_t_catch_body) scm_primitive_eval, scmargs, + guile_catch_error, NULL); + scm_remember_upto_here_1 (scmargs); + + return scm_to_value (scmret); +#else + return (value_zero (builtin_type_void, not_lval)); +#endif +} + +void +_initialize_guile (void) +{ +#ifdef HAVE_LIBGUILE + guile_init_procs (); + + add_com ("guile-exec", class_support, guile_exec_command, + "Execute a Guile command."); + add_com ("guile-eval", class_support, guile_eval_command, + "Evaluate a Guile expression."); + + builtin_type_extern = init_type (TYPE_CODE_EXTERN, sizeof (SCM), 0, + "builtin_type_extern", NULL); +#endif +} Index: src/gdb/main.c =================================================================== --- src.orig/gdb/main.c 2006-12-26 10:09:48.000000000 -0500 +++ src/gdb/main.c 2006-12-27 14:55:00.000000000 -0500 @@ -42,6 +42,10 @@ #include "interps.h" #include "main.h" +#ifdef HAVE_LIBGUILE +#include "libguile.h" +#endif + /* If nonzero, display time usage both at startup and for each command. */ int display_time; @@ -828,11 +832,24 @@ extern int gdbtk_test (char *); /* No exit -- exit is through quit_command. */ } +#ifdef HAVE_LIBGUILE +void +gdb_guile_main (void *closure, int argc, char **argv) +{ + struct captured_main_args *args = closure; + catch_errors (captured_main, args, "", RETURN_MASK_ALL); +} +#endif + int gdb_main (struct captured_main_args *args) { use_windows = args->use_windows; +#ifdef HAVE_LIBGUILE + scm_boot_guile (args->argc, args->argv, gdb_guile_main, args); +#else catch_errors (captured_main, args, "", RETURN_MASK_ALL); +#endif /* The only way to end up here is by an error (normal exit is handled by quit_force()), hence always return an error status. */ return 1; Index: src/gdb/mi/mi-cmds.h =================================================================== --- src.orig/gdb/mi/mi-cmds.h 2006-12-26 10:09:48.000000000 -0500 +++ src/gdb/mi/mi-cmds.h 2006-12-27 14:55:00.000000000 -0500 @@ -150,6 +150,7 @@ extern int mi_debug_p; extern struct ui_file *raw_stdout; extern char *mi_error_message; -extern void mi_execute_command (char *cmd, int from_tty); +extern void mi_execute_command (char *cmd, int from_tty, + struct ui_file *out_stream); #endif Index: src/gdb/mi/mi-interp.c =================================================================== --- src.orig/gdb/mi/mi-interp.c 2006-12-26 10:09:48.000000000 -0500 +++ src/gdb/mi/mi-interp.c 2006-12-27 14:55:00.000000000 -0500 @@ -299,7 +299,7 @@ mi_interp_query_hook (const char *ctlstr static void mi_execute_command_wrapper (char *cmd) { - mi_execute_command (cmd, stdin == instream); + mi_execute_command (cmd, stdin == instream, raw_stdout); } static void Index: src/gdb/mi/mi-main.c =================================================================== --- src.orig/gdb/mi/mi-main.c 2006-12-26 10:09:48.000000000 -0500 +++ src/gdb/mi/mi-main.c 2006-12-27 14:55:00.000000000 -0500 @@ -76,6 +76,9 @@ struct captured_mi_execute_command_args /* The command context to be executed (input) */ struct mi_parse *command; + + /* The stream to write (synchronous) output to. */ + struct ui_file *out_stream; }; int mi_debug_p; @@ -1037,6 +1040,7 @@ captured_mi_execute_command (struct ui_o struct captured_mi_execute_command_args *args = (struct captured_mi_execute_command_args *) data; struct mi_parse *context = args->command; + struct ui_file *out_stream = args->out_stream; switch (context->op) { @@ -1064,21 +1068,21 @@ captured_mi_execute_command (struct ui_o will most likely crash in the mi_out_* routines. */ if (args->rc == MI_CMD_DONE) { - fputs_unfiltered (context->token, raw_stdout); - fputs_unfiltered ("^done", raw_stdout); - mi_out_put (uiout, raw_stdout); + fputs_unfiltered (context->token, out_stream); + fputs_unfiltered ("^done", out_stream); + mi_out_put (uiout, out_stream); mi_out_rewind (uiout); - fputs_unfiltered ("\n", raw_stdout); + fputs_unfiltered ("\n", out_stream); } else if (args->rc == MI_CMD_ERROR) { if (mi_error_message) { - fputs_unfiltered (context->token, raw_stdout); - fputs_unfiltered ("^error,msg=\"", raw_stdout); - fputstr_unfiltered (mi_error_message, '"', raw_stdout); + fputs_unfiltered (context->token, out_stream); + fputs_unfiltered ("^error,msg=\"", out_stream); + fputstr_unfiltered (mi_error_message, '"', out_stream); xfree (mi_error_message); - fputs_unfiltered ("\"\n", raw_stdout); + fputs_unfiltered ("\"\n", out_stream); } mi_out_rewind (uiout); } @@ -1115,22 +1119,22 @@ captured_mi_execute_command (struct ui_o { if (args->rc == MI_CMD_DONE) { - fputs_unfiltered (context->token, raw_stdout); - fputs_unfiltered ("^done", raw_stdout); - mi_out_put (uiout, raw_stdout); + fputs_unfiltered (context->token, out_stream); + fputs_unfiltered ("^done", out_stream); + mi_out_put (uiout, out_stream); mi_out_rewind (uiout); - fputs_unfiltered ("\n", raw_stdout); + fputs_unfiltered ("\n", out_stream); args->action = EXECUTE_COMMAND_DISPLAY_PROMPT; } else if (args->rc == MI_CMD_ERROR) { if (mi_error_message) { - fputs_unfiltered (context->token, raw_stdout); - fputs_unfiltered ("^error,msg=\"", raw_stdout); - fputstr_unfiltered (mi_error_message, '"', raw_stdout); + fputs_unfiltered (context->token, out_stream); + fputs_unfiltered ("^error,msg=\"", out_stream); + fputstr_unfiltered (mi_error_message, '"', out_stream); xfree (mi_error_message); - fputs_unfiltered ("\"\n", raw_stdout); + fputs_unfiltered ("\"\n", out_stream); } mi_out_rewind (uiout); } @@ -1147,7 +1151,8 @@ captured_mi_execute_command (struct ui_o void -mi_execute_command (char *cmd, int from_tty) +mi_execute_command (char *cmd, int from_tty, + struct ui_file *out_stream) { struct mi_parse *command; struct captured_mi_execute_command_args args; @@ -1166,6 +1171,7 @@ mi_execute_command (char *cmd, int from_ /* FIXME: cagney/1999-11-04: Can this use of catch_exceptions either be pushed even further down or even eliminated? */ args.command = command; + args.out_stream = out_stream; result = catch_exception (uiout, captured_mi_execute_command, &args, RETURN_MASK_ALL); exception_print (gdb_stderr, result); @@ -1181,20 +1187,20 @@ mi_execute_command (char *cmd, int from_ { /* The command execution failed and error() was called somewhere. */ - fputs_unfiltered (command->token, raw_stdout); - fputs_unfiltered ("^error,msg=\"", raw_stdout); + fputs_unfiltered (command->token, out_stream); + fputs_unfiltered ("^error,msg=\"", out_stream); if (result.message == NULL) - fputs_unfiltered ("unknown error", raw_stdout); + fputs_unfiltered ("unknown error", out_stream); else - fputstr_unfiltered (result.message, '"', raw_stdout); - fputs_unfiltered ("\"\n", raw_stdout); + fputstr_unfiltered (result.message, '"', out_stream); + fputs_unfiltered ("\"\n", out_stream); mi_out_rewind (uiout); } mi_parse_free (command); } - fputs_unfiltered ("(gdb) \n", raw_stdout); - gdb_flush (raw_stdout); + fputs_unfiltered ("(gdb) \n", out_stream); + gdb_flush (out_stream); /* print any buffered hook code */ /* ..... */ } Index: src/gdb/eval.c =================================================================== --- src.orig/gdb/eval.c 2006-12-27 14:51:45.000000000 -0500 +++ src/gdb/eval.c 2006-12-27 14:55:00.000000000 -0500 @@ -37,6 +37,7 @@ #include "block.h" #include "parser-defs.h" #include "cp-support.h" +#include "guile.h" #include "gdb_assert.h" @@ -1233,7 +1234,10 @@ evaluate_subexp_standard (struct type *e else error (_("Expression of type other than \"Function returning ...\" used as function")); } - return call_function_by_hand (argvec[0], nargs, argvec + 1); + if (TYPE_CODE (value_type (argvec[0])) == TYPE_CODE_EXTERN) + return guile_call_function (argvec[0], nargs, argvec + 1); + else + return call_function_by_hand (argvec[0], nargs, argvec + 1); /* pai: FIXME save value from call_function_by_hand, then adjust pc by adjust_fn_pc if +ve */ case OP_F77_UNDETERMINED_ARGLIST: Index: src/gdb/gdbtypes.c =================================================================== --- src.orig/gdb/gdbtypes.c 2006-12-26 17:17:35.000000000 -0500 +++ src/gdb/gdbtypes.c 2006-12-27 14:55:00.000000000 -0500 @@ -124,6 +124,8 @@ struct type *builtin_type_void_func_ptr; struct type *builtin_type_CORE_ADDR; struct type *builtin_type_bfd_vma; +struct type *builtin_type_extern; + int opaque_type_resolution = 1; static void show_opaque_type_resolution (struct ui_file *file, int from_tty, @@ -3008,6 +3010,9 @@ recursive_dump_type (struct type *type, case TYPE_CODE_NAMESPACE: printf_filtered ("(TYPE_CODE_NAMESPACE)"); break; + case TYPE_CODE_EXTERN: + printf_filtered ("(TYPE_CODE_EXTERN)"); + break; default: printf_filtered ("(UNKNOWN TYPE CODE)"); break; Index: src/gdb/gdbtypes.h =================================================================== --- src.orig/gdb/gdbtypes.h 2006-12-26 10:09:48.000000000 -0500 +++ src/gdb/gdbtypes.h 2006-12-27 14:55:00.000000000 -0500 @@ -167,7 +167,9 @@ enum type_code TYPE_CODE_TEMPLATE, /* C++ template */ TYPE_CODE_TEMPLATE_ARG, /* C++ template arg */ - TYPE_CODE_NAMESPACE /* C++ namespace. */ + TYPE_CODE_NAMESPACE, /* C++ namespace. */ + + TYPE_CODE_EXTERN, /* Value from a scripting language. */ }; /* For now allow source to use TYPE_CODE_CLASS for C++ classes, as an @@ -1163,6 +1165,9 @@ extern struct type *builtin_type_f_void; /* RTTI for C++ */ /* extern struct type *builtin_type_cxx_typeinfo; */ +/* Type for an embedded scripting language. */ +extern struct type *builtin_type_extern; + /* Maximum and minimum values of built-in types */ #define MAX_OF_TYPE(t) \ Index: src/gdb/guile.h =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 +++ src/gdb/guile.h 2006-12-27 14:55:00.000000000 -0500 @@ -0,0 +1,39 @@ +/* Guile support for GDB. + + Copyright 2006 + 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 2 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, write to the Free Software + Foundation, Inc., 59 Temple Place - Suite 330, + Boston, MA 02111-1307, USA. */ + +struct type; +struct value; +struct ui_file; + +void guile_print_type (struct type *type, char *varstring, + struct ui_file *stream, int show); + +int guile_val_print (struct type *type, const gdb_byte *valaddr, + int embedded_offset, CORE_ADDR address, + struct ui_file *stream, int format, + int deref_ref, int recurse, enum val_prettyprint pretty); + +int guile_value_print (struct value *val, struct ui_file *stream, int format, + enum val_prettyprint pretty); + +struct value *guile_call_function (struct value *function, int nargs, + struct value **args); Index: src/gdb/infcall.c =================================================================== --- src.orig/gdb/infcall.c 2006-12-27 14:51:45.000000000 -0500 +++ src/gdb/infcall.c 2006-12-27 14:55:00.000000000 -0500 @@ -168,6 +168,8 @@ value_arg_coerce (struct value *arg, str if (!TYPE_VECTOR (type)) type = lookup_pointer_type (TYPE_TARGET_TYPE (type)); break; + case TYPE_CODE_EXTERN: + error (_("Can not pass script objects to target functions.")); case TYPE_CODE_UNDEF: case TYPE_CODE_PTR: case TYPE_CODE_STRUCT: Index: src/gdb/typeprint.c =================================================================== --- src.orig/gdb/typeprint.c 2006-12-26 18:28:32.000000000 -0500 +++ src/gdb/typeprint.c 2006-12-27 14:55:00.000000000 -0500 @@ -34,6 +34,8 @@ #include "language.h" #include "cp-abi.h" #include "typeprint.h" +#include "guile.h" + #include "gdb_string.h" #include @@ -104,6 +106,12 @@ void type_print (struct type *type, char *varstring, struct ui_file *stream, int show) { + if (TYPE_CODE (type) == TYPE_CODE_EXTERN) + { + guile_print_type (type, varstring, stream, show); + return; + } + LA_PRINT_TYPE (type, varstring, stream, show, 0); } Index: src/gdb/valops.c =================================================================== --- src.orig/gdb/valops.c 2006-12-27 14:51:45.000000000 -0500 +++ src/gdb/valops.c 2006-12-27 14:55:00.000000000 -0500 @@ -1116,7 +1116,7 @@ value_string (char *ptr, int len) builtin_type_int, lowbound, len + lowbound - 1); struct type *stringtype - = create_string_type ((struct type *) NULL, rangetype); + = create_string_type ((struct type *) NULL, rangetype); CORE_ADDR addr; if (current_language->c_style_arrays == 0) @@ -1126,7 +1126,6 @@ value_string (char *ptr, int len) return val; } - /* Allocate space to store the string in the inferior, and then copy LEN bytes from PTR in gdb to that address in the inferior. */ @@ -1137,6 +1136,36 @@ value_string (char *ptr, int len) return (val); } +/* FIXME: This should be value_string and uses which require it + in the target should say so. But we need to build a TYPE_CODE_ARRAY... + maybe value_string shouldn't. Or consider the language? */ +struct value * +value_string_raw (char *ptr, int len) +{ + struct value *val; + int lowbound = current_language->string_lower_bound; + struct type *rangetype = create_range_type ((struct type *) NULL, + builtin_type_int, + lowbound, len + lowbound - 1); + struct type *stringtype + = create_string_type ((struct type *) NULL, rangetype); + + TYPE_CODE (stringtype) = TYPE_CODE_ARRAY; + + if (current_language->c_style_arrays == 0) + { + val = allocate_value (stringtype); + memcpy (value_contents_raw (val), ptr, len); + return val; + } + + /* Allocate space to store the string, and then initialize it. */ + + val = allocate_value (stringtype); + memcpy (value_contents_writeable (val), ptr, len); + return val; +} + struct value * value_bitstring (char *ptr, int len) { Index: src/gdb/valprint.c =================================================================== --- src.orig/gdb/valprint.c 2006-12-26 10:09:49.000000000 -0500 +++ src/gdb/valprint.c 2006-12-27 14:55:00.000000000 -0500 @@ -35,6 +35,7 @@ #include "floatformat.h" #include "doublest.h" #include "exceptions.h" +#include "guile.h" #include @@ -230,8 +231,12 @@ val_print (struct type *type, const gdb_ TRY_CATCH (except, RETURN_MASK_ERROR) { - ret = LA_VAL_PRINT (type, valaddr, embedded_offset, address, - stream, format, deref_ref, recurse, pretty); + if (TYPE_CODE (type) == TYPE_CODE_EXTERN) + ret = guile_val_print (type, valaddr, embedded_offset, address, + stream, format, deref_ref, recurse, pretty); + else + ret = LA_VAL_PRINT (type, valaddr, embedded_offset, address, + stream, format, deref_ref, recurse, pretty); } if (except.reason < 0) fprintf_filtered (stream, _("")); @@ -299,6 +304,9 @@ value_print (struct value *val, struct u if (!value_check_printable (val, stream)) return 0; + if (TYPE_CODE (value_type (val)) == TYPE_CODE_EXTERN) + return guile_value_print (val, stream, format, pretty); + return LA_VALUE_PRINT (val, stream, format, pretty); }