* 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; 19+ 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] 19+ 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; 19+ 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] 19+ 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; 19+ 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] 19+ 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; 19+ 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] 19+ 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; 19+ 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] 19+ 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; 19+ 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] 19+ 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; 19+ 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] 19+ 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; 19+ 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] 19+ 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; 19+ 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] 19+ 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; 19+ 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] 19+ 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; 19+ 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] 19+ 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; 19+ 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] 19+ 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; 19+ 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] 19+ 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; 19+ 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] 19+ messages in thread
* bug#27782: patch for mmap and friends
[not found] <1ee846ab-e9ce-d616-94dd-0056e4b840f9@gmail.com>
@ 2023-01-14 1:00 ` Matt Wette
2023-01-14 15:18 ` Maxime Devos
[not found] ` <445d3567-9bbf-487b-f338-8a16903e9e62@telenet.be>
2 siblings, 0 replies; 19+ messages in thread
From: Matt Wette @ 2023-01-14 1:00 UTC (permalink / raw)
To: 27782, guile-devel
[-- Attachment #1: Type: text/plain, Size: 399 bytes --]
On 1/13/23 4:49 PM, Matt Wette wrote:
> 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
Please add the attached file: test-suite/tests/mman.test.
I thought it was included in the patch. It's the thought that counts,
right?
Matt
[-- Attachment #2: mman.test --]
[-- Type: text/plain, Size: 1493 bytes --]
;;;; 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 [flat|nested] 19+ messages in thread
* bug#27782: patch for mmap and friends
[not found] <1ee846ab-e9ce-d616-94dd-0056e4b840f9@gmail.com>
2023-01-14 1:00 ` bug#27782: patch for mmap and friends Matt Wette
@ 2023-01-14 15:18 ` Maxime Devos
[not found] ` <445d3567-9bbf-487b-f338-8a16903e9e62@telenet.be>
2 siblings, 0 replies; 19+ messages in thread
From: Maxime Devos @ 2023-01-14 15:18 UTC (permalink / raw)
To: Matt Wette, 27782, guile-devel
[-- Attachment #1.1.1: Type: text/plain, Size: 3395 bytes --]
On 14-01-2023 01:49, Matt Wette wrote:
> 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
> + if (SCM_UNBNDP (fd))
> + c_fd = -1;
> + else
> + c_fd = scm_to_int (fd);
Port objects should be accepted too, as previously asked on
<https://lists.gnu.org/archive/html/guile-user/2022-06/msg00060.html>.
As implied by later comments, using a raw fd causes problems with
'move->fdes'. For the remaining response, I'll assume that the function
accepts ports as well.
(---)
After this code, the port 'fd' becomes unreferenced by this function.
> + 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);
Hence, if the GC is run here, its possible for fd to be automatically
closed here.
> + SCM_SYSCALL (c_mem = mmap(c_addr, c_len, c_prot, c_flags, c_fd, c_offset));
As such, C 'mmap' could be called on a closed file descriptor even even
if the argument to Scheme 'mmap' was an open port, which isn't going to
work.
(While it is recommended for Scheme code to keep a reference to the port
to manually close afterwards, to free resources faster than waiting for
GC, it is not actually required.)
Worse, if the port is closed (by GC), in the mean time another thread
may have opened a new port, whose file descriptor coincides with c_fd.
To avoid this problem, you can add
scm_remember_upto_here_1 (fd);
after the SCM_SYSCALL.
Even then, a problem remains -- a concurrent thread might be using
'move->fdes' to 'move' the file descriptor, hence invalidating c_fd.
Functions like 'scm_seek' handle this with 'scm_dynwind_acquire_port'
(IIUC, it takes a mutex to delay concurrent 'move->fdes' until finished).
IIUC, the solution then looks like (ignoring wrapping) (the lack of
scm_remember_upto_here_1 is intentional):
scm_dynwind_begin (0);
scm_dynwind_acquire_port (fd); // (accepts both ports and numbers, IIUC)
// needs to be after scm_dynwind_acquire_port
if (SCM_UNBNDP (fd))
c_fd = -1;
else
c_fd = scm_to_int (fd);
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");
scm_dynwind_end ();
(I'm not really familiar with scm_dynwind_begin & friends, I'm mostly
copy-pasting from libguile/ports.c here.)
> + 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));
IIRC there is a C trick involving fields, arrays and types to check this
at compile-time instead. Maybe:
struct whatever {
/* if availability of zero-length arrays can be assumed */
int foo[sizeof(size_t) - sizeof(void*)];
/* alternatively, a weaker but portable check */
int foo[sizeof(size_t) - sizeof(void*) + 1];
};
Greetings,
Maxime.
[-- Attachment #1.1.2: OpenPGP public key --]
[-- Type: application/pgp-keys, Size: 929 bytes --]
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 236 bytes --]
^ permalink raw reply [flat|nested] 19+ messages in thread
* bug#27782: patch for mmap and friends
[not found] ` <23890f8a-8891-d888-b289-c0d06304fff1@telenet.be>
@ 2023-01-14 23:46 ` Matt Wette
0 siblings, 0 replies; 19+ messages in thread
From: Matt Wette @ 2023-01-14 23:46 UTC (permalink / raw)
To: Maxime Devos, guile-devel; +Cc: 27782
On 1/14/23 2:42 PM, Maxime Devos wrote:
> {
> /* 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_fileno (file);
> }
Thanks. I'll try this, modulo update to scm_to_int (scm_fileno (file)).
Matt
^ permalink raw reply [flat|nested] 19+ 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; 19+ 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] 19+ 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; 19+ 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] 19+ messages in thread
end of thread, other threads:[~2023-03-01 13:31 UTC | newest]
Thread overview: 19+ 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
[not found] <1ee846ab-e9ce-d616-94dd-0056e4b840f9@gmail.com>
2023-01-14 1:00 ` bug#27782: patch for mmap and friends Matt Wette
2023-01-14 15:18 ` Maxime Devos
[not found] ` <445d3567-9bbf-487b-f338-8a16903e9e62@telenet.be>
[not found] ` <5fda49f2-6e23-9a53-85d2-c1cc38cf0cce@gmail.com>
[not found] ` <c7e20254-6387-00c4-ea15-f3ed64668923@gmail.com>
[not found] ` <23890f8a-8891-d888-b289-c0d06304fff1@telenet.be>
2023-01-14 23:46 ` 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).