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 */
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 */
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
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.
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 */
[-- 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 --]
[-- 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 --]
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 #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 --]
[-- 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 ---
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’.
[-- 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
Please disregard previous patch. I have more to do. I'll try to catch the next release cycle.
[-- 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
[-- 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 ---
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.