From 99e9ef6c571e7181bdedc4986242b2e50bdd51ac Mon Sep 17 00:00:00 2001
From: Ralph Ronnquist <ralph.ronnquist@gmail.com>
Date: Tue, 18 Apr 2023 22:20:50 +1000
Subject: [PATCH] Added mmap utility and test

---
 lsp-misc/mmap.lsp | 47 +++++++++++++++++++++++++++++++++++++++++++++++
 lsp-misc/test.lsp |  8 ++++++++
 2 files changed, 55 insertions(+)
 create mode 100644 lsp-misc/mmap.lsp
 create mode 100644 lsp-misc/test.lsp

diff --git a/lsp-misc/mmap.lsp b/lsp-misc/mmap.lsp
new file mode 100644
index 0000000..639b1c9
--- /dev/null
+++ b/lsp-misc/mmap.lsp
@@ -0,0 +1,47 @@
+;; This newlisp module implements mmap access to file regions.
+;;
+
+(unless foop (load "foop.lsp"))
+
+(context 'MAIN:MMap)
+
+(FOOP base len prot flags fd offset)
+
+(constant 'LIBC (exists file? '("/lib/x86_64-linux-gnu/libc.so.6")))
+(unless LIBC (die "cannot find libc"))
+
+(import LIBC "mmap" "void*" 
+        "void*" ; void *addr
+        "long" ; size_t length
+        "int" ; int prot
+        "int" ; int flags
+        "int" ; int fd
+        "long" ; off_t offset
+        )
+(import LIBC "munmap" "int"
+        "void*" ; void *addr
+        "long" ; size_t length
+        )
+(import LIBC "lseek" "long"
+        "int" ; int fd
+        "long" ; off_t offset,
+        "int" ; int whence
+        )
+
+(constant
+ 'PROT_READ 0x01
+ 'MAP_SHARED 0x01
+ 'SEEK_END 2
+ )
+
+;; Creates a new mapping in the virtual address space of the calling
+;; process.
+(define (MMap:MMap FD LENGTH (OFFSET 0))
+  (when (string? FD) (setf FD (open FD "r")))
+  (let ((D (list (context) nil LENGTH 0 0 FD OFFSET)))
+    (when (< LENGTH) (setf (D 2) (lseek FD 0 SEEK_END)))
+    (setf (D 1) (mmap 0 (D 2) PROT_READ MAP_SHARED FD OFFSET))
+    D))
+
+(define (Unmap)
+  (munmap (%base) (%len)))
diff --git a/lsp-misc/test.lsp b/lsp-misc/test.lsp
new file mode 100644
index 0000000..94730fa
--- /dev/null
+++ b/lsp-misc/test.lsp
@@ -0,0 +1,8 @@
+(load "mmap.lsp")
+
+(println (symbols MMap))
+(println MMap:%len)
+
+(println (setf X (MMap "mmap.lsp")))
+(println (get-string (:%base X)))
+(:Unmap X)
-- 
2.39.2