[commit] Add support for guile 2.0.5.

Doug Evans
2014-06-06T23:00:40Z

Hi.

fyi, I committed this.
Regression tested with guile 2.0.5 and 2.0.11 on amd64-linux.

commit d2929fdcf05bb14dc2484ee6918dbf67c5b46d75
Author: Doug Evans <xdje42@gmail.com>
Date: Fri Jun 6 15:57:03 2014 -0700

Add support for guile 2.0.5.

* 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.

doc/
* guile.texi (Guile Configuration): Document guile-data-directory.

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);
\f
/* 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. */