steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Get io.mmap working on Windows CE

release
Slava Pestov 2007-11-17 23:06:34 -05:00
parent 9859d6456a
commit 5c6a7120bb
2 changed files with 16 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

0
extra/io/mmap/mmap.factor Normal file → Executable file
View File

25
extra/io/windows/mmap/mmap.factor Normal file → Executable file
View File

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