guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-159-gc6b08


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-159-gc6b08d2
Date: Fri, 01 Apr 2011 11:31:52 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=c6b08d21947b1b33de1e8cd364553112d4015253

The branch, stable-2.0 has been updated
       via  c6b08d21947b1b33de1e8cd364553112d4015253 (commit)
       via  13a78b0fd75a4825de0624e47911810fe8a5d150 (commit)
       via  355dd8cb4bff2821f4b4da2bd989441b882ed5de (commit)
       via  d050ef66eceb764e0c26e535140ebed795b546fa (commit)
      from  1c8a6308c0050189a777d9384f270aea3206c2e0 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit c6b08d21947b1b33de1e8cd364553112d4015253
Author: Andy Wingo <address@hidden>
Date:   Fri Apr 1 13:31:26 2011 +0200

    string->pointer and pointer->string have optional encoding arg
    
    * test-suite/tests/foreign.test ("pointer<->string"): Add test cases.
    
    * libguile/foreign.c (scm_string_to_pointer, scm_pointer_to_string): Add
      optional encoding, and in the pointer->string case, length arguments.
    
    * libguile/foreign.h: Update prototypes of internal functions.
      Shouldn't affect ABI as they are internal.
    
    * doc/ref/api-foreign.texi (Void Pointers and Byte Access): Update
      docs.

commit 13a78b0fd75a4825de0624e47911810fe8a5d150
Author: Andy Wingo <address@hidden>
Date:   Fri Apr 1 12:10:42 2011 +0200

    support loading objcode even if mmap(2) is unavailable
    
    * configure.ac: Check for sys/mman.h.
    
    * libguile/objcodes.c (verify_cookie): Factor cookie verification out to
      a helper function.
      (make_objcode_from_file): Rename from make_objcode_by_mmap.  If mmap
      is unavailable, just read(2) to a bytevector.

commit 355dd8cb4bff2821f4b4da2bd989441b882ed5de
Author: Andy Wingo <address@hidden>
Date:   Fri Apr 1 11:23:12 2011 +0200

    make_objcode_by_mmap uses MAP_PRIVATE, not MAP_SHARED
    
    * libguile/objcodes.c (make_objcode_by_mmap): MAP_PRIVATE, not
      MAP_SHARED -- we don't need to update the underlying file, nor do we
      need to see updates.

commit d050ef66eceb764e0c26e535140ebed795b546fa
Author: Andy Wingo <address@hidden>
Date:   Fri Apr 1 11:05:37 2011 +0200

    latin1 subr and message in internal scm_{encoding,decoding}_error
    
    * libguile/strings.c (scm_encoding_error, scm_decoding_error): Use
      scm_from_latin1_string for the subr and message args, as these are
      internal functions, and we know their callers.

-----------------------------------------------------------------------

Summary of changes:
 configure.ac                  |    2 +-
 doc/ref/api-foreign.texi      |   20 +++--
 libguile/foreign.c            |   79 ++++++++++++++++----
 libguile/foreign.h            |    4 +-
 libguile/objcodes.c           |  170 ++++++++++++++++++++++++++++-------------
 libguile/strings.c            |    8 +-
 test-suite/tests/foreign.test |   13 +++-
 7 files changed, 213 insertions(+), 83 deletions(-)

diff --git a/configure.ac b/configure.ac
index 4fc2553..2fd72a4 100644
--- a/configure.ac
+++ b/configure.ac
@@ -773,7 +773,7 @@ AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 
ctermid fesetround ftime
 #   cuserid - on Tru64 5.1b the declaration is documented to be available
 #       only with `_XOPEN_SOURCE' or some such.
 #
-AC_CHECK_HEADERS([crypt.h netdb.h pthread.h sys/param.h sys/resource.h 
sys/file.h])
+AC_CHECK_HEADERS([crypt.h netdb.h pthread.h sys/param.h sys/resource.h 
sys/file.h sys/mman.h])
 AC_CHECK_FUNCS(chroot flock getlogin cuserid getpriority setpriority getpass 
sethostname gethostname)
 AC_CHECK_DECLS([sethostname, hstrerror, cuserid])
 
diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi
index b5fdd00..2dd6916 100644
--- a/doc/ref/api-foreign.texi
+++ b/doc/ref/api-foreign.texi
@@ -626,20 +626,22 @@ Assuming @var{pointer} points to a memory region that 
holds a pointer,
 return this pointer.
 @end deffn
 
