Subject: mmap for guile

From: Matt Wette <[email-masked]>
Date: Fri, 24 Nov 2017 07:54:07 -0800

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 */