Subject: bug#27782: Acknowledgement ([wishlist] scheme level mmap)

From: Matt Wette <[email-masked]>
Date: Fri, 21 Jul 2017 07:35:31 -0700

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