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.

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])
 

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)
+make_objcode_from_file (int fd)
-#define FUNC_NAME "make_objcode_by_mmap"
+#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_PRIVATE, fd, 0);
+#ifdef HAVE_SYS_MMAN_H
-  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);
-    }
-
   {
-    char minor_version = addr[strlen (SCM_OBJCODE_COOKIE) - 1];
+    char *addr;
+    struct scm_objcode *data;
 
-    if (minor_version > SCM_OBJCODE_MINOR_VERSION_STRING[0])
+    addr = mmap (0, st.st_size, PROT_READ, MAP_PRIVATE, fd, 0);
-      scm_misc_error (FUNC_NAME, "objcode minor version too new (~a > ~a)",
+
-                      scm_list_2 (scm_from_latin1_stringn (&minor_version, 1),
+    if (addr == MAP_FAILED)
-                                  scm_from_latin1_string
+      {
-                                  (SCM_OBJCODE_MINOR_VERSION_STRING)));
+        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) 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)));
-    }
 
-  sret = scm_double_cell (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_MMAP, 0),
+    verify_cookie (cookie, &st, -1, NULL);
-                          (scm_t_bits)(addr + strlen (SCM_OBJCODE_COOKIE)),
-                          SCM_UNPACK (scm_from_int (fd)), 0);
 
-  /* FIXME: we leak ourselves and the file descriptor. but then again so does
+    return scm_bytecode_to_objcode (bv);
-     dlopen(). */
+  }
-  return scm_permanent_object (sret);
+#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