diff options
| -rw-r--r-- | gdb/ChangeLog | 23 | ||||
| -rw-r--r-- | gdb/doc/ChangeLog | 4 | ||||
| -rw-r--r-- | gdb/doc/guile.texi | 8 | ||||
| -rw-r--r-- | gdb/guile/guile-internal.h | 8 | ||||
| -rw-r--r-- | gdb/guile/guile.c | 40 | ||||
| -rw-r--r-- | gdb/guile/lib/gdb.scm | 4 | ||||
| -rw-r--r-- | gdb/guile/lib/gdb/boot.scm | 7 | ||||
| -rw-r--r-- | gdb/guile/lib/gdb/init.scm | 3 | ||||
| -rw-r--r-- | gdb/guile/scm-exception.c | 4 | ||||
| -rw-r--r-- | gdb/guile/scm-string.c | 13 | ||||
| -rw-r--r-- | gdb/guile/scm-utils.c | 19 | ||||
| -rw-r--r-- | gdb/guile/scm-value.c | 17 |
12 files changed, 127 insertions, 23 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 4a72665..99d78b5 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,26 @@ +2014-06-06 Doug Evans <dje@google.com> + + * guile/guile-internal.h (gdbscm_guile_major_version): Declare. + (gdbscm_guile_minor_version, gdbscm_guile_micro_version): Declare. + (gdbscm_guile_version_is_at_least): Declare. + (gdbscm_scm_string_to_int): Declare. + * guile/guile.c (gdbscm_guile_major_version): New global. + (gdbscm_guile_minor_version, gdbscm_guile_micro_version): New globals. + (guile_datadir): New static global. + (gdbscm_guile_data_directory): New function. + (initialize_scheme_side): Update. + (misc_guile_functions): Add guile-data-directory. + (initialize_gdb_module): Fetch guile version number. + * guile/lib/gdb.scm: Remove call to add-to-load-path. + * guile/lib/gdb/init.scm (%initialize!): Ditto. + * guile/lib/gdb/boot.scm: Use guile-data-directory. + * guile/scm-exception.c (gdbscm_print_exception_with_stack): Fix + comments. + * guile/scm-string.c (gdbscm_scm_string_to_int): New function. + * guile/scm-utils.c (gdbscm_guile_version_is_at_least): New function. + * guile/scm-value.c (gdbscm_value_to_string): Only call + scm_port_conversion_strategy if Guile version >= 2.0.6. + 2014-06-06 Mingjie Xing <mingjie.xing@gmail.com> * main.c (print_gdb_help): Add -q and --silent. diff --git a/gdb/doc/ChangeLog b/gdb/doc/ChangeLog index 0f26420..3dadf06 100644 --- a/gdb/doc/ChangeLog +++ b/gdb/doc/ChangeLog @@ -1,3 +1,7 @@ +2014-06-06 Doug Evans <dje@google.com> + + * guile.texi (Guile Configuration): Document guile-data-directory. + 2014-06-06 Mingjie Xing <mingjie.xing@gmail.com> * gdb.texinfo (Invoking GDB): Add -q and --quiet. diff --git a/gdb/doc/guile.texi b/gdb/doc/guile.texi index bd1040c..4aaba8a 100644 --- a/gdb/doc/guile.texi +++ b/gdb/doc/guile.texi @@ -312,8 +312,12 @@ parameters. @deffn {Scheme Procedure} data-directory Return a string containing @value{GDBN}'s data directory. -This directory contains @value{GDBN}'s ancillary files, including -the Guile modules provided by @value{GDBN}. +This directory contains @value{GDBN}'s ancillary files. +@end deffn + +@deffn {Scheme Procedure} guile-data-directory +Return a string containing @value{GDBN}'s Guile data directory. +This directory contains the Guile modules provided by @value{GDBN}. @end deffn @deffn {Scheme Procedure} gdb-version diff --git a/gdb/guile/guile-internal.h b/gdb/guile/guile-internal.h index 03a2b1e..f28d084 100644 --- a/gdb/guile/guile-internal.h +++ b/gdb/guile/guile-internal.h @@ -121,6 +121,10 @@ extern const char gdbscm_init_module_name[]; extern int gdb_scheme_initialized; +extern int gdbscm_guile_major_version; +extern int gdbscm_guile_minor_version; +extern int gdbscm_guile_micro_version; + extern const char gdbscm_print_excp_none[]; extern const char gdbscm_print_excp_full[]; extern const char gdbscm_print_excp_message[]; @@ -168,6 +172,8 @@ extern int gdbscm_is_procedure (SCM proc); extern char *gdbscm_gc_xstrdup (const char *); extern const char * const *gdbscm_gc_dup_argv (char **argv); + +extern int gdbscm_guile_version_is_at_least (int major, int minor, int micro); /* GDB smobs, from scm-gsmob.c */ @@ -472,6 +478,8 @@ extern SCM psscm_scm_from_pspace (struct program_space *); /* scm-string.c */ +extern int gdbscm_scm_string_to_int (SCM string); + extern char *gdbscm_scm_to_c_string (SCM string); extern SCM gdbscm_scm_from_c_string (const char *string); diff --git a/gdb/guile/guile.c b/gdb/guile/guile.c index 00d7b06..167e717 100644 --- a/gdb/guile/guile.c +++ b/gdb/guile/guile.c @@ -37,6 +37,18 @@ #include "guile-internal.h" #endif +/* The Guile version we're using. + We *could* use the macros in libguile/version.h but that would preclude + handling the user switching in a different version with, e.g., + LD_LIBRARY_PATH (using a different version than what gdb was compiled with + is not something to be done lightly, but can be useful). */ +int gdbscm_guile_major_version; +int gdbscm_guile_minor_version; +int gdbscm_guile_micro_version; + +/* The guile subdirectory within gdb's data-directory. */ +static const char *guile_datadir; + /* Declared constants and enum for guile exception printing. */ const char gdbscm_print_excp_none[] = "none"; const char gdbscm_print_excp_full[] = "full"; @@ -353,6 +365,14 @@ gdbscm_data_directory (void) return gdbscm_scm_from_c_string (gdb_datadir); } +/* (guile-data-directory) -> string */ + +static SCM +gdbscm_guile_data_directory (void) +{ + return gdbscm_scm_from_c_string (guile_datadir); +} + /* (gdb-version) -> string */ static SCM @@ -468,6 +488,10 @@ Execute the given GDB command.\n\ "\ Return the name of GDB's data directory." }, + { "guile-data-directory", 0, 0, 0, gdbscm_guile_data_directory, + "\ +Return the name of the Guile directory within GDB's data directory." }, + { "gdb-version", 0, 0, 0, gdbscm_gdb_version, "\ Return GDB's version string." }, @@ -489,11 +513,13 @@ Return the name of the target configuration." }, static void initialize_scheme_side (void) { - char *gdb_guile_dir = concat (gdb_datadir, SLASH_STRING, "guile", NULL); - char *boot_scm_path = concat (gdb_guile_dir, SLASH_STRING, "gdb", - SLASH_STRING, boot_scm_filename, NULL); + char *boot_scm_path; char *msg; + guile_datadir = concat (gdb_datadir, SLASH_STRING, "guile", NULL); + boot_scm_path = concat (guile_datadir, SLASH_STRING, "gdb", + SLASH_STRING, boot_scm_filename, NULL); + /* While scm_c_primitive_load works, the loaded code is not compiled, instead it is left to be interpreted. Eh? Anyways, this causes a ~100x slowdown, so we only use it to load @@ -512,7 +538,6 @@ initialize_scheme_side (void) boot_scm_path); } - xfree (gdb_guile_dir); xfree (boot_scm_path); } @@ -524,6 +549,13 @@ initialize_scheme_side (void) static void initialize_gdb_module (void *data) { + /* Computing these is a pain, so only do it once. + Also, do it here and save the result so that obtaining the values + is thread-safe. */ + gdbscm_guile_major_version = gdbscm_scm_string_to_int (scm_major_version ()); + gdbscm_guile_minor_version = gdbscm_scm_string_to_int (scm_minor_version ()); + gdbscm_guile_micro_version = gdbscm_scm_string_to_int (scm_micro_version ()); + /* The documentation symbol needs to be defined before any calls to gdbscm_define_{variables,functions}. */ gdbscm_documentation_symbol = scm_from_latin1_symbol ("documentation"); diff --git a/gdb/guile/lib/gdb.scm b/gdb/guile/lib/gdb.scm index d628f00..120fcc6 100644 --- a/gdb/guile/lib/gdb.scm +++ b/gdb/guile/lib/gdb.scm @@ -491,10 +491,6 @@ ) ;; Load the rest of the Scheme side. -;; data-directory is provided by the C code. - -(add-to-load-path - (string-append (data-directory) file-name-separator-string "guile")) (use-modules ((gdb init))) diff --git a/gdb/guile/lib/gdb/boot.scm b/gdb/guile/lib/gdb/boot.scm index cf7d305..8c0bb35 100644 --- a/gdb/guile/lib/gdb/boot.scm +++ b/gdb/guile/lib/gdb/boot.scm @@ -21,10 +21,9 @@ ;; loaded with it are not compiled. So we do very little here, and do ;; most of the initialization elsewhere. -;; data-directory is provided by the C code. -(load (string-append - (data-directory) file-name-separator-string "guile" - file-name-separator-string "gdb.scm")) +;; guile-data-directory is provided by the C code. +(add-to-load-path (guile-data-directory)) +(load-from-path "gdb.scm") ;; Now that the Scheme side support is loaded, initialize it. (let ((init-proc (@@ (gdb init) %initialize!))) diff --git a/gdb/guile/lib/gdb/init.scm b/gdb/guile/lib/gdb/init.scm index 1e90790..7607d49 100644 --- a/gdb/guile/lib/gdb/init.scm +++ b/gdb/guile/lib/gdb/init.scm @@ -155,9 +155,6 @@ ;; GDB+Guile. (define (%initialize!) - (add-to-load-path (string-append (data-directory) - file-name-separator-string "guile")) - (for-each (lambda (key) (set-exception-printer! key %exception-printer)) %exception-keys) diff --git a/gdb/guile/scm-exception.c b/gdb/guile/scm-exception.c index 05f9617..d1df55b 100644 --- a/gdb/guile/scm-exception.c +++ b/gdb/guile/scm-exception.c @@ -521,7 +521,7 @@ gdbscm_print_exception_message (SCM port, SCM frame, SCM key, SCM args) KEY, ARGS are the standard arguments to scm_throw, et.al. Basically this function is just a wrapper around calling - %print-exception-with-args. */ + %print-exception-with-stack. */ void gdbscm_print_exception_with_stack (SCM port, SCM stack, SCM key, SCM args) @@ -536,7 +536,7 @@ gdbscm_print_exception_with_stack (SCM port, SCM stack, SCM key, SCM args) percent_print_exception_with_stack_var = scm_c_private_variable (gdbscm_init_module_name, percent_print_exception_with_stack_name); - /* If we can't find %print-exception-with-args, there's a problem on the + /* If we can't find %print-exception-with-stack, there's a problem on the Scheme side. Don't kill GDB, just flag an error and leave it at that. */ if (gdbscm_is_false (percent_print_exception_with_stack_var)) diff --git a/gdb/guile/scm-string.c b/gdb/guile/scm-string.c index 25f1d67..3e3e015 100644 --- a/gdb/guile/scm-string.c +++ b/gdb/guile/scm-string.c @@ -25,6 +25,19 @@ #include "charset.h" #include "guile-internal.h" +/* Convert STRING to an int. + STRING must be a valid integer. */ + +int +gdbscm_scm_string_to_int (SCM string) +{ + char *s = scm_to_latin1_string (string); + int r = atoi (s); + + free (s); + return r; +} + /* Convert a C (latin1) string to an SCM string. "latin1" is chosen because Guile won't throw an exception. */ diff --git a/gdb/guile/scm-utils.c b/gdb/guile/scm-utils.c index 6d9542d..5a17bd9 100644 --- a/gdb/guile/scm-utils.c +++ b/gdb/guile/scm-utils.c @@ -624,3 +624,22 @@ gdbscm_gc_dup_argv (char **argv) return (const char * const *) result; } + +/* Return non-zero if the version of Guile being used it at least + MAJOR.MINOR.MICRO. */ + +int +gdbscm_guile_version_is_at_least (int major, int minor, int micro) +{ + if (major > gdbscm_guile_major_version) + return 0; + if (major < gdbscm_guile_major_version) + return 1; + if (minor > gdbscm_guile_minor_version) + return 0; + if (minor < gdbscm_guile_minor_version) + return 1; + if (micro > gdbscm_guile_micro_version) + return 0; + return 1; +} diff --git a/gdb/guile/scm-value.c b/gdb/guile/scm-value.c index 0ae8103..211ef66 100644 --- a/gdb/guile/scm-value.c +++ b/gdb/guile/scm-value.c @@ -1016,9 +1016,11 @@ gdbscm_value_to_real (SCM self) the target's charset. ERRORS is one of #f, 'error or 'substitute. - An error setting of #f means use the default, which is - Guile's %default-port-conversion-strategy. If the default is not one - of 'error or 'substitute, 'substitute is used. + An error setting of #f means use the default, which is Guile's + %default-port-conversion-strategy when using Guile >= 2.0.6, or 'error if + using an earlier version of Guile. Earlier versions do not properly + support obtaining the default port conversion strategy. + If the default is not one of 'error or 'substitute, 'substitute is used. An error setting of "error" causes an exception to be thrown if there's a decoding error. An error setting of "substitute" causes invalid characters to be replaced with "?". @@ -1069,7 +1071,14 @@ gdbscm_value_to_string (SCM self, SCM rest) gdbscm_throw (excp); } if (errors == SCM_BOOL_F) - errors = scm_port_conversion_strategy (SCM_BOOL_F); + { + /* N.B. scm_port_conversion_strategy in Guile versions prior to 2.0.6 + will throw a Scheme error when passed #f. */ + if (gdbscm_guile_version_is_at_least (2, 0, 6)) + errors = scm_port_conversion_strategy (SCM_BOOL_F); + else + errors = error_symbol; + } /* We don't assume anything about the result of scm_port_conversion_strategy. From this point on, if errors is not 'errors, use 'substitute. */ |