ffi: provide mmap through carray.

* configure: configure test for mmap depositing HAVE_MMAP into
config.h.

* ffi.c (struct carray): Subject to HAVE_MMAP, new mm_len
member which keeps track of the size of an underlying mapping
so that we can unmap it, as well as peform operations like
msync on it.
(make_carray): Initialize mm_len to 0.
(MAP_GROWSDOWN, MAP_LOCKED, MAP_NORESERVE, MAP_POPULATE,
MAP_NONBLOCK, MAP_STACK, MAP_HUGETLB, MAP_SHARED, MAP_PRIVATE,
MAP_FIXED, MAP_ANON, MAP_HUGE_SHIFT, MAP_HUGE_MASK, PROT_READ,
PROT_WRITE, PROT_EXEC, PROT_NONE, PROT_GROWSDOWN,
PROT_GROWSUP, MADV_NORMAL, MADV_RANDOM, MADV_SEQUENTIAL,
MADV_WILLNEED, MADV_DONTNEED, MADV_FREE, MADV_REMOVE,
MADV_DONTFORK, MADV_DOFORK, MADV_MERGEABLE, MADV_UNMERGEABLE,
MADV_HUGEPAGE, MADV_NOHUGEPAGE, MADV_DONTDUMP, MADV_DODUMP,
MADV_WIPEONFORK, MADV_KEEPONFORK, MADV_HWPOISON, MS_ASYNC,
MS_SYNC, MS_INVALIDATE): #define as 0 if missing.

(carray_munmap_op): New static function.
(carray_mmap_ops): New static structure.
(mmap_wrap, munmap_wrap): New functions.
(mmap_op): New static function.
(mprotect_wrap, madvise_wrap, msync_wrap): New functions.
(ffi_init): Register mmap, munmap, mprotect, madvise and msync
as well as numerous integer variables: map-growsdown,
map-locked, map-noreserve, map-populate, map-nonblock,
map-stack, map-hugetlb, map-shared, map-private, map-fixed,
map-anon, map-huge-shift, map-huge-mask, prot-read,
prot-write, prot-exec, prot-none, prot-growsdown,
prot-growsup, madv-normal, madv-random, madv-sequential,
madv-willneed, madv-dontneed, madv-free, madv-remove,
madv-dontfork, madv-dofork, madv-mergeable, madv-unmergeable,
madv-hugepage, madv-nohugepage, madv-dontdump, madv-dodump,
madv-wipeonfork, madv-keeponfork, madv-hwpoison, ms-async,
ms-sync, ms-invalidate, page-size.

* ffi.h (mmap_wrap, munmap_wrap, mprotect_wrap madvise_wrap,
msync_wrap): Declared.

* tests/017/mmap.tl: New file.

* txr.1: Documented.

* stdlib/doc-syms.tl: Updated.

1 files changed, 52 insertions, 0 deletions

diff --git a/tests/017/mmap.tl b/tests/017/mmap.tl
new file mode 100644
index 00000000..aab86a0e
--- /dev/null
+++ b/tests/017/mmap.tl
@@ -0,0 +1,52 @@
+(load "../common")
+
+(defun parent (wp mm)
+  (with-stream (s (open-fileno wp "w"))
+    (each ((i 0..1024))
+      (set [mm i] i))
+    (put-char #\X s)))
+
+(defun child (rp mm)
+  (let ((s (open-fileno rp "r")))
+    (assert (eq (get-char s) #\X))
+    (each ((i 0..1024))
+      (assert (eql [mm i] i)))))
+
+(let ((mm (mmap (ffi uint32) 4096
+                (logior prot-read prot-write)
+                (logior map-anon map-shared))))
+  (tree-bind (rp . wp) (pipe)
+    (match-ecase (fork)
+      (0 (child rp mm)
+         (exit t))
+      (-1 (error "fork failed"))
+      (@pid (parent wp mm)
+            (tree-bind (p . s) (wait pid)
+              (unless (zerop s)
+                (error "child failed")))))))
+
+(assert (plusp page-size))
+
+(let* ((mk-rnd-buf (opip (expt 256 page-size) rand buf-uint))
+       (rndbuf0 [mk-rnd-buf])
+       (rndbuf1 [mk-rnd-buf])
+       (fname "rand.bin"))
+  (unwind-protect
+    (progn
+      (file-put-buf fname rndbuf0)
+      (let* ((mm (mmap (ffi uchar) page-size
+                       (logior prot-read prot-write)
+                       (logior map-shared)
+                       fname)))
+        (each ((i 0..page-size))
+          (assert (eq [rndbuf0 i] [mm i]))
+          (set [mm i] [rndbuf1 i]))
+        (msync mm ms-sync)
+        (assert (equal (file-get-buf fname) rndbuf1))
+        (each ((i 0..page-size))
+          (set [mm i] [rndbuf0 i]))
+        (munmap mm))
+      (assert (equal (file-get-buf fname) rndbuf0)))
+    (remove-path fname)))
+
+(assert (null (ignerr (mmap (ffi char) 4096 prot-read map-anon))))