address@hidden {Scheme Procedure} string->pointer string
address@hidden {Scheme Procedure} string->pointer string [encoding]
 Return a foreign pointer to a nul-terminated copy of @var{string} in the
-current locale encoding.  The C string is freed when the returned
-foreign pointer becomes unreachable.
+given @var{encoding}, defaulting to the current locale encoding.  The C
+string is freed when the returned foreign pointer becomes unreachable.
 
-This is the Scheme equivalent of @code{scm_to_locale_string}.
+This is the Scheme equivalent of @code{scm_to_stringn}.
 @end deffn
 
address@hidden {Scheme Procedure} pointer->string pointer
-Return the string representing the C nul-terminated string
-pointed to by @var{pointer}.  The C string is assumed to be
-in the current locale encoding.
address@hidden {Scheme Procedure} pointer->string pointer [length] [encoding]
+Return the string representing the C string pointed to by @var{pointer}.
+If @var{length} is omitted or @code{-1}, the string is assumed to be
+nul-terminated.  Otherwise @var{length} is the number of bytes in memory
+pointed to by @var{pointer}.  The C string is assumed to be in the given
address@hidden, defaulting to the current locale encoding.
 
-This is the Scheme equivalent of @code{scm_from_locale_string}.
+This is the Scheme equivalent of @code{scm_from_stringn}.
 @end deffn
 
 @cindex wrapped pointer types
