unofficial mirror of bug-guile@gnu.org 
 help / color / mirror / Atom feed
* bug#27782: [wishlist] scheme level mmap
@ 2017-07-21 13:39 Matt Wette
       [not found] ` <handler.27782.B.150064439025677.ack@debbugs.gnu.org>
                   ` (6 more replies)
  0 siblings, 7 replies; 16+ messages in thread
From: Matt Wette @ 2017-07-21 13:39 UTC (permalink / raw)
  To: 27782

There was an implicit request on the user-guile mailing list (20 Jul 2017) to provide a scheme language call to mmap.

I am working on a prototype and will post when I get a simple case working.  Here is non-working code so far:


Currently I have this in a file “mmap.c” and #including into filesys.c.


#ifdef HAVE_CONFIG_H
#  include <config.h>
#endif

#ifdef HAVE_SYS_MMAN_H
#  include <sys/mman.h>
#endif

#include "libguile/_scm.h"
#include "libguile/smob.h"
#include "libguile/fdes-finalizers.h"
#include "libguile/feature.h"

SCM_API SCM scm_mmap (SCM addr, SCM len, SCM prot, SCM flags, SCM fd,
		      SCM offset);
SCM_API SCM scm_munmap (SCM addr, SCM len);

#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)
// python mmap makes the last four args optional
// should use fd=-1 default on mac
SCM_DEFINE (scm_mmap, "mmap", 6, 0, 0, 
            (SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
	    "See the man page. returns a foreign pointer which one would"
	    "ordinarily convert to bytevector using pointer->bytevector.  "
	    "Note that the region returned by mmap is not (?) searched "
	    "by the garbage collector."
	    "@example\n(define reg\n (pointer->bytevector\n  "
	    "(mmap %void-pointer #x10000 (logior PROT_READ PROT_WRITE) "
	    "MAP_ANON -1 0) #x1000))"
	    "@end example"
	    )
#define FUNC_NAME s_scm_mmap
{
  void *c_mem, *c_addr;
  size_t c_len;
  int c_prot, c_flags, c_fd;
  scm_t_off c_offset;
  SCM ret;

  SCM_VALIDATE_POINTER (1, addr);
  
  c_addr = (void *) SCM_POINTER_VALUE (addr);
  c_len = scm_to_size_t (len);
  c_prot = scm_to_int (prot);
  c_flags = scm_to_int (flags);
  c_fd = scm_to_int (fd);
  c_offset = SCM_UNBNDP (offset) ? 0: scm_to_off_t (offset);
  
  c_mem = mmap(c_addr, c_len, c_prot, c_flags, c_fd, c_offset);

  ret = scm_from_pointer (c_mem, NULL);
  return ret;
}

#undef FUNC_NAME
SCM_DEFINE (scm_munmap, "munmap", 2, 0, 0, 
            (SCM addr, SCM len),
	    "See the man page. Given foreign pointer unmap."
	    )
#define FUNC_NAME s_scm_munmap
{
  void *c_addr;
  size_t c_len;
  int c_res;
  SCM res;

  SCM_VALIDATE_POINTER (1, addr);
  
  c_addr = (void *) SCM_POINTER_VALUE (addr);
  c_len = scm_to_size_t (len);

  c_res = munmap(c_addr, c_len);
  res = scm_from_int (c_res);
  return res;
}
#endif /* HAVE_SYS_MMAN_H */

#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)

#define MMAP_DEFS					\
  scm_c_define ("PROT_NONE", scm_from_int (PROT_NONE)); \
  scm_c_define ("PROT_READ", scm_from_int (PROT_READ)); \
  scm_c_define ("PROT_WRITE", scm_from_int (PROT_WRITE)); \
  scm_c_define ("PROT_EXEC", scm_from_int (PROT_EXEC)); \
  \
  scm_c_define ("MAP_ANONYMOUS", scm_from_int (MAP_ANONYMOUS)); \
  scm_c_define ("MAP_ANON", scm_from_int (MAP_ANON)); \
  scm_c_define ("MAP_FILE", scm_from_int (MAP_FILE)); \
  scm_c_define ("MAP_FIXED", scm_from_int (MAP_FIXED)); \
  scm_c_define ("MAP_HASSEMAPHORE", scm_from_int (MAP_HASSEMAPHORE)); \
  scm_c_define ("MAP_PRIVATE", scm_from_int (MAP_PRIVATE)); \
  scm_c_define ("MAP_SHARED", scm_from_int (MAP_SHARED)); \
  scm_c_define ("MAP_NOCACHE", scm_from_int (MAP_NOCACHE))

#else
#define MMAP_DEFS /* */
#endif /* HAVE_SYS_MMAN_H */







^ permalink raw reply	[flat|nested] 16+ messages in thread

* bug#27782: Acknowledgement ([wishlist] scheme level mmap)
       [not found] ` <handler.27782.B.150064439025677.ack@debbugs.gnu.org>
@ 2017-07-21 14:35   ` Matt Wette
  0 siblings, 0 replies; 16+ messages in thread
From: Matt Wette @ 2017-07-21 14:35 UTC (permalink / raw)
  To: 27782

Works on guile-2.2.2:
> (use-modules (system foreign))
> (define raw (mmap %null-pointer #x1000 (logior PROT_READ PROT_WRITE)
     (logior MAP_ANON MAP_PRIVATE) -1 0))
> (munmap raw #x1000)

  
$ diff filesys.c.orig filesys.c
+ #include "mmap.c"
+ 
  void
  scm_init_filesys ()
  {
+   MMAP_DEFS;
  #ifdef HAVE_POSIX
    scm_tc16_dir = scm_make_smob_type ("directory", 0);
    scm_set_smob_free (scm_tc16_dir, scm_dir_free);


mmap.c-post2: 

#ifdef HAVE_CONFIG_H
#  include <config.h>
#endif

#ifdef HAVE_SYS_MMAN_H
#  include <sys/mman.h>
#  include <errno.h>
#endif

#include "libguile/_scm.h"
#include "libguile/smob.h"
#include "libguile/fdes-finalizers.h"
#include "libguile/feature.h"

SCM_API SCM scm_mmap (SCM addr, SCM len, SCM prot, SCM flags, SCM fd,
		      SCM offset);
SCM_API SCM scm_munmap (SCM addr, SCM len);

#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)
// python mmap makes the last four args optional
// should use fd=-1 default on mac
// The following works:
// > (use-modules (system foreign))
// > (define raw (mmap %null-pointer #x1000 (logior PROT_READ PROT_WRITE)
//      (logior MAP_ANON MAP_PRIVATE) -1 0))
// > (munmap raw #x1000)
SCM_DEFINE (scm_mmap, "mmap", 6, 0, 0, 
            (SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
	    "See the man page. returns a foreign pointer which one would"
	    "ordinarily convert to bytevector using pointer->bytevector.  "
	    "Note that the region returned by mmap is not (?) searched "
	    "by the garbage collector."
	    "@example\n(define reg\n (pointer->bytevector\n  "
	    "(mmap %null-pointer #x10000 (logior PROT_READ PROT_WRITE) "
	    "(logior MAP_ANON MAP_PRIVATE) -1 0) #x1000))"
	    "@end example"
	    )
#define FUNC_NAME s_scm_mmap
{
  void *c_mem, *c_addr;
  size_t c_len;
  int c_prot, c_flags, c_fd;
  scm_t_off c_offset;

  SCM_VALIDATE_POINTER (1, addr);
  
  c_addr = (void *) SCM_POINTER_VALUE (addr);
  c_len = scm_to_size_t (len);
  c_prot = scm_to_int (prot);
  c_flags = scm_to_int (flags);
  c_fd = scm_to_int (fd);
  c_offset = SCM_UNBNDP (offset) ? 0: scm_to_off_t (offset);

  c_mem = mmap(c_addr, c_len, c_prot, c_flags, c_fd, c_offset);
  if (c_mem == MAP_FAILED)
    SCM_SYSERROR; /* errno set */
  else 
    return scm_from_pointer (c_mem, NULL);
}

#undef FUNC_NAME
SCM_DEFINE (scm_munmap, "munmap", 2, 0, 0, 
            (SCM addr, SCM len),
	    "See the man page. Given foreign pointer unmap."
	    )
#define FUNC_NAME s_scm_munmap
{
  void *c_addr;
  size_t c_len;
  int c_res;

  SCM_VALIDATE_POINTER (1, addr);
  
  c_addr = (void *) SCM_POINTER_VALUE (addr);
  c_len = scm_to_size_t (len);

  c_res = munmap(c_addr, c_len);
  if (c_res == -1)
    SCM_SYSERROR; /* errno set */
  else
    return scm_from_int (c_res);
}
#endif /* HAVE_SYS_MMAN_H */

#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)

#define MMAP_DEFS					\
  scm_c_define ("PROT_NONE", scm_from_int (PROT_NONE)); \
  scm_c_define ("PROT_READ", scm_from_int (PROT_READ)); \
  scm_c_define ("PROT_WRITE", scm_from_int (PROT_WRITE)); \
  scm_c_define ("PROT_EXEC", scm_from_int (PROT_EXEC)); \
  \
  scm_c_define ("MAP_ANONYMOUS", scm_from_int (MAP_ANONYMOUS)); \
  scm_c_define ("MAP_ANON", scm_from_int (MAP_ANON)); \
  scm_c_define ("MAP_FILE", scm_from_int (MAP_FILE)); \
  scm_c_define ("MAP_FIXED", scm_from_int (MAP_FIXED)); \
  scm_c_define ("MAP_HASSEMAPHORE", scm_from_int (MAP_HASSEMAPHORE)); \
  scm_c_define ("MAP_PRIVATE", scm_from_int (MAP_PRIVATE)); \
  scm_c_define ("MAP_SHARED", scm_from_int (MAP_SHARED)); \
  scm_c_define ("MAP_NOCACHE", scm_from_int (MAP_NOCACHE))

#else
#define MMAP_DEFS /* */
#endif /* HAVE_SYS_MMAN_H */






^ permalink raw reply	[flat|nested] 16+ messages in thread

* bug#27782: mmap for guile 2.2.2
  2017-07-21 13:39 bug#27782: [wishlist] scheme level mmap Matt Wette
       [not found] ` <handler.27782.B.150064439025677.ack@debbugs.gnu.org>
@ 2017-10-28 15:25 ` Matt Wette
  2017-10-28 17:09   ` Matt Wette
  2017-11-24 15:54 ` bug#27782: mmap for guile Matt Wette
                   ` (4 subsequent siblings)
  6 siblings, 1 reply; 16+ messages in thread
From: Matt Wette @ 2017-10-28 15:25 UTC (permalink / raw)
  To: 27782

I worked on the code a bit more.  It is currently implemented as a #include "mman.c" in filesys.c 
and another file "mman.c".

I believe this needs to be reviewed by someone who understands the constraints on foriegn pointers 
and finalization better than I do.  Also, there is a comment to add a procedure mmap/no-search to 
guarantee that the allocated region is not searched by the GC for pointers.

The following patch is against guile-2.2.2:

--- libguile/filesys.c.orig	2017-07-21 06:14:18.000000000 -0700
+++ libguile/filesys.c	2017-10-27 15:40:04.000000000 -0700
@@ -1828,9 +1828,14 @@
 
 \f
 
+#include "mman.c"
+
 void
 scm_init_filesys ()
 {
+#ifdef HAVE_SYS_MMAN_H
+  init_mman();
+#endif
 #ifdef HAVE_POSIX
   scm_tc16_dir = scm_make_smob_type ("directory", 0);
   scm_set_smob_free (scm_tc16_dir, scm_dir_free);
--- libguile/mman.c.orig	2017-07-20 17:06:55.000000000 -0700
+++ libguile/mman.c	2017-10-28 08:12:46.000000000 -0700
@@ -0,0 +1,165 @@
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#ifdef HAVE_SYS_MMAN_H
+#  include <sys/mman.h>
+#  include <errno.h>
+#endif
+
+#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)
+
+#include "libguile/_scm.h"
+#include "libguile/smob.h"
+#include "libguile/fdes-finalizers.h"
+#include "libguile/feature.h"
+
+SCM_API SCM scm_mmap (SCM addr, SCM len, SCM prot, SCM flags, SCM fd,
+		      SCM offset);
+SCM_API SCM scm_munmap (SCM bvec);
+void init_mman(void);
+static void mmap_finalizer (void *ptr, void *data);
+
+
+SCM_DEFINE (scm_mmap, "mmap", 2, 4, 0, 
+            (SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
+	    "mmap addr len [prot [flags [fd [offset]]]]"
+	    "See the man page.  Returns a bytevector."
+	    "ordinarily convert to bytevector using pointer->bytevector.  "
+	    "Note that the region returned by mmap is not (?) searched "
+	    "by the garbage collector.  Defaults:\n"
+	    "  PROT   (logior PROT_READ PROT_WRITE)\n"
+	    "  FLAGS  (logior MAP_ANON MAP_PRIVATE)\n"
+	    "  FD     -1\n"
+	    "  OFFSET 0\n"
+	    "@example\n(define reg (mmap %null-pointer #x1000)\n"
+	    "@end example"
+	    )
+#define FUNC_NAME s_scm_mmap
+{
+  void *c_mem, *c_addr;
+  size_t c_len;
+  int c_prot, c_flags, c_fd;
+  scm_t_off c_offset;
+  SCM pointer, bvec;
+
+  if (SCM_POINTER_P (addr))
+    c_addr = SCM_POINTER_VALUE (addr);
+  else if (scm_is_integer (addr))
+    c_addr = (void*) scm_to_uintptr_t (addr);
+  else
+    SCM_MISC_ERROR("bad addr", addr);
+
+  c_len = scm_to_size_t (len);
+  
+  if (SCM_UNBNDP (prot))
+    c_prot = PROT_READ | PROT_WRITE;
+  else 
+    c_prot = scm_to_int (prot);
+
+  if (SCM_UNBNDP (flags))
+    c_flags = MAP_ANON | MAP_PRIVATE;
+  else
+    c_flags = scm_to_int (flags);
+
+  if (SCM_UNBNDP (fd))
+    c_fd = -1;
+  else
+    c_fd = scm_to_int (fd);
+
+  if (SCM_UNBNDP (fd))
+    c_offset = 0;
+  else
+    c_offset = scm_to_off_t (offset);
+
+  c_mem = mmap(c_addr, c_len, c_prot, c_flags, c_fd, c_offset);
+  if (c_mem == MAP_FAILED)
+    SCM_SYSERROR;			/* errno set */
+
+  pointer = scm_cell (scm_tc7_pointer, (scm_t_bits) c_mem);
+  bvec = scm_c_take_typed_bytevector((signed char *) c_mem + c_offset, c_len,
+				     SCM_ARRAY_ELEMENT_TYPE_VU8, pointer);
+  /* if sizeof(void*) < sizeof(size_t) we are in trouble: */
+  scm_i_set_finalizer (SCM2PTR (bvec), mmap_finalizer, (void*) c_len);
+  return bvec;
+}
+static void
+mmap_finalizer (void *ptr, void *data)
+{
+  void *c_addr;
+  intptr_t c_len;
+  int res;
+
+  c_addr = (void *) SCM_POINTER_VALUE (SCM_PACK_POINTER (ptr));
+  c_len = (intptr_t) data;
+  res = munmap(c_addr, c_len);
+  if (res != 0) SCM_SYSERROR;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_munmap, "munmap", 1, 0, 0, 
+            (SCM bvec),
+	    "See the man page. Given bytevector unmap."
+	    )
+#define FUNC_NAME s_scm_munmap
+{
+  void *c_addr;
+  size_t c_len;
+  int c_res;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bvec);
+  
+  c_addr = (void *) SCM_BYTEVECTOR_CONTENTS (bvec);
+  c_len = SCM_BYTEVECTOR_LENGTH (bvec);
+
+  c_res = munmap(c_addr, c_len);
+  if (c_res == -1)
+    SCM_SYSERROR;			/* errno set */
+
+  // TODO: clean up bytevector
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+void init_mman(void) {
+#ifdef PROT_NONE
+  scm_c_define ("PROT_NONE", scm_from_int (PROT_NONE));
+#endif
+#ifdef PROT_
+  scm_c_define ("PROT_READ", scm_from_int (PROT_READ));
+#endif
+#ifdef PROT_
+  scm_c_define ("PROT_WRITE", scm_from_int (PROT_WRITE));
+#endif
+#ifdef PROT_
+  scm_c_define ("PROT_EXEC", scm_from_int (PROT_EXEC));
+#endif
+
+#ifdef MAP_ANONYMOUS
+  scm_c_define ("MAP_ANONYMOUS", scm_from_int (MAP_ANONYMOUS));
+#endif
+#ifdef MAP_ANON
+  scm_c_define ("MAP_ANO




^ permalink raw reply	[flat|nested] 16+ messages in thread

* bug#27782: mmap for guile 2.2.2
  2017-10-28 15:25 ` bug#27782: mmap for guile 2.2.2 Matt Wette
@ 2017-10-28 17:09   ` Matt Wette
  0 siblings, 0 replies; 16+ messages in thread
From: Matt Wette @ 2017-10-28 17:09 UTC (permalink / raw)
  To: 27782

I located GC_exclude_static_roots() call for the collector.

Now mmap/search will run allocate a bytevector as in the previously provided patch.
And mmap will call mmap/search and then apply GC_exclude_static_roots() to the mmap'd region.







^ permalink raw reply	[flat|nested] 16+ messages in thread

* bug#27782: mmap for guile
  2017-07-21 13:39 bug#27782: [wishlist] scheme level mmap Matt Wette
       [not found] ` <handler.27782.B.150064439025677.ack@debbugs.gnu.org>
  2017-10-28 15:25 ` bug#27782: mmap for guile 2.2.2 Matt Wette
@ 2017-11-24 15:54 ` Matt Wette
  2017-11-24 16:22   ` Nala Ginrut
  2020-07-04 19:40 ` bug#27782: new patch for mma Matt Wette
                   ` (3 subsequent siblings)
  6 siblings, 1 reply; 16+ messages in thread
From: Matt Wette @ 2017-11-24 15:54 UTC (permalink / raw)
  To: 27782






I did a little more on this.  Here is the latest.
It provides mmap (not searched) and mmap/search (searched for pointers to GC).


--- libguile/filesys.c.orig	2017-03-01 10:54:31.000000000 -0800
+++ libguile/filesys.c	2017-10-28 10:05:10.000000000 -0700
@@ -1828,9 +1828,14 @@
 
 \f
 
+#include "mman.c"
+
 void
 scm_init_filesys ()
 {
+#ifdef HAVE_SYS_MMAN_H
+  init_mman();
+#endif
 #ifdef HAVE_POSIX
   scm_tc16_dir = scm_make_smob_type ("directory", 0);
   scm_set_smob_free (scm_tc16_dir, scm_dir_free);
--- libguile/mman.c.orig	2017-10-28 10:05:10.000000000 -0700
+++ libguile/mman.c	2017-11-04 09:23:35.000000000 -0700
@@ -0,0 +1,199 @@
+// mman.c - v171104a
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#ifdef HAVE_SYS_MMAN_H
+#  include <sys/mman.h>
+#  include <errno.h>
+#endif
+
+#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)
+
+#include "libguile/_scm.h"
+#include "libguile/smob.h"
+#include "libguile/fdes-finalizers.h"
+#include "libguile/feature.h"
+
+SCM_API SCM scm_mmap_search (SCM addr, SCM len, SCM prot, SCM flags, SCM fd,
+		             SCM offset);
+SCM_API SCM scm_mmap (SCM addr, SCM len, SCM prot, SCM flags, SCM fd,
+		      SCM offset);
+SCM_API SCM scm_munmap (SCM bvec);
+void init_mman(void);
+static void mmap_finalizer (void *ptr, void *data);
+
+SCM_DEFINE (scm_mmap_search, "mmap/search", 2, 4, 0, 
+            (SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
+	    "mmap addr len [prot [flags [fd [offset]]]]"
+	    "See the unix man page for mmap.  Returns a bytevector."
+	    "Note that the region allocated will be searched by the garbage"
+	    "collector for pointers.  \n"
+	    " Defaults:\n"
+	    "  PROT   (logior PROT_READ PROT_WRITE)\n"
+	    "  FLAGS  (logior MAP_ANON MAP_PRIVATE)\n"
+	    "  FD     -1\n"
+	    "  OFFSET 0\n"
+	    "@example\n(define reg (mmap/search %null-pointer #x1000)\n"
+	    "@end example"
+	    )
+#define FUNC_NAME s_scm_mmap_search
+{
+  void *c_mem, *c_addr;
+  size_t c_len;
+  int c_prot, c_flags, c_fd;
+  scm_t_off c_offset;
+  SCM pointer, bvec;
+
+  if (SCM_POINTER_P (addr))
+    c_addr = SCM_POINTER_VALUE (addr);
+  else if (scm_is_integer (addr))
+    c_addr = (void*) scm_to_uintptr_t (addr);
+  else
+    SCM_MISC_ERROR("bad addr", addr);
+
+  c_len = scm_to_size_t (len);
+  
+  if (SCM_UNBNDP (prot))
+    c_prot = PROT_READ | PROT_WRITE;
+  else 
+    c_prot = scm_to_int (prot);
+
+  if (SCM_UNBNDP (flags))
+    c_flags = MAP_ANON | MAP_PRIVATE;
+  else
+    c_flags = scm_to_int (flags);
+
+  if (SCM_UNBNDP (fd))
+    c_fd = -1;
+  else
+    c_fd = scm_to_int (fd);
+
+  if (SCM_UNBNDP (fd))
+    c_offset = 0;
+  else
+    c_offset = scm_to_off_t (offset);
+
+  c_mem = mmap(c_addr, c_len, c_prot, c_flags, c_fd, c_offset);
+  if (c_mem == MAP_FAILED)
+    SCM_SYSERROR;			/* errno set */
+
+  pointer = scm_cell (scm_tc7_pointer, (scm_t_bits) c_mem);
+  bvec = scm_c_take_typed_bytevector((signed char *) c_mem + c_offset, c_len,
+				     SCM_ARRAY_ELEMENT_TYPE_VU8, pointer);
+  /* if sizeof(void*) < sizeof(size_t) we are in trouble: */
+  scm_i_set_finalizer (SCM2PTR (bvec), mmap_finalizer, (void*) c_len);
+  return bvec;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_mmap, "mmap", 2, 4, 0, 
+            (SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
+	    "mmap addr len [prot [flags [fd [offset]]]]"
+	    "See the man page.  Returns a bytevector."
+	    "Note that the region returned by mmap will NOT be searched "
+	    "by the garbage collector for pointers.\n"
+	    "Defaults:\n"
+	    "  PROT   (logior PROT_READ PROT_WRITE)\n"
+	    "  FLAGS  (logior MAP_ANON MAP_PRIVATE)\n"
+	    "  FD     -1\n"
+	    "  OFFSET 0\n"
+	    "@example\n"
+	    "(define bvec-1MB (mmap 0 #x100000)\n"
+	    "@end example"
+	    )
+#define FUNC_NAME s_scm_mmap
+{
+  SCM bvec;
+  void *c_mem;
+  size_t c_len;
+
+  bvec = scm_mmap_search(addr, len, prot, flags, fd, offset);
+  c_mem = SCM_BYTEVECTOR_CONTENTS(bvec);
+  c_len = SCM_BYTEVECTOR_LENGTH(bvec);
+
+  /* tell GC not to scan for pointers */
+  GC_exclude_static_roots(c_mem, (char*) c_mem + c_len);
+
+  return bvec;
+}
+static void
+mmap_finalizer (void *ptr, void *data)
+{
+  void *c_addr;
+  intptr_t c_len;
+  int res;
+
+  c_addr = (void *) SCM_POINTER_VALUE (SCM_PACK_POINTER (ptr));
+  c_len = (intptr_t) data;
+  res = munmap(c_addr, c_len);
+  if (res != 0) SCM_SYSERROR;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_munmap, "munmap", 1, 0, 0, 
+            (SCM bvec),
+	    "See the man page. Given bytevector unmap."
+	    )
+#define FUNC_NAME s_scm_munmap
+{
+  void *c_addr;
+  size_t c_len;
+  int c_res;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bvec);
+  
+  c_addr = (void *) SCM_BYTEVECTOR_CONTENTS (bvec);
+  c_len = SCM_BYTEVECTOR_LENGTH (bvec);
+
+  c_res = munmap(c_addr, c_len);
+  if (c_res == -1)
+    SCM_SYSERROR;			/* errno set */
+
+  // TODO: clean up bytevector
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+void init_mman(void) {
+#ifdef PROT_NONE
+  scm_c_define ("PROT_NONE", scm_from_int (PROT_NONE));
+#endif
+#ifdef PROT_
+  scm_c_define ("PROT_READ", scm_from_int (PROT_READ));
+#endif
+#ifdef PROT_
+  scm_c_define ("PROT_WRITE", scm_from_int (PROT_WRITE));
+#endif
+#ifdef PROT_
+  scm_c_define ("PROT_EXEC", scm_from_int (PROT_EXEC));
+#endif
+
+#ifdef MAP_ANONYMOUS
+  scm_c_define ("MAP_ANONYMOUS", scm_from_int (MAP_ANONYMOUS));
+#endif
+#ifdef MAP_ANON
+  scm_c_define ("MAP_ANON", scm_from_int (MAP_ANON));
+#endif
+#ifdef MAP_FILE
+  scm_c_define ("MAP_FILE", scm_from_int (MAP_FILE));
+#endif
+#ifdef MAP_FIXED
+  scm_c_define ("MAP_FIXED", scm_from_int (MAP_FIXED));
+#endif
+#ifdef MAP_HASSEMAPHORE
+  scm_c_define ("MAP_HASSEMAPHORE", scm_from_int (MAP_HASSEMAPHORE));
+#endif
+#ifdef MAP_PRIVATE
+  scm_c_define ("MAP_PRIVATE", scm_from_int (MAP_PRIVATE));
+#endif
+#ifdef MAP_SHARED
+  scm_c_define ("MAP_SHARED", scm_from_int (MAP_SHARED));
+#endif
+#ifdef MAP_NOCACHE
+  scm_c_define ("MAP_NOCACHE", scm_from_int (MAP_NOCACHE));
+#endif
+  scm_c_define ("PAGE_SIZE", scm_from_int (getpagesize()));
+}
+
+#endif /* HAVE_SYS_MMAN_H */






^ permalink raw reply	[flat|nested] 16+ messages in thread

* bug#27782: mmap for guile
  2017-11-24 15:54 ` bug#27782: mmap for guile Matt Wette
@ 2017-11-24 16:22   ` Nala Ginrut
  2017-11-24 17:09     ` Matt Wette
  0 siblings, 1 reply; 16+ messages in thread
From: Nala Ginrut @ 2017-11-24 16:22 UTC (permalink / raw)
  To: Matt Wette; +Cc: 27782

[-- Attachment #1: Type: text/plain, Size: 7196 bytes --]

Thanks for the work! Could you please add MAP_POPULATE too?

2017年11月24日 下午11:55,"Matt Wette" <matt.wette@gmail.com>写道:

>
>
>
>
>
> I did a little more on this.  Here is the latest.
> It provides mmap (not searched) and mmap/search (searched for pointers to
> GC).
>
>
> --- libguile/filesys.c.orig     2017-03-01 10:54:31.000000000 -0800
> +++ libguile/filesys.c  2017-10-28 10:05:10.000000000 -0700
> @@ -1828,9 +1828,14 @@
>
>
>
> +#include "mman.c"
> +
>  void
>  scm_init_filesys ()
>  {
> +#ifdef HAVE_SYS_MMAN_H
> +  init_mman();
> +#endif
>  #ifdef HAVE_POSIX
>    scm_tc16_dir = scm_make_smob_type ("directory", 0);
>    scm_set_smob_free (scm_tc16_dir, scm_dir_free);
> --- libguile/mman.c.orig        2017-10-28 10:05:10.000000000 -0700
> +++ libguile/mman.c     2017-11-04 09:23:35.000000000 -0700
> @@ -0,0 +1,199 @@
> +// mman.c - v171104a
> +#ifdef HAVE_CONFIG_H
> +#  include <config.h>
> +#endif
> +
> +#ifdef HAVE_SYS_MMAN_H
> +#  include <sys/mman.h>
> +#  include <errno.h>
> +#endif
> +
> +#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)
> +
> +#include "libguile/_scm.h"
> +#include "libguile/smob.h"
> +#include "libguile/fdes-finalizers.h"
> +#include "libguile/feature.h"
> +
> +SCM_API SCM scm_mmap_search (SCM addr, SCM len, SCM prot, SCM flags, SCM
> fd,
> +                            SCM offset);
> +SCM_API SCM scm_mmap (SCM addr, SCM len, SCM prot, SCM flags, SCM fd,
> +                     SCM offset);
> +SCM_API SCM scm_munmap (SCM bvec);
> +void init_mman(void);
> +static void mmap_finalizer (void *ptr, void *data);
> +
> +SCM_DEFINE (scm_mmap_search, "mmap/search", 2, 4, 0,
> +            (SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
> +           "mmap addr len [prot [flags [fd [offset]]]]"
> +           "See the unix man page for mmap.  Returns a bytevector."
> +           "Note that the region allocated will be searched by the
> garbage"
> +           "collector for pointers.  \n"
> +           " Defaults:\n"
> +           "  PROT   (logior PROT_READ PROT_WRITE)\n"
> +           "  FLAGS  (logior MAP_ANON MAP_PRIVATE)\n"
> +           "  FD     -1\n"
> +           "  OFFSET 0\n"
> +           "@example\n(define reg (mmap/search %null-pointer #x1000)\n"
> +           "@end example"
> +           )
> +#define FUNC_NAME s_scm_mmap_search
> +{
> +  void *c_mem, *c_addr;
> +  size_t c_len;
> +  int c_prot, c_flags, c_fd;
> +  scm_t_off c_offset;
> +  SCM pointer, bvec;
> +
> +  if (SCM_POINTER_P (addr))
> +    c_addr = SCM_POINTER_VALUE (addr);
> +  else if (scm_is_integer (addr))
> +    c_addr = (void*) scm_to_uintptr_t (addr);
> +  else
> +    SCM_MISC_ERROR("bad addr", addr);
> +
> +  c_len = scm_to_size_t (len);
> +
> +  if (SCM_UNBNDP (prot))
> +    c_prot = PROT_READ | PROT_WRITE;
> +  else
> +    c_prot = scm_to_int (prot);
> +
> +  if (SCM_UNBNDP (flags))
> +    c_flags = MAP_ANON | MAP_PRIVATE;
> +  else
> +    c_flags = scm_to_int (flags);
> +
> +  if (SCM_UNBNDP (fd))
> +    c_fd = -1;
> +  else
> +    c_fd = scm_to_int (fd);
> +
> +  if (SCM_UNBNDP (fd))
> +    c_offset = 0;
> +  else
> +    c_offset = scm_to_off_t (offset);
> +
> +  c_mem = mmap(c_addr, c_len, c_prot, c_flags, c_fd, c_offset);
> +  if (c_mem == MAP_FAILED)
> +    SCM_SYSERROR;                      /* errno set */
> +
> +  pointer = scm_cell (scm_tc7_pointer, (scm_t_bits) c_mem);
> +  bvec = scm_c_take_typed_bytevector((signed char *) c_mem + c_offset,
> c_len,
> +                                    SCM_ARRAY_ELEMENT_TYPE_VU8, pointer);
> +  /* if sizeof(void*) < sizeof(size_t) we are in trouble: */
> +  scm_i_set_finalizer (SCM2PTR (bvec), mmap_finalizer, (void*) c_len);
> +  return bvec;
> +}
> +#undef FUNC_NAME
> +
> +SCM_DEFINE (scm_mmap, "mmap", 2, 4, 0,
> +            (SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
> +           "mmap addr len [prot [flags [fd [offset]]]]"
> +           "See the man page.  Returns a bytevector."
> +           "Note that the region returned by mmap will NOT be searched "
> +           "by the garbage collector for pointers.\n"
> +           "Defaults:\n"
> +           "  PROT   (logior PROT_READ PROT_WRITE)\n"
> +           "  FLAGS  (logior MAP_ANON MAP_PRIVATE)\n"
> +           "  FD     -1\n"
> +           "  OFFSET 0\n"
> +           "@example\n"
> +           "(define bvec-1MB (mmap 0 #x100000)\n"
> +           "@end example"
> +           )
> +#define FUNC_NAME s_scm_mmap
> +{
> +  SCM bvec;
> +  void *c_mem;
> +  size_t c_len;
> +
> +  bvec = scm_mmap_search(addr, len, prot, flags, fd, offset);
> +  c_mem = SCM_BYTEVECTOR_CONTENTS(bvec);
> +  c_len = SCM_BYTEVECTOR_LENGTH(bvec);
> +
> +  /* tell GC not to scan for pointers */
> +  GC_exclude_static_roots(c_mem, (char*) c_mem + c_len);
> +
> +  return bvec;
> +}
> +static void
> +mmap_finalizer (void *ptr, void *data)
> +{
> +  void *c_addr;
> +  intptr_t c_len;
> +  int res;
> +
> +  c_addr = (void *) SCM_POINTER_VALUE (SCM_PACK_POINTER (ptr));
> +  c_len = (intptr_t) data;
> +  res = munmap(c_addr, c_len);
> +  if (res != 0) SCM_SYSERROR;
> +}
> +#undef FUNC_NAME
> +
> +SCM_DEFINE (scm_munmap, "munmap", 1, 0, 0,
> +            (SCM bvec),
> +           "See the man page. Given bytevector unmap."
> +           )
> +#define FUNC_NAME s_scm_munmap
> +{
> +  void *c_addr;
> +  size_t c_len;
> +  int c_res;
> +
> +  SCM_VALIDATE_BYTEVECTOR (1, bvec);
> +
> +  c_addr = (void *) SCM_BYTEVECTOR_CONTENTS (bvec);
> +  c_len = SCM_BYTEVECTOR_LENGTH (bvec);
> +
> +  c_res = munmap(c_addr, c_len);
> +  if (c_res == -1)
> +    SCM_SYSERROR;                      /* errno set */
> +
> +  // TODO: clean up bytevector
> +  return SCM_UNSPECIFIED;
> +}
> +#undef FUNC_NAME
> +
> +void init_mman(void) {
> +#ifdef PROT_NONE
> +  scm_c_define ("PROT_NONE", scm_from_int (PROT_NONE));
> +#endif
> +#ifdef PROT_
> +  scm_c_define ("PROT_READ", scm_from_int (PROT_READ));
> +#endif
> +#ifdef PROT_
> +  scm_c_define ("PROT_WRITE", scm_from_int (PROT_WRITE));
> +#endif
> +#ifdef PROT_
> +  scm_c_define ("PROT_EXEC", scm_from_int (PROT_EXEC));
> +#endif
> +
> +#ifdef MAP_ANONYMOUS
> +  scm_c_define ("MAP_ANONYMOUS", scm_from_int (MAP_ANONYMOUS));
> +#endif
> +#ifdef MAP_ANON
> +  scm_c_define ("MAP_ANON", scm_from_int (MAP_ANON));
> +#endif
> +#ifdef MAP_FILE
> +  scm_c_define ("MAP_FILE", scm_from_int (MAP_FILE));
> +#endif
> +#ifdef MAP_FIXED
> +  scm_c_define ("MAP_FIXED", scm_from_int (MAP_FIXED));
> +#endif
> +#ifdef MAP_HASSEMAPHORE
> +  scm_c_define ("MAP_HASSEMAPHORE", scm_from_int (MAP_HASSEMAPHORE));
> +#endif
> +#ifdef MAP_PRIVATE
> +  scm_c_define ("MAP_PRIVATE", scm_from_int (MAP_PRIVATE));
> +#endif
> +#ifdef MAP_SHARED
> +  scm_c_define ("MAP_SHARED", scm_from_int (MAP_SHARED));
> +#endif
> +#ifdef MAP_NOCACHE
> +  scm_c_define ("MAP_NOCACHE", scm_from_int (MAP_NOCACHE));
> +#endif
> +  scm_c_define ("PAGE_SIZE", scm_from_int (getpagesize()));
> +}
> +
> +#endif /* HAVE_SYS_MMAN_H */
>
>
>
>
>

[-- Attachment #2: Type: text/html, Size: 8998 bytes --]

^ permalink raw reply	[flat|nested] 16+ messages in thread

* bug#27782: mmap for guile
  2017-11-24 16:22   ` Nala Ginrut
@ 2017-11-24 17:09     ` Matt Wette
  2017-11-25 14:41       ` Matt Wette
  0 siblings, 1 reply; 16+ messages in thread
From: Matt Wette @ 2017-11-24 17:09 UTC (permalink / raw)
  To: Nala Ginrut; +Cc: 27782

[-- Attachment #1: Type: text/plain, Size: 7320 bytes --]

got it.

> On Nov 24, 2017, at 8:22 AM, Nala Ginrut <nalaginrut@gmail.com> wrote:
> 
> Thanks for the work! Could you please add MAP_POPULATE too?
> 
> 2017年11月24日 下午11:55,"Matt Wette" <matt.wette@gmail.com <mailto:matt.wette@gmail.com>>写道:
> 
> 
> 
> 
> 
> I did a little more on this.  Here is the latest.
> It provides mmap (not searched) and mmap/search (searched for pointers to GC).
> 
> 
> --- libguile/filesys.c.orig     2017-03-01 10:54:31.000000000 -0800
> +++ libguile/filesys.c  2017-10-28 10:05:10.000000000 -0700
> @@ -1828,9 +1828,14 @@
> 
> 
> 
> +#include "mman.c"
> +
>  void
>  scm_init_filesys ()
>  {
> +#ifdef HAVE_SYS_MMAN_H
> +  init_mman();
> +#endif
>  #ifdef HAVE_POSIX
>    scm_tc16_dir = scm_make_smob_type ("directory", 0);
>    scm_set_smob_free (scm_tc16_dir, scm_dir_free);
> --- libguile/mman.c.orig        2017-10-28 10:05:10.000000000 -0700
> +++ libguile/mman.c     2017-11-04 09:23:35.000000000 -0700
> @@ -0,0 +1,199 @@
> +// mman.c - v171104a
> +#ifdef HAVE_CONFIG_H
> +#  include <config.h>
> +#endif
> +
> +#ifdef HAVE_SYS_MMAN_H
> +#  include <sys/mman.h>
> +#  include <errno.h>
> +#endif
> +
> +#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)
> +
> +#include "libguile/_scm.h"
> +#include "libguile/smob.h"
> +#include "libguile/fdes-finalizers.h"
> +#include "libguile/feature.h"
> +
> +SCM_API SCM scm_mmap_search (SCM addr, SCM len, SCM prot, SCM flags, SCM fd,
> +                            SCM offset);
> +SCM_API SCM scm_mmap (SCM addr, SCM len, SCM prot, SCM flags, SCM fd,
> +                     SCM offset);
> +SCM_API SCM scm_munmap (SCM bvec);
> +void init_mman(void);
> +static void mmap_finalizer (void *ptr, void *data);
> +
> +SCM_DEFINE (scm_mmap_search, "mmap/search", 2, 4, 0,
> +            (SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
> +           "mmap addr len [prot [flags [fd [offset]]]]"
> +           "See the unix man page for mmap.  Returns a bytevector."
> +           "Note that the region allocated will be searched by the garbage"
> +           "collector for pointers.  \n"
> +           " Defaults:\n"
> +           "  PROT   (logior PROT_READ PROT_WRITE)\n"
> +           "  FLAGS  (logior MAP_ANON MAP_PRIVATE)\n"
> +           "  FD     -1\n"
> +           "  OFFSET 0\n"
> +           "@example\n(define reg (mmap/search %null-pointer #x1000)\n"
> +           "@end example"
> +           )
> +#define FUNC_NAME s_scm_mmap_search
> +{
> +  void *c_mem, *c_addr;
> +  size_t c_len;
> +  int c_prot, c_flags, c_fd;
> +  scm_t_off c_offset;
> +  SCM pointer, bvec;
> +
> +  if (SCM_POINTER_P (addr))
> +    c_addr = SCM_POINTER_VALUE (addr);
> +  else if (scm_is_integer (addr))
> +    c_addr = (void*) scm_to_uintptr_t (addr);
> +  else
> +    SCM_MISC_ERROR("bad addr", addr);
> +
> +  c_len = scm_to_size_t (len);
> +
> +  if (SCM_UNBNDP (prot))
> +    c_prot = PROT_READ | PROT_WRITE;
> +  else
> +    c_prot = scm_to_int (prot);
> +
> +  if (SCM_UNBNDP (flags))
> +    c_flags = MAP_ANON | MAP_PRIVATE;
> +  else
> +    c_flags = scm_to_int (flags);
> +
> +  if (SCM_UNBNDP (fd))
> +    c_fd = -1;
> +  else
> +    c_fd = scm_to_int (fd);
> +
> +  if (SCM_UNBNDP (fd))
> +    c_offset = 0;
> +  else
> +    c_offset = scm_to_off_t (offset);
> +
> +  c_mem = mmap(c_addr, c_len, c_prot, c_flags, c_fd, c_offset);
> +  if (c_mem == MAP_FAILED)
> +    SCM_SYSERROR;                      /* errno set */
> +
> +  pointer = scm_cell (scm_tc7_pointer, (scm_t_bits) c_mem);
> +  bvec = scm_c_take_typed_bytevector((signed char *) c_mem + c_offset, c_len,
> +                                    SCM_ARRAY_ELEMENT_TYPE_VU8, pointer);
> +  /* if sizeof(void*) < sizeof(size_t) we are in trouble: */
> +  scm_i_set_finalizer (SCM2PTR (bvec), mmap_finalizer, (void*) c_len);
> +  return bvec;
> +}
> +#undef FUNC_NAME
> +
> +SCM_DEFINE (scm_mmap, "mmap", 2, 4, 0,
> +            (SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
> +           "mmap addr len [prot [flags [fd [offset]]]]"
> +           "See the man page.  Returns a bytevector."
> +           "Note that the region returned by mmap will NOT be searched "
> +           "by the garbage collector for pointers.\n"
> +           "Defaults:\n"
> +           "  PROT   (logior PROT_READ PROT_WRITE)\n"
> +           "  FLAGS  (logior MAP_ANON MAP_PRIVATE)\n"
> +           "  FD     -1\n"
> +           "  OFFSET 0\n"
> +           "@example\n"
> +           "(define bvec-1MB (mmap 0 #x100000)\n"
> +           "@end example"
> +           )
> +#define FUNC_NAME s_scm_mmap
> +{
> +  SCM bvec;
> +  void *c_mem;
> +  size_t c_len;
> +
> +  bvec = scm_mmap_search(addr, len, prot, flags, fd, offset);
> +  c_mem = SCM_BYTEVECTOR_CONTENTS(bvec);
> +  c_len = SCM_BYTEVECTOR_LENGTH(bvec);
> +
> +  /* tell GC not to scan for pointers */
> +  GC_exclude_static_roots(c_mem, (char*) c_mem + c_len);
> +
> +  return bvec;
> +}
> +static void
> +mmap_finalizer (void *ptr, void *data)
> +{
> +  void *c_addr;
> +  intptr_t c_len;
> +  int res;
> +
> +  c_addr = (void *) SCM_POINTER_VALUE (SCM_PACK_POINTER (ptr));
> +  c_len = (intptr_t) data;
> +  res = munmap(c_addr, c_len);
> +  if (res != 0) SCM_SYSERROR;
> +}
> +#undef FUNC_NAME
> +
> +SCM_DEFINE (scm_munmap, "munmap", 1, 0, 0,
> +            (SCM bvec),
> +           "See the man page. Given bytevector unmap."
> +           )
> +#define FUNC_NAME s_scm_munmap
> +{
> +  void *c_addr;
> +  size_t c_len;
> +  int c_res;
> +
> +  SCM_VALIDATE_BYTEVECTOR (1, bvec);
> +
> +  c_addr = (void *) SCM_BYTEVECTOR_CONTENTS (bvec);
> +  c_len = SCM_BYTEVECTOR_LENGTH (bvec);
> +
> +  c_res = munmap(c_addr, c_len);
> +  if (c_res == -1)
> +    SCM_SYSERROR;                      /* errno set */
> +
> +  // TODO: clean up bytevector
> +  return SCM_UNSPECIFIED;
> +}
> +#undef FUNC_NAME
> +
> +void init_mman(void) {
> +#ifdef PROT_NONE
> +  scm_c_define ("PROT_NONE", scm_from_int (PROT_NONE));
> +#endif
> +#ifdef PROT_
> +  scm_c_define ("PROT_READ", scm_from_int (PROT_READ));
> +#endif
> +#ifdef PROT_
> +  scm_c_define ("PROT_WRITE", scm_from_int (PROT_WRITE));
> +#endif
> +#ifdef PROT_
> +  scm_c_define ("PROT_EXEC", scm_from_int (PROT_EXEC));
> +#endif
> +
> +#ifdef MAP_ANONYMOUS
> +  scm_c_define ("MAP_ANONYMOUS", scm_from_int (MAP_ANONYMOUS));
> +#endif
> +#ifdef MAP_ANON
> +  scm_c_define ("MAP_ANON", scm_from_int (MAP_ANON));
> +#endif
> +#ifdef MAP_FILE
> +  scm_c_define ("MAP_FILE", scm_from_int (MAP_FILE));
> +#endif
> +#ifdef MAP_FIXED
> +  scm_c_define ("MAP_FIXED", scm_from_int (MAP_FIXED));
> +#endif
> +#ifdef MAP_HASSEMAPHORE
> +  scm_c_define ("MAP_HASSEMAPHORE", scm_from_int (MAP_HASSEMAPHORE));
> +#endif
> +#ifdef MAP_PRIVATE
> +  scm_c_define ("MAP_PRIVATE", scm_from_int (MAP_PRIVATE));
> +#endif
> +#ifdef MAP_SHARED
> +  scm_c_define ("MAP_SHARED", scm_from_int (MAP_SHARED));
> +#endif
> +#ifdef MAP_NOCACHE
> +  scm_c_define ("MAP_NOCACHE", scm_from_int (MAP_NOCACHE));
> +#endif
> +  scm_c_define ("PAGE_SIZE", scm_from_int (getpagesize()));
> +}
> +
> +#endif /* HAVE_SYS_MMAN_H */
> 
> 
> 
> 


[-- Attachment #2: Type: text/html, Size: 12713 bytes --]

^ permalink raw reply	[flat|nested] 16+ messages in thread

* bug#27782: mmap for guile
  2017-11-24 17:09     ` Matt Wette
@ 2017-11-25 14:41       ` Matt Wette
  2017-11-25 16:17         ` Nala Ginrut
  0 siblings, 1 reply; 16+ messages in thread
From: Matt Wette @ 2017-11-25 14:41 UTC (permalink / raw)
  To: 27782

here is a start on test-suite/tests/mmap.test

+;;;; mmap.test --- test suite for Guile's mmap functions  -*- scheme -*-
+;;;;
+
+(define-module (test-mmap)
+  #:use-module (test-suite lib))
+
+(use-modules (rnrs bytevectors))
+
+(with-test-prefix "mmap"
+
+  (pass-if "basics"
+    (let* ((siz #x10000)
+          (reg (mmap 0 siz)))
+      (and (eqv? (bytevector-length reg) siz)
+          (begin (bytevector-u8-set! reg 0 99)
+                 (eqv? (bytevector-u8-ref reg 0) 99))
+          (begin (bytevector-u8-set! reg (1- siz) 98)
+                 (eqv? (bytevector-u8-ref reg (1- siz)) 98))
+          #t)))
+    
+  )
+
+;;;; --- last line ---






^ permalink raw reply	[flat|nested] 16+ messages in thread

* bug#27782: mmap for guile
  2017-11-25 14:41       ` Matt Wette
@ 2017-11-25 16:17         ` Nala Ginrut
  0 siblings, 0 replies; 16+ messages in thread
From: Nala Ginrut @ 2017-11-25 16:17 UTC (permalink / raw)
  To: Matt Wette; +Cc: 27782

[-- Attachment #1: Type: text/plain, Size: 1069 bytes --]

Actually I've been using a FFI version of mmap in my working code, with my
previous patch to Guile it's very easy to handle errno. Just few lines code
is enough to bind mmap.
I am not sure if C version binding is still the best option to maintain.

2017年11月25日 22:42,"Matt Wette" <matt.wette@gmail.com>写道:

> here is a start on test-suite/tests/mmap.test
>
> +;;;; mmap.test --- test suite for Guile's mmap functions  -*- scheme -*-
> +;;;;
> +
> +(define-module (test-mmap)
> +  #:use-module (test-suite lib))
> +
> +(use-modules (rnrs bytevectors))
> +
> +(with-test-prefix "mmap"
> +
> +  (pass-if "basics"
> +    (let* ((siz #x10000)
> +          (reg (mmap 0 siz)))
> +      (and (eqv? (bytevector-length reg) siz)
> +          (begin (bytevector-u8-set! reg 0 99)
> +                 (eqv? (bytevector-u8-ref reg 0) 99))
> +          (begin (bytevector-u8-set! reg (1- siz) 98)
> +                 (eqv? (bytevector-u8-ref reg (1- siz)) 98))
> +          #t)))
> +
> +  )
> +
> +;;;; --- last line ---
>
>
>
>
>

[-- Attachment #2: Type: text/html, Size: 1504 bytes --]

^ permalink raw reply	[flat|nested] 16+ messages in thread

* bug#27782: new patch for mma
  2017-07-21 13:39 bug#27782: [wishlist] scheme level mmap Matt Wette
                   ` (2 preceding siblings ...)
  2017-11-24 15:54 ` bug#27782: mmap for guile Matt Wette
@ 2020-07-04 19:40 ` Matt Wette
  2020-07-09 12:45   ` Ludovic Courtès
  2022-12-21  1:21 ` bug#27782: patch to add support for mmap and friends Matt Wette
                   ` (2 subsequent siblings)
  6 siblings, 1 reply; 16+ messages in thread
From: Matt Wette @ 2020-07-04 19:40 UTC (permalink / raw)
  To: 27782; +Cc: Ludovic Courtès, matt.wette

[-- Attachment #1: Type: text/plain, Size: 740 bytes --]

Attached is a patch against guile master (at 3.0.4),
commit 5e1748f75128107e3a0707b66df5adb95d98437e

It is a incomplete, but functional, implementation of a mmap-api, including
1) mmap : low-level mmap, returns a bytevector, not searched for roots
2) mmap/search : like mmap, but not marked w/ GC_exclude_static_roots
3) mmap-file: high-level, easy-to-use mmap (e.g., (mmap-file "foo.dat"))

The above are coded in libguile/filesys.[ch].

Also included is test-suite/tests/mmap-api.test.

Build:
$ ./configure --enable-mmap-api
$ make
$ make check
...
Running mmap-api.test
...

Since implementation of mmap may be not simple, I propose a
git branch (e.g., wip-mmap-api) be created to invite group review,
update, test the update.

Matt



[-- Attachment #2: mmap-api-branch.patch --]
[-- Type: text/x-patch, Size: 13760 bytes --]

diff --git a/configure.ac b/configure.ac
index 3e96094f6..382d7d528 100644
--- a/configure.ac
+++ b/configure.ac
@@ -170,6 +170,10 @@ AC_ARG_ENABLE(tmpnam,
   AS_HELP_STRING([--disable-tmpnam],[omit POSIX tmpnam]),,
   enable_tmpnam=yes)
 
+AC_ARG_ENABLE(mmap-api,
+  AS_HELP_STRING([--enable-mmap-api],[enable MMAP interface]),,
+  enable_mmap_api=no)
+
 AC_ARG_ENABLE([deprecated],
   AS_HELP_STRING([--disable-deprecated],[omit deprecated features]))
 
@@ -917,6 +921,10 @@ if test "$enable_tmpnam" = yes; then
    AC_DEFINE([ENABLE_TMPNAM], 1, [Define when tmpnam support is enabled.])
 fi
 
+if test "$enable_mmap_api" = yes; then
+   AC_DEFINE([ENABLE_MMAP_API], 1, [Define when MMAP API is enabled.])
+fi
+
 AC_REPLACE_FUNCS([strerror memmove])
 
 # Reasons for testing:
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 39bfd38cc..04e5dfd4d 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -79,11 +79,22 @@
 # include <sys/sendfile.h>
 #endif
 
+#ifdef ENABLE_MMAP_API
+#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)
+#  include <sys/mman.h>
+#  include <sys/stat.h>
+#  include <errno.h>
+#endif
+#endif
+
 #include "async.h"
 #include "boolean.h"
+#include "bytevectors.h"                /* mmap */
 #include "dynwind.h"
 #include "fdes-finalizers.h"
 #include "feature.h"
+#include "finalizers.h"                 /* mmap */
+#include "foreign.h"                    /* mmap */
 #include "fports.h"
 #include "gsubr.h"
 #include "iselect.h"
@@ -1880,6 +1891,314 @@ scm_dir_free (SCM p)
 
 \f
 
+#ifdef ENABLE_MMAP_API
+#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)
+
+/* FiXME
+ * rlb says add msync()
+ * Windows : look for MapViewOfFile
+ */
+
+/* undefined, string or int acceptable */
+static int
+mm_flags (SCM prot, int def)
+{
+  if (SCM_UNBNDP (prot))
+    return def;
+  else
+    scm_misc_error("mmap", "bad prot option", SCM_EOL);
+  return -1;
+}
+
+static int
+mm_prot (SCM prot, int def)
+{
+  if (SCM_UNBNDP (prot))
+    return def;
+  else
+    scm_misc_error("mmap", "bad prot option", SCM_EOL);
+  return -1;
+}
+
+static void
+mmap_finalizer (void *ptr, void *data)
+{
+  SCM bvec;
+  void *c_addr;
+  size_t c_len;
+  int res;
+
+  bvec = SCM_PACK_POINTER (ptr);
+  if (!SCM_BYTEVECTOR_P (bvec))
+    abort();
+  
+  c_addr = SCM_BYTEVECTOR_CONTENTS (bvec);
+  c_len = (size_t) data;
+  res = munmap(c_addr, c_len);
+  if (res != 0)
+    scm_misc_error ("mmap", "failed to munmap memory", SCM_EOL);
+}
+
+SCM_DEFINE (scm_mmap_search, "mmap/search", 2, 4, 0, 
+            (SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
+	    "mmap addr len [prot [flags [fd [offset]]]]"
+	    "See the unix man page for mmap.  Returns a bytevector."
+	    "Note that the region allocated will be searched by the garbage"
+	    "collector for pointers. \n"
+	    "Defaults:\n"
+	    "  prot   (logior PROT_READ PROT_WRITE)\n"
+	    "  flags  (logior MAP_ANON MAP_PRIVATE)\n"
+	    "  fd     -1\n"
+	    "  offset 0\n"
+	    "E.g., @code{(define reg (mmap/search %null-pointer #x1000)}\n")
+#define FUNC_NAME s_scm_mmap_search
+{
+  void *c_mem, *c_addr;
+  size_t c_len;
+  int c_prot, c_flags, c_fd;
+  scm_t_off c_offset;
+  SCM pointer, bvec;
+
+  if (SCM_POINTER_P (addr))
+    c_addr = SCM_POINTER_VALUE (addr);
+  else if (scm_is_integer (addr))
+    c_addr = (void*) scm_to_uintptr_t (addr);
+  else
+    SCM_MISC_ERROR("bad addr", addr);
+
+  c_len = scm_to_size_t (len);
+  
+  if (SCM_UNBNDP (prot))
+    c_prot = PROT_READ | PROT_WRITE;
+  else 
+    c_prot = scm_to_int (prot);
+
+  if (SCM_UNBNDP (flags))
+    c_flags = MAP_ANON | MAP_PRIVATE;
+  else
+    c_flags = scm_to_int (flags);
+
+  if (SCM_UNBNDP (fd))
+    c_fd = -1;
+  else
+    c_fd = scm_to_int (fd);
+
+  if (SCM_UNBNDP (fd))
+    c_offset = 0;
+  else
+    c_offset = scm_to_off_t (offset);
+
+  c_mem = mmap(c_addr, c_len, c_prot, c_flags, c_fd, c_offset);
+  if (c_mem == MAP_FAILED)
+    SCM_SYSERROR;			/* errno set */
+
+  pointer = scm_cell (scm_tc7_pointer, (scm_t_bits) c_mem);
+  bvec = scm_c_take_typed_bytevector((signed char *) c_mem + c_offset, c_len,
+				     SCM_ARRAY_ELEMENT_TYPE_VU8, pointer);
+  assert(sizeof(void*) <= sizeof(size_t));
+  scm_i_set_finalizer (SCM2PTR (bvec), mmap_finalizer, (void*) c_len);
+  return bvec;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_mmap, "mmap", 2, 4, 0, 
+            (SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
+	    "mmap addr len [prot [flags [fd [offset]]]]"
+	    "See the man page.  Returns a bytevector."
+	    "Note that the region returned by mmap will NOT be searched "
+	    "by the garbage collector for pointers.\n"
+	    "Defaults:\n"
+	    "  PROT   (logior PROT_READ PROT_WRITE)\n"
+	    "  FLAGS  (logior MAP_ANON MAP_PRIVATE)\n"
+	    "  FD     -1\n"
+	    "  OFFSET 0\n"
+	    "@example\n"
+	    "(define bvec-1MB (mmap 0 #x100000)\n"
+	    "@end example"
+	    )
+#define FUNC_NAME s_scm_mmap
+{
+  void *c_mem;
+  size_t c_len;
+  SCM bvec;
+
+  bvec = scm_mmap_search(addr, len, prot, flags, fd, offset);
+  c_mem = SCM_BYTEVECTOR_CONTENTS(bvec);
+  c_len = SCM_BYTEVECTOR_LENGTH(bvec);
+
+  /* Tell GC not to scan for pointers. */
+  GC_exclude_static_roots(c_mem, (char*) c_mem + c_len);
+
+  return bvec;
+}
+#undef FUNC_NAME
+
+
+// call fstat to get file size
+SCM_DEFINE (scm_mmap_file, "mmap-file", 1, 1, 0, 
+            (SCM file, SCM prot),
+	    "This procedure accepts a file in the form of filename,"
+            " file-port or fd.  It returns a bytevector.  It must not"
+            " contain scheme allocated objects as it will not be"
+            " searched for pointers.\n"
+	    "Defaults:\n"
+	    "  prot   \"r\"\n"
+	    "E.g., @code{(define bvec-1MB (mmap-file \"foo.dat\")}")
+#define FUNC_NAME s_scm_mmap_file
+{
+  int fd, flags, prot_;
+  int fd_is_local = 0;
+  struct stat sb;
+  off_t size;
+  void *ptr;
+  size_t len;
+  char *filename;
+  SCM pointer, bvec;
+
+  if (scm_is_string (file)) {
+    scm_dynwind_begin (0);
+    filename = scm_to_locale_string (file);
+    scm_dynwind_free (filename);
+    flags = mm_flags(prot, O_RDONLY);
+    prot_ = mm_prot(prot, PROT_READ);
+    fd = open(filename, flags);
+    if (fd == -1)
+      scm_misc_error ("mmap-file", "could not open file ~S", scm_list_1(file));
+    fd_is_local = 1;
+  } else if (SCM_PORTP (file)) {
+    if (! SCM_UNBNDP (prot))
+      scm_misc_error ("mmap-file", "file open, prot arg not allowed", SCM_EOL);
+    if (SCM_PORT_TYPE (file) != scm_file_port_type)
+      scm_misc_error ("mmap-file", "port is not file port", SCM_EOL);
+    fd = SCM_FPORT_FDES (file);
+    if (scm_input_port_p (file)) {
+      if (scm_output_port_p (file)) {
+        flags = O_RDWR;
+        prot_ = PROT_READ | PROT_WRITE;
+      } else {
+        flags = O_RDONLY;
+        prot_ = PROT_READ;
+      }
+    } else if (scm_output_port_p (file)) {
+      flags = O_WRONLY;
+      prot_ = PROT_WRITE;
+    } else {                            /* not read, not write */
+      abort();
+    }
+  } else if (scm_is_integer (file)) {
+    fd = scm_to_signed_integer (file, 0, 1024); /* FIXME: what for 1024? */
+    /* I think fstat() may tell us if the FD is RD,WR,RDWR. */
+    flags = O_RDONLY;
+    prot_ = PROT_READ;
+  } else {
+    scm_misc_error ("mmap-file", "bad arg for file", SCM_EOL);
+  }
+  fstat(fd, &sb);
+  size = sb.st_size;
+  ptr = mmap(0, size, prot_, MAP_PRIVATE, fd, 0);
+  len = (size_t) size;
+  if (fd_is_local) close(fd);
+  
+  if (ptr == MAP_FAILED)
+    SCM_SYSERROR;			/* errno set */
+
+  pointer = scm_cell (scm_tc7_pointer, (scm_t_bits) ptr);
+  bvec = scm_c_take_typed_bytevector((signed char *) ptr, len,
+				     SCM_ARRAY_ELEMENT_TYPE_VU8, pointer);
+
+  assert(sizeof(void*) <= sizeof(size_t));
+  scm_i_set_finalizer (SCM2PTR (bvec), mmap_finalizer, (void*) len);
+
+  /* Tell GC not to scan for pointers. */
+  GC_exclude_static_roots(ptr, (char*)ptr + len);
+
+  return bvec;
+}
+#undef FUNC_NAME
+
+/* The following copied from bytevectors.c. Kludge? */
+#define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len)            \
+  SCM_SET_CELL_WORD_1 ((_bv), (scm_t_bits) (_len))
+#define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _contents)	\
+  SCM_SET_CELL_WORD_2 ((_bv), (scm_t_bits) (_contents))
+
+SCM_DEFINE (scm_munmap, "munmap", 1, 0, 0, 
+            (SCM bvec),
+	    "See the man page. Given bytevector generated by a mmap"
+            " function, unmap the associated memory.  The argument"
+            " will be modified to reflect a zero length bv.")
+#define FUNC_NAME s_scm_munmap
+{
+  void *addr;
+  size_t len;
+  int res;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bvec);
+  
+  addr = (void *) SCM_BYTEVECTOR_CONTENTS (bvec);
+  len = SCM_BYTEVECTOR_LENGTH (bvec);
+
+  /* Invalidate further work on this bytevector. */
+  SCM_BYTEVECTOR_SET_LENGTH (bvec, 0);
+  SCM_BYTEVECTOR_SET_CONTENTS (bvec, NULL);
+
+  res = munmap(addr, len);
+  if (res == -1)
+    SCM_SYSERROR;			/* errno set */
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+static void init_mmap_api(void) {
+  scm_add_feature("mmap-api");
+  scm_add_feature("mmap-file");
+
+#ifdef PROT_NONE
+  scm_c_define ("PROT_NONE", scm_from_int (PROT_NONE));
+#endif
+#ifdef PROT_READ
+  scm_c_define ("PROT_READ", scm_from_int (PROT_READ));
+#endif
+#ifdef PROT_WRITE
+  scm_c_define ("PROT_WRITE", scm_from_int (PROT_WRITE));
+#endif
+#ifdef PROT_EXEC
+  scm_c_define ("PROT_EXEC", scm_from_int (PROT_EXEC));
+#endif
+
+#ifdef MAP_ANONYMOUS
+  scm_c_define ("MAP_ANONYMOUS", scm_from_int (MAP_ANONYMOUS));
+#endif
+#ifdef MAP_ANON
+  scm_c_define ("MAP_ANON", scm_from_int (MAP_ANON));
+#endif
+#ifdef MAP_FILE
+  scm_c_define ("MAP_FILE", scm_from_int (MAP_FILE));
+#endif
+#ifdef MAP_FIXED
+  scm_c_define ("MAP_FIXED", scm_from_int (MAP_FIXED));
+#endif
+#ifdef MAP_HASSEMAPHORE
+  scm_c_define ("MAP_HASSEMAPHORE", scm_from_int (MAP_HASSEMAPHORE));
+#endif
+#ifdef MAP_PRIVATE
+  scm_c_define ("MAP_PRIVATE", scm_from_int (MAP_PRIVATE));
+#endif
+#ifdef MAP_SHARED
+  scm_c_define ("MAP_SHARED", scm_from_int (MAP_SHARED));
+#endif
+#ifdef MAP_NOCACHE
+  scm_c_define ("MAP_NOCACHE", scm_from_int (MAP_NOCACHE));
+#endif
+  scm_c_define ("PAGE_SIZE", scm_from_int (getpagesize()));
+}
+
+#endif /* HAVE_SYS_MMAN_H && HAVE_MMAP_ANONYMOUS */
+#endif /* ENABLE_MMAP_API */
+
+\f
+
 void
 scm_init_filesys ()
 {
@@ -1954,6 +2273,10 @@ scm_init_filesys ()
 #endif
 #endif /* HAVE_POSIX */
 
+#ifdef ENABLE_MMAP_API
+  init_mmap_api();
+#endif /* ENABLE_MMAP_API */
+  
   /* `access' symbols.  */
   scm_c_define ("R_OK", scm_from_int (R_OK));
   scm_c_define ("W_OK", scm_from_int (W_OK));
diff --git a/libguile/filesys.h b/libguile/filesys.h
index f870ee434..ddf506ae6 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -69,6 +69,10 @@ SCM_API SCM scm_dirname (SCM filename);
 SCM_API SCM scm_basename (SCM filename, SCM suffix);
 SCM_API SCM scm_canonicalize_path (SCM path);
 SCM_API SCM scm_sendfile (SCM out, SCM in, SCM count, SCM offset);
+SCM_API SCM scm_mmap_search(SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset);
+SCM_API SCM scm_mmap(SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset);
+SCM_API SCM scm_mmap_file(SCM file, SCM prot);
+SCM_API SCM scm_munmap(SCM bvec);
 SCM_INTERNAL SCM scm_i_relativize_path (SCM path, SCM in_path);
 
 SCM_INTERNAL void scm_init_filesys (void);
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 8158aaf44..cbd7c6568 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -76,6 +76,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/load.test			\
 	    tests/match.test			\
 	    tests/match.test.upstream		\
+	    tests/mmap-api.test			\
 	    tests/modules.test			\
 	    tests/multilingual.nottest		\
 	    tests/net-db.test			\
diff --git a/test-suite/tests/mmap-api.test b/test-suite/tests/mmap-api.test
new file mode 100644
index 000000000..557d4c8db
--- /dev/null
+++ b/test-suite/tests/mmap-api.test
@@ -0,0 +1,59 @@
+;;;; mmap-api.test --- Tests for Guile threading.    -*- scheme -*-
+;;;;
+;;;; Copyright 2020 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library 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
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-mmap-api)
+  #:use-module (test-suite lib)
+  #:use-module (test-suite guile-test)
+  #:use-module (rnrs bytevectors)
+  )
+
+(define (mmap-test-file)
+  (data-file-name "foo.txt"))
+
+(define mmap-test-string "hello, world")
+
+(define (gen-mmap-test-file)
+  (with-output-to-file (mmap-test-file)
+    (lambda () (display mmap-test-string))))
+
+(when (provided? 'mmap-file)
+
+  (gen-mmap-test-file)
+
+  (with-test-prefix "mmap-file"
+      
+    (pass-if "mmap-file 1"
+      (let ((bv (mmap-file (mmap-test-file))))
+        (string=? (utf8->string bv) mmap-test-string)))
+
+    ))
+
+(when (provided? 'mmap-api)
+
+  (gen-mmap-test-file)
+
+  (with-test-prefix "mmap-api"
+      
+    (pass-if "mmap-api 1"
+      (let ((bv (mmap 0 #x100)))
+        (bytevector-u8-set! bv 0 34)
+        (= (bytevector-u8-ref bv 0) 34)))
+
+    ))
+
+;; --- last line ---

^ permalink raw reply related	[flat|nested] 16+ messages in thread

* bug#27782: new patch for mma
  2020-07-04 19:40 ` bug#27782: new patch for mma Matt Wette
@ 2020-07-09 12:45   ` Ludovic Courtès
  0 siblings, 0 replies; 16+ messages in thread
From: Ludovic Courtès @ 2020-07-09 12:45 UTC (permalink / raw)
  To: Matt Wette; +Cc: 27782

Hi Matt,

Matt Wette <matt.wette@gmail.com> skribis:

> Attached is a patch against guile master (at 3.0.4),
> commit 5e1748f75128107e3a0707b66df5adb95d98437e

Thanks for working on it.  I’m currently head-down on Guix things, but
I’ll look into it in the coming days/weeks if nobody beats me at it!

Ludo’.





^ permalink raw reply	[flat|nested] 16+ messages in thread

* bug#27782: patch to add support for mmap and friends
  2017-07-21 13:39 bug#27782: [wishlist] scheme level mmap Matt Wette
                   ` (3 preceding siblings ...)
  2020-07-04 19:40 ` bug#27782: new patch for mma Matt Wette
@ 2022-12-21  1:21 ` Matt Wette
  2022-12-22 18:49   ` Matt Wette
  2023-01-14  0:49 ` bug#27782: patch " Matt Wette
  2023-02-14 14:50 ` bug#27782: mman patch for v3.0.9 Matt Wette
  6 siblings, 1 reply; 16+ messages in thread
From: Matt Wette @ 2022-12-21  1:21 UTC (permalink / raw)
  To: guile-devel; +Cc: 27782

[-- Attachment #1: Type: text/plain, Size: 127 bytes --]

Guile Maintainers:

Please consider the atttached patch for mmap and friends.
Includes mmap, mmap/shared, munmap, msync.

Matt

[-- Attachment #2: 0001-Add-support-for-mmap-munmap-and-msync.patch --]
[-- Type: text/x-patch, Size: 15767 bytes --]

From 306570beb3d1895abd03700593cc342282e4ccd1 Mon Sep 17 00:00:00 2001
From: Matt Wette <mwette@alumni.caltech.edu>
Date: Tue, 20 Dec 2022 17:15:27 -0800
Subject: [PATCH] Add support for mmap, munmap and msync

* libguile/filesys.c(mmap,munmap,msync): added implementation for mmap
  and friends
* doc/ref/posix.texi: add documentation for mmap and friends
---
 configure.ac                   |  12 ++
 doc/ref/posix.texi             |  45 ++++++
 libguile/filesys.c             | 268 +++++++++++++++++++++++++++++++++
 libguile/filesys.h             |   4 +
 test-suite/Makefile.am         |   1 +
 test-suite/tests/mmap-api.test |  47 ++++++
 6 files changed, 377 insertions(+)
 create mode 100644 test-suite/tests/mmap-api.test

diff --git a/configure.ac b/configure.ac
index b3879df1f..da49d477a 100644
--- a/configure.ac
+++ b/configure.ac
@@ -199,6 +199,10 @@ AC_ARG_ENABLE(regex,
   [  --disable-regex         omit regular expression interfaces],,
   enable_regex=yes)
 
+AC_ARG_ENABLE(mmap_api,
+  AS_HELP_STRING([--disable-mmap_api],[omit mmap API]),,
+  enable_mmap_api=yes)
+
 AC_ARG_ENABLE(tmpnam,
   AS_HELP_STRING([--disable-tmpnam],[omit POSIX tmpnam]),,
   enable_tmpnam=yes)
@@ -950,6 +954,10 @@ if test "$enable_regex" = yes; then
    AC_DEFINE([ENABLE_REGEX], 1, [Define when regex support is enabled.])
 fi
 
+if test "$enable_mmap_api" = yes; then
+   AC_DEFINE([ENABLE_MMAP_API], 1, [Define when mmap API support is enabled.])
+fi
+
 if test "$enable_tmpnam" = yes; then
    AC_DEFINE([ENABLE_TMPNAM], 1, [Define when tmpnam support is enabled.])
 fi
@@ -1018,6 +1026,10 @@ AC_CHECK_MEMBERS([struct tm.tm_gmtoff],,,
 ])
 GUILE_STRUCT_UTIMBUF
 
+if test "$enable_mmap_api" = "yes"; then
+  AC_CHECK_FUNCS([msync])
+fi
+
 
 #--------------------------------------------------------------------
 #
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index bde0f150c..8114135fe 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -1216,6 +1216,51 @@ valid separators.  Thus, programs should not assume that
 separator---e.g., when extracting the components of a file name.
 @end defvr
 
+@deffn {Scheme Procedure} mmap addr len [prot [flags [fd [offset]]]]
+@deffnx {Scheme Procedure} mmap/search addr len [prot [flags [fd [offset]]]]
+Create a memory mapping, returning a bytevector.  @var{addr}, if
+non-zero, is the staring address; or, if zero, is assigned by the
+system.  @var{prot}, if provided, assigns protection.  @var{fd},
+if provided associates the memory region with a file, starting 
+at @var{offset}, if provided.
+The region returned by mmap will NOT be searched by the garbage
+ collector for pointers, while that returned by mmap/search will.
+Note that the finalizer for the returned bytevector will call munmap.
+Defaults for optional arguments are
+@table @asis
+@item prot
+(logior PROT_READ PROT_WRITE)
+@item flags
+(logior MAP_ANONYMOUS MAP_PRIVATE)
+@item fd
+-1
+@item offset
+0
+@end table
+@end deffn
+
+@deffn {Scheme Procedure} munmap bvec
+Given bytevector generated by mmap or mmap/search, unmap the
+the associated memory.  The argument will be modified to 
+reflect a zero length bv.  The return value is unspecified.
+Note that munmap is called by finalizer associated with
+bytevectors returned from mmap and mmap/search.
+@end deffn
+
+@deffn {Scheme Procedure} msync addr length flag
+Flush changes made to the in-core copy of a file mapped using
+mmap or mmap/search.  This should be executed on modified memory
+before calling munmap.  The @var{flags} argument must be exactly one
+of the following:
+@table @code
+@item MS_ASYNC
+Initiate update, return immediately.
+@item MS_SYNC
+Initiate update, block until complete.
+@item MS_INVALIDATE
+Invalidate other mappings of the same file.
+@end table
+@end deffn
 
 @node User Information
 @subsection User Information
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 1f0bba556..ad3dab471 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -67,11 +67,17 @@
 # include <sys/sendfile.h>
 #endif
 
+#if defined(ENABLE_MMAP_API) && defined(HAVE_SYS_MMAN_H)
+# include <sys/mman.h>
+#endif
+
 #include "async.h"
 #include "boolean.h"
 #include "dynwind.h"
 #include "fdes-finalizers.h"
 #include "feature.h"
+#include "finalizers.h"
+#include "foreign.h"
 #include "fports.h"
 #include "gsubr.h"
 #include "iselect.h"
@@ -2263,6 +2269,264 @@ scm_dir_free (SCM p)
 
 \f
 
+#ifdef ENABLE_MMAP_API
+#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)
+
+/* see https://pubs.opengroup.org/onlinepubs/9699919799/functions/mmap.html */
+
+static void
+mmap_finalizer (void *ptr, void *data)
+{
+  SCM bvec;
+  void *c_addr;
+  size_t c_len;
+  int rv;
+
+  bvec = SCM_PACK_POINTER (ptr);
+  if (!SCM_BYTEVECTOR_P (bvec))
+    scm_misc_error ("mmap", "expecting bytevector", SCM_EOL);
+  
+  c_addr = SCM_BYTEVECTOR_CONTENTS (bvec);
+  c_len = SCM_BYTEVECTOR_LENGTH (bvec);
+  SCM_SYSCALL (rv = munmap(c_addr, c_len));
+  if (rv != 0)
+    scm_misc_error ("mmap", "failed to munmap memory", SCM_EOL);
+}
+
+SCM_DEFINE (scm_mmap_search, "mmap/search", 2, 4, 0, 
+            (SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
+	    "Create a memory mapping, returning a bytevector..  @var{addr}, if\n"
+	    "non-zero, is the staring address; or, if zero, is assigned by the\n"
+	    "system.  @var{prot}, if provided, assigns protection.  @var{fd},\n"
+	    "if provided associates the memory region with a file, starting \n"
+	    "at @var{offset}, if provided.\n"
+	    "The region returned by mmap WILL be searched by the garbage\n"
+	    "collector for pointers.  See also mmap.  Note that the\n"
+            "finalizer for the returned bytevector will call munmap.\n"
+	    "Defaults for optional arguments are\n"
+	    "@table @asis\n"
+	    "@item prot\n(logior PROT_READ PROT_WRITE)\n"
+	    "@item flags\n(logior MAP_ANONYMOUS MAP_PRIVATE)\n"
+	    "@item fd\n-1\n"
+	    "@item offset\n0\n"
+	    "@end table")
+#define FUNC_NAME s_scm_mmap_search
+{
+  void *c_mem, *c_addr;
+  size_t c_len;
+  int c_prot, c_flags, c_fd;
+  scm_t_off c_offset;
+  SCM pointer, bvec;
+
+  if (SCM_POINTER_P (addr))
+    c_addr = SCM_POINTER_VALUE (addr);
+  else if (scm_is_integer (addr))
+    c_addr = (void*) scm_to_uintptr_t (addr);
+  else
+    SCM_MISC_ERROR ("bad addr", addr);
+
+  c_len = scm_to_size_t (len);
+  
+  if (SCM_UNBNDP (prot))
+    c_prot = PROT_READ | PROT_WRITE;
+  else 
+    c_prot = scm_to_int (prot);
+
+  if (SCM_UNBNDP (flags))
+    c_flags = MAP_ANONYMOUS | MAP_PRIVATE;
+  else
+    c_flags = scm_to_int (flags);
+
+  if (SCM_UNBNDP (fd))
+    c_fd = -1;
+  else
+    c_fd = scm_to_int (fd);
+
+  if (SCM_UNBNDP (fd))
+    c_offset = 0;
+  else
+    c_offset = scm_to_off_t (offset);
+
+  if ((c_addr == NULL) && (c_flags & MAP_FIXED))
+    SCM_MISC_ERROR ("mmap called with NULL addr and MAP_FIXED", SCM_EOL);
+
+  SCM_SYSCALL (c_mem = mmap(c_addr, c_len, c_prot, c_flags, c_fd, c_offset));
+  if (c_mem == MAP_FAILED)
+    SCM_SYSERROR;			/* errno set */
+
+  pointer = scm_cell (scm_tc7_pointer, (scm_t_bits) c_mem);
+  bvec = scm_c_take_typed_bytevector((signed char *) c_mem + c_offset, c_len,
+				     SCM_ARRAY_ELEMENT_TYPE_VU8, pointer);
+  assert(sizeof(void*) <= sizeof(size_t));
+  scm_i_set_finalizer (SCM2PTR (bvec), mmap_finalizer, (void*) c_len);
+  return bvec;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_mmap, "mmap", 2, 4, 0, 
+            (SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
+	    "Create a memory mapping, returning a bytevector.  @var{addr}, if\n"
+	    "non-zero, is the staring address; or, if zero, is assigned by the\n"
+	    "system.  @var{prot}, if provided, assigns protection.  @var{fd},\n"
+	    "if provided associates the memory region with a file, starting \n"
+	    "at @var{offset}, if provided.\n"
+	    "The region returned by mmap will NOT be searched by the garbage\n"
+	    "collector for pointers. See also mmap/search.  Note that the\n"
+            "finalizer for the returned bytevector will call munmap.\n"
+	    "Defaults for arguments are:\n"
+	    "@table @asis\n"
+	    "@item prot\n(logior PROT_READ PROT_WRITE)\n"
+	    "@item flags\n(logior MAP_ANONYMOUS MAP_PRIVATE)\n"
+	    "@item fd\n-1\n"
+	    "@item offset\n0\n"
+	    "@end table")
+#define FUNC_NAME s_scm_mmap
+{
+  void *c_mem;
+  size_t c_len;
+  SCM bvec;
+
+  bvec = scm_mmap_search(addr, len, prot, flags, fd, offset);
+  c_mem = SCM_BYTEVECTOR_CONTENTS(bvec);
+  c_len = SCM_BYTEVECTOR_LENGTH(bvec);
+
+  /* Tell GC not to scan for pointers. */
+  GC_exclude_static_roots(c_mem, (char*) c_mem + c_len);
+
+  return bvec;
+}
+#undef FUNC_NAME
+
+/* The following copied from bytevectors.c. Kludge? */
+#define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len)            \
+  SCM_SET_CELL_WORD_1 ((_bv), (scm_t_bits) (_len))
+#define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _contents)	\
+  SCM_SET_CELL_WORD_2 ((_bv), (scm_t_bits) (_contents))
+
+SCM_DEFINE (scm_munmap, "munmap", 1, 0, 0, 
+            (SCM bvec),
+	    "Given bytevector generated by mmap or mmap/search, unmap the\n"
+            "the associated memory.  The argument will be modified to \n"
+            "reflect a zero length bv. The return value is unspecified.\n"
+            "Note that munmap is called by finalizer associated with\n"
+            "bytevectors returned from mmap and mmap/search.\n")
+#define FUNC_NAME s_scm_munmap
+{
+  void *addr;
+  size_t len;
+  int rv;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bvec);
+  
+  addr = (void *) SCM_BYTEVECTOR_CONTENTS (bvec);
+  len = SCM_BYTEVECTOR_LENGTH (bvec);
+
+  /* Invalidate further work on this bytevector. */
+  SCM_BYTEVECTOR_SET_LENGTH (bvec, 0);
+  SCM_BYTEVECTOR_SET_CONTENTS (bvec, NULL);
+
+  SCM_SYSCALL (rv = munmap(addr, len));
+  if (rv == -1)
+    SCM_SYSERROR;			/* errno set */
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+#ifdef HAVE_MSYNC
+SCM_DEFINE (scm_msync, "msync", 2, 0, 0, 
+            (SCM bvec, SCM flags),
+	    "Flush changes made to the in-core copy of a file mapped using\n"
+            "mmap or mmap/search.  This should be executed on modified memory\n" 
+            "before calling munmap.  The @var{flags} argument must be exactly\n"
+            "one of the following:\n"
+            "@table @code\n"
+            "@item MS_ASYNC\n"
+            "Initiate update, return immediately.\n"
+            "@item MS_SYNC\n"
+            "Initiate update, block until complete.\n"
+            "@item MS_INVALIDATE\n"
+            "Invalidate other mappings of the same file.\n"
+            "@end table\n"
+            "The return value is unspecified.")
+#define FUNC_NAME s_scm_msync
+{
+  void *addr;
+  size_t len;
+  int c_flags, rv;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bvec);
+  addr = (void *) SCM_BYTEVECTOR_CONTENTS (bvec);
+  len = SCM_BYTEVECTOR_LENGTH (bvec);
+
+  c_flags = scm_to_int (flags);
+
+  SCM_SYSCALL (rv = msync(addr, len, c_flags));
+  if (rv == -1)
+    SCM_SYSERROR;			/* errno set */
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif /* HAVE_MSYNC */
+
+static void init_mmap_api(void) {
+  scm_add_feature("mmap-api");
+
+#ifdef PROT_NONE
+  scm_c_define ("PROT_NONE", scm_from_int (PROT_NONE));
+#endif
+#ifdef PROT_READ
+  scm_c_define ("PROT_READ", scm_from_int (PROT_READ));
+#endif
+#ifdef PROT_WRITE
+  scm_c_define ("PROT_WRITE", scm_from_int (PROT_WRITE));
+#endif
+#ifdef PROT_EXEC
+  scm_c_define ("PROT_EXEC", scm_from_int (PROT_EXEC));
+#endif
+
+#ifdef MAP_ANONYMOUS
+  scm_c_define ("MAP_ANONYMOUS", scm_from_int (MAP_ANONYMOUS));
+#endif
+#ifdef MAP_ANON
+  scm_c_define ("MAP_ANON", scm_from_int (MAP_ANON));
+#endif
+#ifdef MAP_FILE
+  scm_c_define ("MAP_FILE", scm_from_int (MAP_FILE));
+#endif
+#ifdef MAP_FIXED
+  scm_c_define ("MAP_FIXED", scm_from_int (MAP_FIXED));
+#endif
+#ifdef MAP_HASSEMAPHORE
+  scm_c_define ("MAP_HASSEMAPHORE", scm_from_int (MAP_HASSEMAPHORE));
+#endif
+#ifdef MAP_PRIVATE
+  scm_c_define ("MAP_PRIVATE", scm_from_int (MAP_PRIVATE));
+#endif
+#ifdef MAP_SHARED
+  scm_c_define ("MAP_SHARED", scm_from_int (MAP_SHARED));
+#endif
+#ifdef MAP_NOCACHE
+  scm_c_define ("MAP_NOCACHE", scm_from_int (MAP_NOCACHE));
+#endif
+  scm_c_define ("PAGE_SIZE", scm_from_int (getpagesize()));
+#ifdef MS_ASYNC
+  scm_c_define ("MS_ASYNC", scm_from_int (MS_ASYNC));
+#endif
+#ifdef MS_SYNC
+  scm_c_define ("MS_SYNC", scm_from_int (MS_SYNC));
+#endif
+#ifdef MS_INVALIDATE
+  scm_c_define ("MS_INVALIDATE", scm_from_int (MS_INVALIDATE));
+#endif
+}
+
+#endif /* HAVE_SYS_MMAN_H && HAVE_MMAP_ANONYMOUS */
+#endif /* ENABLE_MMAP_API */
+
+\f
+
 void
 scm_init_filesys ()
 {
@@ -2387,6 +2651,10 @@ scm_init_filesys ()
 #ifdef HAVE_READLINKAT
   scm_add_feature("readlink-port");
 #endif
+#if defined(ENABLE_MMAP_API) && defined(HAVE_SYS_MMAN_H) \
+  && defined(HAVE_MAP_ANONYMOUS)
+  init_mmap_api();
+#endif
 
 #include "filesys.x"
 }
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 1ce50d30e..fa40b484f 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -80,6 +80,10 @@ SCM_API SCM scm_dirname (SCM filename);
 SCM_API SCM scm_basename (SCM filename, SCM suffix);
 SCM_API SCM scm_canonicalize_path (SCM path);
 SCM_API SCM scm_sendfile (SCM out, SCM in, SCM count, SCM offset);
+SCM_API SCM scm_mmap_search(SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset);
+SCM_API SCM scm_mmap(SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset);
+SCM_API SCM scm_msync(SCM bvec, SCM flags);
+SCM_API SCM scm_munmap(SCM bvec);
 SCM_INTERNAL SCM scm_i_relativize_path (SCM path, SCM in_path);
 
 SCM_INTERNAL void scm_init_filesys (void);
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 16fa2e952..839309231 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -77,6 +77,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/load.test			\
 	    tests/match.test			\
 	    tests/match.test.upstream		\
+	    tests/mmap-api.test			\
 	    tests/modules.test			\
 	    tests/multilingual.nottest		\
 	    tests/net-db.test			\
diff --git a/test-suite/tests/mmap-api.test b/test-suite/tests/mmap-api.test
new file mode 100644
index 000000000..74ef8777c
--- /dev/null
+++ b/test-suite/tests/mmap-api.test
@@ -0,0 +1,47 @@
+;;;; mmap-api.test --- Tests for mmap API.    -*- scheme -*-
+;;;;
+;;;; Copyright 2022 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library 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
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-mmap-api)
+  #:use-module (test-suite lib)
+  #:use-module (test-suite guile-test)
+  #:use-module (rnrs bytevectors)
+  )
+
+(define (mmap-test-file)
+  (data-file-name "foo.txt"))
+
+(define mmap-test-string "hello, world")
+
+(define (gen-mmap-test-file)
+  (with-output-to-file (mmap-test-file)
+    (lambda () (display mmap-test-string))))
+
+(when (provided? 'mmap-api)
+
+  (gen-mmap-test-file)
+
+  (with-test-prefix "mmap-api"
+      
+    (pass-if "mmap-api 1"
+      (let ((bv (mmap 0 #x100)))
+        (bytevector-u8-set! bv 0 34)
+        (= (bytevector-u8-ref bv 0) 34)))
+
+    ))
+
+;; --- last line ---
-- 
2.34.1


^ permalink raw reply related	[flat|nested] 16+ messages in thread

* bug#27782: patch to add support for mmap and friends
  2022-12-21  1:21 ` bug#27782: patch to add support for mmap and friends Matt Wette
@ 2022-12-22 18:49   ` Matt Wette
  0 siblings, 0 replies; 16+ messages in thread
From: Matt Wette @ 2022-12-22 18:49 UTC (permalink / raw)
  To: 27782

Please disregard previous patch.  I have more to do.
I'll try to catch the next release cycle.





^ permalink raw reply	[flat|nested] 16+ messages in thread

* bug#27782: patch for mmap and friends
  2017-07-21 13:39 bug#27782: [wishlist] scheme level mmap Matt Wette
                   ` (4 preceding siblings ...)
  2022-12-21  1:21 ` bug#27782: patch to add support for mmap and friends Matt Wette
@ 2023-01-14  0:49 ` Matt Wette
  2023-02-14 14:50 ` bug#27782: mman patch for v3.0.9 Matt Wette
  6 siblings, 0 replies; 16+ messages in thread
From: Matt Wette @ 2023-01-14  0:49 UTC (permalink / raw)
  To: 27782, guile-devel

[-- Attachment #1: Type: text/plain, Size: 204 bytes --]

Please consider this patch for adding mmap(), munmap() and msync()
  to libguile/filesys.c.  Included is update for posix.texi and test 
file mman.test.
Once included, feature 'mman should be #t.

Matt

[-- Attachment #2: 0001-Add-mmap-and-friends-munmap-msync.patch --]
[-- Type: text/x-patch, Size: 13066 bytes --]

From 6c944174d35d43f87340c8199d47f3f088fa6ca7 Mon Sep 17 00:00:00 2001
From: Matt Wette <mwette@alumni.caltech.edu>
Date: Fri, 13 Jan 2023 16:42:06 -0800
Subject: [PATCH] Add mmap and friends (munmap, msync).

* libguile/filesys.[ch]: added scm_mmap_search, scm_mmap, scm_msync, and
  init_mman, built on availability of HAVE_MMAN_H; also provides feature
  'mman
* doc/ref/posix.texi: added documentation for mmap and friends
* test-suite/Makefile.am: updated for mman.test
* test-suite/tests/mman.test: mmap tests
---
 configure.ac           |   2 +
 doc/ref/posix.texi     |  45 +++++++
 libguile/filesys.c     | 264 +++++++++++++++++++++++++++++++++++++++++
 libguile/filesys.h     |   4 +
 test-suite/Makefile.am |   1 +
 5 files changed, 316 insertions(+)

diff --git a/configure.ac b/configure.ac
index f8c12f0d7..c348d14a2 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1018,6 +1018,8 @@ AC_CHECK_MEMBERS([struct tm.tm_gmtoff],,,
 ])
 GUILE_STRUCT_UTIMBUF
 
+AC_CHECK_FUNCS([msync])
+
 
 #--------------------------------------------------------------------
 #
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 5653d3758..16f3bbc49 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -1216,6 +1216,51 @@ valid separators.  Thus, programs should not assume that
 separator---e.g., when extracting the components of a file name.
 @end defvr
 
+@deffn {Scheme Procedure} mmap addr len [prot [flags [fd [offset]]]]
+@deffnx {Scheme Procedure} mmap/search addr len [prot [flags [fd [offset]]]]
+Create a memory mapping, returning a bytevector.  @var{addr}, if
+non-zero, is the staring address; or, if zero, is assigned by the
+system.  @var{prot}, if provided, assigns protection.  @var{fd},
+if provided associates the memory region with a file, starting
+at @var{offset}, if provided.
+The region returned by mmap will NOT be searched by the garbage
+ collector for pointers, while that returned by mmap/search will.
+Note that the finalizer for the returned bytevector will call munmap.
+Defaults for optional arguments are
+@table @asis
+@item prot
+(logior PROT_READ PROT_WRITE)
+@item flags
+(logior MAP_ANONYMOUS MAP_PRIVATE)
+@item fd
+-1
+@item offset
+0
+@end table
+@end deffn
+
+@deffn {Scheme Procedure} munmap bvec
+Given bytevector generated by mmap or mmap/search, unmap the
+the associated memory.  The argument will be modified to
+reflect a zero length bv.  The return value is unspecified.
+Note that munmap is called by finalizer associated with
+bytevectors returned from mmap and mmap/search.
+@end deffn
+
+@deffn {Scheme Procedure} msync addr length flag
+Flush changes made to the in-core copy of a file mapped using
+mmap or mmap/search.  This should be executed on modified memory
+before calling munmap.  The @var{flags} argument must be exactly one
+of the following:
+@table @code
+@item MS_ASYNC
+Initiate update, return immediately.
+@item MS_SYNC
+Initiate update, block until complete.
+@item MS_INVALIDATE
+Invalidate other mappings of the same file.
+@end table
+@end deffn
 
 @node User Information
 @subsection User Information
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 1f0bba556..0ddb4cfee 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -67,11 +67,17 @@
 # include <sys/sendfile.h>
 #endif
 
+#ifdef HAVE_SYS_MMAN_H
+# include <sys/mman.h>
+#endif
+
 #include "async.h"
 #include "boolean.h"
 #include "dynwind.h"
 #include "fdes-finalizers.h"
 #include "feature.h"
+#include "finalizers.h"
+#include "foreign.h"
 #include "fports.h"
 #include "gsubr.h"
 #include "iselect.h"
@@ -2263,6 +2269,261 @@ scm_dir_free (SCM p)
 
 \f
 
+#ifdef HAVE_SYS_MMAN_H
+/* see https://pubs.opengroup.org/onlinepubs/9699919799/functions/mmap.html */
+
+static void
+mmap_finalizer (void *ptr, void *data)
+{
+  SCM bvec;
+  void *c_addr;
+  size_t c_len;
+  int rv;
+
+  bvec = SCM_PACK_POINTER (ptr);
+  if (!SCM_BYTEVECTOR_P (bvec))
+    scm_misc_error ("mmap", "expecting bytevector", SCM_EOL);
+
+  c_addr = SCM_BYTEVECTOR_CONTENTS (bvec);
+  c_len = SCM_BYTEVECTOR_LENGTH (bvec);
+  SCM_SYSCALL (rv = munmap(c_addr, c_len));
+  if (rv != 0)
+    scm_misc_error ("mmap", "failed to munmap memory", SCM_EOL);
+}
+
+SCM_DEFINE (scm_mmap_search, "mmap/search", 2, 4, 0,
+            (SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
+	    "Create a memory mapping, returning a bytevector..  @var{addr},\n"
+	    "if non-zero, is the staring address; or, if zero, is assigned by\n"
+	    "the system.  @var{prot}, if provided, assigns protection.\n"
+	    "@var{fd}, if provided associates the memory region with a file\n"
+	    "starting at @var{offset}, if provided.\n"
+	    "The region returned by mmap WILL be searched by the garbage\n"
+	    "collector for pointers.  See also mmap.  Note that the\n"
+            "finalizer for the returned bytevector will call munmap.\n"
+	    "Defaults for optional arguments are\n"
+	    "@table @asis\n"
+	    "@item prot\n(logior PROT_READ PROT_WRITE)\n"
+	    "@item flags\n(logior MAP_ANONYMOUS MAP_PRIVATE)\n"
+	    "@item fd\n-1\n"
+	    "@item offset\n0\n"
+	    "@end table")
+#define FUNC_NAME s_scm_mmap_search
+{
+  void *c_mem, *c_addr;
+  size_t c_len;
+  int c_prot, c_flags, c_fd;
+  scm_t_off c_offset;
+  SCM pointer, bvec;
+
+  if (SCM_POINTER_P (addr))
+    c_addr = SCM_POINTER_VALUE (addr);
+  else if (scm_is_integer (addr))
+    c_addr = (void*) scm_to_uintptr_t (addr);
+  else
+    scm_misc_error ("mmap", "bad addr", addr);
+
+  c_len = scm_to_size_t (len);
+
+  if (SCM_UNBNDP (prot))
+    c_prot = PROT_READ | PROT_WRITE;
+  else
+    c_prot = scm_to_int (prot);
+
+  if (SCM_UNBNDP (flags))
+    c_flags = MAP_ANONYMOUS | MAP_PRIVATE;
+  else
+    c_flags = scm_to_int (flags);
+
+  if (SCM_UNBNDP (fd))
+    c_fd = -1;
+  else
+    c_fd = scm_to_int (fd);
+
+  if (SCM_UNBNDP (offset))
+    c_offset = 0;
+  else
+    c_offset = scm_to_off_t (offset);
+
+  if ((c_addr == NULL) && (c_flags & MAP_FIXED))
+    scm_misc_error ("mmap", "cannot have NULL addr w/ MAP_FIXED", SCM_EOL);
+
+  SCM_SYSCALL (c_mem = mmap(c_addr, c_len, c_prot, c_flags, c_fd, c_offset));
+  if (c_mem == MAP_FAILED)
+    scm_syserror ("mmap");              /* errno set */
+
+  pointer = scm_cell (scm_tc7_pointer, (scm_t_bits) c_mem);
+  bvec = scm_c_take_typed_bytevector((signed char *) c_mem + c_offset, c_len,
+				     SCM_ARRAY_ELEMENT_TYPE_VU8, pointer);
+  assert(sizeof(void*) <= sizeof(size_t));
+  scm_i_set_finalizer (SCM2PTR (bvec), mmap_finalizer, (void*) c_len);
+  return bvec;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_mmap, "mmap", 2, 4, 0,
+            (SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
+	    "Create a memory mapping, returning a bytevector.  @var{addr}, if\n"
+	    "non-zero, is the staring address; or, if zero, is assigned by the\n"
+	    "system.  @var{prot}, if provided, assigns protection.  @var{fd},\n"
+	    "if provided associates the memory region with a file, starting \n"
+	    "at @var{offset}, if provided.\n"
+	    "The region returned by mmap will NOT be searched by the garbage\n"
+	    "collector for pointers. See also mmap/search.  Note that the\n"
+            "finalizer for the returned bytevector will call munmap.\n"
+	    "Defaults for arguments are:\n"
+	    "@table @asis\n"
+	    "@item prot\n(logior PROT_READ PROT_WRITE)\n"
+	    "@item flags\n(logior MAP_ANONYMOUS MAP_PRIVATE)\n"
+	    "@item fd\n-1\n"
+	    "@item offset\n0\n"
+	    "@end table")
+#define FUNC_NAME s_scm_mmap
+{
+  void *c_mem;
+  size_t c_len;
+  SCM bvec;
+
+  bvec = scm_mmap_search(addr, len, prot, flags, fd, offset);
+  c_mem = SCM_BYTEVECTOR_CONTENTS(bvec);
+  c_len = SCM_BYTEVECTOR_LENGTH(bvec);
+
+  /* Tell GC not to scan for pointers. */
+  GC_exclude_static_roots(c_mem, (char*) c_mem + c_len);
+
+  return bvec;
+}
+#undef FUNC_NAME
+
+/* The following copied from bytevectors.c. Kludge? */
+#define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len)            \
+  SCM_SET_CELL_WORD_1 ((_bv), (scm_t_bits) (_len))
+#define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _contents)	\
+  SCM_SET_CELL_WORD_2 ((_bv), (scm_t_bits) (_contents))
+
+SCM_DEFINE (scm_munmap, "munmap", 1, 0, 0,
+            (SCM bvec),
+	    "Given bytevector generated by mmap or mmap/search, unmap the\n"
+            "the associated memory.  The argument will be modified to \n"
+            "reflect a zero length bv. The return value is unspecified.\n"
+            "Note that munmap is called by finalizer associated with\n"
+            "bytevectors returned from mmap and mmap/search.\n")
+#define FUNC_NAME s_scm_munmap
+{
+  void *addr;
+  size_t len;
+  int rv;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bvec);
+
+  addr = (void *) SCM_BYTEVECTOR_CONTENTS (bvec);
+  len = SCM_BYTEVECTOR_LENGTH (bvec);
+
+  /* Invalidate further work on this bytevector. */
+  SCM_BYTEVECTOR_SET_LENGTH (bvec, 0);
+  SCM_BYTEVECTOR_SET_CONTENTS (bvec, NULL);
+
+  SCM_SYSCALL (rv = munmap(addr, len));
+  if (rv == -1)
+    SCM_SYSERROR;			/* errno set */
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+#ifdef HAVE_MSYNC
+SCM_DEFINE (scm_msync, "msync", 2, 0, 0,
+            (SCM bvec, SCM flags),
+	    "Flush changes made to the in-core copy of a file mapped using\n"
+            "mmap or mmap/search.  This should be executed on modified memory\n"
+            "before calling munmap.  The @var{flags} argument must be exactly\n"
+            "one of the following:\n"
+            "@table @code\n"
+            "@item MS_ASYNC\n"
+            "Initiate update, return immediately.\n"
+            "@item MS_SYNC\n"
+            "Initiate update, block until complete.\n"
+            "@item MS_INVALIDATE\n"
+            "Invalidate other mappings of the same file.\n"
+            "@end table\n"
+            "The return value is unspecified.")
+#define FUNC_NAME s_scm_msync
+{
+  void *addr;
+  size_t len;
+  int c_flags, rv;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bvec);
+  addr = (void *) SCM_BYTEVECTOR_CONTENTS (bvec);
+  len = SCM_BYTEVECTOR_LENGTH (bvec);
+
+  c_flags = scm_to_int (flags);
+
+  SCM_SYSCALL (rv = msync(addr, len, c_flags));
+  if (rv == -1)
+    SCM_SYSERROR;			/* errno set */
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif /* HAVE_MSYNC */
+
+static void init_mman(void) {
+  scm_add_feature("mman");
+
+#ifdef PROT_NONE
+  scm_c_define ("PROT_NONE", scm_from_int (PROT_NONE));
+#endif
+#ifdef PROT_READ
+  scm_c_define ("PROT_READ", scm_from_int (PROT_READ));
+#endif
+#ifdef PROT_WRITE
+  scm_c_define ("PROT_WRITE", scm_from_int (PROT_WRITE));
+#endif
+#ifdef PROT_EXEC
+  scm_c_define ("PROT_EXEC", scm_from_int (PROT_EXEC));
+#endif
+
+#ifdef MAP_ANONYMOUS
+  scm_c_define ("MAP_ANONYMOUS", scm_from_int (MAP_ANONYMOUS));
+#endif
+#ifdef MAP_ANON
+  scm_c_define ("MAP_ANON", scm_from_int (MAP_ANON));
+#endif
+#ifdef MAP_FILE
+  scm_c_define ("MAP_FILE", scm_from_int (MAP_FILE));
+#endif
+#ifdef MAP_FIXED
+  scm_c_define ("MAP_FIXED", scm_from_int (MAP_FIXED));
+#endif
+#ifdef MAP_HASSEMAPHORE
+  scm_c_define ("MAP_HASSEMAPHORE", scm_from_int (MAP_HASSEMAPHORE));
+#endif
+#ifdef MAP_PRIVATE
+  scm_c_define ("MAP_PRIVATE", scm_from_int (MAP_PRIVATE));
+#endif
+#ifdef MAP_SHARED
+  scm_c_define ("MAP_SHARED", scm_from_int (MAP_SHARED));
+#endif
+#ifdef MAP_NOCACHE
+  scm_c_define ("MAP_NOCACHE", scm_from_int (MAP_NOCACHE));
+#endif
+  scm_c_define ("PAGE_SIZE", scm_from_int (getpagesize()));
+#ifdef MS_ASYNC
+  scm_c_define ("MS_ASYNC", scm_from_int (MS_ASYNC));
+#endif
+#ifdef MS_SYNC
+  scm_c_define ("MS_SYNC", scm_from_int (MS_SYNC));
+#endif
+#ifdef MS_INVALIDATE
+  scm_c_define ("MS_INVALIDATE", scm_from_int (MS_INVALIDATE));
+#endif
+}
+
+#endif /* HAVE_SYS_MMAN_H */
+
+\f
+
 void
 scm_init_filesys ()
 {
@@ -2387,6 +2648,9 @@ scm_init_filesys ()
 #ifdef HAVE_READLINKAT
   scm_add_feature("readlink-port");
 #endif
+#if defined(HAVE_SYS_MMAN_H)
+  init_mman();
+#endif
 
 #include "filesys.x"
 }
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 1ce50d30e..fa40b484f 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -80,6 +80,10 @@ SCM_API SCM scm_dirname (SCM filename);
 SCM_API SCM scm_basename (SCM filename, SCM suffix);
 SCM_API SCM scm_canonicalize_path (SCM path);
 SCM_API SCM scm_sendfile (SCM out, SCM in, SCM count, SCM offset);
+SCM_API SCM scm_mmap_search(SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset);
+SCM_API SCM scm_mmap(SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset);
+SCM_API SCM scm_msync(SCM bvec, SCM flags);
+SCM_API SCM scm_munmap(SCM bvec);
 SCM_INTERNAL SCM scm_i_relativize_path (SCM path, SCM in_path);
 
 SCM_INTERNAL void scm_init_filesys (void);
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 16fa2e952..3785e2f85 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -77,6 +77,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/load.test			\
 	    tests/match.test			\
 	    tests/match.test.upstream		\
+	    tests/mman.test			\
 	    tests/modules.test			\
 	    tests/multilingual.nottest		\
 	    tests/net-db.test			\
-- 
2.34.1


^ permalink raw reply related	[flat|nested] 16+ messages in thread

* bug#27782: mman patch for v3.0.9
  2017-07-21 13:39 bug#27782: [wishlist] scheme level mmap Matt Wette
                   ` (5 preceding siblings ...)
  2023-01-14  0:49 ` bug#27782: patch " Matt Wette
@ 2023-02-14 14:50 ` Matt Wette
  2023-03-01 13:31   ` Matt Wette
  6 siblings, 1 reply; 16+ messages in thread
From: Matt Wette @ 2023-02-14 14:50 UTC (permalink / raw)
  To: 27782

[-- Attachment #1: Type: text/plain, Size: 344 bytes --]

Note.  I have made more changes based on feedback from the mailing list.

1) removed use of scm_c_take_typed_bytevector
2) changed code to generate PAGE_SIZE

I think the mmap finalizer still needs review from the Guile experts.

I'm attaching a patch to the v3.0.9 release (commit 9b20ca).
Sorry about not using format-patch, but diff.

Matt

[-- Attachment #2: v3.0.9-mman.patch --]
[-- Type: text/x-patch, Size: 15602 bytes --]

diff --git a/configure.ac b/configure.ac
index d5ce1c4ac..c3c33e8b3 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1018,6 +1018,8 @@ AC_CHECK_MEMBERS([struct tm.tm_gmtoff],,,
 ])
 GUILE_STRUCT_UTIMBUF
 
+AC_CHECK_FUNCS([msync])
+
 
 #--------------------------------------------------------------------
 #
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 5653d3758..16f3bbc49 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -1216,6 +1216,51 @@ valid separators.  Thus, programs should not assume that
 separator---e.g., when extracting the components of a file name.
 @end defvr
 
+@deffn {Scheme Procedure} mmap addr len [prot [flags [fd [offset]]]]
+@deffnx {Scheme Procedure} mmap/search addr len [prot [flags [fd [offset]]]]
+Create a memory mapping, returning a bytevector.  @var{addr}, if
+non-zero, is the staring address; or, if zero, is assigned by the
+system.  @var{prot}, if provided, assigns protection.  @var{fd},
+if provided associates the memory region with a file, starting
+at @var{offset}, if provided.
+The region returned by mmap will NOT be searched by the garbage
+ collector for pointers, while that returned by mmap/search will.
+Note that the finalizer for the returned bytevector will call munmap.
+Defaults for optional arguments are
+@table @asis
+@item prot
+(logior PROT_READ PROT_WRITE)
+@item flags
+(logior MAP_ANONYMOUS MAP_PRIVATE)
+@item fd
+-1
+@item offset
+0
+@end table
+@end deffn
+
+@deffn {Scheme Procedure} munmap bvec
+Given bytevector generated by mmap or mmap/search, unmap the
+the associated memory.  The argument will be modified to
+reflect a zero length bv.  The return value is unspecified.
+Note that munmap is called by finalizer associated with
+bytevectors returned from mmap and mmap/search.
+@end deffn
+
+@deffn {Scheme Procedure} msync addr length flag
+Flush changes made to the in-core copy of a file mapped using
+mmap or mmap/search.  This should be executed on modified memory
+before calling munmap.  The @var{flags} argument must be exactly one
+of the following:
+@table @code
+@item MS_ASYNC
+Initiate update, return immediately.
+@item MS_SYNC
+Initiate update, block until complete.
+@item MS_INVALIDATE
+Invalidate other mappings of the same file.
+@end table
+@end deffn
 
 @node User Information
 @subsection User Information
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 1f0bba556..1f4c5c793 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -67,13 +67,21 @@
 # include <sys/sendfile.h>
 #endif
 
+#ifdef HAVE_SYS_MMAN_H
+# include <sys/mman.h>
+#endif
+
 #include "async.h"
+#include "atomics-internal.h"           /* mmap */
 #include "boolean.h"
 #include "dynwind.h"
 #include "fdes-finalizers.h"
 #include "feature.h"
+#include "finalizers.h"                 /* mmap */
+#include "foreign.h"                    /* mmap */
 #include "fports.h"
 #include "gsubr.h"
+#include "ioext.h"                      /* mmap */
 #include "iselect.h"
 #include "list.h"
 #include "load.h"	/* for scm_i_mirror_backslashes */
@@ -2263,6 +2271,311 @@ scm_dir_free (SCM p)
 
 \f
 
+#ifdef HAVE_SYS_MMAN_H
+/* see https://pubs.opengroup.org/onlinepubs/9699919799/functions/mmap.html */
+
+static void
+mmap_finalizer (void *ptr, void *data)
+{
+  SCM bvec;
+  void *c_addr;
+  size_t c_len;
+  int rv;
+
+  bvec = SCM_PACK_POINTER (ptr);
+  if (!SCM_BYTEVECTOR_P (bvec))
+    scm_misc_error ("mmap", "expecting bytevector", SCM_EOL);
+
+  c_addr = SCM_BYTEVECTOR_CONTENTS (bvec);
+  c_len = SCM_BYTEVECTOR_LENGTH (bvec);
+  SCM_SYSCALL (rv = munmap(c_addr, c_len));
+  if (rv != 0)
+    scm_misc_error ("mmap", "failed to munmap memory", SCM_EOL);
+}
+
+/* Code for scm_dynwind_acquire_port and release_port sourced from ports.c. */
+
+static void
+release_port (SCM port)
+{
+  scm_t_port *pt = SCM_PORT (port);
+  uint32_t cur = 1, next = 0;
+  while (!scm_atomic_compare_and_swap_uint32 (&pt->refcount, &cur, next))
+    {
+      if (cur == 0)
+        return;
+      next = cur - 1;
+    }
+ if (cur > 1)
+    return;
+
+  if (SCM_PORT_TYPE (port)->close)
+    SCM_PORT_TYPE (port)->close (port);
+
+  /* Skip encoding code from ports.c! */
+}
+
+static void
+scm_dynwind_acquire_port (SCM port)
+{
+  scm_t_port *pt = SCM_PORT (port);
+  uint32_t cur = 1, next = 2;
+  while (!scm_atomic_compare_and_swap_uint32 (&pt->refcount, &cur, next))
+    {
+      if (cur == 0)
+        scm_wrong_type_arg_msg (NULL, 0, port, "open port");
+      next = cur + 1;
+    }
+  scm_dynwind_unwind_handler_with_scm (release_port, port,
+                                       SCM_F_WIND_EXPLICITLY);
+}
+
+SCM_DEFINE (scm_mmap_search, "mmap/search", 2, 4, 0,
+            (SCM addr, SCM len, SCM prot, SCM flags, SCM file, SCM offset),
+	    "Create a memory mapping, returning a bytevector..  @var{addr},\n"
+	    "if non-zero, is the staring address; or, if zero, is assigned by\n"
+	    "the system.  @var{prot}, if provided, assigns protection.\n"
+	    "@var{file}, a port or fd, if provided associates the memory\n"
+            "region with a file starting at @var{offset}, if provided.\n"
+	    "The region returned by mmap WILL be searched by the garbage\n"
+	    "collector for pointers.  See also mmap.  Note that the\n"
+            "finalizer for the returned bytevector will call munmap.\n"
+	    "Defaults for optional arguments are\n"
+	    "@table @asis\n"
+	    "@item prot\n(logior PROT_READ PROT_WRITE)\n"
+	    "@item flags\n(logior MAP_ANONYMOUS MAP_PRIVATE)\n"
+	    "@item fd\n-1\n"
+	    "@item offset\n0\n"
+	    "@end table")
+#define FUNC_NAME s_scm_mmap_search
+{
+  void *c_mem, *c_addr;
+  size_t c_len;
+  int c_prot, c_flags, c_fd;
+  scm_t_off c_offset;
+  SCM pointer, bvec;
+
+  if (SCM_POINTER_P (addr))
+    c_addr = SCM_POINTER_VALUE (addr);
+  else if (scm_is_integer (addr))
+    c_addr = (void*) scm_to_uintptr_t (addr);
+  else
+    scm_misc_error ("mmap", "bad addr", addr);
+
+  c_len = scm_to_size_t (len);
+
+  if (SCM_UNBNDP (prot))
+    c_prot = PROT_READ | PROT_WRITE;
+  else
+    c_prot = scm_to_int (prot);
+
+  if (SCM_UNBNDP (flags))
+    c_flags = MAP_ANONYMOUS | MAP_PRIVATE;
+  else
+    c_flags = scm_to_int (flags);
+
+  scm_dynwind_begin (0);
+  
+  if (SCM_UNBNDP (file))
+    c_fd = -1;
+  else if (scm_is_integer (file))
+    c_fd = scm_to_int (file);
+  else
+    {
+      /* Use the fd of the port under clobber protection from concurrency.
+         As scm_dynwind_acquire_port assumes that FILE is a port, check 
+         that first. */
+      SCM_VALIDATE_PORT (SCM_ARG5, file);
+      scm_dynwind_acquire_port (file);
+      c_fd = scm_to_int (scm_fileno (file));
+    }
+  
+  if (SCM_UNBNDP (offset))
+    c_offset = 0;
+  else
+    c_offset = scm_to_off_t (offset);
+
+  if ((c_addr == NULL) && (c_flags & MAP_FIXED))
+    scm_misc_error ("mmap", "cannot have NULL addr w/ MAP_FIXED", SCM_EOL);
+
+  SCM_SYSCALL (c_mem = mmap(c_addr, c_len, c_prot, c_flags, c_fd, c_offset));
+  if (c_mem == MAP_FAILED)
+    scm_syserror ("mmap");              /* errno set */
+
+  /* The fd is free to go now. */
+  scm_dynwind_end ();
+
+  pointer = scm_from_pointer ((signed char *) c_mem, mmap_finalizer);
+  bvec = scm_pointer_to_bytevector (pointer, c_len, c_offset,
+                                    SCM_ARRAY_ELEMENT_TYPE_VU8);
+
+  return bvec;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_mmap, "mmap", 2, 4, 0,
+            (SCM addr, SCM len, SCM prot, SCM flags, SCM file, SCM offset),
+	    "Create a memory mapping, returning a bytevector.  @var{addr}, if\n"
+	    "non-zero, is the staring address; or, if zero, is assigned by the\n"
+	    "system.  @var{prot}, if provided, assigns protection.\n"
+            "@var{file}, a port or fd, if provided associates the memory\n"
+            "region with a file, starting at @var{offset}, if provided.\n"
+	    "The region returned by mmap will NOT be searched by the garbage\n"
+	    "collector for pointers. See also mmap/search.  Note that the\n"
+            "finalizer for the returned bytevector will call munmap.\n"
+	    "Defaults for arguments are:\n"
+	    "@table @asis\n"
+	    "@item prot\n(logior PROT_READ PROT_WRITE)\n"
+	    "@item flags\n(logior MAP_ANONYMOUS MAP_PRIVATE)\n"
+	    "@item fd\n-1\n"
+	    "@item offset\n0\n"
+	    "@end table")
+#define FUNC_NAME s_scm_mmap
+{
+  void *c_mem;
+  size_t c_len;
+  SCM bvec;
+
+  bvec = scm_mmap_search(addr, len, prot, flags, file, offset);
+  c_mem = SCM_BYTEVECTOR_CONTENTS(bvec);
+  c_len = SCM_BYTEVECTOR_LENGTH(bvec);
+
+  /* Tell GC not to scan for pointers. */
+  GC_exclude_static_roots(c_mem, (char*) c_mem + c_len);
+
+  return bvec;
+}
+#undef FUNC_NAME
+
+/* The following copied from bytevectors.c. Kludge? */
+#define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len)            \
+  SCM_SET_CELL_WORD_1 ((_bv), (scm_t_bits) (_len))
+#define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _contents)	\
+  SCM_SET_CELL_WORD_2 ((_bv), (scm_t_bits) (_contents))
+
+SCM_DEFINE (scm_munmap, "munmap", 1, 0, 0,
+            (SCM bvec),
+	    "Given bytevector generated by mmap or mmap/search, unmap the\n"
+            "the associated memory.  The argument will be modified to \n"
+            "reflect a zero length bv. The return value is unspecified.\n"
+            "Note that munmap is called by finalizer associated with\n"
+            "bytevectors returned from mmap and mmap/search.\n")
+#define FUNC_NAME s_scm_munmap
+{
+  void *addr;
+  size_t len;
+  int rv;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bvec);
+
+  addr = (void *) SCM_BYTEVECTOR_CONTENTS (bvec);
+  len = SCM_BYTEVECTOR_LENGTH (bvec);
+
+  /* Invalidate further work on this bytevector. */
+  SCM_BYTEVECTOR_SET_LENGTH (bvec, 0);
+  SCM_BYTEVECTOR_SET_CONTENTS (bvec, NULL);
+
+  SCM_SYSCALL (rv = munmap(addr, len));
+  if (rv == -1)
+    SCM_SYSERROR;			/* errno set */
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+#ifdef HAVE_MSYNC
+SCM_DEFINE (scm_msync, "msync", 2, 0, 0,
+            (SCM bvec, SCM flags),
+	    "Flush changes made to the in-core copy of a file mapped using\n"
+            "mmap or mmap/search.  This should be executed on modified memory\n"
+            "before calling munmap.  The @var{flags} argument must be exactly\n"
+            "one of the following:\n"
+            "@table @code\n"
+            "@item MS_ASYNC\n"
+            "Initiate update, return immediately.\n"
+            "@item MS_SYNC\n"
+            "Initiate update, block until complete.\n"
+            "@item MS_INVALIDATE\n"
+            "Invalidate other mappings of the same file.\n"
+            "@end table\n"
+            "The return value is unspecified.")
+#define FUNC_NAME s_scm_msync
+{
+  void *addr;
+  size_t len;
+  int c_flags, rv;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bvec);
+  addr = (void *) SCM_BYTEVECTOR_CONTENTS (bvec);
+  len = SCM_BYTEVECTOR_LENGTH (bvec);
+
+  c_flags = scm_to_int (flags);
+
+  SCM_SYSCALL (rv = msync(addr, len, c_flags));
+  if (rv == -1)
+    SCM_SYSERROR;			/* errno set */
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif /* HAVE_MSYNC */
+
+static void init_mman(void) {
+  scm_add_feature("mman");
+
+#ifdef PROT_NONE
+  scm_c_define ("PROT_NONE", scm_from_int (PROT_NONE));
+#endif
+#ifdef PROT_READ
+  scm_c_define ("PROT_READ", scm_from_int (PROT_READ));
+#endif
+#ifdef PROT_WRITE
+  scm_c_define ("PROT_WRITE", scm_from_int (PROT_WRITE));
+#endif
+#ifdef PROT_EXEC
+  scm_c_define ("PROT_EXEC", scm_from_int (PROT_EXEC));
+#endif
+
+#ifdef MAP_ANONYMOUS
+  scm_c_define ("MAP_ANONYMOUS", scm_from_int (MAP_ANONYMOUS));
+#endif
+#ifdef MAP_ANON
+  scm_c_define ("MAP_ANON", scm_from_int (MAP_ANON));
+#endif
+#ifdef MAP_FILE
+  scm_c_define ("MAP_FILE", scm_from_int (MAP_FILE));
+#endif
+#ifdef MAP_FIXED
+  scm_c_define ("MAP_FIXED", scm_from_int (MAP_FIXED));
+#endif
+#ifdef MAP_HASSEMAPHORE
+  scm_c_define ("MAP_HASSEMAPHORE", scm_from_int (MAP_HASSEMAPHORE));
+#endif
+#ifdef MAP_PRIVATE
+  scm_c_define ("MAP_PRIVATE", scm_from_int (MAP_PRIVATE));
+#endif
+#ifdef MAP_SHARED
+  scm_c_define ("MAP_SHARED", scm_from_int (MAP_SHARED));
+#endif
+#ifdef MAP_NOCACHE
+  scm_c_define ("MAP_NOCACHE", scm_from_int (MAP_NOCACHE));
+#endif
+  scm_c_define ("PAGE_SIZE", scm_from_int (sysconf (_SC_PAGESIZE)));
+#ifdef MS_ASYNC
+  scm_c_define ("MS_ASYNC", scm_from_int (MS_ASYNC));
+#endif
+#ifdef MS_SYNC
+  scm_c_define ("MS_SYNC", scm_from_int (MS_SYNC));
+#endif
+#ifdef MS_INVALIDATE
+  scm_c_define ("MS_INVALIDATE", scm_from_int (MS_INVALIDATE));
+#endif
+}
+
+#endif /* HAVE_SYS_MMAN_H */
+
+\f
+
 void
 scm_init_filesys ()
 {
@@ -2387,6 +2700,9 @@ scm_init_filesys ()
 #ifdef HAVE_READLINKAT
   scm_add_feature("readlink-port");
 #endif
+#if defined(HAVE_SYS_MMAN_H)
+  init_mman();
+#endif
 
 #include "filesys.x"
 }
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 1ce50d30e..fa40b484f 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -80,6 +80,10 @@ SCM_API SCM scm_dirname (SCM filename);
 SCM_API SCM scm_basename (SCM filename, SCM suffix);
 SCM_API SCM scm_canonicalize_path (SCM path);
 SCM_API SCM scm_sendfile (SCM out, SCM in, SCM count, SCM offset);
+SCM_API SCM scm_mmap_search(SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset);
+SCM_API SCM scm_mmap(SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset);
+SCM_API SCM scm_msync(SCM bvec, SCM flags);
+SCM_API SCM scm_munmap(SCM bvec);
 SCM_INTERNAL SCM scm_i_relativize_path (SCM path, SCM in_path);
 
 SCM_INTERNAL void scm_init_filesys (void);
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 16fa2e952..3785e2f85 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -77,6 +77,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/load.test			\
 	    tests/match.test			\
 	    tests/match.test.upstream		\
+	    tests/mman.test			\
 	    tests/modules.test			\
 	    tests/multilingual.nottest		\
 	    tests/net-db.test			\
diff --git a/test-suite/tests/mman.test b/test-suite/tests/mman.test
new file mode 100644
index 000000000..592a800f8
--- /dev/null
+++ b/test-suite/tests/mman.test
@@ -0,0 +1,48 @@
+;;;; mman.test --- Tests for mmap API.    -*- scheme -*-
+;;;;
+;;;; Copyright 2022 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library 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
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-mman)
+  #:use-module (test-suite lib)
+  #:use-module (test-suite guile-test)
+  #:use-module (rnrs bytevectors)
+  #:declarative? #f
+  )
+
+(define (mmap-test-file)
+  (data-file-name "foo.txt"))
+
+(define mmap-test-string "hello, world")
+
+(define (gen-mmap-test-file)
+  (with-output-to-file (mmap-test-file)
+    (lambda () (display mmap-test-string))))
+
+(when (provided? 'mman)
+
+  (gen-mmap-test-file)
+
+  (with-test-prefix "mman"
+
+    (pass-if "mman 1"
+      (let ((bv (mmap 0 #x100)))
+        (bytevector-u8-set! bv 0 34)
+        (= (bytevector-u8-ref bv 0) 34)))
+
+    ))
+
+;; --- last line ---

^ permalink raw reply related	[flat|nested] 16+ messages in thread

* bug#27782: mman patch for v3.0.9
  2023-02-14 14:50 ` bug#27782: mman patch for v3.0.9 Matt Wette
@ 2023-03-01 13:31   ` Matt Wette
  0 siblings, 0 replies; 16+ messages in thread
From: Matt Wette @ 2023-03-01 13:31 UTC (permalink / raw)
  To: 27782

I think this is still not there.
I have found additional issues with some suggested updates.

Maybe we should have a branch in the guile repo for this.







^ permalink raw reply	[flat|nested] 16+ messages in thread

end of thread, other threads:[~2023-03-01 13:31 UTC | newest]

Thread overview: 16+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-07-21 13:39 bug#27782: [wishlist] scheme level mmap Matt Wette
     [not found] ` <handler.27782.B.150064439025677.ack@debbugs.gnu.org>
2017-07-21 14:35   ` bug#27782: Acknowledgement ([wishlist] scheme level mmap) Matt Wette
2017-10-28 15:25 ` bug#27782: mmap for guile 2.2.2 Matt Wette
2017-10-28 17:09   ` Matt Wette
2017-11-24 15:54 ` bug#27782: mmap for guile Matt Wette
2017-11-24 16:22   ` Nala Ginrut
2017-11-24 17:09     ` Matt Wette
2017-11-25 14:41       ` Matt Wette
2017-11-25 16:17         ` Nala Ginrut
2020-07-04 19:40 ` bug#27782: new patch for mma Matt Wette
2020-07-09 12:45   ` Ludovic Courtès
2022-12-21  1:21 ` bug#27782: patch to add support for mmap and friends Matt Wette
2022-12-22 18:49   ` Matt Wette
2023-01-14  0:49 ` bug#27782: patch " Matt Wette
2023-02-14 14:50 ` bug#27782: mman patch for v3.0.9 Matt Wette
2023-03-01 13:31   ` Matt Wette

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).