bug#27782: mmap for guile

2017-11-24 Thread Matt Wette





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.0 -0800
+++ libguile/filesys.c  2017-10-28 10:05:10.0 -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.orig2017-10-28 10:05:10.0 -0700
+++ libguile/mman.c 2017-11-04 09:23:35.0 -0700
@@ -0,0 +1,199 @@
+// mman.c - v171104a
+#ifdef HAVE_CONFIG_H
+#  include 
+#endif
+
+#ifdef HAVE_SYS_MMAN_H
+#  include 
+#  include 
+#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 #x10)\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 =

bug#27782: mmap for guile

2017-11-24 Thread Nala Ginrut
Thanks for the work! Could you please add MAP_POPULATE too?

2017年11月24日 下午11:55,"Matt Wette" 写道:

>
>
>
>
>
> 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.0 -0800
> +++ libguile/filesys.c  2017-10-28 10:05:10.0 -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.orig2017-10-28 10:05:10.0 -0700
> +++ libguile/mman.c 2017-11-04 09:23:35.0 -0700
> @@ -0,0 +1,199 @@
> +// mman.c - v171104a
> +#ifdef HAVE_CONFIG_H
> +#  include 
> +#endif
> +
> +#ifdef HAVE_SYS_MMAN_H
> +#  include 
> +#  include 
> +#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 #x10)\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_

bug#27782: mmap for guile

2017-11-24 Thread Matt Wette
got it.

> On Nov 24, 2017, at 8:22 AM, Nala Ginrut  wrote:
> 
> Thanks for the work! Could you please add MAP_POPULATE too?
> 
> 2017年11月24日 下午11:55,"Matt Wette"  >写道:
> 
> 
> 
> 
> 
> 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.0 -0800
> +++ libguile/filesys.c  2017-10-28 10:05:10.0 -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.orig2017-10-28 10:05:10.0 -0700
> +++ libguile/mman.c 2017-11-04 09:23:35.0 -0700
> @@ -0,0 +1,199 @@
> +// mman.c - v171104a
> +#ifdef HAVE_CONFIG_H
> +#  include 
> +#endif
> +
> +#ifdef HAVE_SYS_MMAN_H
> +#  include 
> +#  include 
> +#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 #x10)\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_PO