basis/io/mmap/windows/windows.factor

   1 USING: alien alien.c-types arrays destructors generic io.mmap
   2 io.ports io.backend.windows io.files.windows io.backend.windows.privileges
   3 io.mmap.private kernel libc math math.bitwise namespaces quotations sequences
   4 windows windows.advapi32 windows.kernel32 io.backend system
   5 accessors locals windows.errors literals ;
   6 IN: io.mmap.windows
   7
   8 : create-file-mapping ( hFile lpAttributes flProtect dwMaximumSizeHigh dwMaximumSizeLow lpName -- HANDLE )
   9     CreateFileMapping [ win32-error=0/f ] keep <win32-handle> ;
  10
  11 : map-view-of-file ( hFileMappingObject dwDesiredAccess dwFileOffsetHigh dwFileOffsetLow dwNumberOfBytesToMap -- HANDLE )
  12     MapViewOfFile [ win32-error=0/f ] keep ;
  13
  14 :: mmap-open ( path length access-mode create-mode protect access -- handle handle address )
  15     length 32 bits :> lo
  16     length -32 shift 32 bits :> hi
  17     { "SeCreateGlobalPrivilege" "SeLockMemoryPrivilege" } [
  18         path access-mode create-mode 0 open-file |dispose
  19         dup handle>> f protect hi lo f create-file-mapping |dispose
  20         dup handle>> access 0 0 0 map-view-of-file
  21     ] with-privileges ;
  22
  23 TUPLE: win32-mapped-file file mapping ;
  24
  25 M: win32-mapped-file dispose
  26     [ file>> dispose ] [ mapping>> dispose ] bi ;
  27
  28 C: <win32-mapped-file> win32-mapped-file
  29
  30 M: windows (mapped-file-r/w)
  31     [
  32         flags{ GENERIC_WRITE GENERIC_READ }
  33         OPEN_ALWAYS
  34         flags{ PAGE_READWRITE SEC_COMMIT }
  35         FILE_MAP_ALL_ACCESS mmap-open
  36         -rot <win32-mapped-file>
  37     ] with-destructors ;
  38
  39 M: windows (mapped-file-reader)
  40     [
  41         GENERIC_READ
  42         OPEN_ALWAYS
  43         flags{ PAGE_READONLY SEC_COMMIT }
  44         FILE_MAP_READ mmap-open
  45         -rot <win32-mapped-file>
  46     ] with-destructors ;
  47
  48 M: windows close-mapped-file ( mapped-file -- )
  49     [
  50         [ handle>> &dispose drop ]
  51         [ address>> UnmapViewOfFile win32-error=0/f ] bi
  52     ] with-destructors ;