From 5c6a7120bb920328d12ce8a6152439d584b905f2 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 17 Nov 2007 23:06:34 -0500
Subject: [PATCH] Get io.mmap working on Windows CE

---
 extra/io/mmap/mmap.factor         |  0
 extra/io/windows/mmap/mmap.factor | 31 ++++++++++++++++---------------
 2 files changed, 16 insertions(+), 15 deletions(-)
 mode change 100644 => 100755 extra/io/mmap/mmap.factor
 mode change 100644 => 100755 extra/io/windows/mmap/mmap.factor

diff --git a/extra/io/mmap/mmap.factor b/extra/io/mmap/mmap.factor
old mode 100644
new mode 100755
diff --git a/extra/io/windows/mmap/mmap.factor b/extra/io/windows/mmap/mmap.factor
old mode 100644
new mode 100755
index 2742d1b006..b291bb6bcd
--- a/extra/io/windows/mmap/mmap.factor
+++ b/extra/io/windows/mmap/mmap.factor
@@ -1,7 +1,7 @@
 USING: alien alien.c-types alien.syntax arrays continuations
 destructors generic io.mmap io.nonblocking io.windows
 kernel libc math namespaces quotations sequences windows
-windows.advapi32 windows.kernel32 ;
+windows.advapi32 windows.kernel32 io.backend ;
 IN: io.windows.mmap
 
 TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
@@ -51,12 +51,16 @@ TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
         dup length f f AdjustTokenPrivileges win32-error=0/f
     ] with-process-token ;
 
-: with-privileges ( seq quot -- )
+HOOK: with-privileges io-backend ( seq quot -- ) inline
+
+M: windows-nt-io with-privileges
     over [ [ t set-privilege ] each ] curry compose
     swap [ [ f set-privilege ] each ] curry [ ] cleanup ;
 
-: mmap-open ( path access-mode create-mode flProtect access length -- handle handle address )
-    drop
+M: windows-ce-io with-privileges
+    nip call ;
+
+: mmap-open ( path access-mode create-mode flProtect access -- handle handle address )
     { "SeCreateGlobalPrivilege" "SeLockMemoryPrivilege" } [
         >r >r open-file dup f r> 0 0 f
         CreateFileMapping [ win32-error=0/f ] keep
@@ -68,20 +72,17 @@ TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
     
 M: windows-io <mapped-file> ( path length -- mmap )
     [
-        [
-            >r
-            GENERIC_WRITE GENERIC_READ bitor
-            OPEN_ALWAYS
-            PAGE_READWRITE SEC_COMMIT bitor
-            FILE_MAP_ALL_ACCESS r> mmap-open
-        ] keep
-    -roll -rot 2array \ mapped-file construct-boa
+        swap
+        GENERIC_WRITE GENERIC_READ bitor
+        OPEN_ALWAYS
+        PAGE_READWRITE SEC_COMMIT bitor
+        FILE_MAP_ALL_ACCESS mmap-open
+        -rot 2array
+        \ mapped-file construct-boa
     ] with-destructors ;
 
 M: windows-io close-mapped-file ( mapped-file -- )
     [
-        dup mapped-file-handle [
-            close-always
-        ] each
+        dup mapped-file-handle [ close-always ] each
         mapped-file-address UnmapViewOfFile win32-error=0/f
     ] with-destructors ;