diff --git a/libguile/foreign.c b/libguile/foreign.c
index dbfba87..ae9e27a 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -355,13 +355,13 @@ SCM_DEFINE (scm_dereference_pointer, 
"dereference-pointer", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_string_to_pointer, "string->pointer", 1, 0, 0,
-           (SCM string),
+SCM_DEFINE (scm_string_to_pointer, "string->pointer", 1, 1, 0,
+           (SCM string, SCM encoding),
            "Return a foreign pointer to a nul-terminated copy of\n"
-           "@var{string} in the current locale encoding.  The C\n"
-           "string is freed when the returned foreign pointer\n"
-           "becomes unreachable.\n\n"
-            "This is the Scheme equivalent of @code{scm_to_locale_string}.")
+           "@var{string} in the given @var{encoding}, defaulting to\n"
+            "the current locale encoding.  The C string is freed when\n"
+            "the returned foreign pointer becomes unreachable.\n\n"
+            "This is the Scheme equivalent of @code{scm_to_stringn}.")
 #define FUNC_NAME s_scm_string_to_pointer
 {
   SCM_VALIDATE_STRING (1, string);
@@ -369,21 +369,72 @@ SCM_DEFINE (scm_string_to_pointer, "string->pointer", 1, 
0, 0,
   /* XXX: Finalizers slow down libgc; they could be avoided if
      `scm_to_string' & co. were able to use libgc-allocated memory.  */
 
-  return scm_from_pointer (scm_to_locale_string (string), free);
+  if (SCM_UNBNDP (encoding))
+    return scm_from_pointer (scm_to_locale_string (string), free);
+  else
+    {
+      char *enc;
+      SCM ret;
+      
+      SCM_VALIDATE_STRING (2, encoding);
+
+      enc = scm_to_locale_string (encoding);
+      scm_dynwind_begin (0);
+      scm_dynwind_free (enc);
+
+      ret = scm_from_pointer
+        (scm_to_stringn (string, NULL, enc,
+                         scm_i_get_conversion_strategy (SCM_BOOL_F)),
+         free);
+
+      scm_dynwind_end ();
+
+      return ret;
+    }
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_pointer_to_string, "pointer->string", 1, 0, 0,
-           (SCM pointer),
-           "Return the string representing the C nul-terminated string\n"
-           "pointed to by @var{pointer}.  The C string is assumed to be\n"
-           "in the current locale encoding.\n\n"
-           "This is the Scheme equivalent of @code{scm_from_locale_string}.")
+SCM_DEFINE (scm_pointer_to_string, "pointer->string", 1, 2, 0,
+           (SCM pointer, SCM length, SCM encoding),
+           "Return the string representing the C string pointed to by\n"
+            "@var{pointer}.  If @var{length} is omitted or @code{-1}, the\n"
+            "string is assumed to be nul-terminated.  Otherwise\n"
+            "@var{length} is the number of bytes in memory pointed to by\n"
+            "@var{pointer}.  The C string is assumed to be in the given\n"
+            "@var{encoding}, defaulting to the current locale encoding.\n\n"
+           "This is the Scheme equivalent of @code{scm_from_stringn}.")
 #define FUNC_NAME s_scm_pointer_to_string
 {
+  size_t len;
+
   SCM_VALIDATE_POINTER (1, pointer);
 
-  return scm_from_locale_string (SCM_POINTER_VALUE (pointer));
+  if (SCM_UNBNDP (length)
+      || scm_is_true (scm_eqv_p (length, scm_from_int (-1))))
+    len = (size_t)-1;
+  else
+    len = scm_to_size_t (length);
+    
+  if (SCM_UNBNDP (encoding))
+    return scm_from_locale_stringn (SCM_POINTER_VALUE (pointer), len);
+  else
+    {
+      char *enc;
+      SCM ret;
+      
+      SCM_VALIDATE_STRING (3, encoding);
+
+      enc = scm_to_locale_string (encoding);
+      scm_dynwind_begin (0);
+      scm_dynwind_free (enc);
+
+      ret = scm_from_stringn (SCM_POINTER_VALUE (pointer), len, enc,
+                              scm_i_get_conversion_strategy (SCM_BOOL_F));
+
+      scm_dynwind_end ();
+
+      return ret;
+    }
 }
 #undef FUNC_NAME
 
diff --git a/libguile/foreign.h b/libguile/foreign.h
index b290019..6c6f373 100644
--- a/libguile/foreign.h
+++ b/libguile/foreign.h
@@ -72,8 +72,8 @@ SCM_INTERNAL void scm_i_pointer_print (SCM pointer, SCM port,
                                        scm_print_state *pstate);
 
 SCM_INTERNAL SCM scm_dereference_pointer (SCM pointer);
-SCM_INTERNAL SCM scm_string_to_pointer (SCM string);
-SCM_INTERNAL SCM scm_pointer_to_string (SCM pointer);
+SCM_INTERNAL SCM scm_string_to_pointer (SCM string, SCM encoding);
+SCM_INTERNAL SCM scm_pointer_to_string (SCM pointer, SCM length, SCM encoding);
 
 
 
diff --git a/libguile/objcodes.c b/libguile/objcodes.c
index f4e20f8..448bada 100644
--- a/libguile/objcodes.c
+++ b/libguile/objcodes.c
@@ -23,12 +23,18 @@
 #include <string.h>
 #include <fcntl.h>
 #include <unistd.h>
+
+#ifdef HAVE_SYS_MMAN_H
 #include <sys/mman.h>
+#endif
+
 #include <sys/stat.h>
 #include <sys/types.h>
 #include <assert.h>
 #include <alignof.h>
 
+#include <full-read.h>
+
 #include "_scm.h"
 #include "programs.h"
 #include "objcodes.h"
@@ -44,6 +50,52 @@ verify (((sizeof (SCM_OBJCODE_COOKIE) - 1) & 7) == 0);
  * Objcode type
  */
 
+static void
+verify_cookie (char *cookie, struct stat *st, int map_fd, void *map_addr)
+#define FUNC_NAME "make_objcode_from_file"
+{
+  /* The cookie ends with a version of the form M.N, where M is the
+     major version and N is the minor version.  For this Guile to be
+     able to load an objcode, M must be SCM_OBJCODE_MAJOR_VERSION, and N
+     must be less than or equal to SCM_OBJCODE_MINOR_VERSION.  Since N
+     is the last character, we do a strict comparison on all but the
+     last, then a <= on the last one.  */
+  if (memcmp (cookie, SCM_OBJCODE_COOKIE, strlen (SCM_OBJCODE_COOKIE) - 1))
+    {
+      SCM args = scm_list_1 (scm_from_latin1_stringn
+                             (cookie, strlen (SCM_OBJCODE_COOKIE)));
+      if (map_fd >= 0)
+        {
+          (void) close (map_fd);
+#ifdef HAVE_SYS_MMAN_H
+          (void) munmap (map_addr, st->st_size);
+#endif
+        }
+      scm_misc_error (FUNC_NAME, "bad header on object file: ~s", args);
+    }
+
+  {
+    char minor_version = cookie[strlen (SCM_OBJCODE_COOKIE) - 1];
+
+    if (minor_version > SCM_OBJCODE_MINOR_VERSION_STRING[0])
+      {
+        if (map_fd >= 0)
+          {
+            (void) close (map_fd);
+#ifdef HAVE_SYS_MMAN_H
+            (void) munmap (map_addr, st->st_size);
+#endif
+          }
+
+        scm_misc_error (FUNC_NAME, "objcode minor version too new (~a > ~a)",
+                        scm_list_2 (scm_from_latin1_stringn (&minor_version, 
1),
+                                    scm_from_latin1_string
+                                    (SCM_OBJCODE_MINOR_VERSION_STRING)));
+      }
+  }
+}
+#undef FUNC_NAME
+
 /* The words in an objcode SCM object are as follows:
      - scm_tc7_objcode | type | flags
      - the struct scm_objcode C object
@@ -53,77 +105,91 @@ verify (((sizeof (SCM_OBJCODE_COOKIE) - 1) & 7) == 0);
  */
 
 static SCM
-make_objcode_by_mmap (int fd)
-#define FUNC_NAME "make_objcode_by_mmap"
+make_objcode_from_file (int fd)
+#define FUNC_NAME "make_objcode_from_file"
 {
   int ret;
-  char *addr;
+  /* The SCM_OBJCODE_COOKIE is a string literal, and thus has an extra
+     trailing NUL, hence the - 1. */
+  char cookie[sizeof (SCM_OBJCODE_COOKIE) - 1];
   struct stat st;
-  SCM sret = SCM_BOOL_F;
-  struct scm_objcode *data;
 
   ret = fstat (fd, &st);
   if (ret < 0)
     SCM_SYSERROR;
 
-  if (st.st_size <= sizeof (struct scm_objcode) + strlen (SCM_OBJCODE_COOKIE))
+  if (st.st_size <= sizeof (struct scm_objcode) + sizeof cookie)
     scm_misc_error (FUNC_NAME, "object file too small (~a bytes)",
                    scm_list_1 (SCM_I_MAKINUM (st.st_size)));
 
-  addr = mmap (0, st.st_size, PROT_READ, MAP_SHARED, fd, 0);
-  if (addr == MAP_FAILED)
-    {
-      (void) close (fd);
-      SCM_SYSERROR;
-    }
-
-  /* The cookie ends with a version of the form M.N, where M is the
-     major version and N is the minor version.  For this Guile to be
-     able to load an objcode, M must be SCM_OBJCODE_MAJOR_VERSION, and N
-     must be less than or equal to SCM_OBJCODE_MINOR_VERSION.  Since N
-     is the last character, we do a strict comparison on all but the
-     last, then a <= on the last one.  */
-  if (memcmp (addr, SCM_OBJCODE_COOKIE, strlen (SCM_OBJCODE_COOKIE) - 1))
-    {
-      SCM args = scm_list_1 (scm_from_latin1_stringn
-                             (addr, strlen (SCM_OBJCODE_COOKIE)));
-      (void) close (fd);
-      (void) munmap (addr, st.st_size);
-      scm_misc_error (FUNC_NAME, "bad header on object file: ~s", args);
-    }
-
+#ifdef HAVE_SYS_MMAN_H
   {
-    char minor_version = addr[strlen (SCM_OBJCODE_COOKIE) - 1];
-
-    if (minor_version > SCM_OBJCODE_MINOR_VERSION_STRING[0])
-      scm_misc_error (FUNC_NAME, "objcode minor version too new (~a > ~a)",
-                      scm_list_2 (scm_from_latin1_stringn (&minor_version, 1),
-                                  scm_from_latin1_string
-                                  (SCM_OBJCODE_MINOR_VERSION_STRING)));
+    char *addr;
+    struct scm_objcode *data;
+
+    addr = mmap (0, st.st_size, PROT_READ, MAP_PRIVATE, fd, 0);
+
+    if (addr == MAP_FAILED)
+      {
+        int errno_save = errno;
+        (void) close (fd);
+        errno = errno_save;
+        SCM_SYSERROR;
+      }
+    else
+      {
+        memcpy (cookie, addr, sizeof cookie);
+        data = (struct scm_objcode *) (addr + sizeof cookie);
+      }
+
+    verify_cookie (cookie, &st, fd, addr);
+
+
+    if (data->len + data->metalen
+        != (st.st_size - sizeof (*data) - sizeof cookie))
+      {
+        size_t total_len = sizeof (*data) + data->len + data->metalen;
+
+        (void) close (fd);
+        (void) munmap (addr, st.st_size);
+
+        scm_misc_error (FUNC_NAME, "bad length header (~a, ~a)",
+                        scm_list_2 (scm_from_size_t (st.st_size),
+                                    scm_from_size_t (total_len)));
+      }
+
+    /* FIXME: we leak ourselves and the file descriptor. but then again so does
+       dlopen(). */
+    return scm_permanent_object
+      (scm_double_cell (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_MMAP, 0),
+                        (scm_t_bits)(addr + strlen (SCM_OBJCODE_COOKIE)),
+                        SCM_UNPACK (scm_from_int (fd)), 0));
   }
+#else
+  {
+    SCM bv = scm_c_make_bytevector (st.st_size - sizeof cookie);
 
-  data = (struct scm_objcode*)(addr + strlen (SCM_OBJCODE_COOKIE));
+    if (full_read (fd, cookie, sizeof cookie) != sizeof cookie
+        || full_read (fd, SCM_BYTEVECTOR_CONTENTS (bv),
+                      SCM_BYTEVECTOR_LENGTH (bv)) != SCM_BYTEVECTOR_LENGTH 
(bv))
+      {
+        int errno_save = errno;
+        (void) close (fd);
+        errno = errno_save;
+        SCM_SYSERROR;
+      }
 
-  if (data->len + data->metalen != (st.st_size - sizeof (*data) - strlen 
(SCM_OBJCODE_COOKIE)))
-    {
-      (void) close (fd);
-      (void) munmap (addr, st.st_size);
-      scm_misc_error (FUNC_NAME, "bad length header (~a, ~a)",
-                     scm_list_2 (scm_from_size_t (st.st_size),
-                                 scm_from_uint32 (sizeof (*data) + data->len
-                                                  + data->metalen)));
-    }
+    (void) close (fd);
 
-  sret = scm_double_cell (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_MMAP, 0),
-                          (scm_t_bits)(addr + strlen (SCM_OBJCODE_COOKIE)),
-                          SCM_UNPACK (scm_from_int (fd)), 0);
+    verify_cookie (cookie, &st, -1, NULL);
 
-  /* FIXME: we leak ourselves and the file descriptor. but then again so does
-     dlopen(). */
-  return scm_permanent_object (sret);
+    return scm_bytecode_to_objcode (bv);
+  }
+#endif
 }
 #undef FUNC_NAME
 
+
 SCM
 scm_c_make_objcode_slice (SCM parent, const scm_t_uint8 *ptr)
 #define FUNC_NAME "make-objcode-slice"
@@ -233,7 +299,7 @@ SCM_DEFINE (scm_load_objcode, "load-objcode", 1, 0, 0,
   free (c_file);
   if (fd < 0) SCM_SYSERROR;
 
-  return make_objcode_by_mmap (fd);
+  return make_objcode_from_file (fd);
 }
 #undef FUNC_NAME
 
diff --git a/libguile/strings.c b/libguile/strings.c
index cdf8141..bf63704 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -1423,8 +1423,8 @@ scm_encoding_error (const char *subr, int err, const char 
*message,
                    SCM port, SCM chr)
 {
   scm_throw (scm_encoding_error_key,
-            scm_list_n (scm_from_locale_string (subr),
-                        scm_from_locale_string (message),
+            scm_list_n (scm_from_latin1_string (subr),
+                        scm_from_latin1_string (message),
                         scm_from_int (err),
                         port, chr,
                         SCM_UNDEFINED));
@@ -1436,8 +1436,8 @@ void
 scm_decoding_error (const char *subr, int err, const char *message, SCM port)
 {
   scm_throw (scm_decoding_error_key,
-            scm_list_n (scm_from_locale_string (subr),
-                        scm_from_locale_string (message),
+            scm_list_n (scm_from_latin1_string (subr),
+                        scm_from_latin1_string (message),
                         scm_from_int (err),
                         port,
                         SCM_UNDEFINED));
diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test
index 1353e7d..60b466e 100644
--- a/test-suite/tests/foreign.test
+++ b/test-suite/tests/foreign.test
@@ -153,7 +153,18 @@
   (pass-if "bijection [latin1]"
     (with-latin1-locale
       (let ((s "Szép jó napot!"))
-        (string=? s (pointer->string (string->pointer s)))))))
+        (string=? s (pointer->string (string->pointer s))))))
+
+  (pass-if "bijection, utf-8"
+    (let ((s "hello, world"))
+      (string=? s (pointer->string (string->pointer s "utf-8")
+                                   -1 "utf-8"))))
+
+  (pass-if "bijection, utf-8 [latin1]"
+    (let ((s "Szép jó napot!"))
+      (string=? s (pointer->string (string->pointer s "utf-8")
+                                   -1 "utf-8")))))
+
 
 
 (with-test-prefix "pointer->procedure"


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]